marc_export_custom/marc_export_custom

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