2728fdee1c43c1d656cf270a1decb9f02658f947
[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                     if($cfg){
457                         my $thisorg = $orgs{$circlib};
458
459                         if($collapse_to_depth){
460                             while ( $outypes{ $thisorg->ou_type }->depth > $collapse_to_depth ){
461                                 my $localcfg = $cfg->param(-block=> $thisorg->shortname);
462                                 if( $localcfg->{'DontCollapse'} ){
463                                     last;
464                                 }
465                                 if($thisorg->parent_ou){
466                                     $thisorg = $orgs{$thisorg->parent_ou};
467                                     $printlib = $thisorg->id;
468                                 }
469                             }
470                         }
471
472                         $thisorg = $orgs{$circlib};
473
474
475                         while( $thisorg ){
476                             # load the local config from the .ini file for exclusions
477                             my $localcfg = $cfg->param(-block=> $thisorg->shortname);
478                             my $cfgparam;
479
480                             # if we see this setting, just skip that org
481
482                             $cfgparam = 'ExcludeEntireOrg'; 
483                             if( $localcfg->{$cfgparam} ) 
484                             { skipnote($bib->id, $cfgparam); next COPYMAP; } 
485
486                             # what follows are exclusion rules
487                     
488                             # Excluded Flags
489                             $cfgparam = 'Flags'; 
490                             if($localcfg->{$cfgparam}){
491                                 # this little line is just forcing scalars into an array so we can 'use strict' with Config::Simple
492                                 my @flags = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}));
493                                 if( grep { $_ eq 'reference' } @flags && $cp->ref eq 't')
494                                 { skipnote($bib->id,"Flags: reference"); next COPYMAP; } 
495                                 elsif( grep { $_ eq 'unholdable' } @flags && $cp->holdable eq 'f')
496                                 { skipnote($bib->id,"Flags: unholdable"); next COPYMAP; } 
497                                 elsif( grep { $_ eq 'circulate' } @flags && $cp->circulate eq 'f')
498                                 { skipnote($bib->id,"Flags: circulate"); next COPYMAP; } 
499                                 elsif( grep { $_ eq 'hidden' } @flags && $cp->opac_visible eq 'f')
500                                 { skipnote($bib->id,"Flags: hidden"); next COPYMAP; } 
501                             }
502
503                             # Excluded Circ Modifiers
504                             $cfgparam = 'CircMods'; 
505                             if($localcfg->{$cfgparam}){
506                                 my $circmod = $cp->circ_modifier || "";
507                                 my @circmods = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) );
508                                 if( grep { $_ eq $circmod } @circmods && @circmods)
509                                 { skipnote($bib->id,$cfgparam); next COPYMAP; } 
510                             }
511                             # Inverse rule -- only include specified Circ Mods
512                             $cfgparam = 'OnlyIncludeCircMods'; 
513                             if($localcfg->{$cfgparam}){
514                                 my $circmod = $cp->circ_modifier || "";
515                                 my @circmods = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) );
516                                 unless( grep { $_ and $_ eq $circmod } @circmods && @circmods)
517                                 { skipnote($bib->id,$cfgparam); next COPYMAP; } 
518                             }
519                             # Excluded Copy Statuses
520                             $cfgparam = 'Statuses'; 
521                             if($localcfg->{$cfgparam}){
522                                 my @statuses = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) );
523                                 if( grep { $_ eq $statuses{$cp->status}->name } @statuses && @statuses)
524                                 { skipnote($bib->id,$cfgparam); next COPYMAP; } 
525                             }
526                             # Excluded Locations
527                             $cfgparam = 'Locations'; 
528                             if($localcfg->{$cfgparam}){
529                                 my @locations = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) );
530                                 if( grep { $_ eq $shelves{$cp->location}->name } @locations && @locations)
531                                 { skipnote($bib->id,$cfgparam); next COPYMAP; }
532                             }
533                             # Inverse rule - Only use the specified locations
534                             $cfgparam = 'OnlyIncludeLocations'; 
535                             if($localcfg->{$cfgparam}){
536                                 my @locations = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{'Locations'}) );
537                                 unless( grep { $_ eq $shelves{$cp->location}->name } @locations && @locations)
538                                 { skipnote($bib->id,$cfgparam); next COPYMAP; } 
539                             }
540                             # exclude based on a regex match to location names
541                             $cfgparam = 'LocationRegex'; 
542                             if($localcfg->{$cfgparam}){
543                                 my @locregex = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) );
544                                 my $reg = $localcfg->{$cfgparam};
545                                 if( grep { $shelves{$cp->location}->name =~ m/($reg)/ } @locregex && @locregex)
546                                 { skipnote($bib->id,$cfgparam); next COPYMAP; }
547                             }
548                             # include based on a regex match to location names
549                             $cfgparam = 'OnlyIncludeLocationRegex'; 
550                             if($localcfg->{$cfgparam}){
551                                 my @locregex = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) );
552                                 my $reg = $localcfg->{$cfgparam};
553                                 unless( grep { $shelves{$cp->location}->name =~ m/($reg)/ } @locregex && @locregex)
554                                 { skipnote($bib->id,$cfgparam); next COPYMAP; } 
555                             }
556                             # Exclude based on a callno regex
557                             $cfgparam = 'CallNoRegex'; 
558                             if($localcfg->{$cfgparam}){
559                                 my @callnoregex = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) );
560                                 my $reg = $localcfg->{$cfgparam};
561                                 if( grep { $cn->label =~ m/($reg)/ } @callnoregex && @callnoregex)
562                                 { skipnote($bib->id,$cfgparam); next COPYMAP; }
563                             }
564                             # Include based on a callno regex
565                             $cfgparam = 'OnlyIncludeCallNoRegex'; 
566                             if($localcfg->{$cfgparam}){
567                                 my @callnoregex = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) );
568                                 my $reg = $localcfg->{$cfgparam};
569                                 unless( grep { $cn->label =~ m/($reg)/ } @callnoregex && @callnoregex)
570                                 { skipnote($bib->id,$cfgparam); next COPYMAP; } 
571                             }
572
573                             # Trim call number to a float and exclude based on Dewey Range
574                             if($localcfg->{'DeweyGT'} || $localcfg->{'DeweyLT'}){
575                                 my $gt = $localcfg->{'DeweyGT'};
576                                 my $lt = $localcfg->{'DeweyLT'};
577
578                                 # FIXME if either config has an array just ditch for now
579                                 if (ref($gt) eq "ARRAY" or ref($lt) eq "ARRAY")
580                                 { skipnote($bib->id,""); next COPYMAP; } 
581                                 $gt =~ s/[^0-9\.]//g if $gt; #trim off anything not deweyish
582                                 $lt =~ s/[^0-9\.]//g if $lt; #trim off anything not deweyish
583
584                                 my $callno = $cn->label;
585                                 $callno =~ s/[^0-9\.]//g; #trim off anything not deweyish
586                                 print STDERR $callno;
587                                 #note that we are making big assumptions about the call numbers in the db 
588
589                                 # we have a range, exclude what's inbetween
590                                 if($lt && $gt){
591                                     if($callno > $gt and $callno < $lt)
592                                     { skipnote($bib->id,"Dewey LTGT"); next COPYMAP; } 
593                                 # we only have a top threshold, exclude everything below it
594                                 } elsif ($lt){
595                                     if($callno < $lt)
596                                     { skipnote($bib->id,"Dewey LT"); next COPYMAP; }
597                                 # we only have a bottom threshold, exclude everything above it
598                                 } elsif ($gt){
599                                     if($callno > $gt)
600                                     { skipnote($bib->id,"Dewey GT"); next COPYMAP; } 
601                                 }
602                             }
603
604                             if($thisorg->parent_ou){
605                                  $thisorg = $orgs{$thisorg->parent_ou}
606                             } else {
607                                 $thisorg = ();
608                             }
609                             
610                         }
611                     }
612
613                     $r->append_fields(
614                         MARC::Field->new(
615                             852, '4', '', 
616                             a => $location,
617                             b => $orgs{$printlib}->shortname,
618                             #b => $orgs{$owninglib}->shortname,
619                             #b => $orgs{$circlib}->shortname,
620                             c => $shelves{$cp->location}->name,
621                             j => $cn->label,
622                             ($cp->circ_modifier ? ( g => $cp->circ_modifier ) : ()),
623                             p => $cp->barcode,
624                             ($cp->price ? ( y => $dollarsign.$cp->price ) : ()),
625                             ($cp->copy_number ? ( t => $cp->copy_number ) : ()),
626                             ($cp->ref eq 't' ? ( x => 'reference' ) : ()),
627                             ($cp->holdable eq 'f' ? ( x => 'unholdable' ) : ()),
628                             ($cp->circulate eq 'f' ? ( x => 'noncirculating' ) : ()),
629                             ($cp->opac_visible eq 'f' ? ( x => 'hidden' ) : ()),
630                             z => $statuses{$cp->status}->name,
631                         )
632                     );
633
634
635
636                     stats() if (! ($count{cp} % 100 ));
637                 } # COPYMAP: for my $cp ( @$cn_map_list )
638             } # for my $cn ( @$cn_list )
639         } # if ($cp_list && @$cp_list)
640     } # if ($cn_list && @$cn_list) 
641 } # sub
642
643 sub skipnote { 
644         my $id = shift;
645         my $note = shift;
646         my $outf = *STDERR;
647         $outf = *STDOUT if($output_file) ;
648         printf($outf "Skipped %s due to config: %s\n",$id,$note); 
649 }