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