LP#1117808: new methods for calculating MARC merges
[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, $strip_grps ) = @_;
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, $strip_grps);
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, $strip_grps ) = @_;
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('UPDATE_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, $strip_grps);
173
174     $e->commit unless $U->event_code($res);
175
176     return $res;
177 }
178
179 __PACKAGE__->register_method(
180     method    => "template_overlay_biblio_record_entry",
181     api_name  => "open-ils.cat.biblio.record_entry.template_overlay",
182     stream    => 1,
183     signature => q#
184         Overlays biblio.record_entry MARC values
185         @param auth The authtoken
186         @param records The record ids to be updated by the template
187         @param template The overlay template
188         @return Stream of hashes record id in the key "record" and t or f for the success of the overlay operation in key "success"
189     #
190 );
191
192 sub template_overlay_biblio_record_entry {
193     my($self, $conn, $auth, $records, $template) = @_;
194     my $e = new_editor(authtoken=>$auth, xact=>1);
195     return $e->die_event unless $e->checkauth;
196
197     $records = [$records] if (!ref($records));
198
199     for my $rid ( @$records ) {
200         my $rec = $e->retrieve_biblio_record_entry($rid);
201         next unless $rec;
202
203         unless ($e->allowed('UPDATE_RECORD', $rec->owner, $rec)) {
204             $conn->respond({ record => $rid, success => 'f' });
205             next;
206         }
207
208         my $success = $e->json_query(
209             { from => [ 'vandelay.template_overlay_bib_record', $template, $rid ] }
210         )->[0]->{'vandelay.template_overlay_bib_record'};
211
212         $conn->respond({ record => $rid, success => $success });
213     }
214
215     $e->commit;
216     return undef;
217 }
218
219 __PACKAGE__->register_method(
220     method    => "template_overlay_container",
221     api_name  => "open-ils.cat.container.template_overlay",
222     stream    => 1,
223     signature => q#
224         Overlays biblio.record_entry MARC values
225         @param auth The authtoken
226         @param container The container, um, containing the records to be updated by the template
227         @param template The overlay template, or nothing and the method will look for a negative bib id in the container
228         @return Stream of hashes record id in the key "record" and t or f for the success of the overlay operation in key "success"
229     #
230 );
231
232 __PACKAGE__->register_method(
233     method    => "template_overlay_container",
234     api_name  => "open-ils.cat.container.template_overlay.background",
235     stream    => 1,
236     signature => q#
237         Overlays biblio.record_entry MARC values
238         @param auth The authtoken
239         @param container The container, um, containing the records to be updated by the template
240         @param template The overlay template, or nothing and the method will look for a negative bib id in the container
241         @return Cache key to check for status of the container overlay
242     #
243 );
244
245 sub template_overlay_container {
246     my($self, $conn, $auth, $container, $template) = @_;
247     my $e = new_editor(authtoken=>$auth, xact=>1);
248     return $e->die_event unless $e->checkauth;
249
250     my $actor = OpenSRF::AppSession->create('open-ils.actor') if ($self->api_name =~ /background$/);
251
252     my $items = $e->search_container_biblio_record_entry_bucket_item({ bucket => $container });
253
254     my $titem;
255     if (!$template) {
256         ($titem) = grep { $_->target_biblio_record_entry < 0 } @$items;
257         if (!$titem) {
258             $e->rollback;
259             return undef;
260         }
261         $items = [grep { $_->target_biblio_record_entry > 0 } @$items];
262
263         $template = $e->retrieve_biblio_record_entry( $titem->target_biblio_record_entry )->marc;
264     }
265
266     my $responses = [];
267     my $some_failed = 0;
268
269     $conn->respond_complete(
270         $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses)->gather(1)
271     ) if ($actor);
272
273     for my $item ( @$items ) {
274         my $rec = $e->retrieve_biblio_record_entry($item->target_biblio_record_entry);
275         next unless $rec;
276
277         my $success = 'f';
278         if ($e->allowed('UPDATE_RECORD', $rec->owner, $rec)) {
279             $success = $e->json_query(
280                 { from => [ 'vandelay.template_overlay_bib_record', $template, $rec->id ] }
281             )->[0]->{'vandelay.template_overlay_bib_record'};
282         }
283
284         $some_failed++ if ($success eq 'f');
285
286         if ($actor) {
287             push @$responses, { record => $rec->id, success => $success };
288             $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
289         } else {
290             $conn->respond({ record => $rec->id, success => $success });
291         }
292
293         if ($success eq 't') {
294             unless ($e->delete_container_biblio_record_entry_bucket_item($item)) {
295                 $e->rollback;
296                 if ($actor) {
297                     push @$responses, { complete => 1, success => 'f' };
298                     $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
299                     return undef;
300                 } else {
301                     return { complete => 1, success => 'f' };
302                 }
303             }
304         }
305     }
306
307     if ($titem && !$some_failed) {
308         return $e->die_event unless ($e->delete_container_biblio_record_entry_bucket_item($titem));
309     }
310
311     if ($e->commit) {
312         if ($actor) {
313             push @$responses, { complete => 1, success => 't' };
314             $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
315         } else {
316             return { complete => 1, success => 't' };
317         }
318     } else {
319         if ($actor) {
320             push @$responses, { complete => 1, success => 'f' };
321             $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
322         } else {
323             return { complete => 1, success => 'f' };
324         }
325     }
326     return undef;
327 }
328
329 __PACKAGE__->register_method(
330     method    => "update_biblio_record_entry",
331     api_name  => "open-ils.cat.biblio.record_entry.update",
332     signature => q/
333         Updates a biblio.record_entry
334         @param auth The authtoken
335         @param record The record with updated values
336         @return 1 on success, Event on error.
337     /
338 );
339
340 sub update_biblio_record_entry {
341     my($self, $conn, $auth, $record) = @_;
342     my $e = new_editor(authtoken=>$auth, xact=>1);
343     return $e->die_event unless $e->checkauth;
344     return $e->die_event unless $e->allowed('UPDATE_RECORD');
345     $e->update_biblio_record_entry($record) or return $e->die_event;
346     $e->commit;
347     return 1;
348 }
349
350 __PACKAGE__->register_method(
351     method    => "undelete_biblio_record_entry",
352     api_name  => "open-ils.cat.biblio.record_entry.undelete",
353     signature => q/
354         Un-deletes a record and sets active=true
355         @param auth The authtoken
356         @param record The record_id to ressurect
357         @return 1 on success, Event on error.
358     /
359 );
360 sub undelete_biblio_record_entry {
361     my($self, $conn, $auth, $record_id) = @_;
362     my $e = new_editor(authtoken=>$auth, xact=>1);
363     return $e->die_event unless $e->checkauth;
364     return $e->die_event unless $e->allowed('UPDATE_RECORD');
365
366     my $record = $e->retrieve_biblio_record_entry($record_id)
367         or return $e->die_event;
368     $record->deleted('f');
369     $record->active('t');
370
371     # Set the leader/05 to indicate that the record has been corrected/revised
372     my $marc = $record->marc();
373     $marc =~ s{(<leader>.{5}).}{$1c};
374     $record->marc($marc);
375
376     # no 2 non-deleted records can have the same tcn_value
377     my $existing = $e->search_biblio_record_entry(
378         {   deleted => 'f', 
379             tcn_value => $record->tcn_value, 
380             id => {'!=' => $record_id}
381         }, {idlist => 1});
382     return OpenILS::Event->new('TCN_EXISTS') if @$existing;
383
384     $e->update_biblio_record_entry($record) or return $e->die_event;
385     $e->commit;
386     return 1;
387 }
388
389
390 __PACKAGE__->register_method(
391     method    => "biblio_record_xml_import",
392     api_name  => "open-ils.cat.biblio.record.xml.import.override",
393     signature => q/@see open-ils.cat.biblio.record.xml.import/);
394
395 __PACKAGE__->register_method(
396     method    => "biblio_record_xml_import",
397     api_name  => "open-ils.cat.biblio.record.xml.import",
398     notes     => <<"    NOTES");
399     Takes a marcxml record and imports the record into the database.  In this
400     case, the marcxml record is assumed to be a complete record (i.e. valid
401     MARC).  The title control number is taken from (whichever comes first)
402     tags 001, 039[ab], 020a, 022a, 010, 035a and whichever does not already exist
403     in the database.
404     user_session must have IMPORT_MARC permissions
405     NOTES
406
407
408 sub biblio_record_xml_import {
409     my( $self, $client, $authtoken, $xml, $source, $auto_tcn, $oargs, $strip_grps) = @_;
410     my $e = new_editor(xact=>1, authtoken=>$authtoken);
411     return $e->die_event unless $e->checkauth;
412     return $e->die_event unless $e->allowed('IMPORT_MARC', $e->requestor->ws_ou);
413
414     if ($self->api_name =~ /override/) {
415         $oargs = { all => 1 } unless defined $oargs;
416     } else {
417         $oargs = {};
418     }
419     my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
420         $e, $xml, $source, $auto_tcn, $oargs, $strip_grps);
421
422     return $record if $U->event_code($record);
423
424     $e->commit;
425
426     return $record;
427 }
428
429 __PACKAGE__->register_method(
430     method        => "biblio_record_record_metadata",
431     api_name      => "open-ils.cat.biblio.record.metadata.retrieve",
432     authoritative => 1,
433     argc          => 2, #(session_id, list of bre ids )
434     notes         => "Returns a list of slim-downed bre objects based on the " .
435                      "ids passed in",
436 );
437
438 sub biblio_record_record_metadata {
439     my( $self, $client, $authtoken, $ids ) = @_;
440
441     return [] unless $ids and @$ids;
442
443     my $editor = new_editor(authtoken => $authtoken);
444     return $editor->event unless $editor->checkauth;
445     return $editor->event unless $editor->allowed('VIEW_USER');
446
447     my @results;
448
449     for(@$ids) {
450         return $editor->event unless 
451             my $rec = $editor->retrieve_biblio_record_entry($_);
452         $rec->creator($editor->retrieve_actor_user($rec->creator));
453         $rec->editor($editor->retrieve_actor_user($rec->editor));
454         $rec->attrs($U->get_bre_attrs([$rec->id], $editor)->{$rec->id});
455         $rec->clear_marc; # slim the record down
456         push( @results, $rec );
457     }
458
459     return \@results;
460 }
461
462
463
464 __PACKAGE__->register_method(
465     method    => "biblio_record_marc_cn",
466     api_name  => "open-ils.cat.biblio.record.marc_cn.retrieve",
467     argc      => 1, #(bib id ) 
468     signature => {
469         desc   => 'Extracts call number candidates from a bibliographic record',
470         params => [
471             {desc => 'Record ID', type => 'number'},
472             {desc => '(Optional) Classification scheme ID', type => 'number'},
473         ]
474     },
475     return => {desc => 'Hash of candidate call numbers identified by tag' }
476 );
477
478 sub biblio_record_marc_cn {
479     my( $self, $client, $id, $class ) = @_;
480
481     my $e = new_editor();
482     my $marc = $e->retrieve_biblio_record_entry($id)->marc;
483
484     my $doc = XML::LibXML->new->parse_string($marc);
485     $doc->documentElement->setNamespace( "http://www.loc.gov/MARC21/slim", "marc", 1 );
486
487     my @fields;
488     my @res;
489     if ($class) {
490         @fields = split(/,/, $e->retrieve_asset_call_number_class($class)->field);
491     } else {
492         @fields = qw/050ab 055ab 060ab 070ab 080ab 082ab 086ab 088ab 090 092 096 098 099/;
493     }
494
495     # Get field/subfield combos based on acnc value; for example "050ab,055ab"
496
497     foreach my $field (@fields) {
498         my $tag = substr($field, 0, 3);
499         $logger->debug("Tag = $tag");
500         my @node = $doc->findnodes("//marc:datafield[\@tag='$tag']");
501
502         # Now parse the subfields and build up the subfield XPath
503         my @subfields = split(//, substr($field, 3));
504
505         # If they give us no subfields to parse, default to just the 'a'
506         if (!@subfields) {
507             @subfields = ('a');
508         }
509         my $subxpath;
510         foreach my $sf (@subfields) {
511             $subxpath .= "\@code='$sf' or ";
512         }
513         $subxpath = substr($subxpath, 0, -4);
514         $logger->debug("subxpath = $subxpath");
515
516         # Find the contents of the specified subfields
517         foreach my $x (@node) {
518             my $cn = $x->findvalue("marc:subfield[$subxpath]");
519             push @res, {$tag => $cn} if ($cn);
520         }
521     }
522
523     return \@res;
524 }
525
526 __PACKAGE__->register_method(
527     method    => 'autogen_barcodes',
528     api_name  => "open-ils.cat.item.barcode.autogen",
529     signature => {
530         desc   => 'Returns N generated barcodes following a specified barcode.',
531         params => [
532             {desc => 'Authentication token', type => 'string'},
533             {desc => 'Barcode which the sequence should follow from', type => 'string'},
534             {desc => 'Number of barcodes to generate', type => 'number'},
535             {desc => 'Options hash.  Currently you can pass in checkdigit : false to disable the use of checkdigits.'}
536         ],
537         return => {desc => 'Array of generated barcodes'}
538     }
539 );
540
541 sub autogen_barcodes {
542     my( $self, $client, $auth, $barcode, $num_of_barcodes, $options ) = @_;
543     my $e = new_editor(authtoken => $auth);
544     return $e->event unless $e->checkauth;
545     return $e->event unless $e->allowed('UPDATE_COPY', $e->requestor->ws_ou);
546     $options ||= {};
547
548     my $barcode_text = '';
549     my $barcode_number = 0;
550
551     if ($barcode =~ /^(\D+)/) { $barcode_text = $1; }
552     if ($barcode =~ /(\d+)$/) { $barcode_number = $1; }
553
554     my @res;
555     for (my $i = 1; $i <= $num_of_barcodes; $i++) {
556         my $calculated_barcode;
557
558         # default is to use checkdigits, so looking for an explicit false here
559         if (defined $$options{'checkdigit'} && ! $$options{'checkdigit'}) { 
560             $calculated_barcode = $barcode_number + $i;
561         } else {
562             if ($barcode_number =~ /^\d{8}$/) {
563                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0);
564             } elsif ($barcode_number =~ /^\d{9}$/) {
565                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit
566             } elsif ($barcode_number =~ /^\d{13}$/) {
567                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0);
568             } elsif ($barcode_number =~ /^\d{14}$/) {
569                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit
570             } else {
571                 $calculated_barcode = $barcode_number + $i;
572             }
573         }
574         push @res, $barcode_text . $calculated_barcode;
575     }
576     return \@res
577 }
578
579 # Codabar doesn't define a checkdigit algorithm, but this one is typically used by libraries.  gmcharlt++
580 sub add_codabar_checkdigit {
581     my $barcode = shift;
582     my $strip_last_digit = shift;
583
584     return $barcode if $barcode =~ /\D/;
585     $barcode = substr($barcode, 0, length($barcode)-1) if $strip_last_digit;
586     my @digits = split //, $barcode;
587     my $total = 0;
588     for (my $i = 1; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 1,3,5,7,9,11
589         $total += $digits[$i];
590     }
591     for (my $i = 0; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 0,2,4,6,8,10,12
592         $total += (2 * $digits[$i] >= 10) ? (2 * $digits[$i] - 9) : (2 * $digits[$i]);
593     }
594     my $remainder = $total % 10;
595     my $checkdigit = ($remainder == 0) ? $remainder : 10 - $remainder;
596     return $barcode . $checkdigit;
597 }
598
599 __PACKAGE__->register_method(
600     method        => "orgs_for_title",
601     authoritative => 1,
602     api_name      => "open-ils.cat.actor.org_unit.retrieve_by_title"
603 );
604
605 sub orgs_for_title {
606     my( $self, $client, $record_id ) = @_;
607
608     my $vols = $U->simple_scalar_request(
609         "open-ils.cstore",
610         "open-ils.cstore.direct.asset.call_number.search.atomic",
611         { record => $record_id, deleted => 'f' });
612
613     my $orgs = { map {$_->owning_lib => 1 } @$vols };
614     return [ keys %$orgs ];
615 }
616
617
618 __PACKAGE__->register_method(
619     method        => "retrieve_copies",
620     authoritative => 1,
621     api_name      => "open-ils.cat.asset.copy_tree.retrieve");
622
623 __PACKAGE__->register_method(
624     method   => "retrieve_copies",
625     api_name => "open-ils.cat.asset.copy_tree.global.retrieve");
626
627 # user_session may be null/undef
628 sub retrieve_copies {
629
630     my( $self, $client, $user_session, $docid, @org_ids ) = @_;
631
632     if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
633
634     $docid = "$docid";
635
636     # grabbing copy trees should be available for everyone..
637     if(!@org_ids and $user_session) {
638         my($user_obj, $evt) = OpenILS::Application::AppUtils->checkses($user_session); 
639         return $evt if $evt;
640         @org_ids = ($user_obj->home_ou);
641     }
642
643     # Create an editor that can be shared across all iterations of 
644     # _build_volume_list().  Otherwise, .authoritative calls can result 
645     # in creating too many cstore connections.
646     my $e = new_editor();
647
648     if( $self->api_name =~ /global/ ) {
649         return _build_volume_list($e, { record => $docid, deleted => 'f', label => { '<>' => '##URI##' } } );
650
651     } else {
652
653         my @all_vols;
654         for my $orgid (@org_ids) {
655             my $vols = _build_volume_list($e,
656                     { record => $docid, owning_lib => $orgid, deleted => 'f', label => { '<>' => '##URI##' } } );
657             push( @all_vols, @$vols );
658         }
659         
660         return \@all_vols;
661     }
662
663     return undef;
664 }
665
666
667 sub _build_volume_list {
668     my $e = shift;
669     my $search_hash = shift;
670
671     $e ||= new_editor();
672
673     $search_hash->{deleted} = 'f';
674
675     my $vols = $e->search_asset_call_number([
676         $search_hash,
677         {
678             flesh => 1,
679             flesh_fields => { acn => ['prefix','suffix','label_class'] },
680             'order_by' => { 'acn' => 'oils_text_as_bytea(label_sortkey), oils_text_as_bytea(label), id, owning_lib' }
681         }
682     ]);
683
684     my @volumes;
685
686     for my $volume (@$vols) {
687
688         my $copies = $e->search_asset_copy([
689             { call_number => $volume->id , deleted => 'f' },
690             {
691                 join => {
692                     acpm => {
693                         type => 'left',
694                         join => {
695                             bmp => { type => 'left' }
696                         }
697                     }
698                 },
699                 flesh => 1,
700                 flesh_fields => { acp => ['stat_cat_entries','parts'] },
701                 order_by => [
702                     {'class' => 'bmp', 'field' => 'label_sortkey', 'transform' => 'oils_text_as_bytea'},
703                     {'class' => 'bmp', 'field' => 'label', 'transform' => 'oils_text_as_bytea'},
704                     {'class' => 'acp', 'field' => 'barcode'}
705                 ]
706             }
707         ]);
708
709         for my $c (@$copies) {
710             if( $c->status == OILS_COPY_STATUS_CHECKED_OUT ) {
711                 $c->circulations(
712                     $e->search_action_circulation(
713                         [
714                             { target_copy => $c->id },
715                             {
716                                 order_by => { circ => 'xact_start desc' },
717                                 limit => 1
718                             }
719                         ]
720                     )
721                 )
722             }
723         }
724
725         $volume->copies($copies);
726         push( @volumes, $volume );
727     }
728
729     #$session->disconnect();
730     return \@volumes;
731
732 }
733
734
735 __PACKAGE__->register_method(
736     method   => "fleshed_copy_update",
737     api_name => "open-ils.cat.asset.copy.fleshed.batch.update",);
738
739 __PACKAGE__->register_method(
740     method   => "fleshed_copy_update",
741     api_name => "open-ils.cat.asset.copy.fleshed.batch.update.override",);
742
743
744 sub fleshed_copy_update {
745     my( $self, $conn, $auth, $copies, $delete_stats, $oargs, $create_parts ) = @_;
746     return 1 unless ref $copies;
747     my( $reqr, $evt ) = $U->checkses($auth);
748     return $evt if $evt;
749     my $editor = new_editor(requestor => $reqr, xact => 1);
750     if ($self->api_name =~ /override/) {
751         $oargs = { all => 1 } unless defined $oargs;
752     } else {
753         $oargs = {};
754     }
755     my $retarget_holds = [];
756     $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
757         $editor, $oargs, undef, $copies, $delete_stats, $retarget_holds, undef, $create_parts);
758
759     if( $evt ) { 
760         $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
761         $editor->rollback; 
762         return $evt; 
763     }
764
765     $editor->commit;
766     $logger->info("fleshed copy update successfully updated ".scalar(@$copies)." copies");
767     reset_hold_list($auth, $retarget_holds);
768
769     return 1;
770 }
771
772 sub reset_hold_list {
773     my($auth, $hold_ids) = @_;
774     return unless @$hold_ids;
775     $logger->info("reseting holds after copy status change: @$hold_ids");
776     my $ses = OpenSRF::AppSession->create('open-ils.circ');
777     $ses->request('open-ils.circ.hold.reset.batch', $auth, $hold_ids);
778 }
779
780 __PACKAGE__->register_method(
781     method    => "transfer_copies_to_volume",
782     api_name  => "open-ils.cat.transfer_copies_to_volume",
783     argc      => 3,
784     signature => {
785         desc   => 'Transfers specified copies to the specified call number, and changes Circ Lib to match the new Owning Lib.',
786         params => [
787             {desc => 'Authtoken', type => 'string'},
788             {desc => 'Call Number ID', type => 'number'},
789             {desc => 'Array of Copy IDs', type => 'array'},
790         ]
791     },
792     return => {desc => '1 on success, Event on error'}
793 );
794
795 __PACKAGE__->register_method(
796     method   => "transfer_copies_to_volume",
797     api_name => "open-ils.cat.transfer_copies_to_volume.override",);
798
799 sub transfer_copies_to_volume {
800     my( $self, $conn, $auth, $volume, $copies, $oargs ) = @_;
801     my $delete_stats = 1;
802     my $force_delete_empty_bib = undef;
803     my $create_parts = undef;
804
805     # initial tests
806
807     return 1 unless ref $copies;
808     my( $reqr, $evt ) = $U->checkses($auth);
809     return $evt if $evt;
810     my $editor = new_editor(requestor => $reqr, xact => 1);
811     if ($self->api_name =~ /override/) {
812         $oargs = { all => 1 } unless defined $oargs;
813     } else {
814         $oargs = {};
815     }
816
817     # does the volume exist?  good, we also need its owning_lib later
818     my( $cn, $cn_evt ) = $U->fetch_callnumber( $volume, 0, $editor );
819     return $cn_evt if $cn_evt;
820
821     # flesh and munge the copies
822     my $fleshed_copies = [];
823     my ($copy, $copy_evt);
824     foreach my $copy_id ( @{ $copies } ) {
825         ($copy, $copy_evt) = $U->fetch_copy($copy_id);
826         return $copy_evt if $copy_evt;
827         $copy->call_number( $volume );
828         $copy->circ_lib( $cn->owning_lib() );
829         $copy->ischanged( 't' );
830         push @$fleshed_copies, $copy;
831     }
832
833     # actual work
834     my $retarget_holds = [];
835     $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
836         $editor, $oargs, undef, $fleshed_copies, $delete_stats, $retarget_holds, $force_delete_empty_bib, $create_parts);
837
838     if( $evt ) { 
839         $logger->info("copy to volume transfer failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
840         $editor->rollback; 
841         return $evt; 
842     }
843
844     $editor->commit;
845     $logger->info("copy to volume transfer successfully updated ".scalar(@$copies)." copies");
846     reset_hold_list($auth, $retarget_holds);
847
848     return 1;
849 }
850
851 __PACKAGE__->register_method(
852     method    => 'in_db_merge',
853     api_name  => 'open-ils.cat.biblio.records.merge',
854     signature => q/
855         Merges a group of records
856         @param auth The login session key
857         @param master The id of the record all other records should be merged into
858         @param records Array of records to be merged into the master record
859         @return 1 on success, Event on error.
860     /
861 );
862
863 sub in_db_merge {
864     my( $self, $conn, $auth, $master, $records ) = @_;
865
866     my $editor = new_editor( authtoken => $auth, xact => 1 );
867     return $editor->die_event unless $editor->checkauth;
868     return $editor->die_event unless $editor->allowed('MERGE_BIB_RECORDS'); # TODO see below about record ownership
869
870     my $count = 0;
871     for my $source ( @$records ) {
872         #XXX we actually /will/ want to check perms for master and sources after record ownership exists
873
874         # This stored proc (asset.merge_record_assets(target,source)) has the side effects of
875         # moving call_number, title-type (and some volume-type) hold_request and uri-mapping
876         # objects from the source record to the target record, so must be called from within
877         # a transaction.
878
879         $count += $editor->json_query({
880             select => {
881                 bre => [{
882                     alias => 'count',
883                     transform => 'asset.merge_record_assets',
884                     column => 'id',
885                     params => [$source]
886                 }]
887             },
888             from   => 'bre',
889             where  => { id => $master }
890         })->[0]->{count}; # count of objects moved, of all types
891
892     }
893
894     $editor->commit;
895     return $count;
896 }
897
898 __PACKAGE__->register_method(
899     method    => 'in_db_auth_merge',
900     api_name  => 'open-ils.cat.authority.records.merge',
901     signature => q/
902         Merges a group of authority records
903         @param auth The login session key
904         @param master The id of the record all other records should be merged into
905         @param records Array of records to be merged into the master record
906         @return 1 on success, Event on error.
907     /
908 );
909
910 sub in_db_auth_merge {
911     my( $self, $conn, $auth, $master, $records ) = @_;
912
913     my $editor = new_editor( authtoken => $auth, xact => 1 );
914     return $editor->die_event unless $editor->checkauth;
915     return $editor->die_event unless $editor->allowed('MERGE_AUTH_RECORDS'); # TODO see below about record ownership
916
917     my $count = 0;
918     for my $source ( @$records ) {
919         $count += $editor->json_query({
920             select => {
921                 are => [{
922                     alias => 'count',
923                     transform => 'authority.merge_records',
924                     column => 'id',
925                     params => [$source]
926                 }]
927             },
928             from   => 'are',
929             where  => { id => $master }
930         })->[0]->{count}; # count of objects moved, of all types
931     }
932
933     $editor->commit;
934     return $count;
935 }
936
937 __PACKAGE__->register_method(
938     method    => 'calculate_marc_merge',
939     api_name  => 'open-ils.cat.merge.marc.per_profile',
940     signature => q/
941         Calculate the result of merging one or more MARC records
942         per the specified merge profile
943         @param auth The login session key
944         @param merge_profile ID of the record merge profile
945         @param records Array of two or more MARCXML records to be
946                        merged. If two are supplied, the first
947                        is treated as the record to be overlaid,
948                        and the the incoming record that will
949                        overlay the first. If more than two are
950                        supplied, the first is treated as the
951                        record to be overlaid, and each following
952                        record in turn will be merged into that
953                        record.
954         @return MARCXML string of the results of the merge
955     /
956 );
957 __PACKAGE__->register_method(
958     method    => 'calculate_bib_marc_merge',
959     api_name  => 'open-ils.cat.merge.biblio.per_profile',
960     signature => q/
961         Calculate the result of merging one or more bib records
962         per the specified merge profile
963         @param auth The login session key
964         @param merge_profile ID of the record merge profile
965         @param records Array of two or more bib record IDs of
966                        the bibs to be merged.
967         @return MARCXML string of the results of the merge
968     /
969 );
970 __PACKAGE__->register_method(
971     method    => 'calculate_authority_marc_merge',
972     api_name  => 'open-ils.cat.merge.authority.per_profile',
973     signature => q/
974         Calculate the result of merging one or more authority records
975         per the specified merge profile
976         @param auth The login session key
977         @param merge_profile ID of the record merge profile
978         @param records Array of two or more bib record IDs of
979                        the bibs to be merged.
980         @return MARCXML string of the results of the merge
981     /
982 );
983
984 sub _handle_marc_merge {
985     my ($e, $merge_profile_id, $records) = @_;
986
987     my $result = shift @$records;
988     foreach my $incoming (@$records) {
989         my $response = $e->json_query({
990             from => [
991                 'vandelay.merge_record_xml_using_profile',
992                 $incoming, $result,
993                 $merge_profile_id
994             ]
995         });
996         return unless ref($response);
997         $result = $response->[0]->{'vandelay.merge_record_xml_using_profile'};
998     }
999     return $result;
1000 }
1001
1002 sub calculate_marc_merge {
1003     my( $self, $conn, $auth, $merge_profile_id, $records ) = @_;
1004
1005     my $e = new_editor(authtoken=>$auth, xact=>1);
1006     return $e->die_event unless $e->checkauth;
1007
1008     my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1009         or return $e->die_event;
1010     return $e->die_event unless ref($records) && @$records >= 2;
1011
1012     return _handle_marc_merge($e, $merge_profile_id, $records)
1013 }
1014
1015 sub calculate_bib_marc_merge {
1016     my( $self, $conn, $auth, $merge_profile_id, $bib_ids ) = @_;
1017
1018     my $e = new_editor(authtoken=>$auth, xact=>1);
1019     return $e->die_event unless $e->checkauth;
1020
1021     my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1022         or return $e->die_event;
1023     return $e->die_event unless ref($bib_ids) && @$bib_ids >= 2;
1024
1025     my $records = [];
1026     foreach my $id (@$bib_ids) {
1027         my $bre = $e->retrieve_biblio_record_entry($id) or return $e->die_event;
1028         push @$records, $bre->marc();
1029     }
1030
1031     return _handle_marc_merge($e, $merge_profile_id, $records)
1032 }
1033
1034 sub calculate_authority_marc_merge {
1035     my( $self, $conn, $auth, $merge_profile_id, $authority_ids ) = @_;
1036
1037     my $e = new_editor(authtoken=>$auth, xact=>1);
1038     return $e->die_event unless $e->checkauth;
1039
1040     my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1041         or return $e->die_event;
1042     return $e->die_event unless ref($authority_ids) && @$authority_ids >= 2;
1043
1044     my $records = [];
1045     foreach my $id (@$authority_ids) {
1046         my $are = $e->retrieve_authority_record_entry($id) or return $e->die_event;
1047         push @$records, $are->marc();
1048     }
1049
1050     return _handle_marc_merge($e, $merge_profile_id, $records)
1051 }
1052
1053 __PACKAGE__->register_method(
1054     method   => "fleshed_volume_update",
1055     api_name => "open-ils.cat.asset.volume.fleshed.batch.update",);
1056
1057 __PACKAGE__->register_method(
1058     method   => "fleshed_volume_update",
1059     api_name => "open-ils.cat.asset.volume.fleshed.batch.update.override",);
1060
1061 sub fleshed_volume_update {
1062     my( $self, $conn, $auth, $volumes, $delete_stats, $options, $oargs ) = @_;
1063     my( $reqr, $evt ) = $U->checkses($auth);
1064     return $evt if $evt;
1065     $options ||= {};
1066
1067     if ($self->api_name =~ /override/) {
1068         $oargs = { all => 1 } unless defined $oargs;
1069     } else {
1070         $oargs = {};
1071     }
1072     my $editor = new_editor( requestor => $reqr, xact => 1 );
1073     my $retarget_holds = [];
1074     my $auto_merge_vols = $options->{auto_merge_vols};
1075     my $create_parts = $options->{create_parts};
1076
1077     for my $vol (@$volumes) {
1078         $logger->info("vol-update: investigating volume ".$vol->id);
1079
1080         $vol->editor($reqr->id);
1081         $vol->edit_date('now');
1082
1083         my $copies = $vol->copies;
1084         $vol->clear_copies;
1085
1086         $vol->editor($editor->requestor->id);
1087         $vol->edit_date('now');
1088
1089         if( $vol->isdeleted ) {
1090
1091             $logger->info("vol-update: deleting volume");
1092             return $editor->die_event unless
1093                 $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
1094
1095             if(my $evt = $assetcom->delete_volume($editor, $vol, $oargs, $$options{force_delete_copies})) {
1096                 $editor->rollback;
1097                 return $evt;
1098             }
1099
1100             return $editor->die_event unless
1101                 $editor->update_asset_call_number($vol);
1102
1103         } elsif( $vol->isnew ) {
1104             $logger->info("vol-update: creating volume");
1105             $evt = $assetcom->create_volume( $oargs, $editor, $vol );
1106             return $evt if $evt;
1107
1108         } elsif( $vol->ischanged ) {
1109             $logger->info("vol-update: update volume");
1110             my $resp = update_volume($vol, $editor, ($oargs->{all} or grep { $_ eq 'VOLUME_LABEL_EXISTS' } @{$oargs->{events}} or $auto_merge_vols));
1111             return $resp->{evt} if $resp->{evt};
1112             $vol = $resp->{merge_vol} if $resp->{merge_vol};
1113         }
1114
1115         # now update any attached copies
1116         if( $copies and @$copies and !$vol->isdeleted ) {
1117             $_->call_number($vol->id) for @$copies;
1118             $evt = $assetcom->update_fleshed_copies(
1119                 $editor, $oargs, $vol, $copies, $delete_stats, $retarget_holds, undef, $create_parts);
1120             return $evt if $evt;
1121         }
1122     }
1123
1124     $editor->finish;
1125     reset_hold_list($auth, $retarget_holds);
1126     return scalar(@$volumes);
1127 }
1128
1129
1130 sub update_volume {
1131     my $vol = shift;
1132     my $editor = shift;
1133     my $auto_merge = shift;
1134     my $evt;
1135     my $merge_vol;
1136
1137     return {evt => $editor->event} unless
1138         $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
1139
1140     return {evt => $evt} 
1141         if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $vol->owning_lib) );
1142
1143     my $vols = $editor->search_asset_call_number({ 
1144         owning_lib => $vol->owning_lib,
1145         record     => $vol->record,
1146         label      => $vol->label,
1147         prefix     => $vol->prefix,
1148         suffix     => $vol->suffix,
1149         deleted    => 'f',
1150         id         => {'!=' => $vol->id}
1151     });
1152
1153     if(@$vols) {
1154
1155         if($auto_merge) {
1156
1157             # If the auto-merge option is on, merge our updated volume into the existing
1158             # volume with the same record + owner + label.
1159             ($merge_vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $vols->[0]);
1160             return {evt => $evt, merge_vol => $merge_vol};
1161
1162         } else {
1163             return {evt => OpenILS::Event->new('VOLUME_LABEL_EXISTS', payload => $vol->id)};
1164         }
1165     }
1166
1167     return {evt => $editor->die_event} unless $editor->update_asset_call_number($vol);
1168     return {};
1169 }
1170
1171
1172
1173 __PACKAGE__->register_method (
1174     method   => 'delete_bib_record',
1175     api_name => 'open-ils.cat.biblio.record_entry.delete');
1176
1177 sub delete_bib_record {
1178     my($self, $conn, $auth, $rec_id) = @_;
1179     my $e = new_editor(xact=>1, authtoken=>$auth);
1180     return $e->die_event unless $e->checkauth;
1181     return $e->die_event unless $e->allowed('DELETE_RECORD', $e->requestor->ws_ou);
1182     my $vols = $e->search_asset_call_number({record=>$rec_id, deleted=>'f'});
1183     return OpenILS::Event->new('RECORD_NOT_EMPTY', payload=>$rec_id) if @$vols;
1184     my $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $rec_id);
1185     if($evt) { $e->rollback; return $evt; }   
1186     $e->commit;
1187     return 1;
1188 }
1189
1190
1191
1192 __PACKAGE__->register_method (
1193     method   => 'batch_volume_transfer',
1194     api_name => 'open-ils.cat.asset.volume.batch.transfer',
1195 );
1196
1197 __PACKAGE__->register_method (
1198     method   => 'batch_volume_transfer',
1199     api_name => 'open-ils.cat.asset.volume.batch.transfer.override',
1200 );
1201
1202
1203 sub batch_volume_transfer {
1204     my( $self, $conn, $auth, $args, $oargs ) = @_;
1205
1206     my $evt;
1207     my $rec     = $$args{docid};
1208     my $o_lib   = $$args{lib};
1209     my $vol_ids = $$args{volumes};
1210
1211     my $override = 1 if $self->api_name =~ /override/;
1212     $oargs = { all => 1 } unless defined $oargs;
1213
1214     $logger->info("merge: transferring volumes to lib=$o_lib and record=$rec");
1215
1216     my $e = new_editor(authtoken => $auth, xact =>1);
1217     return $e->event unless $e->checkauth;
1218     return $e->event unless $e->allowed('UPDATE_VOLUME', $o_lib);
1219
1220     my $dorg = $e->retrieve_actor_org_unit($o_lib)
1221         or return $e->event;
1222
1223     my $ou_type = $e->retrieve_actor_org_unit_type($dorg->ou_type)
1224         or return $e->event;
1225
1226     return $evt if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($e, $o_lib) );
1227
1228     my $vols = $e->batch_retrieve_asset_call_number($vol_ids);
1229     my @seen;
1230
1231    my @rec_ids;
1232
1233     for my $vol (@$vols) {
1234
1235         # if we've already looked at this volume, go to the next
1236         next if !$vol or grep { $vol->id == $_ } @seen;
1237
1238         # grab all of the volumes in the list that have 
1239         # the same label so they can be merged
1240         my @all = grep { $_->label eq $vol->label } @$vols;
1241
1242         # take note of the fact that we've looked at this set of volumes
1243         push( @seen, $_->id ) for @all;
1244         push( @rec_ids, $_->record ) for @all;
1245
1246         # for each volume, see if there are any copies that have a 
1247         # remote circ_lib (circ_lib != vol->owning_lib and != $o_lib ).  
1248         # if so, warn them
1249         unless( $override && ($oargs->{all} || grep { $_ eq 'COPY_REMOTE_CIRC_LIB' } @{$oargs->{events}}) ) {
1250             for my $v (@all) {
1251
1252                 $logger->debug("merge: searching for copies with remote circ_lib for volume ".$v->id);
1253                 my $args = { 
1254                     call_number => $v->id, 
1255                     circ_lib    => { "not in" => [ $o_lib, $v->owning_lib ] },
1256                     deleted     => 'f'
1257                 };
1258
1259                 my $copies = $e->search_asset_copy($args, {idlist=>1});
1260
1261                 # if the copy's circ_lib matches the destination lib,
1262                 # that's ok too
1263                 return OpenILS::Event->new('COPY_REMOTE_CIRC_LIB') if @$copies;
1264             }
1265         }
1266
1267         # see if there is a volume at the destination lib that 
1268         # already has the requested label
1269         my $existing_vol = $e->search_asset_call_number(
1270             {
1271                 label      => $vol->label, 
1272                 prefix     => $vol->prefix, 
1273                 suffix     => $vol->suffix, 
1274                 record     => $rec, 
1275                 owning_lib => $o_lib,
1276                 deleted    => 'f'
1277             }
1278         )->[0];
1279
1280         if( $existing_vol ) {
1281
1282             if( grep { $_->id == $existing_vol->id } @all ) {
1283                 # this volume is already accounted for in our list of volumes to merge
1284                 $existing_vol = undef;
1285
1286             } else {
1287                 # this volume exists on the destination record/owning_lib and must
1288                 # be used as the destination for merging
1289                 $logger->debug("merge: volume already exists at destination record: ".
1290                     $existing_vol->id.' : '.$existing_vol->label) if $existing_vol;
1291             }
1292         } 
1293
1294         if( @all > 1 || $existing_vol ) {
1295             $logger->info("merge: found collisions in volume transfer");
1296             my @args = ($e, \@all);
1297             @args = ($e, \@all, $existing_vol) if $existing_vol;
1298             ($vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes(@args);
1299             return $evt if $evt;
1300         } 
1301         
1302         if( !$existing_vol ) {
1303
1304             $vol->owning_lib($o_lib);
1305             $vol->record($rec);
1306             $vol->editor($e->requestor->id);
1307             $vol->edit_date('now');
1308     
1309             $logger->info("merge: updating volume ".$vol->id);
1310             $e->update_asset_call_number($vol) or return $e->event;
1311
1312         } else {
1313             $logger->info("merge: bypassing volume update because existing volume used as target");
1314         }
1315
1316         # regardless of what volume was used as the destination, 
1317         # update any copies that have moved over to the new lib
1318         my $copies = $e->search_asset_copy({call_number=>$vol->id, deleted => 'f'});
1319
1320         # update circ lib on the copies - make this a method flag?
1321         for my $copy (@$copies) {
1322             next if $copy->circ_lib == $o_lib;
1323             $logger->info("merge: transfer moving circ lib on copy ".$copy->id);
1324             $copy->circ_lib($o_lib);
1325             $copy->editor($e->requestor->id);
1326             $copy->edit_date('now');
1327             $e->update_asset_copy($copy) or return $e->event;
1328         }
1329
1330         # Now see if any empty records need to be deleted after all of this
1331
1332         for(@rec_ids) {
1333             $logger->debug("merge: seeing if we should delete record $_...");
1334             $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $_) 
1335                 if OpenILS::Application::Cat::BibCommon->title_is_empty($e, $_);
1336             return $evt if $evt;
1337         }
1338     }
1339
1340     $logger->info("merge: transfer succeeded");
1341     $e->commit;
1342     return 1;
1343 }
1344
1345
1346
1347
1348 __PACKAGE__->register_method(
1349     api_name => 'open-ils.cat.call_number.find_or_create',
1350     method   => 'find_or_create_volume',
1351 );
1352
1353 sub find_or_create_volume {
1354     my( $self, $conn, $auth, $label, $record_id, $org_id, $prefix, $suffix, $label_class ) = @_;
1355     my $e = new_editor(authtoken=>$auth, xact=>1);
1356     return $e->die_event unless $e->checkauth;
1357     my ($vol, $evt, $exists) = 
1358         OpenILS::Application::Cat::AssetCommon->find_or_create_volume($e, $label, $record_id, $org_id, $prefix, $suffix, $label_class);
1359     return $evt if $evt;
1360     $e->rollback if $exists;
1361     $e->commit if $vol;
1362     return { 'acn_id' => $vol->id, 'existed' => $exists };
1363 }
1364
1365
1366 __PACKAGE__->register_method(
1367     method    => "create_serial_record_xml",
1368     api_name  => "open-ils.cat.serial.record.xml.create.override",
1369     signature => q/@see open-ils.cat.serial.record.xml.create/);
1370
1371 __PACKAGE__->register_method(
1372     method    => "create_serial_record_xml",
1373     api_name  => "open-ils.cat.serial.record.xml.create",
1374     signature => q/
1375         Inserts a new serial record with the given XML
1376     /
1377 );
1378
1379 sub create_serial_record_xml {
1380     my( $self, $client, $login, $source, $owning_lib, $record_id, $xml, $oargs ) = @_;
1381
1382     my $override = 1 if $self->api_name =~ /override/; # not currently used
1383     $oargs = { all => 1 } unless defined $oargs; # Not currently used, but here for consistency.
1384
1385     my $e = new_editor(xact=>1, authtoken=>$login);
1386     return $e->die_event unless $e->checkauth;
1387     return $e->die_event unless $e->allowed('CREATE_MFHD_RECORD', $owning_lib);
1388
1389     # Auto-populate the location field of a placeholder MFHD record with the library name
1390     my $aou = $e->retrieve_actor_org_unit($owning_lib) or return $e->die_event;
1391
1392     my $mfhd = Fieldmapper::serial::record_entry->new;
1393
1394     $mfhd->source($source) if $source;
1395     $mfhd->record($record_id);
1396     $mfhd->creator($e->requestor->id);
1397     $mfhd->editor($e->requestor->id);
1398     $mfhd->create_date('now');
1399     $mfhd->edit_date('now');
1400     $mfhd->owning_lib($owning_lib);
1401
1402     # If the caller did not pass in MFHD XML, create a placeholder record.
1403     # The placeholder will only contain the name of the owning library.
1404     # The goal is to generate common patterns for the caller in the UI that
1405     # then get passed in here.
1406     if (!$xml) {
1407         my $aou_name = $aou->name;
1408         $xml = <<HERE;
1409 <record 
1410  xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1411  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
1412  xmlns="http://www.loc.gov/MARC21/slim">
1413 <leader>00307ny  a22001094  4500</leader>
1414 <controlfield tag="001">42153</controlfield>
1415 <controlfield tag="005">20090601182414.0</controlfield>
1416 <controlfield tag="004">$record_id</controlfield>
1417 <controlfield tag="008">      4u####8###l# 4   uueng1      </controlfield>
1418 <datafield tag="852" ind1=" " ind2=" "> <subfield code="b">$aou_name</subfield></datafield>
1419 </record>
1420 HERE
1421     }
1422     my $marcxml = XML::LibXML->new->parse_string($xml);
1423     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim", "marc", 1 );
1424     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim");
1425
1426     $mfhd->marc($U->entityize($marcxml->documentElement->toString));
1427
1428     $e->create_serial_record_entry($mfhd) or return $e->die_event;
1429
1430     $e->commit;
1431     return $mfhd->id;
1432 }
1433
1434 __PACKAGE__->register_method(
1435     method   => "create_update_asset_copy_template",
1436     api_name => "open-ils.cat.asset.copy_template.create_or_update"
1437 );
1438
1439 sub create_update_asset_copy_template {
1440     my ($self, $client, $authtoken, $act) = @_;
1441
1442     my $e = new_editor("xact" => 1, "authtoken" => $authtoken);
1443     return $e->die_event unless $e->checkauth;
1444     return $e->die_event unless $e->allowed(
1445         "ADMIN_ASSET_COPY_TEMPLATE", $act->owning_lib
1446     );
1447
1448     $act->editor($e->requestor->id);
1449     $act->edit_date("now");
1450
1451     my $retval;
1452     if (!$act->id) {
1453         $act->creator($e->requestor->id);
1454         $act->create_date("now");
1455
1456         $e->create_asset_copy_template($act) or return $e->die_event;
1457         $retval = $e->data;
1458     } else {
1459         $e->update_asset_copy_template($act) or return $e->die_event;
1460         $retval = $e->retrieve_asset_copy_template($e->data);
1461     }
1462     $e->commit and return $retval;
1463 }
1464
1465 __PACKAGE__->register_method(
1466     method      => "acn_sms_msg",
1467     api_name    => "open-ils.cat.acn.send_sms_text",
1468     signature   => q^
1469         Send an SMS text from an A/T template for specified call numbers.
1470
1471         First parameter is null or an auth token (whether a null is allowed
1472         depends on the sms.disable_authentication_requirement.callnumbers OU
1473         setting).
1474
1475         Second parameter is the id of the context org.
1476
1477         Third parameter is the code of the SMS carrier from the
1478         config.sms_carrier table.
1479
1480         Fourth parameter is the SMS number.
1481
1482         Fifth parameter is the ACN id's to target, though currently only the
1483         first ACN is used by the template (and the UI is only sending one).
1484     ^
1485 );
1486
1487 sub acn_sms_msg {
1488     my($self, $conn, $auth, $org_id, $carrier, $number, $target_ids) = @_;
1489
1490     my $sms_enable = $U->ou_ancestor_setting_value(
1491         $org_id || $U->get_org_tree->id,
1492         'sms.enable'
1493     );
1494     # We could maybe make a Validator for this on the templates
1495     if (! $U->is_true($sms_enable)) {
1496         return -1;
1497     }
1498
1499     my $disable_auth = $U->ou_ancestor_setting_value(
1500         $org_id || $U->get_org_tree->id,
1501         'sms.disable_authentication_requirement.callnumbers'
1502     );
1503
1504     my $e = new_editor(
1505         (defined $auth)
1506         ? (authtoken => $auth, xact => 1)
1507         : (xact => 1)
1508     );
1509     return $e->event unless $disable_auth || $e->checkauth;
1510
1511     my $targets = $e->batch_retrieve_asset_call_number($target_ids);
1512
1513     $e->rollback; # FIXME using transaction because of pgpool/slony setups, but not
1514                   # simply making this method authoritative because of weirdness
1515                   # with transaction handling in A/T code that causes rollback
1516                   # failure down the line if handling many targets
1517
1518     return undef unless @$targets;
1519     return $U->fire_object_event(
1520         undef,                    # event_def
1521         'acn.format.sms_text',    # hook
1522         $targets,
1523         $org_id,
1524         undef,                    # granularity
1525         {                         # user_data
1526             sms_carrier => $carrier,
1527             sms_notify => $number
1528         }
1529     );
1530 }
1531
1532
1533
1534 __PACKAGE__->register_method(
1535     method    => "fixed_field_values_by_rec_type",
1536     api_name  => "open-ils.cat.biblio.fixed_field_values.by_rec_type",
1537     argc      => 2,
1538     signature => {
1539         desc   => 'Given a record type (as in cmfpm.rec_type), return fixed fields and their possible values as known to the DB',
1540         params => [
1541             {desc => 'Record Type', type => 'string'},
1542             {desc => '(Optional) Fixed field', type => 'string'},
1543         ]
1544     },
1545     return => {desc => 'an object in which the keys are fixed fields and the values are arrays representing the set of all unique values for that fixed field in that record type', type => 'object' }
1546 );
1547
1548
1549 sub fixed_field_values_by_rec_type {
1550     my ($self, $conn, $rec_type, $fixed_field) = @_;
1551
1552     my $e = new_editor;
1553     my $values = $e->json_query({
1554         select => {
1555             crad  => ["fixed_field"],
1556             ccvm  => [qw/code value/],
1557             cmfpm => [qw/length default_val/],
1558         },
1559         distinct => 1,
1560         from => {
1561             ccvm => {
1562                 crad => {
1563                     join => {
1564                         cmfpm => {
1565                             fkey => "fixed_field",
1566                             field => "fixed_field"
1567                         }
1568                     }
1569                 }
1570             }
1571         },
1572         where => {
1573             "+cmfpm" => {rec_type => $rec_type},
1574             defined $fixed_field ?
1575                 ("+crad" => {fixed_field => $fixed_field}) : ()
1576         },
1577         order_by => [
1578             {class => "crad", field => "fixed_field"},
1579             {class => "ccvm", field => "code"}
1580         ]
1581     }) or return $e->die_event;
1582
1583     my $result = {};
1584     for my $row (@$values) {
1585         $result->{$row->{fixed_field}} ||= [];
1586         push @{$result->{$row->{fixed_field}}}, [@$row{qw/code value length default_val/}];
1587     }
1588
1589     return $result;
1590 }
1591
1592 __PACKAGE__->register_method(
1593     method    => "retrieve_tag_table",
1594     api_name  => "open-ils.cat.tag_table.all.retrieve.local",
1595     stream    => 1,
1596     argc      => 3,
1597     signature => {
1598         desc   => "Retrieve set of MARC tags, subfields, and indicator values for the user's OU",
1599         params => [
1600             {desc => 'Authtoken', type => 'string'},
1601             {desc => 'MARC Format', type => 'string'},
1602             {desc => 'MARC Record Type', type => 'string'},
1603         ]
1604     },
1605     return => {desc => 'Structure representing the tag table available to that user', type => 'object' }
1606 );
1607 __PACKAGE__->register_method(
1608     method    => "retrieve_tag_table",
1609     api_name  => "open-ils.cat.tag_table.all.retrieve.stock",
1610     stream    => 1,
1611     argc      => 3,
1612     signature => {
1613         desc   => 'Retrieve set of MARC tags, subfields, and indicator values for stock MARC standard',
1614         params => [
1615             {desc => 'Authtoken', type => 'string'},
1616             {desc => 'MARC Format', type => 'string'},
1617             {desc => 'MARC Record Type', type => 'string'},
1618         ]
1619     },
1620     return => {desc => 'Structure representing the stock tag table', type => 'object' }
1621 );
1622 __PACKAGE__->register_method(
1623     method    => "retrieve_tag_table",
1624     api_name  => "open-ils.cat.tag_table.field_list.retrieve.local",
1625     stream    => 1,
1626     argc      => 3,
1627     signature => {
1628         desc   => "Retrieve set of MARC tags for available to the user's OU",
1629         params => [
1630             {desc => 'Authtoken', type => 'string'},
1631             {desc => 'MARC Format', type => 'string'},
1632             {desc => 'MARC Record Type', type => 'string'},
1633         ]
1634     },
1635     return => {desc => 'Structure representing the tags available to that user', type => 'object' }
1636 );
1637 __PACKAGE__->register_method(
1638     method    => "retrieve_tag_table",
1639     api_name  => "open-ils.cat.tag_table.field_list.retrieve.stock",
1640     stream    => 1,
1641     argc      => 3,
1642     signature => {
1643         desc   => 'Retrieve set of MARC tags for stock MARC standard',
1644         params => [
1645             {desc => 'Authtoken', type => 'string'},
1646             {desc => 'MARC Format', type => 'string'},
1647             {desc => 'MARC Record Type', type => 'string'},
1648         ]
1649     },
1650     return => {desc => 'Structure representing the stock MARC tags', type => 'object' }
1651 );
1652
1653 sub retrieve_tag_table {
1654     my( $self, $conn, $auth, $marc_format, $marc_record_type ) = @_;
1655     my $e = new_editor( authtoken=>$auth, xact=>1 );
1656     return $e->die_event unless $e->checkauth;
1657     return $e->die_event unless $e->allowed('UPDATE_MARC', $e->requestor->ws_ou);
1658
1659     my $field_list_only = ($self->api_name =~ /\.field_list\./) ? 1 : 0;
1660     my $context_ou;
1661     if ($self->api_name =~ /\.local$/) {
1662         $context_ou = $e->requestor->ws_ou;
1663     }
1664
1665     my %sf_by_tag;
1666     unless ($field_list_only) {
1667         my $subfields = $e->json_query(
1668             { from => [ 'config.ou_marc_subfields', 1, $marc_record_type, $context_ou ] }
1669         );
1670         foreach my $sf (@$subfields) {
1671             my $sf_data = {
1672                 code        => $sf->{code},
1673                 description => $sf->{description},
1674                 mandatory   => $sf->{mandatory},
1675                 repeatable   => $sf->{repeatable},
1676             };
1677             if ($sf->{value_ctype}) {
1678                 $sf_data->{value_list} = $e->json_query({
1679                     select => { ccvm => [
1680                                             'code',
1681                                             { column => 'value', alias => 'description' }
1682                                         ]
1683                               },
1684                     from   => 'ccvm',
1685                     where  => { ctype => $sf->{value_ctype} },
1686                     order_by => { ccvm => { code => {} } },
1687                 });
1688             }
1689             push @{ $sf_by_tag{$sf->{tag}} }, $sf_data;
1690         }
1691     }
1692
1693     my $fields = $e->json_query(
1694         { from => [ 'config.ou_marc_fields', 1, $marc_record_type, $context_ou ] }
1695     );
1696
1697     foreach my $field (@$fields) {
1698         next if $field->{hidden} eq 't';
1699         unless ($field_list_only) {
1700             my $tag = $field->{tag};
1701             if ($tag ge '010') {
1702                 for my $pos (1..2) {
1703                     my $ind_ccvm_key = "${marc_format}_${marc_record_type}_${tag}_ind_${pos}";
1704                     my $indvals = $e->json_query({
1705                         select => { ccvm => [
1706                                                 'code',
1707                                                 { column => 'value', alias => 'description' }
1708                                             ]
1709                                   },
1710                         from   => 'ccvm',
1711                         where  => { ctype => $ind_ccvm_key }
1712                     });
1713                     next unless defined($indvals);
1714                     $field->{"ind$pos"} = $indvals;
1715                 }
1716                 $field->{subfields} = exists($sf_by_tag{$tag}) ? $sf_by_tag{$tag} : [];
1717             }
1718         }
1719         $conn->respond($field);
1720     }
1721 }
1722
1723 1;
1724
1725 # vi:et:ts=4:sw=4