5 use lib '/openils/lib/perl5';
8 use OpenSRF::EX qw/:try/;
9 use OpenSRF::AppSession;
10 use OpenSRF::Utils::SettingsClient;
11 use OpenILS::Utils::Fieldmapper;
12 use Digest::MD5 qw/md5_hex/;
16 use Time::HiRes qw/time/;
19 my ($file,$config,$profileid,$identtypeid,$default_profile,$profile_map,$seenmap,$nosaveseen,$usermap) =
20 ('return_file_0623-2.xml', '/openils/conf/opensrf_core.xml', 1, 3, 'User', 'profile.map','/tmp/patron-import.seen');
23 'usermap=s' => \$usermap,
25 'config=s' => \$config,
26 'seenmap=s' => \$seenmap,
27 'no_save_seenmap' => \$nosaveseen,
28 'default_profile=i' => \$default_profile,
29 'profile_map=s' => \$profile_map,
30 'profile_statcat_id=i' => \$profileid,
31 'identtypeid=i' => \$identtypeid,
37 while (my $line = <F>) {
39 my ($b,$i) = split(/\|/, $line);
40 $b =~ s/^\s*(\S+)\s*$/$1/o;
41 $i =~ s/^\s*(\S+)\s*$/$1/o;
50 while (my $line = <F>) {
52 my ($b,$i) = split(/\|/, $line);
53 $b =~ s/^\s*(\S+)\s*$/$1/o;
54 $i =~ s/^\s*(\S+)\s*$/$1/o;
63 while (my $line = <F>) {
65 next if ($line eq '');
71 my $doc = XML::LibXML->new->parse_file($file);
73 OpenSRF::System->bootstrap_client( config_file => $config );
74 Fieldmapper->import(IDL => OpenSRF::Utils::SettingsClient->new->config_value("IDL"));
76 my $cstore = OpenSRF::AppSession->create( 'open-ils.cstore' );
78 my $profiles = $cstore->request(
79 'open-ils.cstore.direct.permission.grp_tree.search.atomic',
80 { id => { '!=' => undef } },
83 my $orgs = $cstore->request(
84 'open-ils.cstore.direct.actor.org_unit.search.atomic',
85 { id => { '!=' => undef } },
88 $profiles = { map { ($_->name => $_->id) } @$profiles };
89 $orgs = { map { ($_->shortname => $_->id) } @$orgs };
93 for my $patron ( $doc->documentElement->childNodes ) {
94 next if ($patron->nodeType == 3);
95 my $p = new Fieldmapper::actor::user;
96 my $card = new Fieldmapper::actor::card;
97 my $profile_sce = new Fieldmapper::actor::stat_cat_entry_user_map;
99 my $old_profile = $patron->findvalue( 'user_profile' );
101 my $bc = $patron->findvalue( 'user_id' );
102 if (exists($s_map{$bc})) {
104 warn "\n!!! already saw barcode $bc, skipping\n";
110 unless (defined($bc)) {
111 my $xml = $patron->toString;
112 warn "\n!!! no barcode found in UMS data, user number $count, xml => $xml \n";
122 warn "\n!!! no uid mapping found for barcode $bc\n";
131 warn "\n!!! user id lower than 2\n";
135 $card->barcode( $bc );
137 $card->active( 't' );
141 $p->passwd( $patron->findvalue( 'user_pin' ) );
143 my $new_profile = $p_map{$old_profile} || $default_profile;
145 $p->profile( $$profiles{$new_profile} );
148 warn "\n!!! no new profile found for $old_profile\n";
156 $p->master_account('f');
159 $p->claims_returned_count(0);
160 $p->credit_forward_balance(0);
161 $p->last_xact_id('IMPORT-'.$starttime);
164 $p->barred('t') if ( $patron->findvalue( 'user_status' ) eq 'BARRED' );
166 $p->ident_type( $identtypeid );
167 my $id_val = $patron->findvalue( 'user_altid' );
168 $p->ident_value( $id_val ) if ($id_val);
170 my ($fname,$mname,$lname) = ($patron->findvalue('first_name'),$patron->findvalue('middle_name'),$patron->findvalue('last_name'));
180 $p->first_given_name( $fname );
181 $p->second_given_name( $mname );
182 $p->family_name( $lname );
184 $p->day_phone( $patron->findvalue( 'Address/dayphone' ) );
185 $p->evening_phone( $patron->findvalue( 'Address/homephone' ) );
186 $p->other_phone( $patron->findvalue( 'Address/workphone' ) );
188 my $hlib = $$orgs{$patron->findvalue( 'user_library' )};
191 warn "\n!!! no home library found in patron record\n";
194 $p->home_ou( $hlib );
196 $p->dob( parse_date( $patron->findvalue( 'birthdate' ) ) );
197 $p->create_date( parse_date( $patron->findvalue( 'user_priv_granted' ) ) );
198 $p->expire_date( parse_date( $patron->findvalue( 'user_priv_expires' ) ) );
200 $p->alert_message("Legacy Import Message: old profile was FIXME")
201 if ($old_profile eq 'FIXME');
204 $net_access = 2 if ($old_profile =~ /^U.I/o);
205 $net_access = 3 if ($old_profile =~ /^X.I/o);
207 $p->net_access_level( $net_access );
209 $profile_sce->target_usr( $uid );
210 $profile_sce->stat_cat( $profileid );
211 $profile_sce->stat_cat_entry( $old_profile );
214 my $mailing_addr_id = $patron->findvalue( 'user_mailingaddr' );
217 for my $addr ( $patron->findnodes( "Address" ) ) {
219 $p->email( $patron->findvalue( 'email' ) );
224 my $line1 = $addr->findvalue( "${prefix}line1" );
225 $prefix = 'std_' if (!$line1);
227 $line1 = $addr->findvalue( "${prefix}line1" );
228 next unless ($line1);
230 my $a = new Fieldmapper::actor::user_address;
232 $a->street1( $line1 );
233 $a->street2( $addr->findvalue( "${prefix}line2" ) );
234 $a->city( $addr->findvalue( "${prefix}city" ) );
235 $a->state( $addr->findvalue( "${prefix}state" ) );
237 $addr->findvalue( "${prefix}zip" ) .
238 '-' . $addr->findvalue( "${prefix}zip4" )
242 $a->valid( 't' ) if ($prefix eq 'std_');
243 $a->valid( 'f' ) if ($prefix eq 'std_' and $addr->findvalue( "${prefix}dpvscore" ) < 3);
245 $a->within_city_limits( 'f' );
248 if ($addr->getAttribute('addr_type') == $mailing_addr_id) {
249 $a->address_type( 'LEGACY MAILING' );
251 $a->address_type( 'LEGACY' );
256 if ($prefix eq 'coa_') {
260 $line1 = $addr->findvalue( "${prefix}line1" );
261 next unless ($line1);
263 $a = new Fieldmapper::actor::user_address;
265 $a->street1( $line1 );
266 $a->street2( $addr->findvalue( "${prefix}line2" ) );
267 $a->city( $addr->findvalue( "${prefix}city" ) );
268 $a->state( $addr->findvalue( "${prefix}state" ) );
270 $addr->findvalue( "${prefix}zip" ) .
271 '-' . $addr->findvalue( "${prefix}zip4" )
276 $a->within_city_limits( 'f' );
279 $a->address_type( 'LEGACY' );
285 if ($all_valid eq 'f') {
286 $_->valid('f') for (@addresses);
290 for my $note_field ( qw#note comment voter bus_school Address/phone1 Address/phone2# ) {
291 for my $note ( $patron->findnodes( $note_field) ) {
292 my $a = new Fieldmapper::actor::usr_note;
295 $a->create_date('now');
297 $a->title( "Legacy ".$note->localName );
298 $a->value( $note->textContent );
304 print STDERR "\r$count ".$count/(time - $starttime) unless ($count % 100);
305 print JSON->perl2JSON( $_ )."\n" for ($p,$card,$profile_sce,@addresses,@notes);
310 unless ($nosaveseen) {
311 warn "writing seen_map $seenmap...\n";
314 print F "$_\n" for (keys %s_map);
327 if ($string eq 'NEVER') {
328 my (undef,undef,undef,$d,$m,$y) = localtime();
329 return sprintf('%04d-%02d-%02d', $y + 1920, $m + 1, $d);
330 } elsif (length($string) == 8 && $string =~ /^(\d{4})(\d{2})(\d{2})$/o) {
331 ($y,$m,$d) = ($1,$2,$3);
332 } elsif ($string =~ /(\d+)\D(\d+)\D(\d+)/o) { #looks like it's parsable
333 if ( length($3) > 2 ) { # looks like mm.dd.yyyy
334 if ( $1 < 99 && $2 < 99 && $1 > 0 && $2 > 0 && $3 > 0) {
335 if ($1 > 12 && $1 < 31 && $2 < 13) { # well, actually it looks like dd.mm.yyyy
336 ($y,$m,$d) = ($3,$2,$1);
337 } elsif ($2 > 12 && $2 < 31 && $1 < 13) {
338 ($y,$m,$d) = ($3,$1,$2);
341 } elsif ( length($1) > 3 ) { # format probably yyyy.mm.dd
342 if ( $3 < 99 && $2 < 99 && $1 > 0 && $2 > 0 && $3 > 0) {
343 if ($2 > 12 && $2 < 32 && $3 < 13) { # well, actually it looks like yyyy.dd.mm -- why, I don't konw
344 ($y,$m,$d) = ($1,$3,$2);
345 } elsif ($3 > 12 && $3 < 31 && $2 < 13) {
346 ($y,$m,$d) = ($1,$2,$3);
349 } elsif ( $1 < 99 && $2 < 99 && $3 < 99 && $1 > 0 && $2 > 0 && $3 > 0) {
350 if ($3 < 7) { # probably 2000 or greater, mm.dd.yy
352 if ($1 > 12 && $1 < 32 && $2 < 13) { # well, actually it looks like dd.mm.yyyy
354 } elsif ($2 > 12 && $2 < 32 && $1 < 13) {
357 } else { # probably before 2000, mm.dd.yy
359 if ($1 > 12 && $1 < 32 && $2 < 13) { # well, actually it looks like dd.mm.yyyy
361 } elsif ($2 > 12 && $2 < 32 && $1 < 13) {
369 if ($y && $m && $d) {
371 $date = sprintf('%04d-%02d-%-2d',$y, $m, $d)
372 if (new DateTime ( year => $y, month => $m, day => $d ));