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