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