Allow more granular overrides
[Evergreen.git] / Open-ILS / src / perlmods / lib / OpenILS / Application / Cat.pm
1 use strict; use warnings;
2 package OpenILS::Application::Cat;
3 use OpenILS::Application::AppUtils;
4 use OpenILS::Application;
5 use OpenILS::Application::Cat::Merge;
6 use OpenILS::Application::Cat::Authority;
7 use OpenILS::Application::Cat::BibCommon;
8 use OpenILS::Application::Cat::AssetCommon;
9 use base qw/OpenILS::Application/;
10 use Time::HiRes qw(time);
11 use OpenSRF::EX qw(:try);
12 use OpenSRF::Utils::JSON;
13 use OpenILS::Utils::Fieldmapper;
14 use OpenILS::Event;
15 use OpenILS::Const qw/:const/;
16
17 use XML::LibXML;
18 use Unicode::Normalize;
19 use Data::Dumper;
20 use OpenILS::Utils::CStoreEditor q/:funcs/;
21 use OpenILS::Perm;
22 use OpenSRF::Utils::SettingsClient;
23 use OpenSRF::Utils::Logger qw($logger);
24 use OpenSRF::AppSession;
25
26 my $U = "OpenILS::Application::AppUtils";
27 my $conf;
28 my %marctemplates;
29 my $assetcom = 'OpenILS::Application::Cat::AssetCommon';
30
31 __PACKAGE__->register_method(
32     method   => "retrieve_marc_template",
33     api_name => "open-ils.cat.biblio.marc_template.retrieve",
34     notes    => <<"    NOTES");
35     Returns a MARC 'record tree' based on a set of pre-defined templates.
36     Templates include : book
37     NOTES
38
39 sub retrieve_marc_template {
40     my( $self, $client, $type ) = @_;
41     return $marctemplates{$type} if defined($marctemplates{$type});
42     $marctemplates{$type} = _load_marc_template($type);
43     return $marctemplates{$type};
44 }
45
46 __PACKAGE__->register_method(
47     method   => 'fetch_marc_template_types',
48     api_name => 'open-ils.cat.marc_template.types.retrieve'
49 );
50
51 my $marc_template_files;
52
53 sub fetch_marc_template_types {
54     my( $self, $conn ) = @_;
55     __load_marc_templates();
56     return [ keys %$marc_template_files ];
57 }
58
59 sub __load_marc_templates {
60     return if $marc_template_files;
61     if(!$conf) { $conf = OpenSRF::Utils::SettingsClient->new; }
62
63     $marc_template_files = $conf->config_value(                    
64         "apps", "open-ils.cat","app_settings", "marctemplates" );
65
66     $logger->info("Loaded marc templates: " . Dumper($marc_template_files));
67 }
68
69 sub _load_marc_template {
70     my $type = shift;
71
72     __load_marc_templates();
73
74     my $template = $$marc_template_files{$type};
75     open( F, $template ) or 
76         throw OpenSRF::EX::ERROR ("Unable to open MARC template file: $template : $@");
77
78     my @xml = <F>;
79     close(F);
80     my $xml = join('', @xml);
81
82     return XML::LibXML->new->parse_string($xml)->documentElement->toString;
83 }
84
85
86
87 __PACKAGE__->register_method(
88     method   => 'fetch_bib_sources',
89     api_name => 'open-ils.cat.bib_sources.retrieve.all');
90
91 sub fetch_bib_sources {
92     return OpenILS::Application::Cat::BibCommon->fetch_bib_sources();
93 }
94
95 __PACKAGE__->register_method(
96     method    => "create_record_xml",
97     api_name  => "open-ils.cat.biblio.record.xml.create.override",
98     signature => q/@see open-ils.cat.biblio.record.xml.create/);
99
100 __PACKAGE__->register_method(
101     method    => "create_record_xml",
102     api_name  => "open-ils.cat.biblio.record.xml.create",
103     signature => q/
104         Inserts a new biblio with the given XML
105     /
106 );
107
108 sub create_record_xml {
109     my( $self, $client, $login, $xml, $source, $oargs ) = @_;
110
111     my $override = 1 if $self->api_name =~ /override/;
112     $oargs = { all => 1 } unless defined $oargs;
113
114     my( $user_obj, $evt ) = $U->checksesperm($login, 'CREATE_MARC');
115     return $evt if $evt;
116
117     $logger->activity("user ".$user_obj->id." creating new MARC record");
118
119     my $meth = $self->method_lookup("open-ils.cat.biblio.record.xml.import");
120
121     $meth = $self->method_lookup(
122         "open-ils.cat.biblio.record.xml.import.override") if $override;
123
124     my ($s) = $meth->run($login, $xml, $source, $oargs);
125     return $s;
126 }
127
128
129
130 __PACKAGE__->register_method(
131     method    => "biblio_record_replace_marc",
132     api_name  => "open-ils.cat.biblio.record.xml.update",
133     argc      => 3, 
134     signature => q/
135         Updates the XML for a given biblio record.
136         This does not change any other aspect of the record entry
137         exception the XML, the editor, and the edit date.
138         @return The update record object
139     /
140 );
141
142 __PACKAGE__->register_method(
143     method    => 'biblio_record_replace_marc',
144     api_name  => 'open-ils.cat.biblio.record.marc.replace',
145     signature => q/
146         @param auth The authtoken
147         @param recid The record whose MARC we're replacing
148         @param newxml The new xml to use
149     /
150 );
151
152 __PACKAGE__->register_method(
153     method    => 'biblio_record_replace_marc',
154     api_name  => 'open-ils.cat.biblio.record.marc.replace.override',
155     signature => q/@see open-ils.cat.biblio.record.marc.replace/
156 );
157
158 sub biblio_record_replace_marc  {
159     my( $self, $conn, $auth, $recid, $newxml, $source, $oargs ) = @_;
160     my $e = new_editor(authtoken=>$auth, xact=>1);
161     return $e->die_event unless $e->checkauth;
162     return $e->die_event unless $e->allowed('CREATE_MARC', $e->requestor->ws_ou);
163
164     my $fix_tcn = $self->api_name =~ /replace/o;
165     if($self->api_name =~ /override/o) {
166         $oargs = { all => 1 } unless defined $oargs;
167     } else {
168         $oargs = {};
169     }
170
171     my $res = OpenILS::Application::Cat::BibCommon->biblio_record_replace_marc(
172         $e, $recid, $newxml, $source, $fix_tcn, $oargs);
173
174     $e->commit unless $U->event_code($res);
175
176     #my $ses = OpenSRF::AppSession->create('open-ils.ingest');
177     #$ses->request('open-ils.ingest.full.biblio.record', $recid);
178
179     return $res;
180 }
181
182 __PACKAGE__->register_method(
183     method    => "template_overlay_biblio_record_entry",
184     api_name  => "open-ils.cat.biblio.record_entry.template_overlay",
185     stream    => 1,
186     signature => q#
187         Overlays biblio.record_entry MARC values
188         @param auth The authtoken
189         @param records The record ids to be updated by the template
190         @param template The overlay template
191         @return Stream of hashes record id in the key "record" and t or f for the success of the overlay operation in key "success"
192     #
193 );
194
195 sub template_overlay_biblio_record_entry {
196     my($self, $conn, $auth, $records, $template) = @_;
197     my $e = new_editor(authtoken=>$auth, xact=>1);
198     return $e->die_event unless $e->checkauth;
199
200     $records = [$records] if (!ref($records));
201
202     for my $rid ( @$records ) {
203         my $rec = $e->retrieve_biblio_record_entry($rid);
204         next unless $rec;
205
206         unless ($e->allowed('UPDATE_RECORD', $rec->owner, $rec)) {
207             $conn->respond({ record => $rid, success => 'f' });
208             next;
209         }
210
211         my $success = $e->json_query(
212             { from => [ 'vandelay.template_overlay_bib_record', $template, $rid ] }
213         )->[0]->{'vandelay.template_overlay_bib_record'};
214
215         $conn->respond({ record => $rid, success => $success });
216     }
217
218     $e->commit;
219     return undef;
220 }
221
222 __PACKAGE__->register_method(
223     method    => "template_overlay_container",
224     api_name  => "open-ils.cat.container.template_overlay",
225     stream    => 1,
226     signature => q#
227         Overlays biblio.record_entry MARC values
228         @param auth The authtoken
229         @param container The container, um, containing the records to be updated by the template
230         @param template The overlay template, or nothing and the method will look for a negative bib id in the container
231         @return Stream of hashes record id in the key "record" and t or f for the success of the overlay operation in key "success"
232     #
233 );
234
235 __PACKAGE__->register_method(
236     method    => "template_overlay_container",
237     api_name  => "open-ils.cat.container.template_overlay.background",
238     stream    => 1,
239     signature => q#
240         Overlays biblio.record_entry MARC values
241         @param auth The authtoken
242         @param container The container, um, containing the records to be updated by the template
243         @param template The overlay template, or nothing and the method will look for a negative bib id in the container
244         @return Cache key to check for status of the container overlay
245     #
246 );
247
248 sub template_overlay_container {
249     my($self, $conn, $auth, $container, $template) = @_;
250     my $e = new_editor(authtoken=>$auth, xact=>1);
251     return $e->die_event unless $e->checkauth;
252
253     my $actor = OpenSRF::AppSession->create('open-ils.actor') if ($self->api_name =~ /background$/);
254
255     my $items = $e->search_container_biblio_record_entry_bucket_item({ bucket => $container });
256
257     my $titem;
258     if (!$template) {
259         ($titem) = grep { $_->target_biblio_record_entry < 0 } @$items;
260         if (!$titem) {
261             $e->rollback;
262             return undef;
263         }
264         $items = [grep { $_->target_biblio_record_entry > 0 } @$items];
265
266         $template = $e->retrieve_biblio_record_entry( $titem->target_biblio_record_entry )->marc;
267     }
268
269     my $responses = [];
270     my $some_failed = 0;
271
272     $self->respond_complete(
273         $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses)->gather(1)
274     ) if ($actor);
275
276     for my $item ( @$items ) {
277         my $rec = $e->retrieve_biblio_record_entry($item->target_biblio_record_entry);
278         next unless $rec;
279
280         my $success = 'f';
281         if ($e->allowed('UPDATE_RECORD', $rec->owner, $rec)) {
282             $success = $e->json_query(
283                 { from => [ 'vandelay.template_overlay_bib_record', $template, $rec->id ] }
284             )->[0]->{'vandelay.template_overlay_bib_record'};
285         }
286
287         $some_failed++ if ($success eq 'f');
288
289         if ($actor) {
290             push @$responses, { record => $rec->id, success => $success };
291             $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
292         } else {
293             $conn->respond({ record => $rec->id, success => $success });
294         }
295
296         if ($success eq 't') {
297             unless ($e->delete_container_biblio_record_entry_bucket_item($item)) {
298                 $e->rollback;
299                 if ($actor) {
300                     push @$responses, { complete => 1, success => 'f' };
301                     $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
302                     return undef;
303                 } else {
304                     return { complete => 1, success => 'f' };
305                 }
306             }
307         }
308     }
309
310     if ($titem && !$some_failed) {
311         return $e->die_event unless ($e->delete_container_biblio_record_entry_bucket_item($titem));
312     }
313
314     if ($e->commit) {
315         if ($actor) {
316             push @$responses, { complete => 1, success => 't' };
317             $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
318         } else {
319             return { complete => 1, success => 't' };
320         }
321     } else {
322         if ($actor) {
323             push @$responses, { complete => 1, success => 'f' };
324             $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
325         } else {
326             return { complete => 1, success => 'f' };
327         }
328     }
329     return undef;
330 }
331
332 __PACKAGE__->register_method(
333     method    => "update_biblio_record_entry",
334     api_name  => "open-ils.cat.biblio.record_entry.update",
335     signature => q/
336         Updates a biblio.record_entry
337         @param auth The authtoken
338         @param record The record with updated values
339         @return 1 on success, Event on error.
340     /
341 );
342
343 sub update_biblio_record_entry {
344     my($self, $conn, $auth, $record) = @_;
345     my $e = new_editor(authtoken=>$auth, xact=>1);
346     return $e->die_event unless $e->checkauth;
347     return $e->die_event unless $e->allowed('UPDATE_RECORD');
348     $e->update_biblio_record_entry($record) or return $e->die_event;
349     $e->commit;
350     return 1;
351 }
352
353 __PACKAGE__->register_method(
354     method    => "undelete_biblio_record_entry",
355     api_name  => "open-ils.cat.biblio.record_entry.undelete",
356     signature => q/
357         Un-deletes a record and sets active=true
358         @param auth The authtoken
359         @param record The record_id to ressurect
360         @return 1 on success, Event on error.
361     /
362 );
363 sub undelete_biblio_record_entry {
364     my($self, $conn, $auth, $record_id) = @_;
365     my $e = new_editor(authtoken=>$auth, xact=>1);
366     return $e->die_event unless $e->checkauth;
367     return $e->die_event unless $e->allowed('UPDATE_RECORD');
368
369     my $record = $e->retrieve_biblio_record_entry($record_id)
370         or return $e->die_event;
371     $record->deleted('f');
372     $record->active('t');
373
374     # Set the leader/05 to indicate that the record has been corrected/revised
375     my $marc = $record->marc();
376     $marc =~ s{(<leader>.{5}).}{$1c};
377     $record->marc($marc);
378
379     # no 2 non-deleted records can have the same tcn_value
380     my $existing = $e->search_biblio_record_entry(
381         {   deleted => 'f', 
382             tcn_value => $record->tcn_value, 
383             id => {'!=' => $record_id}
384         }, {idlist => 1});
385     return OpenILS::Event->new('TCN_EXISTS') if @$existing;
386
387     $e->update_biblio_record_entry($record) or return $e->die_event;
388     $e->commit;
389     return 1;
390 }
391
392
393 __PACKAGE__->register_method(
394     method    => "biblio_record_xml_import",
395     api_name  => "open-ils.cat.biblio.record.xml.import.override",
396     signature => q/@see open-ils.cat.biblio.record.xml.import/);
397
398 __PACKAGE__->register_method(
399     method    => "biblio_record_xml_import",
400     api_name  => "open-ils.cat.biblio.record.xml.import",
401     notes     => <<"    NOTES");
402     Takes a marcxml record and imports the record into the database.  In this
403     case, the marcxml record is assumed to be a complete record (i.e. valid
404     MARC).  The title control number is taken from (whichever comes first)
405     tags 001, 039[ab], 020a, 022a, 010, 035a and whichever does not already exist
406     in the database.
407     user_session must have IMPORT_MARC permissions
408     NOTES
409
410
411 sub biblio_record_xml_import {
412     my( $self, $client, $authtoken, $xml, $source, $auto_tcn, $oargs) = @_;
413     my $e = new_editor(xact=>1, authtoken=>$authtoken);
414     return $e->die_event unless $e->checkauth;
415     return $e->die_event unless $e->allowed('IMPORT_MARC', $e->requestor->ws_ou);
416
417     if ($self->api_name =~ /override/) {
418         $oargs = { all => 1 } unless defined $oargs;
419     } else {
420         $oargs = {};
421     }
422     my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
423         $e, $xml, $source, $auto_tcn, $oargs);
424
425     return $record if $U->event_code($record);
426
427     $e->commit;
428
429     #my $ses = OpenSRF::AppSession->create('open-ils.ingest');
430     #$ses->request('open-ils.ingest.full.biblio.record', $record->id);
431
432     return $record;
433 }
434
435 __PACKAGE__->register_method(
436     method        => "biblio_record_record_metadata",
437     api_name      => "open-ils.cat.biblio.record.metadata.retrieve",
438     authoritative => 1,
439     argc          => 2, #(session_id, list of bre ids )
440     notes         => "Returns a list of slim-downed bre objects based on the " .
441                      "ids passed in",
442 );
443
444 sub biblio_record_record_metadata {
445     my( $self, $client, $authtoken, $ids ) = @_;
446
447     return [] unless $ids and @$ids;
448
449     my $editor = new_editor(authtoken => $authtoken);
450     return $editor->event unless $editor->checkauth;
451     return $editor->event unless $editor->allowed('VIEW_USER');
452
453     my @results;
454
455     for(@$ids) {
456         return $editor->event unless 
457             my $rec = $editor->retrieve_biblio_record_entry($_);
458         $rec->creator($editor->retrieve_actor_user($rec->creator));
459         $rec->editor($editor->retrieve_actor_user($rec->editor));
460         $rec->attrs($U->get_bre_attrs([$rec->id], $editor)->{$rec->id});
461         $rec->clear_marc; # slim the record down
462         push( @results, $rec );
463     }
464
465     return \@results;
466 }
467
468
469
470 __PACKAGE__->register_method(
471     method    => "biblio_record_marc_cn",
472     api_name  => "open-ils.cat.biblio.record.marc_cn.retrieve",
473     argc      => 1, #(bib id ) 
474     signature => {
475         desc   => 'Extracts call number candidates from a bibliographic record',
476         params => [
477             {desc => 'Record ID', type => 'number'},
478             {desc => '(Optional) Classification scheme ID', type => 'number'},
479         ]
480     },
481     return => {desc => 'Hash of candidate call numbers identified by tag' }
482 );
483
484 sub biblio_record_marc_cn {
485     my( $self, $client, $id, $class ) = @_;
486
487     my $e = new_editor();
488     my $marc = $e->retrieve_biblio_record_entry($id)->marc;
489
490     my $doc = XML::LibXML->new->parse_string($marc);
491     $doc->documentElement->setNamespace( "http://www.loc.gov/MARC21/slim", "marc", 1 );
492
493     my @fields;
494     my @res;
495     if ($class) {
496         @fields = split(/,/, $e->retrieve_asset_call_number_class($class)->field);
497     } else {
498         @fields = qw/050ab 055ab 060ab 070ab 080ab 082ab 086ab 088ab 090 092 096 098 099/;
499     }
500
501     # Get field/subfield combos based on acnc value; for example "050ab,055ab"
502
503     foreach my $field (@fields) {
504         my $tag = substr($field, 0, 3);
505         $logger->debug("Tag = $tag");
506         my @node = $doc->findnodes("//marc:datafield[\@tag='$tag']");
507
508         # Now parse the subfields and build up the subfield XPath
509         my @subfields = split(//, substr($field, 3));
510
511         # If they give us no subfields to parse, default to just the 'a'
512         if (!@subfields) {
513             @subfields = ('a');
514         }
515         my $subxpath;
516         foreach my $sf (@subfields) {
517             $subxpath .= "\@code='$sf' or ";
518         }
519         $subxpath = substr($subxpath, 0, -4);
520         $logger->debug("subxpath = $subxpath");
521
522         # Find the contents of the specified subfields
523         foreach my $x (@node) {
524             my $cn = $x->findvalue("marc:subfield[$subxpath]");
525             push @res, {$tag => $cn} if ($cn);
526         }
527     }
528
529     return \@res;
530 }
531
532 __PACKAGE__->register_method(
533     method    => 'autogen_barcodes',
534     api_name  => "open-ils.cat.item.barcode.autogen",
535     signature => {
536         desc   => 'Returns N generated barcodes following a specified barcode.',
537         params => [
538             {desc => 'Authentication token', type => 'string'},
539             {desc => 'Barcode which the sequence should follow from', type => 'string'},
540             {desc => 'Number of barcodes to generate', type => 'number'},
541             {desc => 'Options hash.  Currently you can pass in checkdigit : false to disable the use of checkdigits.'}
542         ],
543         return => {desc => 'Array of generated barcodes'}
544     }
545 );
546
547 sub autogen_barcodes {
548     my( $self, $client, $auth, $barcode, $num_of_barcodes, $options ) = @_;
549     my $e = new_editor(authtoken => $auth);
550     return $e->event unless $e->checkauth;
551     return $e->event unless $e->allowed('UPDATE_COPY', $e->requestor->ws_ou);
552     $options ||= {};
553
554     my $barcode_text = '';
555     my $barcode_number = 0;
556
557     if ($barcode =~ /^(\D+)/) { $barcode_text = $1; }
558     if ($barcode =~ /(\d+)$/) { $barcode_number = $1; }
559
560     my @res;
561     for (my $i = 1; $i <= $num_of_barcodes; $i++) {
562         my $calculated_barcode;
563
564         # default is to use checkdigits, so looking for an explicit false here
565         if (defined $$options{'checkdigit'} && ! $$options{'checkdigit'}) { 
566             $calculated_barcode = $barcode_number + $i;
567         } else {
568             if ($barcode_number =~ /^\d{8}$/) {
569                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0);
570             } elsif ($barcode_number =~ /^\d{9}$/) {
571                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit
572             } elsif ($barcode_number =~ /^\d{13}$/) {
573                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0);
574             } elsif ($barcode_number =~ /^\d{14}$/) {
575                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit
576             } else {
577                 $calculated_barcode = $barcode_number + $i;
578             }
579         }
580         push @res, $barcode_text . $calculated_barcode;
581     }
582     return \@res
583 }
584
585 # Codabar doesn't define a checkdigit algorithm, but this one is typically used by libraries.  gmcharlt++
586 sub add_codabar_checkdigit {
587     my $barcode = shift;
588     my $strip_last_digit = shift;
589
590     return $barcode if $barcode =~ /\D/;
591     $barcode = substr($barcode, 0, length($barcode)-1) if $strip_last_digit;
592     my @digits = split //, $barcode;
593     my $total = 0;
594     for (my $i = 1; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 1,3,5,7,9,11
595         $total += $digits[$i];
596     }
597     for (my $i = 0; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 0,2,4,6,8,10,12
598         $total += (2 * $digits[$i] >= 10) ? (2 * $digits[$i] - 9) : (2 * $digits[$i]);
599     }
600     my $remainder = $total % 10;
601     my $checkdigit = ($remainder == 0) ? $remainder : 10 - $remainder;
602     return $barcode . $checkdigit;
603 }
604
605 __PACKAGE__->register_method(
606     method        => "orgs_for_title",
607     authoritative => 1,
608     api_name      => "open-ils.cat.actor.org_unit.retrieve_by_title"
609 );
610
611 sub orgs_for_title {
612     my( $self, $client, $record_id ) = @_;
613
614     my $vols = $U->simple_scalar_request(
615         "open-ils.cstore",
616         "open-ils.cstore.direct.asset.call_number.search.atomic",
617         { record => $record_id, deleted => 'f' });
618
619     my $orgs = { map {$_->owning_lib => 1 } @$vols };
620     return [ keys %$orgs ];
621 }
622
623
624 __PACKAGE__->register_method(
625     method        => "retrieve_copies",
626     authoritative => 1,
627     api_name      => "open-ils.cat.asset.copy_tree.retrieve");
628
629 __PACKAGE__->register_method(
630     method   => "retrieve_copies",
631     api_name => "open-ils.cat.asset.copy_tree.global.retrieve");
632
633 # user_session may be null/undef
634 sub retrieve_copies {
635
636     my( $self, $client, $user_session, $docid, @org_ids ) = @_;
637
638     if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
639
640     $docid = "$docid";
641
642     # grabbing copy trees should be available for everyone..
643     if(!@org_ids and $user_session) {
644         my($user_obj, $evt) = OpenILS::Application::AppUtils->checkses($user_session); 
645         return $evt if $evt;
646         @org_ids = ($user_obj->home_ou);
647     }
648
649     if( $self->api_name =~ /global/ ) {
650         return _build_volume_list( { record => $docid, deleted => 'f', label => { '<>' => '##URI##' } } );
651
652     } else {
653
654         my @all_vols;
655         for my $orgid (@org_ids) {
656             my $vols = _build_volume_list( 
657                     { record => $docid, owning_lib => $orgid, deleted => 'f', label => { '<>' => '##URI##' } } );
658             push( @all_vols, @$vols );
659         }
660         
661         return \@all_vols;
662     }
663
664     return undef;
665 }
666
667
668 sub _build_volume_list {
669     my $search_hash = shift;
670
671     $search_hash->{deleted} = 'f';
672     my $e = new_editor();
673
674     my $vols = $e->search_asset_call_number([
675         $search_hash,
676         {
677             flesh => 1,
678             flesh_fields => { acn => ['prefix','suffix','label_class'] },
679             'order_by' => { 'acn' => 'oils_text_as_bytea(label_sortkey), oils_text_as_bytea(label), id, owning_lib' }
680         }
681     ]);
682
683     my @volumes;
684
685     for my $volume (@$vols) {
686
687         my $copies = $e->search_asset_copy([
688             { call_number => $volume->id , deleted => 'f' },
689             { flesh => 1, flesh_fields => { acp => ['stat_cat_entries','parts'] } }
690         ]);
691
692         $copies = [ sort { $a->barcode cmp $b->barcode } @$copies  ];
693
694         for my $c (@$copies) {
695             if( $c->status == OILS_COPY_STATUS_CHECKED_OUT ) {
696                 $c->circulations(
697                     $e->search_action_circulation(
698                         [
699                             { target_copy => $c->id },
700                             {
701                                 order_by => { circ => 'xact_start desc' },
702                                 limit => 1
703                             }
704                         ]
705                     )
706                 )
707             }
708         }
709
710         $volume->copies($copies);
711         push( @volumes, $volume );
712     }
713
714     #$session->disconnect();
715     return \@volumes;
716
717 }
718
719
720 __PACKAGE__->register_method(
721     method   => "fleshed_copy_update",
722     api_name => "open-ils.cat.asset.copy.fleshed.batch.update",);
723
724 __PACKAGE__->register_method(
725     method   => "fleshed_copy_update",
726     api_name => "open-ils.cat.asset.copy.fleshed.batch.update.override",);
727
728
729 sub fleshed_copy_update {
730     my( $self, $conn, $auth, $copies, $delete_stats, $oargs ) = @_;
731     return 1 unless ref $copies;
732     my( $reqr, $evt ) = $U->checkses($auth);
733     return $evt if $evt;
734     my $editor = new_editor(requestor => $reqr, xact => 1);
735     if ($self->api_name =~ /override/) {
736         $oargs = { all => 1 } unless defined $oargs;
737     } else {
738         $oargs = {};
739     }
740     my $retarget_holds = [];
741     $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
742         $editor, $oargs, undef, $copies, $delete_stats, $retarget_holds, undef);
743
744     if( $evt ) { 
745         $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
746         $editor->rollback; 
747         return $evt; 
748     }
749
750     $editor->commit;
751     $logger->info("fleshed copy update successfully updated ".scalar(@$copies)." copies");
752     reset_hold_list($auth, $retarget_holds);
753
754     return 1;
755 }
756
757 sub reset_hold_list {
758     my($auth, $hold_ids) = @_;
759     return unless @$hold_ids;
760     $logger->info("reseting holds after copy status change: @$hold_ids");
761     my $ses = OpenSRF::AppSession->create('open-ils.circ');
762     $ses->request('open-ils.circ.hold.reset.batch', $auth, $hold_ids);
763 }
764
765
766 __PACKAGE__->register_method(
767     method    => 'in_db_merge',
768     api_name  => 'open-ils.cat.biblio.records.merge',
769     signature => q/
770         Merges a group of records
771         @param auth The login session key
772         @param master The id of the record all other records should be merged into
773         @param records Array of records to be merged into the master record
774         @return 1 on success, Event on error.
775     /
776 );
777
778 sub in_db_merge {
779     my( $self, $conn, $auth, $master, $records ) = @_;
780
781     my $editor = new_editor( authtoken => $auth, xact => 1 );
782     return $editor->die_event unless $editor->checkauth;
783     return $editor->die_event unless $editor->allowed('MERGE_BIB_RECORDS'); # TODO see below about record ownership
784
785     my $count = 0;
786     for my $source ( @$records ) {
787         #XXX we actually /will/ want to check perms for master and sources after record ownership exists
788
789         # This stored proc (asset.merge_record_assets(target,source)) has the side effects of
790         # moving call_number, title-type (and some volume-type) hold_request and uri-mapping
791         # objects from the source record to the target record, so must be called from within
792         # a transaction.
793
794         $count += $editor->json_query({
795             select => {
796                 bre => [{
797                     alias => 'count',
798                     transform => 'asset.merge_record_assets',
799                     column => 'id',
800                     params => [$source]
801                 }]
802             },
803             from   => 'bre',
804             where  => { id => $master }
805         })->[0]->{count}; # count of objects moved, of all types
806
807     }
808
809     $editor->commit;
810     return $count;
811 }
812
813 __PACKAGE__->register_method(
814     method    => 'in_db_auth_merge',
815     api_name  => 'open-ils.cat.authority.records.merge',
816     signature => q/
817         Merges a group of authority records
818         @param auth The login session key
819         @param master The id of the record all other records should be merged into
820         @param records Array of records to be merged into the master record
821         @return 1 on success, Event on error.
822     /
823 );
824
825 sub in_db_auth_merge {
826     my( $self, $conn, $auth, $master, $records ) = @_;
827
828     my $editor = new_editor( authtoken => $auth, xact => 1 );
829     return $editor->die_event unless $editor->checkauth;
830     return $editor->die_event unless $editor->allowed('MERGE_AUTH_RECORDS'); # TODO see below about record ownership
831
832     my $count = 0;
833     for my $source ( @$records ) {
834         $count += $editor->json_query({
835             select => {
836                 are => [{
837                     alias => 'count',
838                     transform => 'authority.merge_records',
839                     column => 'id',
840                     params => [$source]
841                 }]
842             },
843             from   => 'are',
844             where  => { id => $master }
845         })->[0]->{count}; # count of objects moved, of all types
846     }
847
848     $editor->commit;
849     return $count;
850 }
851
852 __PACKAGE__->register_method(
853     method   => "fleshed_volume_update",
854     api_name => "open-ils.cat.asset.volume.fleshed.batch.update",);
855
856 __PACKAGE__->register_method(
857     method   => "fleshed_volume_update",
858     api_name => "open-ils.cat.asset.volume.fleshed.batch.update.override",);
859
860 sub fleshed_volume_update {
861     my( $self, $conn, $auth, $volumes, $delete_stats, $options, $oargs ) = @_;
862     my( $reqr, $evt ) = $U->checkses($auth);
863     return $evt if $evt;
864     $options ||= {};
865
866     if ($self->api_name =~ /override/) {
867         $oargs = { all => 1 } unless defined $oargs;
868     } else {
869         $oargs = {};
870     }
871     my $editor = new_editor( requestor => $reqr, xact => 1 );
872     my $retarget_holds = [];
873     my $auto_merge_vols = $options->{auto_merge_vols};
874
875     for my $vol (@$volumes) {
876         $logger->info("vol-update: investigating volume ".$vol->id);
877
878         $vol->editor($reqr->id);
879         $vol->edit_date('now');
880
881         my $copies = $vol->copies;
882         $vol->clear_copies;
883
884         $vol->editor($editor->requestor->id);
885         $vol->edit_date('now');
886
887         if( $vol->isdeleted ) {
888
889             $logger->info("vol-update: deleting volume");
890             return $editor->die_event unless
891                 $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
892
893             if(my $evt = $assetcom->delete_volume($editor, $vol, $oargs, $$options{force_delete_copies})) {
894                 $editor->rollback;
895                 return $evt;
896             }
897
898             return $editor->die_event unless
899                 $editor->update_asset_call_number($vol);
900
901         } elsif( $vol->isnew ) {
902             $logger->info("vol-update: creating volume");
903             $evt = $assetcom->create_volume( $oargs, $editor, $vol );
904             return $evt if $evt;
905
906         } elsif( $vol->ischanged ) {
907             $logger->info("vol-update: update volume");
908             my $resp = update_volume($vol, $editor, ($oargs->{all} or grep { $_ eq 'VOLUME_LABEL_EXISTS' } @{$oargs->{events}} or $auto_merge_vols));
909             return $resp->{evt} if $resp->{evt};
910             $vol = $resp->{merge_vol};
911         }
912
913         # now update any attached copies
914         if( $copies and @$copies and !$vol->isdeleted ) {
915             $_->call_number($vol->id) for @$copies;
916             $evt = $assetcom->update_fleshed_copies(
917                 $editor, $oargs, $vol, $copies, $delete_stats, $retarget_holds, undef);
918             return $evt if $evt;
919         }
920     }
921
922     $editor->finish;
923     reset_hold_list($auth, $retarget_holds);
924     return scalar(@$volumes);
925 }
926
927
928 sub update_volume {
929     my $vol = shift;
930     my $editor = shift;
931     my $auto_merge = shift;
932     my $evt;
933     my $merge_vol;
934
935     return {evt => $editor->event} unless
936         $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
937
938     return {evt => $evt} 
939         if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $vol->owning_lib) );
940
941     my $vols = $editor->search_asset_call_number({ 
942         owning_lib => $vol->owning_lib,
943         record     => $vol->record,
944         label      => $vol->label,
945         prefix     => $vol->prefix,
946         suffix     => $vol->suffix,
947         deleted    => 'f',
948         id         => {'!=' => $vol->id}
949     });
950
951     if(@$vols) {
952
953         if($auto_merge) {
954
955             # If the auto-merge option is on, merge our updated volume into the existing
956             # volume with the same record + owner + label.
957             ($merge_vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $vols->[0]);
958             return {evt => $evt, merge_vol => $merge_vol};
959
960         } else {
961             return {evt => OpenILS::Event->new('VOLUME_LABEL_EXISTS', payload => $vol->id)};
962         }
963     }
964
965     return {evt => $editor->die_event} unless $editor->update_asset_call_number($vol);
966     return {};
967 }
968
969
970
971 __PACKAGE__->register_method (
972     method   => 'delete_bib_record',
973     api_name => 'open-ils.cat.biblio.record_entry.delete');
974
975 sub delete_bib_record {
976     my($self, $conn, $auth, $rec_id) = @_;
977     my $e = new_editor(xact=>1, authtoken=>$auth);
978     return $e->die_event unless $e->checkauth;
979     return $e->die_event unless $e->allowed('DELETE_RECORD', $e->requestor->ws_ou);
980     my $vols = $e->search_asset_call_number({record=>$rec_id, deleted=>'f'});
981     return OpenILS::Event->new('RECORD_NOT_EMPTY', payload=>$rec_id) if @$vols;
982     my $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $rec_id);
983     if($evt) { $e->rollback; return $evt; }   
984     $e->commit;
985     return 1;
986 }
987
988
989
990 __PACKAGE__->register_method (
991     method   => 'batch_volume_transfer',
992     api_name => 'open-ils.cat.asset.volume.batch.transfer',
993 );
994
995 __PACKAGE__->register_method (
996     method   => 'batch_volume_transfer',
997     api_name => 'open-ils.cat.asset.volume.batch.transfer.override',
998 );
999
1000
1001 sub batch_volume_transfer {
1002     my( $self, $conn, $auth, $args, $oargs ) = @_;
1003
1004     my $evt;
1005     my $rec     = $$args{docid};
1006     my $o_lib   = $$args{lib};
1007     my $vol_ids = $$args{volumes};
1008
1009     my $override = 1 if $self->api_name =~ /override/;
1010     $oargs = { all => 1 } unless defined $oargs;
1011
1012     $logger->info("merge: transferring volumes to lib=$o_lib and record=$rec");
1013
1014     my $e = new_editor(authtoken => $auth, xact =>1);
1015     return $e->event unless $e->checkauth;
1016     return $e->event unless $e->allowed('UPDATE_VOLUME', $o_lib);
1017
1018     my $dorg = $e->retrieve_actor_org_unit($o_lib)
1019         or return $e->event;
1020
1021     my $ou_type = $e->retrieve_actor_org_unit_type($dorg->ou_type)
1022         or return $e->event;
1023
1024     return $evt if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($e, $o_lib) );
1025
1026     my $vols = $e->batch_retrieve_asset_call_number($vol_ids);
1027     my @seen;
1028
1029    my @rec_ids;
1030
1031     for my $vol (@$vols) {
1032
1033         # if we've already looked at this volume, go to the next
1034         next if !$vol or grep { $vol->id == $_ } @seen;
1035
1036         # grab all of the volumes in the list that have 
1037         # the same label so they can be merged
1038         my @all = grep { $_->label eq $vol->label } @$vols;
1039
1040         # take note of the fact that we've looked at this set of volumes
1041         push( @seen, $_->id ) for @all;
1042         push( @rec_ids, $_->record ) for @all;
1043
1044         # for each volume, see if there are any copies that have a 
1045         # remote circ_lib (circ_lib != vol->owning_lib and != $o_lib ).  
1046         # if so, warn them
1047         unless( $override && ($oargs->{all} || grep { $_ eq 'COPY_REMOTE_CIRC_LIB' } @{$oargs->{events}}) ) {
1048             for my $v (@all) {
1049
1050                 $logger->debug("merge: searching for copies with remote circ_lib for volume ".$v->id);
1051                 my $args = { 
1052                     call_number => $v->id, 
1053                     circ_lib    => { "not in" => [ $o_lib, $v->owning_lib ] },
1054                     deleted     => 'f'
1055                 };
1056
1057                 my $copies = $e->search_asset_copy($args, {idlist=>1});
1058
1059                 # if the copy's circ_lib matches the destination lib,
1060                 # that's ok too
1061                 return OpenILS::Event->new('COPY_REMOTE_CIRC_LIB') if @$copies;
1062             }
1063         }
1064
1065         # see if there is a volume at the destination lib that 
1066         # already has the requested label
1067         my $existing_vol = $e->search_asset_call_number(
1068             {
1069                 label      => $vol->label, 
1070                 prefix     => $vol->prefix, 
1071                 suffix     => $vol->suffix, 
1072                 record     => $rec, 
1073                 owning_lib => $o_lib,
1074                 deleted    => 'f'
1075             }
1076         )->[0];
1077
1078         if( $existing_vol ) {
1079
1080             if( grep { $_->id == $existing_vol->id } @all ) {
1081                 # this volume is already accounted for in our list of volumes to merge
1082                 $existing_vol = undef;
1083
1084             } else {
1085                 # this volume exists on the destination record/owning_lib and must
1086                 # be used as the destination for merging
1087                 $logger->debug("merge: volume already exists at destination record: ".
1088                     $existing_vol->id.' : '.$existing_vol->label) if $existing_vol;
1089             }
1090         } 
1091
1092         if( @all > 1 || $existing_vol ) {
1093             $logger->info("merge: found collisions in volume transfer");
1094             my @args = ($e, \@all);
1095             @args = ($e, \@all, $existing_vol) if $existing_vol;
1096             ($vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes(@args);
1097             return $evt if $evt;
1098         } 
1099         
1100         if( !$existing_vol ) {
1101
1102             $vol->owning_lib($o_lib);
1103             $vol->record($rec);
1104             $vol->editor($e->requestor->id);
1105             $vol->edit_date('now');
1106     
1107             $logger->info("merge: updating volume ".$vol->id);
1108             $e->update_asset_call_number($vol) or return $e->event;
1109
1110         } else {
1111             $logger->info("merge: bypassing volume update because existing volume used as target");
1112         }
1113
1114         # regardless of what volume was used as the destination, 
1115         # update any copies that have moved over to the new lib
1116         my $copies = $e->search_asset_copy({call_number=>$vol->id, deleted => 'f'});
1117
1118         # update circ lib on the copies - make this a method flag?
1119         for my $copy (@$copies) {
1120             next if $copy->circ_lib == $o_lib;
1121             $logger->info("merge: transfer moving circ lib on copy ".$copy->id);
1122             $copy->circ_lib($o_lib);
1123             $copy->editor($e->requestor->id);
1124             $copy->edit_date('now');
1125             $e->update_asset_copy($copy) or return $e->event;
1126         }
1127
1128         # Now see if any empty records need to be deleted after all of this
1129
1130         for(@rec_ids) {
1131             $logger->debug("merge: seeing if we should delete record $_...");
1132             $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $_) 
1133                 if OpenILS::Application::Cat::BibCommon->title_is_empty($e, $_);
1134             return $evt if $evt;
1135         }
1136     }
1137
1138     $logger->info("merge: transfer succeeded");
1139     $e->commit;
1140     return 1;
1141 }
1142
1143
1144
1145
1146 __PACKAGE__->register_method(
1147     api_name => 'open-ils.cat.call_number.find_or_create',
1148     method   => 'find_or_create_volume',
1149 );
1150
1151 sub find_or_create_volume {
1152     my( $self, $conn, $auth, $label, $record_id, $org_id, $prefix, $suffix, $label_class ) = @_;
1153     my $e = new_editor(authtoken=>$auth, xact=>1);
1154     return $e->die_event unless $e->checkauth;
1155     my ($vol, $evt, $exists) = 
1156         OpenILS::Application::Cat::AssetCommon->find_or_create_volume($e, $label, $record_id, $org_id, $prefix, $suffix, $label_class);
1157     return $evt if $evt;
1158     $e->rollback if $exists;
1159     $e->commit if $vol;
1160     return { 'acn_id' => $vol->id, 'existed' => $exists };
1161 }
1162
1163
1164 __PACKAGE__->register_method(
1165     method    => "create_serial_record_xml",
1166     api_name  => "open-ils.cat.serial.record.xml.create.override",
1167     signature => q/@see open-ils.cat.serial.record.xml.create/);
1168
1169 __PACKAGE__->register_method(
1170     method    => "create_serial_record_xml",
1171     api_name  => "open-ils.cat.serial.record.xml.create",
1172     signature => q/
1173         Inserts a new serial record with the given XML
1174     /
1175 );
1176
1177 sub create_serial_record_xml {
1178     my( $self, $client, $login, $source, $owning_lib, $record_id, $xml, $oargs ) = @_;
1179
1180     my $override = 1 if $self->api_name =~ /override/; # not currently used
1181     $oargs = { all => 1 } unless defined $oargs; # Not currently used, but here for consistency.
1182
1183     my $e = new_editor(xact=>1, authtoken=>$login);
1184     return $e->die_event unless $e->checkauth;
1185     return $e->die_event unless $e->allowed('CREATE_MFHD_RECORD', $owning_lib);
1186
1187     # Auto-populate the location field of a placeholder MFHD record with the library name
1188     my $aou = $e->retrieve_actor_org_unit($owning_lib) or return $e->die_event;
1189
1190     my $mfhd = Fieldmapper::serial::record_entry->new;
1191
1192     $mfhd->source($source) if $source;
1193     $mfhd->record($record_id);
1194     $mfhd->creator($e->requestor->id);
1195     $mfhd->editor($e->requestor->id);
1196     $mfhd->create_date('now');
1197     $mfhd->edit_date('now');
1198     $mfhd->owning_lib($owning_lib);
1199
1200     # If the caller did not pass in MFHD XML, create a placeholder record.
1201     # The placeholder will only contain the name of the owning library.
1202     # The goal is to generate common patterns for the caller in the UI that
1203     # then get passed in here.
1204     if (!$xml) {
1205         my $aou_name = $aou->name;
1206         $xml = <<HERE;
1207 <record 
1208  xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1209  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
1210  xmlns="http://www.loc.gov/MARC21/slim">
1211 <leader>00307ny  a22001094  4500</leader>
1212 <controlfield tag="001">42153</controlfield>
1213 <controlfield tag="005">20090601182414.0</controlfield>
1214 <controlfield tag="004">$record_id</controlfield>
1215 <controlfield tag="008">      4u####8###l# 4   uueng1      </controlfield>
1216 <datafield tag="852" ind1=" " ind2=" "> <subfield code="b">$aou_name</subfield></datafield>
1217 </record>
1218 HERE
1219     }
1220     my $marcxml = XML::LibXML->new->parse_string($xml);
1221     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim", "marc", 1 );
1222     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim");
1223
1224     $mfhd->marc($U->entityize($marcxml->documentElement->toString));
1225
1226     $e->create_serial_record_entry($mfhd) or return $e->die_event;
1227
1228     $e->commit;
1229     return $mfhd->id;
1230 }
1231
1232 __PACKAGE__->register_method(
1233     method   => "create_update_asset_copy_template",
1234     api_name => "open-ils.cat.asset.copy_template.create_or_update"
1235 );
1236
1237 sub create_update_asset_copy_template {
1238     my ($self, $client, $authtoken, $act) = @_;
1239
1240     my $e = new_editor("xact" => 1, "authtoken" => $authtoken);
1241     return $e->die_event unless $e->checkauth;
1242     return $e->die_event unless $e->allowed(
1243         "ADMIN_ASSET_COPY_TEMPLATE", $act->owning_lib
1244     );
1245
1246     $act->editor($e->requestor->id);
1247     $act->edit_date("now");
1248
1249     my $retval;
1250     if (!$act->id) {
1251         $act->creator($e->requestor->id);
1252         $act->create_date("now");
1253
1254         $e->create_asset_copy_template($act) or return $e->die_event;
1255         $retval = $e->data;
1256     } else {
1257         $e->update_asset_copy_template($act) or return $e->die_event;
1258         $retval = $e->retrieve_asset_copy_template($e->data);
1259     }
1260     $e->commit and return $retval;
1261 }
1262
1263 __PACKAGE__->register_method(
1264     method      => "acn_sms_msg",
1265     api_name    => "open-ils.cat.acn.send_sms_text",
1266     signature   => q^
1267         Send an SMS text from an A/T template for specified call numbers.
1268
1269         First parameter is null or an auth token (whether a null is allowed
1270         depends on the sms.disable_authentication_requirement.callnumbers OU
1271         setting).
1272
1273         Second parameter is the id of the context org.
1274
1275         Third parameter is the code of the SMS carrier from the
1276         config.sms_carrier table.
1277
1278         Fourth parameter is the SMS number.
1279
1280         Fifth parameter is the ACN id's to target, though currently only the
1281         first ACN is used by the template (and the UI is only sending one).
1282     ^
1283 );
1284
1285 sub acn_sms_msg {
1286     my($self, $conn, $auth, $org_id, $carrier, $number, $target_ids) = @_;
1287
1288     my $sms_enable = $U->ou_ancestor_setting_value(
1289         $org_id || $U->fetch_org_tree->id,
1290         'sms.enable'
1291     );
1292     # We could maybe make a Validator for this on the templates
1293     if (! $U->is_true($sms_enable)) {
1294         return -1;
1295     }
1296
1297     my $disable_auth = $U->ou_ancestor_setting_value(
1298         $org_id || $U->fetch_org_tree->id,
1299         'sms.disable_authentication_requirement.callnumbers'
1300     );
1301
1302     my $e = new_editor(
1303         (defined $auth)
1304         ? (authtoken => $auth, xact => 1)
1305         : (xact => 1)
1306     );
1307     return $e->event unless $disable_auth || $e->checkauth;
1308
1309     my $targets = $e->batch_retrieve_asset_call_number($target_ids);
1310
1311     $e->rollback; # FIXME using transaction because of pgpool/slony setups, but not
1312                   # simply making this method authoritative because of weirdness
1313                   # with transaction handling in A/T code that causes rollback
1314                   # failure down the line if handling many targets
1315
1316     return undef unless @$targets;
1317     return $U->fire_object_event(
1318         undef,                    # event_def
1319         'acn.format.sms_text',    # hook
1320         $targets,
1321         $org_id,
1322         undef,                    # granularity
1323         {                         # user_data
1324             sms_carrier => $carrier,
1325             sms_notify => $number
1326         }
1327     );
1328 }
1329
1330
1331
1332 1;
1333
1334 # vi:et:ts=4:sw=4