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