1 package OpenILS::Application::Cat::BibCommon;
2 use strict; use warnings;
3 use OpenILS::Utils::CStoreEditor q/:funcs/;
4 use OpenSRF::Utils::Logger qw($logger);
5 use OpenILS::Application::AppUtils;
6 use OpenILS::Utils::Fieldmapper;
7 use OpenILS::Const qw/:const/;
8 use OpenSRF::AppSession;
10 my $U = 'OpenILS::Application::AppUtils';
13 # ---------------------------------------------------------------------------
14 # Shared bib mangling code. Do not publish methods from here.
15 # ---------------------------------------------------------------------------
18 sub bib_source_from_name {
20 $logger->debug("searching for bib source: $name");
24 my ($s) = grep { lc($_->source) eq lc($name) } @$__bib_sources;
30 sub fetch_bib_sources {
31 $__bib_sources = new_editor()->retrieve_all_config_bib_source()
32 unless $__bib_sources;
33 return $__bib_sources;
37 sub biblio_record_replace_marc {
38 my($class, $e, $recid, $newxml, $source, $fixtcn, $override, $strip_grps) = @_;
40 $override = { all => 1 } if($override && !ref $override);
41 $override = { all => 0 } if(!ref $override);
43 my $rec = $e->retrieve_biblio_record_entry($recid)
44 or return $e->die_event;
46 # See if there is a different record in the database that has our TCN value
47 # If we're not updating the TCN, all we care about it the marcdoc
48 # XXX should .update even bother with the tcn_info if it's not going to replace it?
49 # there is the potential for returning a TCN_EXISTS event, even though no replacement happens
51 my( $tcn, $tsource, $marcdoc, $evt);
53 if($fixtcn or $override->{all} or $override->{events}) {
55 ($tcn, $tsource, $marcdoc, $evt) =
56 _find_tcn_info($e, $newxml, $override, $recid);
60 $rec->tcn_value($tcn) if ($tcn);
61 $rec->tcn_source($tsource);
65 $marcdoc = __make_marc_doc($newxml);
68 my $marc = $U->strip_marc_fields($e, $marcdoc, $strip_grps);
70 $rec->source(bib_source_from_name($source)) if $source;
71 $rec->editor($e->requestor->id);
72 $rec->edit_date('now');
75 my $inline_ingest = $e->retrieve_config_global_flag('ingest.queued.biblio.update.marc_edit_inline');
76 $inline_ingest = ($inline_ingest and $U->is_true($inline_ingest->enabled));
79 {from => [ 'action.set_queued_ingest_force', 'ingest.queued.biblio.update.disabled' ]}
80 ) if ($inline_ingest);
82 $e->update_biblio_record_entry($rec) or return $e->die_event;
85 {from => ['action.clear_queued_ingest_force']}
86 ) if ($inline_ingest);
91 sub biblio_record_xml_import {
92 my($class, $e, $xml, $source, $auto_tcn, $override, $strip_grps) = @_;
94 $override = { all => 1 } if($override && !ref $override);
95 $override = { all => 0 } if(!ref $override);
97 my( $evt, $tcn, $tcn_source, $marcdoc );
99 my $use_id = $e->retrieve_config_global_flag('cat.bib.use_id_for_tcn');
100 $use_id = ($use_id and $U->is_true($use_id->enabled));
102 if( $auto_tcn or $use_id ) {
103 # auto_tcn forces a blank TCN value so the DB will have to generate one for us
104 $marcdoc = __make_marc_doc($xml);
106 ( $tcn, $tcn_source, $marcdoc, $evt ) = _find_tcn_info($e, $xml, $override);
110 # Silence warnings when _find_tcn_info() fails
113 $logger->info("user ".$e->requestor->id.
114 " creating new biblio entry with tcn=$tcn and tcn_source $tcn_source");
116 my $marc = $U->strip_marc_fields($e, $marcdoc, $strip_grps);
118 my $record = Fieldmapper::biblio::record_entry->new;
120 $record->source(bib_source_from_name($source)) if $source;
121 $record->tcn_source($tcn_source) if $tcn_source;
122 $record->tcn_value($tcn) if ($tcn);
123 $record->creator($e->requestor->id);
124 $record->editor($e->requestor->id);
125 $record->create_date('now');
126 $record->edit_date('now');
127 $record->marc($marc);
129 my $inline_ingest = $e->retrieve_config_global_flag('ingest.queued.biblio.insert.marc_edit_inline');
130 $inline_ingest = ($inline_ingest and $U->is_true($inline_ingest->enabled));
133 {from => [ 'action.set_queued_ingest_force', 'ingest.queued.biblio.insert.disabled' ]}
134 ) if ($inline_ingest);
136 $record = $e->create_biblio_record_entry($record) or return $e->die_event;
139 {from => ['action.clear_queued_ingest_force']}
140 ) if ($inline_ingest);
143 my $existing = $e->search_biblio_record_entry(
145 tcn_value => $record->id,
153 # leave the auto-generated tcn_value in place
154 $logger->warn("Collision using internal ID as tcn_value for record " . $record->id);
156 $record->tcn_value($record->id);
157 $e->update_biblio_record_entry($record) or return $e->die_event;
161 $logger->info("marc create/import created new record ".$record->id);
165 sub __make_marc_doc {
167 my $marcxml = XML::LibXML->new->parse_string($xml);
168 $marcxml->documentElement->setNamespace(MARC_NAMESPACE, "marc", 1 );
169 $marcxml->documentElement->setNamespace(MARC_NAMESPACE);
170 __remove_empty_marc_nodes($marcxml);
174 # remove empty control fields, subfields, and variable data fields, which
175 # can creep in via less-than-correct imported MARC records or issues
177 sub __remove_empty_marc_nodes {
180 __remove_if_childless($_) foreach $marcxml->documentElement->getElementsByTagNameNS(MARC_NAMESPACE, 'controlfield');
181 __remove_if_childless($_) foreach $marcxml->documentElement->getElementsByTagNameNS(MARC_NAMESPACE, 'subfield');
182 __remove_if_childless($_) foreach $marcxml->documentElement->getElementsByTagNameNS(MARC_NAMESPACE, 'datafield');
185 sub __remove_if_childless {
187 my @children = $node->childNodes();
188 my $has_nonblank_children = 0;
189 # can do this more concisely by requiring XML::LibXML >= 1.70 and using nonBlankChildNodes()
190 foreach my $node ($node->childNodes()) {
191 if ($node->nodeType != XML::LibXML::XML_TEXT_NODE || $node->nodeValue !~ /^\s*$/) {
192 $has_nonblank_children = 1;
196 $node->parentNode->removeChild($node) unless $has_nonblank_children;
202 my $override = shift;
203 my $existing_rec = shift || 0;
205 $override = { all => 1 } if($override && !ref $override);
206 $override = { all => 0 } if(!ref $override);
209 my $marcxml = __make_marc_doc($xml);
211 my $xpath = '//marc:controlfield[@tag="001"]';
212 my $tcn = $marcxml->documentElement->findvalue($xpath);
213 $logger->info("biblio import located 001 (tcn) value of $tcn");
215 $xpath = '//marc:controlfield[@tag="003"]';
216 my $tcn_source = $marcxml->documentElement->findvalue($xpath) || "System Local";
218 if(my $rec = _tcn_exists($editor, $tcn, $tcn_source, $existing_rec) ) {
221 $tcn = find_free_tcn( $marcxml, $editor, $existing_rec );
223 # if we're overriding, try to find a different TCN to use
224 if( $override->{all} || grep { $_ eq 'TCN_EXISTS' } @{$override->{events}} ) {
226 # XXX Create ALLOW_ALT_TCN permission check support
228 $logger->info("tcn value $tcn already exists, attempting to override");
236 'OPEN_TCN_NOT_FOUND',
237 payload => $marcxml->toString())
243 $logger->warn("tcn value $origtcn already exists in import/create");
245 # otherwise, return event
251 'TCN_EXISTS', payload => {
261 return ($tcn, $tcn_source, $marcxml);
268 my $existing_rec = shift;
270 my $xpath = '//marc:datafield[@tag="901"]/marc:subfield[@code="a"]';
271 my ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
274 $xpath = '//marc:datafield[@tag="039"]/marc:subfield[@code="a"]';
275 ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
278 $xpath = '//marc:datafield[@tag="901"]/marc:subfield[@code="b"]';
279 my ($tcn_source) = $marcxml->documentElement->findvalue($xpath);
281 $xpath = '//marc:datafield[@tag="039"]/marc:subfield[@code="b"]';
282 $tcn_source = $marcxml->documentElement->findvalue($xpath) || "System Local";
285 if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {
291 $xpath = '//marc:datafield[@tag="020"]/marc:subfield[@code="a"]';
292 ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
293 $tcn_source = "ISBN";
294 if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
298 $xpath = '//marc:datafield[@tag="022"]/marc:subfield[@code="a"]';
299 ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
300 $tcn_source = "ISSN";
301 if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
305 $xpath = '//marc:datafield[@tag="010"]';
306 ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
307 $tcn_source = "LCCN";
308 if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
312 $xpath = '//marc:datafield[@tag="035"]/marc:subfield[@code="a"]';
313 ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
314 $tcn_source = "System Legacy";
315 if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
318 $marcxml->documentElement->removeChild(
319 $marcxml->documentElement->findnodes( '//marc:datafield[@tag="035"]' )
324 return undef unless $tcn;
334 my $existing_rec = shift || 0;
336 if(!$tcn) {return 0;}
338 $logger->debug("tcn_exists search for tcn $tcn and source $source and id $existing_rec");
340 # XXX why does the source matter?
341 # my $req = $session->request(
342 # { tcn_value => $tcn, tcn_source => $source, deleted => 'f' } );
344 my $recs = $editor->search_biblio_record_entry(
345 {tcn_value => $tcn, deleted => 'f', id => {'!=' => $existing_rec}}, {idlist =>1});
348 $logger->debug("_tcn_exists is true for tcn : $tcn ($source)");
352 $logger->debug("_tcn_exists is false for tcn : $tcn ($source)");
358 my($class, $editor, $rec_id ) = @_;
360 my $rec = $editor->retrieve_biblio_record_entry($rec_id)
361 or return $editor->event;
363 return undef if $U->is_true($rec->deleted);
367 $rec->editor( $editor->requestor->id );
368 $rec->edit_date('now');
370 # Set the leader/05 to indicate that the record has been deleted
371 my $marc = $rec->marc();
372 $marc =~ s{(<leader>.{5}).}{$1d};
375 $editor->update_biblio_record_entry($rec) or return $editor->event;
377 my $holds = $editor->search_action_hold_request({
380 cancel_time => undef,
381 fulfillment_time => undef
384 for my $hold (@$holds) {
386 $hold->cancel_time('now');
387 $hold->cancel_cause(1); # un-targeted expiration.
388 $editor->update_action_hold_request($hold) or return $editor->die_event;
390 # Update our copy of the hold to pick up the cancel_time
391 # before we pass it off to A/T.
392 $hold = $editor->retrieve_action_hold_request($hold->id);
394 my $at_ses = OpenSRF::AppSession->create('open-ils.trigger');
396 'open-ils.trigger.event.autocreate',
397 'hold_request.cancel.expire_no_target',
398 $hold, $hold->pickup_lib);
405 # ---------------------------------------------------------------------------
406 # returns true if the given title (id) has no un-deleted volumes or
407 # copies attached. If a context volume is defined, a record
408 # is considered empty only if the context volume is the only
409 # remaining volume on the record.
410 # ---------------------------------------------------------------------------
412 my($class, $editor, $rid, $vol_id) = @_;
414 # check if $rid is an object, because may be passing the volume
415 # with a fleshed record in one of our callers.
416 $rid = $rid->id() if (ref($rid));
418 return 0 if $rid == OILS_PRECAT_RECORD;
420 my $cnlist = $editor->search_asset_call_number(
421 { record => $rid, deleted => 'f' }, { idlist => 1 } );
423 return 1 unless @$cnlist; # no attached volumes
424 return 0 if @$cnlist > 1; # multiple attached volumes
425 return 0 unless $$cnlist[0] == $vol_id; # attached volume is not the context vol.
427 # see if the sole remaining context volume has any attached copies
428 for my $cn (@$cnlist) {
429 my $copylist = $editor->search_asset_copy(
431 { call_number => $cn, deleted => 'f' },
434 return 0 if @$copylist; # false if we find any copies
440 # --------------------------------------------------------------------------
441 # returns true if the given title (id) has active hold requests on it
442 # --------------------------------------------------------------------------
443 sub title_has_holds {
444 my($class, $editor, $rid) = @_;
446 # check if $rid is an object, because may be passing the volume
447 # with a fleshed record in one of our callers.
448 $rid = $rid->id() if (ref($rid));
450 my $holds = $editor->search_action_hold_request(
452 { fulfillment_time => undef,
453 cancel_time => undef,
458 return 0 unless @$holds;
460 return 1; # we found a hold