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