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