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