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