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