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