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