05802183ff9ce41e7753c2bea570cb32eb377148
[sitka/sitka-tools.git] / marc_export_custom / marc_export_custom
1 #!/usr/bin/perl
2 # vim:et:sw=4:ts=4:
3 use strict;
4 use warnings;
5 use bytes;
6
7 use OpenSRF::System;
8 use OpenSRF::EX qw/:try/;
9 use OpenSRF::AppSession;
10 use OpenSRF::Utils::JSON;
11 use OpenSRF::Utils::SettingsClient;
12 use OpenILS::Application::AppUtils;
13 use OpenILS::Utils::Fieldmapper;
14 use OpenILS::Utils::CStoreEditor;
15
16 use MARC::Record;
17 use MARC::File::XML;
18 use UNIVERSAL::require;
19
20 use Time::HiRes qw/time/;
21 use Getopt::Long;
22
23 use Config::Simple;
24 use Data::Dumper;
25
26 my @formats = qw/USMARC UNIMARC XML BRE ARE/;
27
28 my ($config,$format,$encoding,$location,$dollarsign,$idl,$help,$holdings,$timeout,$export_mfhd,$type,$all_records) = ('/openils/conf/opensrf_core.xml','USMARC','MARC8','','$',0,undef,undef,0,undef,'biblio',undef);
29 my ($exclusion_ini,$collapse_to_depth, $output_file);
30 my $cfg;
31 my $force901;
32
33 GetOptions(
34         'help'       => \$help,
35         'items'      => \$holdings,
36         'mfhd'       => \$export_mfhd,
37         'all'        => \$all_records,
38         'location=s' => \$location,
39         'money=s'    => \$dollarsign,
40         'config=s'   => \$config,
41         'format=s'   => \$format,
42         'type=s'     => \$type,
43         'xml-idl=s'  => \$idl,
44         'encoding=s' => \$encoding,
45         'timeout=i'  => \$timeout,
46         'force901'  => \$force901,
47         'exclusion_ini=s' => \$exclusion_ini,
48         'collapse_to_depth=i' => \$collapse_to_depth,
49         'output-file=s' => \$output_file,
50 );
51
52 if ($exclusion_ini) {
53         die "exclusion ini file does not exist" unless (-r $exclusion_ini and -s $exclusion_ini);
54         $cfg = new Config::Simple($exclusion_ini) 
55 }
56
57 if ($help) {
58 print <<"HELP";
59 This script exports MARC authority, bibliographic, and serial holdings
60 records from an Evergreen database. 
61
62 Input to this script can consist of a list of record IDs, with one record ID
63 per line, corresponding to the record ID in the Evergreen database table of
64 your requested record type.
65
66 Alternately, passing the --all option will attempt to export all records of
67 the specified type from the Evergreen database. The --all option starts at
68 record ID 1 and increments the ID by 1 until the largest ID in the database
69 is retrieved. This may not be very efficient for databases with large gaps
70 in their ID sequences.
71
72 Usage: $0 [options]
73  --help or -h       This screen.
74  --config or -c     Configuration file [/openils/conf/opensrf_core.xml]
75  --format or -f     Output format (USMARC, UNIMARC, XML, BRE, ARE) [USMARC]
76  --encoding or -e   Output encoding (UTF-8, ISO-8859-?, MARC8) [MARC8]
77  --xml-idl or -x    Location of the IDL XML
78  --timeout          Timeout for exporting a single record; increase if you
79                     are using --holdings and are exporting records that
80                     have a lot of items attached to them.
81  --type or -t       Record type (BIBLIO, AUTHORITY) [BIBLIO]
82  --all or -a        Export all records; ignores input list
83
84  Additional options for type = 'BIBLIO':
85  --items or -i      Include items (holdings) in the output
86  --money            Currency symbol to use in item price field [\$]
87  --mfhd             Export serial MFHD records for associated bib records
88                     Not compatible with --format=BRE
89  --location or -l   MARC Location Code for holdings from
90                     http://www.loc.gov/marc/organizations/orgshome.html
91
92 Examples:
93
94 To export a set of USMARC records in a file named "output_file" based on the
95 IDs contained in a file named "list_of_ids":
96   cat list_of_ids | $0 > output_file
97
98 To export a set of MARC21XML authority records in a file named "output.xml"
99 for all authority records in the database:
100   $0 --format XML --type AUTHORITY --all > output.xml
101
102 HELP
103     exit;
104 }
105
106 $type = lc($type);
107 $format = uc($format);
108 $encoding = uc($encoding);
109
110 my $outfh;
111 my $real_stdout;
112 open($real_stdout, ">&STDOUT") or die "Can't dup STDOUT: $!";
113 if($output_file) {
114     open($outfh, '>', $output_file) or die "Can't open file for output $output_file: $!"; 
115 } else {
116     $outfh = $real_stdout;
117 }
118
119 binmode($outfh, ':raw') if ($encoding ne 'UTF-8');
120 binmode($outfh, ':utf8') if ($encoding eq 'UTF-8');
121
122 if (!grep { $format eq $_ } @formats) {
123     die "Please select a supported format.  ".
124         "Right now that means one of [".
125         join('|',@formats). "]\n";
126 }
127
128 if ($format ne 'XML') {
129     my $type = 'MARC::File::' . $format;
130     $type->require;
131 }
132
133 if ($timeout <= 0) {
134     # set default timeout and/or correct silly user who 
135     # supplied a negative timeout; default timeout of
136     # 300 seconds if exporting items determined empirically.
137     $timeout = $holdings ? 300 : 1;
138 }
139
140 OpenSRF::System->bootstrap_client( config_file => $config );
141
142 if (!$idl) {
143     $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
144 }
145
146 Fieldmapper->import(IDL => $idl);
147
148 my $ses = OpenSRF::AppSession->create('open-ils.cstore');
149 OpenILS::Utils::CStoreEditor::init();
150 my $editor = OpenILS::Utils::CStoreEditor->new();
151
152 print $outfh <<HEADER if ($format eq 'XML');
153 <?xml version="1.0" encoding="$encoding"?>
154 <collection xmlns='http://www.loc.gov/MARC21/slim'>
155 HEADER
156
157 my %orgs;
158 my %shelves;
159 my %statuses;
160 my %outypes;
161
162 my $flesh = {};
163
164 if ($holdings) {
165     get_bib_locations();
166 }
167
168 my $start = time;
169 my $last_time = time;
170 my %count = ('bib' => 0, 'did' => 0);
171 my $speed = 0;
172
173 if ($all_records) {
174     my $top_record = 0;
175     if ($type eq 'biblio') {
176         $top_record = $editor->search_biblio_record_entry([
177             {deleted => 'f'},
178             {order_by => { 'bre' => 'id DESC' }, limit => 1}
179         ])->[0]->id;
180     } elsif ($type eq 'authority') {
181         $top_record = $editor->search_authority_record_entry([
182             {deleted => 'f'},
183             {order_by => { 'are' => 'id DESC' }, limit => 1}
184         ])->[0]->id;
185     }
186     for (my $i = 0; $i++ < $top_record;) {
187         export_record($i);
188     }
189 } else {
190     while ( my $i = <> ) {
191         export_record($i);
192     }
193 }
194
195 print $outfh "</collection>\n" if ($format eq 'XML');
196
197 $speed = $count{did} / (time - $start);
198 my $time = time - $start;
199 print STDERR <<DONE;
200
201 Exports Attempted : $count{bib}
202 Exports Completed : $count{did}
203 Overall Speed     : $speed
204 Total Time Elapsed: $time seconds
205
206 DONE
207
208 sub export_record {
209     my $id = shift;
210
211     my $bib; 
212
213     my $r = $ses->request( "open-ils.cstore.direct.$type.record_entry.retrieve", $id, $flesh );
214     my $s = $r->recv(timeout => $timeout);
215     if (!$s) {
216         warn "\n!!!!! Failed trying to read record $id\n";
217         return;
218     }
219     if ($r->failed) {
220         warn "\n!!!!!! Failed trying to read record $id: " . $r->failed->stringify . "\n";
221         return;
222     }
223     if ($r->timed_out) {
224         warn "\n!!!!!! Timed out trying to read record $id\n";
225         return;
226     }
227     $bib = $s->content;
228     $r->finish;
229
230     $count{bib}++;
231     return unless $bib;
232
233     if ($format eq 'ARE' or $format eq 'BRE') {
234         print $outfh OpenSRF::Utils::JSON->perl2JSON($bib);
235         stats();
236         $count{did}++;
237         return;
238     }
239
240     try {
241
242         my $r = MARC::Record->new_from_xml( $bib->marc, $encoding, $format );
243         if ($type eq 'biblio') {
244             add_bib_holdings($bib, $r);
245         }
246
247         if ($format eq 'XML') {
248             my $xml = $r->as_xml_record;
249             $xml =~ s/^<\?.+?\?>$//mo;
250             print $outfh $xml;
251         } elsif ($format eq 'UNIMARC') {
252             print $outfh $r->as_usmarc;
253         } elsif ($format eq 'USMARC') {
254             print $outfh $r->as_usmarc;
255         }
256
257         $count{did}++;
258
259     } otherwise {
260         my $e = shift;
261         my $errorid = $id;
262         chomp($errorid);
263         chomp($e);
264         warn "\nERROR ON RECORD $errorid: $e\n";
265         import MARC::File::XML; # reset SAX parser so that one bad record doesn't kill the entire export
266     };
267
268     if ($export_mfhd and $type eq 'biblio') {
269         my $mfhds = $editor->search_serial_record_entry({record => $id, deleted => 'f'});
270         foreach my $mfhd (@$mfhds) {
271             try {
272                 my $r = MARC::Record->new_from_xml( $mfhd->marc, $encoding, $format );
273
274                 if ($format eq 'XML') {
275                     my $xml = $r->as_xml_record;
276                     $xml =~ s/^<\?.+?\?>$//mo;
277                     print $outfh $xml;
278                 } elsif ($format eq 'UNIMARC') {
279                     print $outfh $r->as_usmarc;
280                 } elsif ($format eq 'USMARC') {
281                     print $outfh $r->as_usmarc;
282                 }
283             } otherwise {
284                 my $e = shift;
285                 my $errorid = chomp($id);
286                 chomp($e);
287                 warn "\nERROR ON MFHD RECORD $errorid: $e\n";
288                 import MARC::File::XML; # reset SAX parser so that one bad record doesn't kill the entire export
289             };
290         }
291     }
292
293     stats() if (! ($count{bib} % 50 ));
294 }
295
296 sub stats {
297     try {
298         no warnings;
299
300         $speed = $count{did} / (time - $start);
301
302         my $speed_now = ($count{did} - $count{did_last}) / (time - $count{time_last});
303         my $cn_speed = $count{cn} / (time - $start);
304         my $cp_speed = $count{cp} / (time - $start);
305
306         printf STDERR "\r  $count{did} of $count{bib} @  \%0.4f/s ttl / \%0.4f/s rt ".
307                 "($count{cn} CNs @ \%0.4f/s :: $count{cp} CPs @ \%0.4f/s)\r",
308                 $speed,
309                 $speed_now,
310                 $cn_speed,
311                 $cp_speed;
312     } otherwise {};
313     $count{did_last} = $count{did};
314     $count{time_last} = time;
315 }
316
317 sub get_bib_locations {
318     print STDERR "Retrieving Org Units ... ";
319     my $r = $ses->request( 'open-ils.cstore.direct.actor.org_unit.search', { id => { '!=' => undef } } );
320
321     while (my $o = $r->recv) {
322         die $r->failed->stringify if ($r->failed);
323         $o = $o->content;
324         last unless ($o);
325         $orgs{$o->id} = $o;
326     }
327     $r->finish;
328     print STDERR "OK\n";
329
330     print STDERR "Retrieving Copy statuses ... ";
331     $r = $ses->request( 'open-ils.cstore.direct.config.copy_status.search', { id => { '!=' => undef } } );
332
333     while (my $sta = $r->recv) {
334         die $r->failed->stringify if ($r->failed);
335         $sta = $sta->content;
336         last unless ($sta);
337         $statuses{$sta->id} = $sta;
338     }
339     $r->finish;
340     print STDERR "OK\n";
341
342     print STDERR "Retrieving OU types ... ";
343     $r = $ses->request( 'open-ils.cstore.direct.actor.org_unit_type.search', { id => { '!=' => undef } } );
344
345     while (my $outy = $r->recv) {
346         die $r->failed->stringify if ($r->failed);
347         $outy = $outy->content;
348         last unless ($outy);
349         $outypes{$outy->id} = $outy;
350     }
351     $r->finish;
352     print STDERR "OK\n";
353
354     print STDERR "Retrieving Shelving locations ... ";
355     $r = $ses->request( 'open-ils.cstore.direct.asset.copy_location.search', { id => { '!=' => undef } } );
356
357     while (my $s = $r->recv) {
358         die $r->failed->stringify if ($r->failed);
359         $s = $s->content;
360         last unless ($s);
361         $shelves{$s->id} = $s;
362     }
363     $r->finish;
364     print STDERR "OK\n";
365
366     $flesh = { flesh => 2, flesh_fields => { bre => [ 'call_numbers' ], acn => [ 'copies' ] } };
367 }
368
369 sub add_bib_holdings {
370     my $bib = shift;
371     my $r = shift;
372
373     my $cn_list = $bib->call_numbers;
374     if ($cn_list && @$cn_list) {
375
376         $count{cn} += @$cn_list;
377     
378         my $cp_list = [ map { @{ $_->copies } } @$cn_list ];
379         if ($cp_list && @$cp_list) {
380
381             my %cn_map;
382             push @{$cn_map{$_->call_number}}, $_ for (@$cp_list);
383                             
384             for my $cn ( @$cn_list ) {
385                 my $cn_map_list = $cn_map{$cn->id};
386
387                 COPYMAP: for my $cp ( @$cn_map_list ) {
388                     $count{cp}++;
389
390
391                     my $owninglib = $cn->owning_lib;
392                     my $circlib = $cp->circ_lib;
393                     my $printlib = $cp->circ_lib;
394
395                     if($cfg){
396                         my $thisorg = $orgs{$circlib};
397
398                         if($collapse_to_depth){
399                             while ( $outypes{ $thisorg->ou_type }->depth > $collapse_to_depth ){
400                                 my $localcfg = $cfg->param(-block=> $thisorg->shortname);
401                                 if( $localcfg->{'DontCollapse'} ){
402                                     last;
403                                 }
404                                 if($thisorg->parent_ou){
405                                     $thisorg = $orgs{$thisorg->parent_ou};
406                                     $printlib = $thisorg->id;
407                                 }
408                             }
409                         }
410
411                         $thisorg = $orgs{$circlib};
412
413
414                         while( $thisorg ){
415                             # load the local config from the .ini file for exclusions
416                             my $localcfg = $cfg->param(-block=> $thisorg->shortname);
417
418                             # if we see this setting, just skip that org
419
420                             if( $localcfg->{'ExcludeEntireOrg'} ) 
421                             { skipnote($bib->id,"ExcludeEntireOrg"); next COPYMAP; } 
422
423                             # what follows are exclusion rules
424                     
425                             # Excluded Flags
426                             if($localcfg->{'Flags'}){
427                                 # this little line is just forcing scalars into an array so we can 'use strict' with Config::Simple
428                                 my @flags = ( (ref($localcfg->{'Flags'}) eq "ARRAY") ? @{$localcfg->{'Flags'}} : ($localcfg->{'Flags'}));
429                                 if( grep { $_ eq 'reference' } @flags && $cp->ref eq 't')
430                                 { skipnote($bib->id,"Flags: reference"); next COPYMAP; } 
431                                 elsif( grep { $_ eq 'unholdable' } @flags && $cp->holdable eq 'f')
432                                 { skipnote($bib->id,"Flags: unholdable"); next COPYMAP; } 
433                                 elsif( grep { $_ eq 'circulate' } @flags && $cp->circulate eq 'f')
434                                 { skipnote($bib->id,"Flags: circulate"); next COPYMAP; } 
435                                 elsif( grep { $_ eq 'hidden' } @flags && $cp->opac_visible eq 'f')
436                                 { skipnote($bib->id,"Flags: hidden"); next COPYMAP; } 
437                             }
438                             # Excluded Circ Modifiers
439                             if($localcfg->{'CircMods'}){
440                                 my $circmod = $cp->circ_modifier || "";
441                                 my @circmods = ( (ref($localcfg->{'CircMods'}) eq "ARRAY") ? @{$localcfg->{'CircMods'}} : ($localcfg->{'CircMods'}) );
442                                 if( grep { $_ eq $circmod } @circmods && @circmods)
443                                 { skipnote($bib->id,"CircMods"); next COPYMAP; } 
444                             }
445                             # Inverse rule -- only include specified Circ Mods
446                             if($localcfg->{'OnlyIncludeCircMods'}){
447                                 my $circmod = $cp->circ_modifier || "";
448                                 my @circmods = ( (ref($localcfg->{'CircMods'}) eq "ARRAY") ? @{$localcfg->{'CircMods'}} : ($localcfg->{'CircMods'}) );
449                                 unless( grep { $_ eq $circmod } @circmods && @circmods)
450                                 { skipnote($bib->id,"OnlyIncludeCircMods"); next COPYMAP; } 
451                             }
452                             # Excluded Copy Statuses
453                             if($localcfg->{'Statuses'}){
454                                 my @statuses = ( (ref($localcfg->{'Statuses'}) eq "ARRAY") ? @{$localcfg->{'Statuses'}} : ($localcfg->{'Statuses'}) );
455                                 if( grep { $_ eq $statuses{$cp->status}->name } @statuses && @statuses)
456                                 { skipnote($bib->id,"Statuses"); next COPYMAP; } 
457                             }
458                             # Excluded Locations
459                             if($localcfg->{'Locations'}){
460                                 my @locations = ( (ref($localcfg->{'Locations'}) eq "ARRAY") ? @{$localcfg->{'Locations'}} : ($localcfg->{'Locations'}) );
461                                 if( grep { $_ eq $shelves{$cp->location}->name } @locations && @locations)
462                                 { skipnote($bib->id,"Locations"); next COPYMAP; }
463                             }
464                             # Inverse rule - Only use the specified locations
465                             if($localcfg->{'OnlyIncludeLocations'}){
466                                 my @locations = ( (ref($localcfg->{'OnlyIncludeLocations'}) eq "ARRAY") ? @{$localcfg->{'OnlyIncludeLocations'}} : ($localcfg->{'Locations'}) );
467                                 unless( grep { $_ eq $shelves{$cp->location}->name } @locations && @locations)
468                                 { skipnote($bib->id,"OnlyIncludeLocations"); next COPYMAP; } 
469                             }
470                             # exclude based on a regex match to location names
471                             if($localcfg->{'LocationRegex'}){
472                                 my @locregex = ( (ref($localcfg->{'LocationRegex'}) eq "ARRAY") ? @{$localcfg->{'LocationRegex'}} : ($localcfg->{'LocationRegex'}) );
473                                 my $reg = $localcfg->{'LocationRegex'};
474                                 if( grep { $shelves{$cp->location}->name =~ m/($reg)/ } @locregex && @locregex)
475                                 { skipnote($bib->id,"LocationRegex"); next COPYMAP; }
476                             }
477                             # include based on a regex match to location names
478                             if($localcfg->{'OnlyIncludeLocationRegex'}){
479                                 my @locregex = ( (ref($localcfg->{'OnlyIncludeLocationRegex'}) eq "ARRAY") ? @{$localcfg->{'OnlyIncludeLocationRegex'}} : ($localcfg->{'OnlyIncludeLocationRegex'}) );
480                                 my $reg = $localcfg->{'OnlyIncludeLocationRegex'};
481                                 unless( grep { $shelves{$cp->location}->name =~ m/($reg)/ } @locregex && @locregex)
482                                 { skipnote($bib->id,"OnlyIncludeLocationRegex"); next COPYMAP; } 
483                             }
484                             # Exclude based on a callno regex
485                             if($localcfg->{'CallNoRegex'}){
486                                 my @callnoregex = ( (ref($localcfg->{'CallNoRegex'}) eq "ARRAY") ? @{$localcfg->{'CallNoRegex'}} : ($localcfg->{'CallNoRegex'}) );
487                                 my $reg = $localcfg->{'CallNoRegex'};
488                                 if( grep { $cn->label =~ m/($reg)/ } @callnoregex && @callnoregex)
489                                 { skipnote($bib->id,"CallNoRegex"); next COPYMAP; }
490                             }
491                             # Include based on a callno regex
492                             if($localcfg->{'OnlyIncludeCallNoRegex'}){
493                                 my @callnoregex = ( (ref($localcfg->{'OnlyIncludeCallNoRegex'}) eq "ARRAY") ? @{$localcfg->{'OnlyIncludeCallNoRegex'}} : ($localcfg->{'OnlyIncludeCallNoRegex'}) );
494                                 my $reg = $localcfg->{'OnlyIncludeCallNoRegex'};
495                                 unless( grep { $cn->label =~ m/($reg)/ } @callnoregex && @callnoregex)
496                                 { skipnote($bib->id,"OnlyIncludeCallNoRegex"); next COPYMAP; } 
497                             }
498
499                             # Trim call number to a float and exclude based on Dewey Range
500                             if($localcfg->{'DeweyGT'} || $localcfg->{'DeweyLT'}){
501                                 my $gt = $localcfg->{'DeweyGT'};
502                                 my $lt = $localcfg->{'DeweyLT'};
503
504                                 # FIXME if either config has an array just ditch for now
505                                 if (ref($gt) eq "ARRAY" or ref($lt) eq "ARRAY")
506                                 { skipnote($bib->id,""); next COPYMAP; } 
507                                 $gt =~ s/[^0-9\.]//g if $gt; #trim off anything not deweyish
508                                 $lt =~ s/[^0-9\.]//g if $lt; #trim off anything not deweyish
509
510                                 my $callno = $cn->label;
511                                 $callno =~ s/[^0-9\.]//g; #trim off anything not deweyish
512                                 print STDERR $callno;
513                                 #note that we are making big assumptions about the call numbers in the db 
514
515                                 # we have a range, exclude what's inbetween
516                                 if($lt && $gt){
517                                     if($callno > $gt and $callno < $lt)
518                                     { skipnote($bib->id,"Dewey LTGT"); next COPYMAP; } 
519                                 # we only have a top threshold, exclude everything below it
520                                 } elsif ($lt){
521                                     if($callno < $lt)
522                                     { skipnote($bib->id,"Dewey LT"); next COPYMAP; }
523                                 # we only have a bottom threshold, exclude everything above it
524                                 } elsif ($gt){
525                                     if($callno > $gt)
526                                     { skipnote($bib->id,"Dewey GT"); next COPYMAP; } 
527                                 }
528                             }
529
530                             if($thisorg->parent_ou){
531                                  $thisorg = $orgs{$thisorg->parent_ou}
532                             } else {
533                                 $thisorg = ();
534                             }
535                             
536                         }
537                     }
538
539                     $r->append_fields(
540                         MARC::Field->new(
541                             852, '4', '', 
542                             a => $location,
543                             b => $orgs{$printlib}->shortname,
544                             #b => $orgs{$owninglib}->shortname,
545                             #b => $orgs{$circlib}->shortname,
546                             c => $shelves{$cp->location}->name,
547                             j => $cn->label,
548                             ($cp->circ_modifier ? ( g => $cp->circ_modifier ) : ()),
549                             p => $cp->barcode,
550                             ($cp->price ? ( y => $dollarsign.$cp->price ) : ()),
551                             ($cp->copy_number ? ( t => $cp->copy_number ) : ()),
552                             ($cp->ref eq 't' ? ( x => 'reference' ) : ()),
553                             ($cp->holdable eq 'f' ? ( x => 'unholdable' ) : ()),
554                             ($cp->circulate eq 'f' ? ( x => 'noncirculating' ) : ()),
555                             ($cp->opac_visible eq 'f' ? ( x => 'hidden' ) : ()),
556                             z => $statuses{$cp->status}->name,
557                         )
558                     );
559
560                     if($force901){
561                         $r->delete_field( $r->field('901') );
562                         $r->append_fields(
563                             MARC::Field->new(
564                                 '901', ' ', ' ',
565                                 a => $bib->tcn_value,
566                                 b => $bib->tcn_source,
567                                 c => $bib->id
568                             )
569                         );
570
571                     }
572
573                     stats() if (! ($count{cp} % 100 ));
574                 } # for cnmap
575             } # for cnlist
576         } # if block
577     } # if block
578 } # sub
579
580 sub skipnote { 
581         my $id = shift;
582         my $note = shift;
583         my $outf = *STDERR;
584         $outf = *STDOUT if($output_file) ;
585         printf($outf "Skipped %s due to config: %s\n",$id,$note); 
586 }