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