Commit | Line | Data |
---|---|---|
456d236e JF |
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 | ||
0cb63574 | 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); |
48566282 | 29 | my ($exclusion_ini,$collapse_to_depth, $output_file); |
456d236e | 30 | my $cfg; |
5eb3fcb8 | 31 | my $force901; |
5d62207e | 32 | my $onlyholdings; |
41d8e042 | 33 | my $field852_4b_type = 'collapsed'; |
456d236e JF |
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, | |
5eb3fcb8 | 48 | 'force901' => \$force901, |
456d236e JF |
49 | 'exclusion_ini=s' => \$exclusion_ini, |
50 | 'collapse_to_depth=i' => \$collapse_to_depth, | |
5d62207e | 51 | 'onlyholdings' => \$onlyholdings, |
6de37f36 | 52 | 'output-file=s' => \$output_file, |
0cb63574 | 53 | 'quiet' => \$quiet, |
41d8e042 | 54 | 'field-852-4b-type=s' => \$field852_4b_type, |
456d236e JF |
55 | ); |
56 | ||
8a28571b | 57 | if ($exclusion_ini) { |
6de37f36 RJ |
58 | die "exclusion ini file does not exist" unless (-r $exclusion_ini and -s $exclusion_ini); |
59 | $cfg = new Config::Simple($exclusion_ini) | |
8a28571b | 60 | } |
41d8e042 RJ |
61 | unless($field852_4b_type =~ /^(collapsed?|circ|owning)/) { |
62 | die sprintf("Invalid argument '%s' to --field-852-4b-type", $field852_4b_type); | |
63 | } | |
456d236e JF |
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 | ||
0709b380 JF |
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 | |
41d8e042 RJ |
107 | --field-852-4b-type TYPE TYPE IN 'circ', 'owning', 'collapsed' (default) |
108 | What library should be displayed in field 852 4\$b? | |
0709b380 | 109 | |
456d236e JF |
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 | ||
48566282 RJ |
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'); | |
456d236e JF |
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 | ||
48566282 | 170 | print $outfh <<HEADER if ($format eq 'XML'); |
456d236e JF |
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 | ||
48566282 | 213 | print $outfh "</collection>\n" if ($format eq 'XML'); |
456d236e JF |
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; | |
96e007eb | 250 | # Return if the bib is deleted |
42df8c35 | 251 | return if ( $bib->deleted eq 't' ); |
456d236e JF |
252 | |
253 | if ($format eq 'ARE' or $format eq 'BRE') { | |
48566282 | 254 | print $outfh OpenSRF::Utils::JSON->perl2JSON($bib); |
0cb63574 | 255 | stats() unless $quiet; |
456d236e JF |
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') { | |
5d62207e JF |
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 | } | |
456d236e JF |
278 | } |
279 | ||
6f8820ad JF |
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 | ||
0a16be0c RJ |
292 | my $recordstr = undef; |
293 | ||
456d236e JF |
294 | if ($format eq 'XML') { |
295 | my $xml = $r->as_xml_record; | |
296 | $xml =~ s/^<\?.+?\?>$//mo; | |
0a16be0c | 297 | $recordstr = $xml; |
456d236e | 298 | } elsif ($format eq 'UNIMARC') { |
0a16be0c | 299 | $recordstr = $r->as_usmarc; |
456d236e | 300 | } elsif ($format eq 'USMARC') { |
0a16be0c | 301 | $recordstr = $r->as_usmarc; |
456d236e | 302 | } |
0a16be0c RJ |
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; | |
456d236e JF |
315 | |
316 | $count{did}++; | |
317 | ||
318 | } otherwise { | |
319 | my $e = shift; | |
28ab66e8 | 320 | my $errorid = $id; |
6de37f36 | 321 | chomp($errorid); |
e759b05b JF |
322 | chomp($e); |
323 | warn "\nERROR ON RECORD $errorid: $e\n"; | |
456d236e JF |
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 | ||
6f8820ad JF |
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 | ||
456d236e JF |
345 | if ($format eq 'XML') { |
346 | my $xml = $r->as_xml_record; | |
347 | $xml =~ s/^<\?.+?\?>$//mo; | |
48566282 | 348 | print $outfh $xml; |
456d236e | 349 | } elsif ($format eq 'UNIMARC') { |
48566282 | 350 | print $outfh $r->as_usmarc; |
456d236e | 351 | } elsif ($format eq 'USMARC') { |
48566282 | 352 | print $outfh $r->as_usmarc; |
456d236e JF |
353 | } |
354 | } otherwise { | |
355 | my $e = shift; | |
e759b05b JF |
356 | my $errorid = chomp($id); |
357 | chomp($e); | |
358 | warn "\nERROR ON MFHD RECORD $errorid: $e\n"; | |
456d236e JF |
359 | import MARC::File::XML; # reset SAX parser so that one bad record doesn't kill the entire export |
360 | }; | |
361 | } | |
362 | } | |
363 | ||
0cb63574 | 364 | stats() if (!$quiet && ! ($count{bib} % 50 )); |
456d236e JF |
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 { | |
c6520c91 | 389 | print STDERR "Retrieving Org Units ... " unless $quiet; |
456d236e JF |
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 | ||
c6520c91 | 401 | print STDERR "Retrieving Copy statuses ... " unless $quiet; |
456d236e JF |
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 | ||
c6520c91 | 413 | print STDERR "Retrieving OU types ... " unless $quiet; |
456d236e JF |
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 | ||
c6520c91 | 425 | print STDERR "Retrieving Shelving locations ... " unless $quiet; |
456d236e JF |
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 | ||
96e007eb | 455 | CALLNUMMAP: for my $cn ( @$cn_list ) { |
456d236e | 456 | my $cn_map_list = $cn_map{$cn->id}; |
96e007eb RJ |
457 | |
458 | # Ignore deleted copies | |
42df8c35 | 459 | next CALLNUMMAP if ( $cn->deleted eq 't' ); |
456d236e JF |
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 | ||
58953181 | 469 | # Ignore deleted copies |
42df8c35 | 470 | next COPYMAP if ( $cp->deleted eq 't'); |
58953181 | 471 | |
456d236e JF |
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 | ||
806177d6 | 490 | |
456d236e | 491 | while( $thisorg ){ |
456d236e JF |
492 | # load the local config from the .ini file for exclusions |
493 | my $localcfg = $cfg->param(-block=> $thisorg->shortname); | |
0cd9cd7d | 494 | my $cfgparam; |
456d236e JF |
495 | |
496 | # if we see this setting, just skip that org | |
497 | ||
0cd9cd7d RJ |
498 | $cfgparam = 'ExcludeEntireOrg'; |
499 | if( $localcfg->{$cfgparam} ) | |
500 | { skipnote($bib->id, $cfgparam); next COPYMAP; } | |
456d236e JF |
501 | |
502 | # what follows are exclusion rules | |
806177d6 | 503 | |
456d236e | 504 | # Excluded Flags |
0cd9cd7d RJ |
505 | $cfgparam = 'Flags'; |
506 | if($localcfg->{$cfgparam}){ | |
456d236e | 507 | # this little line is just forcing scalars into an array so we can 'use strict' with Config::Simple |
0cd9cd7d | 508 | my @flags = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam})); |
dd134fdd | 509 | if(grep( { $_ eq 'reference' } @flags) && ($cp->ref eq 't')) |
48566282 | 510 | { skipnote($bib->id,"Flags: reference"); next COPYMAP; } |
dd134fdd | 511 | if(grep( { $_ eq 'unholdable' } @flags) && ($cp->holdable eq 'f')) |
48566282 | 512 | { skipnote($bib->id,"Flags: unholdable"); next COPYMAP; } |
dd134fdd | 513 | if(grep( { $_ eq 'circulate' } @flags) && ($cp->circulate eq 'f')) |
48566282 | 514 | { skipnote($bib->id,"Flags: circulate"); next COPYMAP; } |
dd134fdd RJ |
515 | if(grep( { $_ eq 'hidden' } @flags) && ($cp->opac_visible eq 'f')) |
516 | { skipnote($bib->id,"Flags: hidden"); next COPYMAP; } | |
456d236e | 517 | } |
0cd9cd7d | 518 | |
456d236e | 519 | # Excluded Circ Modifiers |
0cd9cd7d RJ |
520 | $cfgparam = 'CircMods'; |
521 | if($localcfg->{$cfgparam}){ | |
806177d6 | 522 | my $circmod = $cp->circ_modifier || ""; |
0cd9cd7d | 523 | my @circmods = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) ); |
dd134fdd | 524 | if(grep( { $_ eq $circmod } @circmods) && @circmods) |
0cd9cd7d | 525 | { skipnote($bib->id,$cfgparam); next COPYMAP; } |
456d236e | 526 | } |
3add9381 | 527 | # Inverse rule -- only include specified Circ Mods |
0cd9cd7d RJ |
528 | $cfgparam = 'OnlyIncludeCircMods'; |
529 | if($localcfg->{$cfgparam}){ | |
806177d6 | 530 | my $circmod = $cp->circ_modifier || ""; |
0cd9cd7d | 531 | my @circmods = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) ); |
dd134fdd | 532 | unless(grep( { $_ and $_ eq $circmod } @circmods) && @circmods) |
0cd9cd7d | 533 | { skipnote($bib->id,$cfgparam); next COPYMAP; } |
3add9381 | 534 | } |
456d236e | 535 | # Excluded Copy Statuses |
0cd9cd7d RJ |
536 | $cfgparam = 'Statuses'; |
537 | if($localcfg->{$cfgparam}){ | |
538 | my @statuses = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) ); | |
dd134fdd | 539 | if(grep( { $_ eq $statuses{$cp->status}->name } @statuses) && @statuses) |
0cd9cd7d | 540 | { skipnote($bib->id,$cfgparam); next COPYMAP; } |
456d236e JF |
541 | } |
542 | # Excluded Locations | |
0cd9cd7d RJ |
543 | $cfgparam = 'Locations'; |
544 | if($localcfg->{$cfgparam}){ | |
545 | my @locations = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) ); | |
dd134fdd | 546 | if(grep( { $_ eq $shelves{$cp->location}->name } @locations) && @locations) |
0cd9cd7d | 547 | { skipnote($bib->id,$cfgparam); next COPYMAP; } |
456d236e JF |
548 | } |
549 | # Inverse rule - Only use the specified locations | |
0cd9cd7d RJ |
550 | $cfgparam = 'OnlyIncludeLocations'; |
551 | if($localcfg->{$cfgparam}){ | |
552 | my @locations = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{'Locations'}) ); | |
dd134fdd | 553 | unless(grep( { $_ eq $shelves{$cp->location}->name } @locations) && @locations) |
0cd9cd7d | 554 | { skipnote($bib->id,$cfgparam); next COPYMAP; } |
456d236e JF |
555 | } |
556 | # exclude based on a regex match to location names | |
0cd9cd7d RJ |
557 | $cfgparam = 'LocationRegex'; |
558 | if($localcfg->{$cfgparam}){ | |
559 | my @locregex = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) ); | |
560 | my $reg = $localcfg->{$cfgparam}; | |
dd134fdd | 561 | if(grep( { $shelves{$cp->location}->name =~ m/($reg)/ } @locregex) && @locregex) |
0cd9cd7d | 562 | { skipnote($bib->id,$cfgparam); next COPYMAP; } |
456d236e JF |
563 | } |
564 | # include based on a regex match to location names | |
0cd9cd7d RJ |
565 | $cfgparam = 'OnlyIncludeLocationRegex'; |
566 | if($localcfg->{$cfgparam}){ | |
567 | my @locregex = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) ); | |
568 | my $reg = $localcfg->{$cfgparam}; | |
dd134fdd | 569 | unless(grep( { $shelves{$cp->location}->name =~ m/($reg)/ } @locregex) && @locregex) |
0cd9cd7d | 570 | { skipnote($bib->id,$cfgparam); next COPYMAP; } |
456d236e JF |
571 | } |
572 | # Exclude based on a callno regex | |
0cd9cd7d RJ |
573 | $cfgparam = 'CallNoRegex'; |
574 | if($localcfg->{$cfgparam}){ | |
575 | my @callnoregex = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) ); | |
576 | my $reg = $localcfg->{$cfgparam}; | |
dd134fdd | 577 | if(grep( { $cn->label =~ m/($reg)/ } @callnoregex) && @callnoregex) |
0cd9cd7d | 578 | { skipnote($bib->id,$cfgparam); next COPYMAP; } |
456d236e JF |
579 | } |
580 | # Include based on a callno regex | |
0cd9cd7d RJ |
581 | $cfgparam = 'OnlyIncludeCallNoRegex'; |
582 | if($localcfg->{$cfgparam}){ | |
583 | my @callnoregex = ( (ref($localcfg->{$cfgparam}) eq "ARRAY") ? @{$localcfg->{$cfgparam}} : ($localcfg->{$cfgparam}) ); | |
584 | my $reg = $localcfg->{$cfgparam}; | |
dd134fdd | 585 | unless(grep( { $cn->label =~ m/($reg)/ } @callnoregex) && @callnoregex) |
0cd9cd7d | 586 | { skipnote($bib->id,$cfgparam); next COPYMAP; } |
456d236e | 587 | } |
806177d6 | 588 | |
456d236e JF |
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 | |
48566282 RJ |
595 | if (ref($gt) eq "ARRAY" or ref($lt) eq "ARRAY") |
596 | { skipnote($bib->id,""); next COPYMAP; } | |
456d236e JF |
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){ | |
48566282 RJ |
607 | if($callno > $gt and $callno < $lt) |
608 | { skipnote($bib->id,"Dewey LTGT"); next COPYMAP; } | |
456d236e JF |
609 | # we only have a top threshold, exclude everything below it |
610 | } elsif ($lt){ | |
48566282 RJ |
611 | if($callno < $lt) |
612 | { skipnote($bib->id,"Dewey LT"); next COPYMAP; } | |
456d236e JF |
613 | # we only have a bottom threshold, exclude everything above it |
614 | } elsif ($gt){ | |
48566282 RJ |
615 | if($callno > $gt) |
616 | { skipnote($bib->id,"Dewey GT"); next COPYMAP; } | |
456d236e JF |
617 | } |
618 | } | |
619 | ||
456d236e JF |
620 | if($thisorg->parent_ou){ |
621 | $thisorg = $orgs{$thisorg->parent_ou} | |
622 | } else { | |
623 | $thisorg = (); | |
624 | } | |
625 | ||
626 | } | |
627 | } | |
628 | ||
41d8e042 RJ |
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 | ||
456d236e JF |
640 | $r->append_fields( |
641 | MARC::Field->new( | |
642 | 852, '4', '', | |
643 | a => $location, | |
41d8e042 | 644 | b => $field_852_4b, |
456d236e JF |
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 | ||
5eb3fcb8 | 659 | |
5eb3fcb8 | 660 | |
0cb63574 | 661 | stats() if (!$quiet && ! ($count{cp} % 100 )); |
0cd9cd7d RJ |
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) | |
456d236e | 666 | } # sub |
48566282 RJ |
667 | |
668 | sub skipnote { | |
6de37f36 RJ |
669 | my $id = shift; |
670 | my $note = shift; | |
671 | my $outf = *STDERR; | |
672 | $outf = *STDOUT if($output_file) ; | |
0cb63574 | 673 | printf($outf "Skipped %s due to config: %s\n",$id,$note) unless $quiet; |
48566282 | 674 | } |