Allow more granular overrides
[Evergreen.git] / Open-ILS / src / perlmods / lib / OpenILS / Application / Cat / BibCommon.pm
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;
9 use OpenILS::Event;
10 my $U = 'OpenILS::Application::AppUtils';
11 my $MARC_NAMESPACE = 'http://www.loc.gov/MARC21/slim';
12
13
14 # ---------------------------------------------------------------------------
15 # Shared bib mangling code.  Do not publish methods from here.
16 # ---------------------------------------------------------------------------
17
18 my $__bib_sources;
19 sub bib_source_from_name {
20         my $name = shift;
21         $logger->debug("searching for bib source: $name");
22
23         fetch_bib_sources();
24
25         my ($s) = grep { lc($_->source) eq lc($name) } @$__bib_sources;
26
27         return $s->id if $s;
28         return undef;
29 }
30
31 sub fetch_bib_sources {
32         $__bib_sources = new_editor()->retrieve_all_config_bib_source()
33                 unless $__bib_sources;
34         return $__bib_sources;
35 }
36
37
38 sub biblio_record_replace_marc  {
39         my($class, $e, $recid, $newxml, $source, $fixtcn, $override) = @_;
40
41     $override = { all => 1 } if($override && !ref $override);
42     $override = { all => 0 } if(!ref $override);
43
44         my $rec = $e->retrieve_biblio_record_entry($recid)
45                 or return $e->die_event;
46
47     # See if there is a different record in the database that has our TCN value
48     # If we're not updating the TCN, all we care about it the marcdoc
49     # XXX should .update even bother with the tcn_info if it's not going to replace it?
50     # there is the potential for returning a TCN_EXISTS event, even though no replacement happens
51
52         my( $tcn, $tsource, $marcdoc, $evt);
53
54     if($fixtcn or $override->{all} or $override->{events}) {
55
56             ($tcn, $tsource, $marcdoc, $evt) = 
57                     _find_tcn_info($e, $newxml, $override, $recid);
58
59             return $evt if $evt;
60
61                 $rec->tcn_value($tcn) if ($tcn);
62                 $rec->tcn_source($tsource);
63
64     } else {
65
66         $marcdoc = __make_marc_doc($newxml);
67     }
68
69
70         $rec->source(bib_source_from_name($source)) if $source;
71         $rec->editor($e->requestor->id);
72         $rec->edit_date('now');
73         $rec->marc( $U->entityize( $marcdoc->documentElement->toString ) );
74         $e->update_biblio_record_entry($rec) or return $e->die_event;
75
76         return $rec;
77 }
78
79 sub biblio_record_xml_import {
80         my($class, $e, $xml, $source, $auto_tcn, $override) = @_;
81
82     $override = { all => 1 } if($override && !ref $override);
83     $override = { all => 0 } if(!ref $override);
84
85         my( $evt, $tcn, $tcn_source, $marcdoc );
86
87     my $use_id = $e->retrieve_config_global_flag('cat.bib.use_id_for_tcn');
88     $use_id = ($use_id and $U->is_true($use_id->enabled));
89
90         if( $auto_tcn or $use_id ) {
91                 # auto_tcn forces a blank TCN value so the DB will have to generate one for us
92                 $marcdoc = __make_marc_doc($xml);
93         } else {
94                 ( $tcn, $tcn_source, $marcdoc, $evt ) = _find_tcn_info($e, $xml, $override);
95                 return $evt if $evt;
96         }
97
98         # Silence warnings when _find_tcn_info() fails
99         $tcn ||= '';
100         $tcn_source ||= '';
101         $logger->info("user ".$e->requestor->id.
102                 " creating new biblio entry with tcn=$tcn and tcn_source $tcn_source");
103
104         my $record = Fieldmapper::biblio::record_entry->new;
105
106         $record->source(bib_source_from_name($source)) if $source;
107         $record->tcn_source($tcn_source);
108         $record->tcn_value($tcn) if ($tcn);
109         $record->creator($e->requestor->id);
110         $record->editor($e->requestor->id);
111         $record->create_date('now');
112         $record->edit_date('now');
113         $record->marc($U->entityize($marcdoc->documentElement->toString));
114
115     $record = $e->create_biblio_record_entry($record) or return $e->die_event;
116
117     if($use_id) {
118         my $existing = $e->search_biblio_record_entry(
119             {   
120                 tcn_value => $record->id,
121                 deleted => 'f'
122             }, { 
123                 idlist => 1 
124             }
125         );
126
127         if(@$existing) {
128             # leave the auto-generated tcn_value in place
129             $logger->warn("Collision using internal ID as tcn_value for record " . $record->id);
130         } else {
131             $record->tcn_value($record->id);
132             $e->update_biblio_record_entry($record) or return $e->die_event;
133         }
134     }
135
136         $logger->info("marc create/import created new record ".$record->id);
137         return $record;
138 }
139
140 sub __make_marc_doc {
141         my $xml = shift;
142         my $marcxml = XML::LibXML->new->parse_string($xml);
143         $marcxml->documentElement->setNamespace($MARC_NAMESPACE, "marc", 1 );
144         $marcxml->documentElement->setNamespace($MARC_NAMESPACE);
145         __remove_empty_marc_nodes($marcxml);
146         return $marcxml;
147 }
148
149 # remove empty control fields, subfields, and variable data fields, which
150 # can creep in via less-than-correct imported MARC records or issues
151 # with templates
152 sub __remove_empty_marc_nodes {
153         my $marcxml = shift;
154
155         __remove_if_childless($_) foreach $marcxml->documentElement->getElementsByTagNameNS($MARC_NAMESPACE, 'controlfield');
156         __remove_if_childless($_) foreach $marcxml->documentElement->getElementsByTagNameNS($MARC_NAMESPACE, 'subfield');
157         __remove_if_childless($_) foreach $marcxml->documentElement->getElementsByTagNameNS($MARC_NAMESPACE, 'datafield');
158 }
159
160 sub __remove_if_childless {
161         my $node = shift;
162         my @children = $node->childNodes();
163         my $has_nonblank_children = 0;
164         # can do this more concisely by requiring XML::LibXML >= 1.70 and using nonBlankChildNodes()
165         foreach my $node ($node->childNodes()) {
166                 if ($node->nodeType != XML::LibXML::XML_TEXT_NODE || $node->nodeValue !~ /^\s*$/) {
167                         $has_nonblank_children = 1;
168                         last;
169                 }
170         }
171         $node->parentNode->removeChild($node) unless $has_nonblank_children;
172 }
173
174 sub _find_tcn_info { 
175         my $editor              = shift;
176         my $xml                 = shift;
177         my $override    = shift;
178         my $existing_rec        = shift || 0;
179
180     $override = { all => 1 } if($override && !ref $override);
181     $override = { all => 0 } if(!ref $override);
182
183         # parse the XML
184         my $marcxml = __make_marc_doc($xml);
185
186         my $xpath = '//marc:controlfield[@tag="001"]';
187         my $tcn = $marcxml->documentElement->findvalue($xpath);
188         $logger->info("biblio import located 001 (tcn) value of $tcn");
189
190         $xpath = '//marc:controlfield[@tag="003"]';
191         my $tcn_source = $marcxml->documentElement->findvalue($xpath) || "System Local";
192
193         if(my $rec = _tcn_exists($editor, $tcn, $tcn_source, $existing_rec) ) {
194
195                 my $origtcn = $tcn;
196                 $tcn = find_free_tcn( $marcxml, $editor, $existing_rec );
197
198                 # if we're overriding, try to find a different TCN to use
199                 if( $override->{all} || grep { $_ eq 'TCN_EXISTS' } @{$override->{events}} ) {
200
201          # XXX Create ALLOW_ALT_TCN permission check support 
202
203                         $logger->info("tcn value $tcn already exists, attempting to override");
204
205                         if(!$tcn) {
206                                 return ( 
207                                         undef, 
208                                         undef, 
209                                         undef,
210                                         OpenILS::Event->new(
211                                                 'OPEN_TCN_NOT_FOUND', 
212                                                         payload => $marcxml->toString())
213                                         );
214                         }
215
216                 } else {
217
218                         $logger->warn("tcn value $origtcn already exists in import/create");
219
220                         # otherwise, return event
221                         return ( 
222                                 undef, 
223                                 undef, 
224                                 undef,
225                                 OpenILS::Event->new( 
226                                         'TCN_EXISTS', payload => { 
227                                                 dup_record      => $rec, 
228                                                 tcn                     => $origtcn,
229                                                 new_tcn         => $tcn
230                                                 }
231                                         )
232                                 );
233                 }
234         }
235
236         return ($tcn, $tcn_source, $marcxml);
237 }
238
239 sub find_free_tcn {
240
241         my $marcxml = shift;
242         my $editor = shift;
243         my $existing_rec = shift;
244
245         my $xpath = '//marc:datafield[@tag="901"]/marc:subfield[@code="a"]';
246         my ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
247
248     if (!$tcn) {
249             $xpath = '//marc:datafield[@tag="039"]/marc:subfield[@code="a"]';
250             ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
251     }
252
253         $xpath = '//marc:datafield[@tag="901"]/marc:subfield[@code="b"]';
254         my ($tcn_source) = $marcxml->documentElement->findvalue($xpath);
255     if (!$tcn_source) {
256             $xpath = '//marc:datafield[@tag="039"]/marc:subfield[@code="b"]';
257         $tcn_source = $marcxml->documentElement->findvalue($xpath) || "System Local";
258     }
259
260         if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {
261                 $tcn = undef;
262         }
263
264
265         if(!$tcn) {
266                 $xpath = '//marc:datafield[@tag="020"]/marc:subfield[@code="a"]';
267                 ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
268                 $tcn_source = "ISBN";
269                 if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
270         }
271
272         if(!$tcn) { 
273                 $xpath = '//marc:datafield[@tag="022"]/marc:subfield[@code="a"]';
274                 ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
275                 $tcn_source = "ISSN";
276                 if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
277         }
278
279         if(!$tcn) {
280                 $xpath = '//marc:datafield[@tag="010"]';
281                 ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
282                 $tcn_source = "LCCN";
283                 if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
284         }
285
286         if(!$tcn) {
287                 $xpath = '//marc:datafield[@tag="035"]/marc:subfield[@code="a"]';
288                 ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
289                 $tcn_source = "System Legacy";
290                 if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
291
292                 if($tcn) {
293                         $marcxml->documentElement->removeChild(
294                                 $marcxml->documentElement->findnodes( '//marc:datafield[@tag="035"]' )
295                         );
296                 }
297         }
298
299         return undef unless $tcn;
300         return $tcn;
301 }
302
303
304
305 sub _tcn_exists {
306         my $editor = shift;
307         my $tcn = shift;
308         my $source = shift;
309         my $existing_rec = shift || 0;
310
311         if(!$tcn) {return 0;}
312
313         $logger->debug("tcn_exists search for tcn $tcn and source $source and id $existing_rec");
314
315         # XXX why does the source matter?
316 #       my $req = $session->request(      
317 #               { tcn_value => $tcn, tcn_source => $source, deleted => 'f' } );
318
319     my $recs = $editor->search_biblio_record_entry(
320         {tcn_value => $tcn, deleted => 'f', id => {'!=' => $existing_rec}}, {idlist =>1});
321
322         if(@$recs) {
323                 $logger->debug("_tcn_exists is true for tcn : $tcn ($source)");
324                 return $recs->[0];
325         }
326
327         $logger->debug("_tcn_exists is false for tcn : $tcn ($source)");
328         return 0;
329 }
330
331
332 sub delete_rec {
333    my($class, $editor, $rec_id ) = @_;
334
335    my $rec = $editor->retrieve_biblio_record_entry($rec_id)
336       or return $editor->event;
337
338    return undef if $U->is_true($rec->deleted);
339    
340    $rec->deleted('t');
341    $rec->active('f');
342    $rec->editor( $editor->requestor->id );
343    $rec->edit_date('now');
344
345    # Set the leader/05 to indicate that the record has been deleted
346    my $marc = $rec->marc();
347    $marc =~ s{(<leader>.{5}).}{$1d};
348    $rec->marc($marc);
349
350    $editor->update_biblio_record_entry($rec) or return $editor->event;
351
352     my $holds = $editor->search_action_hold_request({
353         target => $rec->id,
354         hold_type => 'T',
355         cancel_time => undef,
356         fulfillment_time => undef
357     });
358
359     for my $hold (@$holds) {
360
361         $hold->cancel_time('now');
362         $hold->cancel_cause(1); # un-targeted expiration.
363         $editor->update_action_hold_request($hold) or return $editor->die_event;
364
365         my $maps = $editor->search_action_hold_copy_map({hold => $hold->id});
366         for(@$maps) {
367             $editor->delete_action_hold_copy_map($_) 
368                 or return $editor->die_event;
369         }
370
371         my $at_ses = OpenSRF::AppSession->create('open-ils.trigger');
372         $at_ses->request(
373             'open-ils.trigger.event.autocreate',
374             'hold_request.cancel.expire_no_target', 
375             $hold, $hold->pickup_lib);
376     }
377
378    return undef;
379 }
380
381
382 # ---------------------------------------------------------------------------
383 # returns true if the given title (id) has no un-deleted volumes or 
384 # copies attached.  If a context volume is defined, a record
385 # is considered empty only if the context volume is the only
386 # remaining volume on the record.  
387 # ---------------------------------------------------------------------------
388 sub title_is_empty {
389         my($class, $editor, $rid, $vol_id) = @_;
390
391         return 0 if $rid == OILS_PRECAT_RECORD;
392
393         my $cnlist = $editor->search_asset_call_number(
394                 { record => $rid, deleted => 'f' }, { idlist => 1 } );
395
396         return 1 unless @$cnlist; # no attached volumes
397     return 0 if @$cnlist > 1; # multiple attached volumes
398     return 0 unless $$cnlist[0] == $vol_id; # attached volume is not the context vol.
399
400     # see if the sole remaining context volume has any attached copies
401         for my $cn (@$cnlist) {
402                 my $copylist = $editor->search_asset_copy(
403                         [
404                                 { call_number => $cn, deleted => 'f' }, 
405                                 { limit => 1 },
406                         ], { idlist => 1 });
407                 return 0 if @$copylist; # false if we find any copies
408         }
409
410         return 1;
411 }
412 1;