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