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