We should NOT have deleted copies in the export.
[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
243     if ($format eq 'ARE' or $format eq 'BRE') {
244         print $outfh OpenSRF::Utils::JSON->perl2JSON($bib);
245         stats();
246         $count{did}++;
247         return;
248     }
249
250     try {
251
252         my $r = MARC::Record->new_from_xml( $bib->marc, $encoding, $format );
253         if ($type eq 'biblio') {
254
255             if($onlyholdings){
256                 # Remove old 852 fields
257                 my @f = $r->field('852');
258                 $r->delete_fields(@f) if @f;
259                 # Add new 852 fields 
260                 add_bib_holdings($bib, $r);
261                 # Check that at least one 852 was added
262                 @f = $r->field('852');
263                 # If not, we should NOT add this item to the export 
264                 return unless @f;
265             } else {
266                 add_bib_holdings($bib, $r);
267             }
268         }
269
270         if($force901){
271             $r->delete_field( $r->field('901') );
272             $r->append_fields(
273                 MARC::Field->new(
274                     '901', ' ', ' ',
275                     a => $bib->tcn_value,
276                     b => $bib->tcn_source,
277                     c => $bib->id
278                 )
279             );
280         }
281
282         my $recordstr = undef;
283
284         if ($format eq 'XML') {
285             my $xml = $r->as_xml_record;
286             $xml =~ s/^<\?.+?\?>$//mo;
287             $recordstr = $xml;
288         } elsif ($format eq 'UNIMARC') {
289             $recordstr = $r->as_usmarc;
290         } elsif ($format eq 'USMARC') {
291             $recordstr = $r->as_usmarc;
292         }
293         eval {
294             if($format eq  'UNIMARC' or $format eq 'USMARC') {
295                 my $rec = MARC::File::USMARC->decode($recordstr);
296                 #throw Error::Simple('Reparsed MARC is not identical') if($recordstr ne $rec->as_usmarc);
297             } elsif($format eq 'XML') {
298                 my $rec = MARC::Record->new_from_xml($recordstr, 'utf8', 'UNIMARC');
299                 #my $tmp = $rec->as_xml_record;
300                 #$tmp =~ s/^<\?.+?\?>$//mo;
301                 #throw Error::Simple('Reparsed XML is not identical') if($tmp ne $recordstr);
302             }
303         } or throw Error::Simple("Failed to parse MARC record back: $!");
304         print $outfh $recordstr;
305
306         $count{did}++;
307
308     } otherwise {
309         my $e = shift;
310         my $errorid = $id;
311         chomp($errorid);
312         chomp($e);
313         warn "\nERROR ON RECORD $errorid: $e\n";
314         import MARC::File::XML; # reset SAX parser so that one bad record doesn't kill the entire export
315     };
316
317     if ($export_mfhd and $type eq 'biblio') {
318         my $mfhds = $editor->search_serial_record_entry({record => $id, deleted => 'f'});
319         foreach my $mfhd (@$mfhds) {
320             try {
321                 my $r = MARC::Record->new_from_xml( $mfhd->marc, $encoding, $format );
322
323                 if($force901){
324                     $r->delete_field( $r->field('901') );
325                     $r->append_fields(
326                         MARC::Field->new(
327                             '901', ' ', ' ',
328                             a => $bib->tcn_value,
329                             b => $bib->tcn_source,
330                             c => $bib->id
331                         )
332                     );
333                 }
334
335                 if ($format eq 'XML') {
336                     my $xml = $r->as_xml_record;
337                     $xml =~ s/^<\?.+?\?>$//mo;
338                     print $outfh $xml;
339                 } elsif ($format eq 'UNIMARC') {
340                     print $outfh $r->as_usmarc;
341                 } elsif ($format eq 'USMARC') {
342                     print $outfh $r->as_usmarc;
343                 }
344             } otherwise {
345                 my $e = shift;
346                 my $errorid = chomp($id);
347                 chomp($e);
348                 warn "\nERROR ON MFHD RECORD $errorid: $e\n";
349                 import MARC::File::XML; # reset SAX parser so that one bad record doesn't kill the entire export
350             };
351         }
352     }
353
354     stats() if (! ($count{bib} % 50 ));
355 }
356
357 sub stats {
358     try {
359         no warnings;
360
361         $speed = $count{did} / (time - $start);
362
363         my $speed_now = ($count{did} - $count{did_last}) / (time - $count{time_last});
364         my $cn_speed = $count{cn} / (time - $start);
365         my $cp_speed = $count{cp} / (time - $start);
366
367         printf STDERR "\r  $count{did} of $count{bib} @  \%0.4f/s ttl / \%0.4f/s rt ".
368                 "($count{cn} CNs @ \%0.4f/s :: $count{cp} CPs @ \%0.4f/s)\r",
369                 $speed,
370                 $speed_now,
371                 $cn_speed,
372                 $cp_speed;
373     } otherwise {};
374     $count{did_last} = $count{did};
375     $count{time_last} = time;
376 }
377
378 sub get_bib_locations {
379     print STDERR "Retrieving Org Units ... ";
380     my $r = $ses->request( 'open-ils.cstore.direct.actor.org_unit.search', { id => { '!=' => undef } } );
381
382     while (my $o = $r->recv) {
383         die $r->failed->stringify if ($r->failed);
384         $o = $o->content;
385         last unless ($o);
386         $orgs{$o->id} = $o;
387     }
388     $r->finish;
389     print STDERR "OK\n";
390
391     print STDERR "Retrieving Copy statuses ... ";
392     $r = $ses->request( 'open-ils.cstore.direct.config.copy_status.search', { id => { '!=' => undef } } );
393
394     while (my $sta = $r->recv) {
395         die $r->failed->stringify if ($r->failed);
396         $sta = $sta->content;
397         last unless ($sta);
398         $statuses{$sta->id} = $sta;
399     }
400     $r->finish;
401     print STDERR "OK\n";
402
403     print STDERR "Retrieving OU types ... ";
404     $r = $ses->request( 'open-ils.cstore.direct.actor.org_unit_type.search', { id => { '!=' => undef } } );
405
406     while (my $outy = $r->recv) {
407         die $r->failed->stringify if ($r->failed);
408         $outy = $outy->content;
409         last unless ($outy);
410         $outypes{$outy->id} = $outy;
411     }
412     $r->finish;
413     print STDERR "OK\n";
414
415     print STDERR "Retrieving Shelving locations ... ";
416     $r = $ses->request( 'open-ils.cstore.direct.asset.copy_location.search', { id => { '!=' => undef } } );
417
418     while (my $s = $r->recv) {
419         die $r->failed->stringify if ($r->failed);
420         $s = $s->content;
421         last unless ($s);
422         $shelves{$s->id} = $s;
423     }
424     $r->finish;
425     print STDERR "OK\n";
426
427     $flesh = { flesh => 2, flesh_fields => { bre => [ 'call_numbers' ], acn => [ 'copies' ] } };
428 }
429
430 sub add_bib_holdings {
431     my $bib = shift;
432     my $r = shift;
433
434     my $cn_list = $bib->call_numbers;
435     if ($cn_list && @$cn_list) {
436
437         $count{cn} += @$cn_list;
438     
439         my $cp_list = [ map { @{ $_->copies } } @$cn_list ];
440         if ($cp_list && @$cp_list) {
441
442             my %cn_map;
443             push @{$cn_map{$_->call_number}}, $_ for (@$cp_list);
444                             
445             for my $cn ( @$cn_list ) {
446                 my $cn_map_list = $cn_map{$cn->id};
447
448                 COPYMAP: for my $cp ( @$cn_map_list ) {
449                     $count{cp}++;
450
451
452                     my $owninglib = $cn->owning_lib;
453                     my $circlib = $cp->circ_lib;
454                     my $printlib = $cp->circ_lib;
455
456                     # Ignore deleted copies
457                     next COPYMAP if $cp->deleted;
458
459                     if($cfg){
460                         my $thisorg = $orgs{$circlib};
461
462                         if($collapse_to_depth){
463                             while ( $outypes{ $thisorg->ou_type }->depth > $collapse_to_depth ){
464                                 my $localcfg = $cfg->param(-block=> $thisorg->shortname);
465                                 if( $localcfg->{'DontCollapse'} ){
466                                     last;
467                                 }
468                                 if($thisorg->parent_ou){
469                                     $thisorg = $orgs{$thisorg->parent_ou};
470                                     $printlib = $thisorg->id;
471                                 }
472                             }
473                         }
474
475                         $thisorg = $orgs{$circlib};
476
477
478                         while( $thisorg ){
479                             # load the local config from the .ini file for exclusions
480                             my $localcfg = $cfg->param(-block=> $thisorg->shortname);
481                             my $cfgparam;
482
483                             # if we see this setting, just skip that org
484
485                             $cfgparam = 'ExcludeEntireOrg'; 
486                             if( $localcfg->{$cfgparam} ) 
487                             { skipnote($bib->id, $cfgparam); next COPYMAP; } 
488
489                             # what follows are exclusion rules
490                     
491                             # Excluded Flags
492                             $cfgparam = 'Flags'; 
493                             if($localcfg->{$cfgparam}){
494                                 # this little line is just forcing scalars into an array so we can 'use strict' with Config::Simple
495                                 my @flags = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}));
496                                 if( grep { $_ eq 'reference' } @flags && $cp->ref eq 't')
497                                 { skipnote($bib->id,"Flags: reference"); next COPYMAP; } 
498                                 elsif( grep { $_ eq 'unholdable' } @flags && $cp->holdable eq 'f')
499                                 { skipnote($bib->id,"Flags: unholdable"); next COPYMAP; } 
500                                 elsif( grep { $_ eq 'circulate' } @flags && $cp->circulate eq 'f')
501                                 { skipnote($bib->id,"Flags: circulate"); next COPYMAP; } 
502                                 elsif( grep { $_ eq 'hidden' } @flags && $cp->opac_visible eq 'f')
503                                 { skipnote($bib->id,"Flags: hidden"); next COPYMAP; } 
504                             }
505
506                             # Excluded Circ Modifiers
507                             $cfgparam = 'CircMods'; 
508                             if($localcfg->{$cfgparam}){
509                                 my $circmod = $cp->circ_modifier || "";
510                                 my @circmods = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) );
511                                 if( grep { $_ eq $circmod } @circmods && @circmods)
512                                 { skipnote($bib->id,$cfgparam); next COPYMAP; } 
513                             }
514                             # Inverse rule -- only include specified Circ Mods
515                             $cfgparam = 'OnlyIncludeCircMods'; 
516                             if($localcfg->{$cfgparam}){
517                                 my $circmod = $cp->circ_modifier || "";
518                                 my @circmods = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) );
519                                 unless( grep { $_ and $_ eq $circmod } @circmods && @circmods)
520                                 { skipnote($bib->id,$cfgparam); next COPYMAP; } 
521                             }
522                             # Excluded Copy Statuses
523                             $cfgparam = 'Statuses'; 
524                             if($localcfg->{$cfgparam}){
525                                 my @statuses = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) );
526                                 if( grep { $_ eq $statuses{$cp->status}->name } @statuses && @statuses)
527                                 { skipnote($bib->id,$cfgparam); next COPYMAP; } 
528                             }
529                             # Excluded Locations
530                             $cfgparam = 'Locations'; 
531                             if($localcfg->{$cfgparam}){
532                                 my @locations = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) );
533                                 if( grep { $_ eq $shelves{$cp->location}->name } @locations && @locations)
534                                 { skipnote($bib->id,$cfgparam); next COPYMAP; }
535                             }
536                             # Inverse rule - Only use the specified locations
537                             $cfgparam = 'OnlyIncludeLocations'; 
538                             if($localcfg->{$cfgparam}){
539                                 my @locations = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{'Locations'}) );
540                                 unless( grep { $_ eq $shelves{$cp->location}->name } @locations && @locations)
541                                 { skipnote($bib->id,$cfgparam); next COPYMAP; } 
542                             }
543                             # exclude based on a regex match to location names
544                             $cfgparam = 'LocationRegex'; 
545                             if($localcfg->{$cfgparam}){
546                                 my @locregex = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) );
547                                 my $reg = $localcfg->{$cfgparam};
548                                 if( grep { $shelves{$cp->location}->name =~ m/($reg)/ } @locregex && @locregex)
549                                 { skipnote($bib->id,$cfgparam); next COPYMAP; }
550                             }
551                             # include based on a regex match to location names
552                             $cfgparam = 'OnlyIncludeLocationRegex'; 
553                             if($localcfg->{$cfgparam}){
554                                 my @locregex = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) );
555                                 my $reg = $localcfg->{$cfgparam};
556                                 unless( grep { $shelves{$cp->location}->name =~ m/($reg)/ } @locregex && @locregex)
557                                 { skipnote($bib->id,$cfgparam); next COPYMAP; } 
558                             }
559                             # Exclude based on a callno regex
560                             $cfgparam = 'CallNoRegex'; 
561                             if($localcfg->{$cfgparam}){
562                                 my @callnoregex = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) );
563                                 my $reg = $localcfg->{$cfgparam};
564                                 if( grep { $cn->label =~ m/($reg)/ } @callnoregex && @callnoregex)
565                                 { skipnote($bib->id,$cfgparam); next COPYMAP; }
566                             }
567                             # Include based on a callno regex
568                             $cfgparam = 'OnlyIncludeCallNoRegex'; 
569                             if($localcfg->{$cfgparam}){
570                                 my @callnoregex = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) );
571                                 my $reg = $localcfg->{$cfgparam};
572                                 unless( grep { $cn->label =~ m/($reg)/ } @callnoregex && @callnoregex)
573                                 { skipnote($bib->id,$cfgparam); next COPYMAP; } 
574                             }
575
576                             # Trim call number to a float and exclude based on Dewey Range
577                             if($localcfg->{'DeweyGT'} || $localcfg->{'DeweyLT'}){
578                                 my $gt = $localcfg->{'DeweyGT'};
579                                 my $lt = $localcfg->{'DeweyLT'};
580
581                                 # FIXME if either config has an array just ditch for now
582                                 if (ref($gt) eq "ARRAY" or ref($lt) eq "ARRAY")
583                                 { skipnote($bib->id,""); next COPYMAP; } 
584                                 $gt =~ s/[^0-9\.]//g if $gt; #trim off anything not deweyish
585                                 $lt =~ s/[^0-9\.]//g if $lt; #trim off anything not deweyish
586
587                                 my $callno = $cn->label;
588                                 $callno =~ s/[^0-9\.]//g; #trim off anything not deweyish
589                                 print STDERR $callno;
590                                 #note that we are making big assumptions about the call numbers in the db 
591
592                                 # we have a range, exclude what's inbetween
593                                 if($lt && $gt){
594                                     if($callno > $gt and $callno < $lt)
595                                     { skipnote($bib->id,"Dewey LTGT"); next COPYMAP; } 
596                                 # we only have a top threshold, exclude everything below it
597                                 } elsif ($lt){
598                                     if($callno < $lt)
599                                     { skipnote($bib->id,"Dewey LT"); next COPYMAP; }
600                                 # we only have a bottom threshold, exclude everything above it
601                                 } elsif ($gt){
602                                     if($callno > $gt)
603                                     { skipnote($bib->id,"Dewey GT"); next COPYMAP; } 
604                                 }
605                             }
606
607                             if($thisorg->parent_ou){
608                                  $thisorg = $orgs{$thisorg->parent_ou}
609                             } else {
610                                 $thisorg = ();
611                             }
612                             
613                         }
614                     }
615
616                     $r->append_fields(
617                         MARC::Field->new(
618                             852, '4', '', 
619                             a => $location,
620                             b => $orgs{$printlib}->shortname,
621                             #b => $orgs{$owninglib}->shortname,
622                             #b => $orgs{$circlib}->shortname,
623                             c => $shelves{$cp->location}->name,
624                             j => $cn->label,
625                             ($cp->circ_modifier ? ( g => $cp->circ_modifier ) : ()),
626                             p => $cp->barcode,
627                             ($cp->price ? ( y => $dollarsign.$cp->price ) : ()),
628                             ($cp->copy_number ? ( t => $cp->copy_number ) : ()),
629                             ($cp->ref eq 't' ? ( x => 'reference' ) : ()),
630                             ($cp->holdable eq 'f' ? ( x => 'unholdable' ) : ()),
631                             ($cp->circulate eq 'f' ? ( x => 'noncirculating' ) : ()),
632                             ($cp->opac_visible eq 'f' ? ( x => 'hidden' ) : ()),
633                             z => $statuses{$cp->status}->name,
634                         )
635                     );
636
637
638
639                     stats() if (! ($count{cp} % 100 ));
640                 } # COPYMAP: for my $cp ( @$cn_map_list )
641             } # for my $cn ( @$cn_list )
642         } # if ($cp_list && @$cp_list)
643     } # if ($cn_list && @$cn_list) 
644 } # sub
645
646 sub skipnote { 
647         my $id = shift;
648         my $note = shift;
649         my $outf = *STDERR;
650         $outf = *STDOUT if($output_file) ;
651         printf($outf "Skipped %s due to config: %s\n",$id,$note); 
652 }