remove over-zealous chomping
[sitka/sitka-tools.git] / marc_export_custom / marc_export_custom
CommitLineData
456d236e
JF
1#!/usr/bin/perl
2# vim:et:sw=4:ts=4:
3use strict;
4use warnings;
5use bytes;
6
7use OpenSRF::System;
8use OpenSRF::EX qw/:try/;
9use OpenSRF::AppSession;
10use OpenSRF::Utils::JSON;
11use OpenSRF::Utils::SettingsClient;
12use OpenILS::Application::AppUtils;
13use OpenILS::Utils::Fieldmapper;
14use OpenILS::Utils::CStoreEditor;
15
16use MARC::Record;
17use MARC::File::XML;
18use UNIVERSAL::require;
19
20use Time::HiRes qw/time/;
21use Getopt::Long;
22
23use Config::Simple;
24use Data::Dumper;
25
26my @formats = qw/USMARC UNIMARC XML BRE ARE/;
27
28my ($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);
29my ($exclusion_ini,$collapse_to_depth);
30my $cfg;
5eb3fcb8 31my $force901;
456d236e
JF
32
33GetOptions(
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,
5eb3fcb8 46 'force901' => \$force901,
456d236e
JF
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
54if ($help) {
55print <<"HELP";
56This script exports MARC authority, bibliographic, and serial holdings
57records from an Evergreen database.
58
59Input to this script can consist of a list of record IDs, with one record ID
60per line, corresponding to the record ID in the Evergreen database table of
61your requested record type.
62
63Alternately, passing the --all option will attempt to export all records of
64the specified type from the Evergreen database. The --all option starts at
65record ID 1 and increments the ID by 1 until the largest ID in the database
66is retrieved. This may not be very efficient for databases with large gaps
67in their ID sequences.
68
69Usage: $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
89Examples:
90
91To export a set of USMARC records in a file named "output_file" based on the
92IDs contained in a file named "list_of_ids":
93 cat list_of_ids | $0 > output_file
94
95To export a set of MARC21XML authority records in a file named "output.xml"
96for all authority records in the database:
97 $0 --format XML --type AUTHORITY --all > output.xml
98
99HELP
100 exit;
101}
102
103$type = lc($type);
104$format = uc($format);
105$encoding = uc($encoding);
106
107binmode(STDOUT, ':raw') if ($encoding ne 'UTF-8');
108binmode(STDOUT, ':utf8') if ($encoding eq 'UTF-8');
109
110if (!grep { $format eq $_ } @formats) {
111 die "Please select a supported format. ".
112 "Right now that means one of [".
113 join('|',@formats). "]\n";
114}
115
116if ($format ne 'XML') {
117 my $type = 'MARC::File::' . $format;
118 $type->require;
119}
120
121if ($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
128OpenSRF::System->bootstrap_client( config_file => $config );
129
130if (!$idl) {
131 $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
132}
133
134Fieldmapper->import(IDL => $idl);
135
136my $ses = OpenSRF::AppSession->create('open-ils.cstore');
137OpenILS::Utils::CStoreEditor::init();
138my $editor = OpenILS::Utils::CStoreEditor->new();
139
140print <<HEADER if ($format eq 'XML');
141<?xml version="1.0" encoding="$encoding"?>
142<collection xmlns='http://www.loc.gov/MARC21/slim'>
143HEADER
144
145my %orgs;
146my %shelves;
147my %statuses;
148my %outypes;
149
150my $flesh = {};
151
152if ($holdings) {
153 get_bib_locations();
154}
155
156my $start = time;
157my $last_time = time;
158my %count = ('bib' => 0, 'did' => 0);
159my $speed = 0;
160
161if ($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
183print "</collection>\n" if ($format eq 'XML');
184
185$speed = $count{did} / (time - $start);
186my $time = time - $start;
187print STDERR <<DONE;
188
189Exports Attempted : $count{bib}
190Exports Completed : $count{did}
191Overall Speed : $speed
192Total Time Elapsed: $time seconds
193
194DONE
195
196sub 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;
28ab66e8
JF
249 my $errorid = $id;
250 $errorid =~ s/\n$//g;
e759b05b
JF
251 chomp($e);
252 warn "\nERROR ON RECORD $errorid: $e\n";
456d236e
JF
253 import MARC::File::XML; # reset SAX parser so that one bad record doesn't kill the entire export
254 };
255
256 if ($export_mfhd and $type eq 'biblio') {
257 my $mfhds = $editor->search_serial_record_entry({record => $id, deleted => 'f'});
258 foreach my $mfhd (@$mfhds) {
259 try {
260 my $r = MARC::Record->new_from_xml( $mfhd->marc, $encoding, $format );
261
262 if ($format eq 'XML') {
263 my $xml = $r->as_xml_record;
264 $xml =~ s/^<\?.+?\?>$//mo;
265 print $xml;
266 } elsif ($format eq 'UNIMARC') {
267 print $r->as_usmarc;
268 } elsif ($format eq 'USMARC') {
269 print $r->as_usmarc;
270 }
271 } otherwise {
272 my $e = shift;
e759b05b
JF
273 my $errorid = chomp($id);
274 chomp($e);
275 warn "\nERROR ON MFHD RECORD $errorid: $e\n";
456d236e
JF
276 import MARC::File::XML; # reset SAX parser so that one bad record doesn't kill the entire export
277 };
278 }
279 }
280
281 stats() if (! ($count{bib} % 50 ));
282}
283
284sub stats {
285 try {
286 no warnings;
287
288 $speed = $count{did} / (time - $start);
289
290 my $speed_now = ($count{did} - $count{did_last}) / (time - $count{time_last});
291 my $cn_speed = $count{cn} / (time - $start);
292 my $cp_speed = $count{cp} / (time - $start);
293
294 printf STDERR "\r $count{did} of $count{bib} @ \%0.4f/s ttl / \%0.4f/s rt ".
295 "($count{cn} CNs @ \%0.4f/s :: $count{cp} CPs @ \%0.4f/s)\r",
296 $speed,
297 $speed_now,
298 $cn_speed,
299 $cp_speed;
300 } otherwise {};
301 $count{did_last} = $count{did};
302 $count{time_last} = time;
303}
304
305sub get_bib_locations {
306 print STDERR "Retrieving Org Units ... ";
307 my $r = $ses->request( 'open-ils.cstore.direct.actor.org_unit.search', { id => { '!=' => undef } } );
308
309 while (my $o = $r->recv) {
310 die $r->failed->stringify if ($r->failed);
311 $o = $o->content;
312 last unless ($o);
313 $orgs{$o->id} = $o;
314 }
315 $r->finish;
316 print STDERR "OK\n";
317
318 print STDERR "Retrieving Copy statuses ... ";
319 $r = $ses->request( 'open-ils.cstore.direct.config.copy_status.search', { id => { '!=' => undef } } );
320
321 while (my $sta = $r->recv) {
322 die $r->failed->stringify if ($r->failed);
323 $sta = $sta->content;
324 last unless ($sta);
325 $statuses{$sta->id} = $sta;
326 }
327 $r->finish;
328 print STDERR "OK\n";
329
330 print STDERR "Retrieving OU types ... ";
331 $r = $ses->request( 'open-ils.cstore.direct.actor.org_unit_type.search', { id => { '!=' => undef } } );
332
333 while (my $outy = $r->recv) {
334 die $r->failed->stringify if ($r->failed);
335 $outy = $outy->content;
336 last unless ($outy);
337 $outypes{$outy->id} = $outy;
338 }
339 $r->finish;
340 print STDERR "OK\n";
341
342 print STDERR "Retrieving Shelving locations ... ";
343 $r = $ses->request( 'open-ils.cstore.direct.asset.copy_location.search', { id => { '!=' => undef } } );
344
345 while (my $s = $r->recv) {
346 die $r->failed->stringify if ($r->failed);
347 $s = $s->content;
348 last unless ($s);
349 $shelves{$s->id} = $s;
350 }
351 $r->finish;
352 print STDERR "OK\n";
353
354 $flesh = { flesh => 2, flesh_fields => { bre => [ 'call_numbers' ], acn => [ 'copies' ] } };
355}
356
357sub add_bib_holdings {
358 my $bib = shift;
359 my $r = shift;
360
361 my $cn_list = $bib->call_numbers;
362 if ($cn_list && @$cn_list) {
363
364 $count{cn} += @$cn_list;
365
366 my $cp_list = [ map { @{ $_->copies } } @$cn_list ];
367 if ($cp_list && @$cp_list) {
368
369 my %cn_map;
370 push @{$cn_map{$_->call_number}}, $_ for (@$cp_list);
371
372 for my $cn ( @$cn_list ) {
373 my $cn_map_list = $cn_map{$cn->id};
374
375 COPYMAP: for my $cp ( @$cn_map_list ) {
376 $count{cp}++;
377
378
379 my $owninglib = $cn->owning_lib;
380 my $circlib = $cp->circ_lib;
381 my $printlib = $cp->circ_lib;
382
383 if($cfg){
384 my $thisorg = $orgs{$circlib};
385
386 if($collapse_to_depth){
387 while ( $outypes{ $thisorg->ou_type }->depth > $collapse_to_depth ){
388 my $localcfg = $cfg->param(-block=> $thisorg->shortname);
389 if( $localcfg->{'DontCollapse'} ){
390 last;
391 }
392 if($thisorg->parent_ou){
393 $thisorg = $orgs{$thisorg->parent_ou};
394 $printlib = $thisorg->id;
395 }
396 }
397 }
398
399 $thisorg = $orgs{$circlib};
400
806177d6 401
456d236e 402 while( $thisorg ){
456d236e
JF
403 # load the local config from the .ini file for exclusions
404 my $localcfg = $cfg->param(-block=> $thisorg->shortname);
405
406 # if we see this setting, just skip that org
407
408 next COPYMAP if( $localcfg->{'ExcludeEntireOrg'} );
409
410 # what follows are exclusion rules
806177d6 411
456d236e
JF
412 # Excluded Flags
413 if($localcfg->{'Flags'}){
414 # this little line is just forcing scalars into an array so we can 'use strict' with Config::Simple
415 my @flags = ( (ref($localcfg->{'Flags'}) eq "ARRAY") ? @{$localcfg->{'Flags'}} : ($localcfg->{'Flags'}));
416 next COPYMAP if( grep { $_ eq 'reference' } @flags && $cp->ref eq 't');
417 next COPYMAP if( grep { $_ eq 'unholdable' } @flags && $cp->holdable eq 'f');
418 next COPYMAP if( grep { $_ eq 'circulate' } @flags && $cp->circulate eq 'f');
419 next COPYMAP if( grep { $_ eq 'hidden' } @flags && $cp->opac_visible eq 'f');
420 }
421 # Excluded Circ Modifiers
422 if($localcfg->{'CircMods'}){
806177d6 423 my $circmod = $cp->circ_modifier || "";
456d236e 424 my @circmods = ( (ref($localcfg->{'CircMods'}) eq "ARRAY") ? @{$localcfg->{'CircMods'}} : ($localcfg->{'CircMods'}) );
806177d6 425 next COPYMAP if( grep { $_ eq $circmod } @circmods && @circmods);
456d236e 426 }
3add9381
JF
427 # Inverse rule -- only include specified Circ Mods
428 if($localcfg->{'OnlyIncludeCircMods'}){
806177d6 429 my $circmod = $cp->circ_modifier || "";
3add9381 430 my @circmods = ( (ref($localcfg->{'CircMods'}) eq "ARRAY") ? @{$localcfg->{'CircMods'}} : ($localcfg->{'CircMods'}) );
806177d6 431 next COPYMAP unless( grep { $_ eq $circmod } @circmods && @circmods);
3add9381 432 }
456d236e
JF
433 # Excluded Copy Statuses
434 if($localcfg->{'Statuses'}){
435 my @statuses = ( (ref($localcfg->{'Statuses'}) eq "ARRAY") ? @{$localcfg->{'Statuses'}} : ($localcfg->{'Statuses'}) );
436 next COPYMAP if( grep { $_ eq $statuses{$cp->status}->name } @statuses && @statuses);
437 }
438 # Excluded Locations
439 if($localcfg->{'Locations'}){
440 my @locations = ( (ref($localcfg->{'Locations'}) eq "ARRAY") ? @{$localcfg->{'Locations'}} : ($localcfg->{'Locations'}) );
441 next COPYMAP if( grep { $_ eq $shelves{$cp->location}->name } @locations && @locations);
442 }
443 # Inverse rule - Only use the specified locations
444 if($localcfg->{'OnlyIncludeLocations'}){
445 my @locations = ( (ref($localcfg->{'OnlyIncludeLocations'}) eq "ARRAY") ? @{$localcfg->{'OnlyIncludeLocations'}} : ($localcfg->{'Locations'}) );
446 next COPYMAP unless( grep { $_ eq $shelves{$cp->location}->name } @locations && @locations);
447 }
448 # exclude based on a regex match to location names
449 if($localcfg->{'LocationRegex'}){
450 my @locregex = ( (ref($localcfg->{'LocationRegex'}) eq "ARRAY") ? @{$localcfg->{'LocationRegex'}} : ($localcfg->{'LocationRegex'}) );
451 my $reg = $localcfg->{'LocationRegex'};
452 next COPYMAP if( grep { $shelves{$cp->location}->name =~ m/($reg)/ } @locregex && @locregex);
453 }
454 # include based on a regex match to location names
455 if($localcfg->{'OnlyIncludeLocationRegex'}){
456 my @locregex = ( (ref($localcfg->{'OnlyIncludeLocationRegex'}) eq "ARRAY") ? @{$localcfg->{'OnlyIncludeLocationRegex'}} : ($localcfg->{'OnlyIncludeLocationRegex'}) );
457 my $reg = $localcfg->{'OnlyIncludeLocationRegex'};
458 next COPYMAP unless( grep { $shelves{$cp->location}->name =~ m/($reg)/ } @locregex && @locregex);
459 }
460 # Exclude based on a callno regex
461 if($localcfg->{'CallNoRegex'}){
462 my @callnoregex = ( (ref($localcfg->{'CallNoRegex'}) eq "ARRAY") ? @{$localcfg->{'CallNoRegex'}} : ($localcfg->{'CallNoRegex'}) );
463 my $reg = $localcfg->{'CallNoRegex'};
464 next COPYMAP if( grep { $cn->label =~ m/($reg)/ } @callnoregex && @callnoregex);
465 }
466 # Include based on a callno regex
467 if($localcfg->{'OnlyIncludeCallNoRegex'}){
468 my @callnoregex = ( (ref($localcfg->{'OnlyIncludeCallNoRegex'}) eq "ARRAY") ? @{$localcfg->{'OnlyIncludeCallNoRegex'}} : ($localcfg->{'OnlyIncludeCallNoRegex'}) );
469 my $reg = $localcfg->{'OnlyIncludeCallNoRegex'};
470 next COPYMAP unless( grep { $cn->label =~ m/($reg)/ } @callnoregex && @callnoregex);
471 }
806177d6 472
456d236e
JF
473 # Trim call number to a float and exclude based on Dewey Range
474 if($localcfg->{'DeweyGT'} || $localcfg->{'DeweyLT'}){
475 my $gt = $localcfg->{'DeweyGT'};
476 my $lt = $localcfg->{'DeweyLT'};
477
478 # FIXME if either config has an array just ditch for now
479 next COPYMAP if (ref($gt) eq "ARRAY" or ref($lt) eq "ARRAY");
480 $gt =~ s/[^0-9\.]//g if $gt; #trim off anything not deweyish
481 $lt =~ s/[^0-9\.]//g if $lt; #trim off anything not deweyish
482
483 my $callno = $cn->label;
484 $callno =~ s/[^0-9\.]//g; #trim off anything not deweyish
485 print STDERR $callno;
486 #note that we are making big assumptions about the call numbers in the db
487
488 # we have a range, exclude what's inbetween
489 if($lt && $gt){
490 next COPYMAP if $callno > $gt and $callno < $lt;
491 # we only have a top threshold, exclude everything below it
492 } elsif ($lt){
493 next COPYMAP if $callno < $lt;
494 # we only have a bottom threshold, exclude everything above it
495 } elsif ($gt){
496 next COPYMAP if $callno > $gt;
497 }
498 }
499
456d236e
JF
500 if($thisorg->parent_ou){
501 $thisorg = $orgs{$thisorg->parent_ou}
502 } else {
503 $thisorg = ();
504 }
505
506 }
507 }
508
509 $r->append_fields(
510 MARC::Field->new(
511 852, '4', '',
512 a => $location,
513 b => $orgs{$printlib}->shortname,
514 #b => $orgs{$owninglib}->shortname,
515 #b => $orgs{$circlib}->shortname,
516 c => $shelves{$cp->location}->name,
517 j => $cn->label,
518 ($cp->circ_modifier ? ( g => $cp->circ_modifier ) : ()),
519 p => $cp->barcode,
520 ($cp->price ? ( y => $dollarsign.$cp->price ) : ()),
521 ($cp->copy_number ? ( t => $cp->copy_number ) : ()),
522 ($cp->ref eq 't' ? ( x => 'reference' ) : ()),
523 ($cp->holdable eq 'f' ? ( x => 'unholdable' ) : ()),
524 ($cp->circulate eq 'f' ? ( x => 'noncirculating' ) : ()),
525 ($cp->opac_visible eq 'f' ? ( x => 'hidden' ) : ()),
526 z => $statuses{$cp->status}->name,
527 )
528 );
529
5eb3fcb8
JF
530 if($force901){
531 $r->delete_field( $r->field('901') );
532 $r->append_fields(
533 MARC::Field->new(
534 '901', ' ', ' ',
535 a => $bib->tcn_value,
536 b => $bib->tcn_source,
537 c => $bib->id
538 )
539 );
540
541 }
542
456d236e
JF
543 stats() if (! ($count{cp} % 100 ));
544 } # for cnmap
545 } # for cnlist
546 } # if block
547 } # if block
548} # sub