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