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