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