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