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