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