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