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;
15 use OpenILS::Const qw/:const/;
18 use Unicode::Normalize;
20 use OpenILS::Utils::CStoreEditor q/:funcs/;
22 use OpenSRF::Utils::SettingsClient;
23 use OpenSRF::Utils::Logger qw($logger);
24 use OpenSRF::AppSession;
26 my $U = "OpenILS::Application::AppUtils";
29 my $assetcom = 'OpenILS::Application::Cat::AssetCommon';
31 __PACKAGE__->register_method(
32 method => "retrieve_marc_template",
33 api_name => "open-ils.cat.biblio.marc_template.retrieve",
35 Returns a MARC 'record tree' based on a set of pre-defined templates.
36 Templates include : book
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};
46 __PACKAGE__->register_method(
47 method => 'fetch_marc_template_types',
48 api_name => 'open-ils.cat.marc_template.types.retrieve'
51 my $marc_template_files;
53 sub fetch_marc_template_types {
54 my( $self, $conn ) = @_;
55 __load_marc_templates();
56 return [ keys %$marc_template_files ];
59 sub __load_marc_templates {
60 return if $marc_template_files;
61 if(!$conf) { $conf = OpenSRF::Utils::SettingsClient->new; }
63 $marc_template_files = $conf->config_value(
64 "apps", "open-ils.cat","app_settings", "marctemplates" );
66 $logger->info("Loaded marc templates: " . Dumper($marc_template_files));
69 sub _load_marc_template {
72 __load_marc_templates();
74 my $template = $$marc_template_files{$type};
75 open( F, $template ) or
76 throw OpenSRF::EX::ERROR ("Unable to open MARC template file: $template : $@");
80 my $xml = join('', @xml);
82 return XML::LibXML->new->parse_string($xml)->documentElement->toString;
87 __PACKAGE__->register_method(
88 method => 'fetch_bib_sources',
89 api_name => 'open-ils.cat.bib_sources.retrieve.all');
91 sub fetch_bib_sources {
92 return OpenILS::Application::Cat::BibCommon->fetch_bib_sources();
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/);
100 __PACKAGE__->register_method(
101 method => "create_record_xml",
102 api_name => "open-ils.cat.biblio.record.xml.create",
104 Inserts a new biblio with the given XML
108 sub create_record_xml {
109 my( $self, $client, $login, $xml, $source, $oargs, $strip_grps ) = @_;
111 my $override = 1 if $self->api_name =~ /override/;
112 $oargs = { all => 1 } unless defined $oargs;
114 my( $user_obj, $evt ) = $U->checksesperm($login, 'CREATE_MARC');
117 $logger->activity("user ".$user_obj->id." creating new MARC record");
119 my $meth = $self->method_lookup("open-ils.cat.biblio.record.xml.import");
121 $meth = $self->method_lookup(
122 "open-ils.cat.biblio.record.xml.import.override") if $override;
124 my ($s) = $meth->run($login, $xml, $source, $oargs, $strip_grps);
130 __PACKAGE__->register_method(
131 method => "biblio_record_replace_marc",
132 api_name => "open-ils.cat.biblio.record.xml.update",
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
142 __PACKAGE__->register_method(
143 method => 'biblio_record_replace_marc',
144 api_name => 'open-ils.cat.biblio.record.marc.replace',
146 @param auth The authtoken
147 @param recid The record whose MARC we're replacing
148 @param newxml The new xml to use
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/
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);
164 my $fix_tcn = $self->api_name =~ /replace/o;
165 if($self->api_name =~ /override/o) {
166 $oargs = { all => 1 } unless defined $oargs;
171 my $res = OpenILS::Application::Cat::BibCommon->biblio_record_replace_marc(
172 $e, $recid, $newxml, $source, $fix_tcn, $oargs, $strip_grps);
174 $e->commit unless $U->event_code($res);
175 $U->create_events_for_hook('bre.edit', $res, $e->requestor->ws_ou) unless $U->event_code($res);;
180 __PACKAGE__->register_method(
181 method => "template_overlay_biblio_record_entry",
182 api_name => "open-ils.cat.biblio.record_entry.template_overlay",
185 Overlays biblio.record_entry MARC values
186 @param auth The authtoken
187 @param records The record ids to be updated by the template
188 @param template The overlay template
189 @return Stream of hashes record id in the key "record" and t or f for the success of the overlay operation in key "success"
193 sub template_overlay_biblio_record_entry {
194 my($self, $conn, $auth, $records, $template) = @_;
195 my $e = new_editor(authtoken=>$auth, xact=>1);
196 return $e->die_event unless $e->checkauth;
198 $records = [$records] if (!ref($records));
200 for my $rid ( @$records ) {
201 my $rec = $e->retrieve_biblio_record_entry($rid);
204 unless ($e->allowed('UPDATE_RECORD', $rec->owner, $rec)) {
205 $conn->respond({ record => $rid, success => 'f' });
209 my $success = $e->json_query(
210 { from => [ 'vandelay.template_overlay_bib_record', $template, $rid ] }
211 )->[0]->{'vandelay.template_overlay_bib_record'};
212 $U->create_events_for_hook('bre.edit', $rec, $e->requestor->ws_ou);
214 $conn->respond({ record => $rid, success => $success });
221 __PACKAGE__->register_method(
222 method => "template_overlay_container",
223 api_name => "open-ils.cat.container.template_overlay",
226 Overlays biblio.record_entry MARC values
227 @param auth The authtoken
228 @param container The container, um, containing the records to be updated by the template
229 @param template The overlay template, or nothing and the method will look for a negative bib id in the container
230 @return Stream of hashes record id in the key "record" and t or f for the success of the overlay operation in key "success"
234 __PACKAGE__->register_method(
235 method => "template_overlay_container",
236 api_name => "open-ils.cat.container.template_overlay.background",
239 Overlays biblio.record_entry MARC values
240 @param auth The authtoken
241 @param container The container, um, containing the records to be updated by the template
242 @param template The overlay template, or nothing and the method will look for a negative bib id in the container
243 @param options Hash of options; currently supports:
244 xact_per_record: Apply updates to each bib record within its own transaction.
245 @return Cache key to check for status of the container overlay
249 sub template_overlay_container {
250 my($self, $conn, $auth, $container, $template, $options) = @_;
252 my $xact_per_rec = $options->{xact_per_record};
254 my $e = new_editor(authtoken=>$auth, xact=>1);
255 return $e->die_event unless $e->checkauth;
257 my $actor = OpenSRF::AppSession->create('open-ils.actor') if ($self->api_name =~ /background$/);
259 my $items = $e->search_container_biblio_record_entry_bucket_item({ bucket => $container });
263 ($titem) = grep { $_->target_biblio_record_entry < 0 } @$items;
268 $items = [grep { $_->target_biblio_record_entry > 0 } @$items];
270 $template = $e->retrieve_biblio_record_entry( $titem->target_biblio_record_entry )->marc;
273 my $num_total = scalar(@$items);
275 my $num_succeeded = 0;
277 $conn->respond_complete(
278 $actor->request('open-ils.actor.anon_cache.set_value', $auth,
279 batch_edit_progress => {total => $num_total})->gather(1)
282 # read-only up to here.
283 $e->rollback if $xact_per_rec;
285 for my $item ( @$items ) {
286 $e->xact_begin if $xact_per_rec;
287 my $rec = $e->retrieve_biblio_record_entry($item->target_biblio_record_entry);
291 if ($e->allowed('UPDATE_RECORD', $rec->owner, $rec)) {
292 $success = $e->json_query(
293 { from => [ 'vandelay.template_overlay_bib_record', $template, $rec->id ] }
294 )->[0]->{'vandelay.template_overlay_bib_record'};
297 if ($success eq 'f') {
300 $U->create_events_for_hook('bre.edit', $rec, $e->requestor->ws_ou);
306 'open-ils.actor.anon_cache.set_value', $auth,
307 batch_edit_progress => {
309 succeeded => $num_succeeded,
310 failed => $num_failed
314 $conn->respond({ record => $rec->id, success => $success });
317 if ($success eq 't') {
318 unless ($e->delete_container_biblio_record_entry_bucket_item($item)) {
322 'open-ils.actor.anon_cache.set_value', $auth,
323 batch_edit_progress => {
327 succeeded => $num_succeeded,
328 failed => $num_failed,
333 return { complete => 1, success => 'f' };
337 $e->xact_commit if $xact_per_rec;
340 if ($titem && !$num_failed) {
341 $e->xact_begin if $xact_per_rec;
342 return $e->die_event unless ($e->delete_container_biblio_record_entry_bucket_item($titem));
343 $e->xact_commit if $xact_per_rec;
346 if ($xact_per_rec || $e->commit) {
349 'open-ils.actor.anon_cache.set_value', $auth,
350 batch_edit_progress => {
354 succeeded => $num_succeeded,
355 failed => $num_failed,
359 return { complete => 1, success => 't' };
364 'open-ils.actor.anon_cache.set_value', $auth,
365 batch_edit_progress => {
369 succeeded => $num_succeeded,
370 failed => $num_failed,
374 return { complete => 1, success => 'f' };
380 __PACKAGE__->register_method(
381 method => "update_biblio_record_entry",
382 api_name => "open-ils.cat.biblio.record_entry.update",
384 Updates a biblio.record_entry
385 @param auth The authtoken
386 @param record The record with updated values
387 @return 1 on success, Event on error.
391 sub update_biblio_record_entry {
392 my($self, $conn, $auth, $record) = @_;
393 my $e = new_editor(authtoken=>$auth, xact=>1);
394 return $e->die_event unless $e->checkauth;
395 return $e->die_event unless $e->allowed('UPDATE_RECORD');
396 $e->update_biblio_record_entry($record) or return $e->die_event;
398 $U->create_events_for_hook('bre.edit', $record, $e->requestor->ws_ou);
402 __PACKAGE__->register_method(
403 method => "undelete_biblio_record_entry",
404 api_name => "open-ils.cat.biblio.record_entry.undelete",
406 Un-deletes a record and sets active=true
407 @param auth The authtoken
408 @param record The record_id to ressurect
409 @return 1 on success, Event on error.
412 sub undelete_biblio_record_entry {
413 my($self, $conn, $auth, $record_id) = @_;
414 my $e = new_editor(authtoken=>$auth, xact=>1);
415 return $e->die_event unless $e->checkauth;
416 return $e->die_event unless $e->allowed('UPDATE_RECORD');
418 my $record = $e->retrieve_biblio_record_entry($record_id)
419 or return $e->die_event;
420 $record->deleted('f');
421 $record->active('t');
423 # Set the leader/05 to indicate that the record has been corrected/revised
424 my $marc = $record->marc();
425 $marc =~ s{(<leader>.{5}).}{$1c};
426 $record->marc($marc);
428 # no 2 non-deleted records can have the same tcn_value
429 my $existing = $e->search_biblio_record_entry(
431 tcn_value => $record->tcn_value,
432 id => {'!=' => $record_id}
434 return OpenILS::Event->new('TCN_EXISTS') if @$existing;
436 $e->update_biblio_record_entry($record) or return $e->die_event;
438 $U->create_events_for_hook('bre.edit', $record, $e->requestor->ws_ou);
443 __PACKAGE__->register_method(
444 method => "biblio_record_xml_import",
445 api_name => "open-ils.cat.biblio.record.xml.import.override",
446 signature => q/@see open-ils.cat.biblio.record.xml.import/);
448 __PACKAGE__->register_method(
449 method => "biblio_record_xml_import",
450 api_name => "open-ils.cat.biblio.record.xml.import",
451 notes => <<" NOTES");
452 Takes a marcxml record and imports the record into the database. In this
453 case, the marcxml record is assumed to be a complete record (i.e. valid
454 MARC). The title control number is taken from (whichever comes first)
455 tags 001, 039[ab], 020a, 022a, 010, 035a and whichever does not already exist
457 user_session must have IMPORT_MARC permissions
461 sub biblio_record_xml_import {
462 my( $self, $client, $authtoken, $xml, $source, $auto_tcn, $oargs, $strip_grps) = @_;
463 my $e = new_editor(xact=>1, authtoken=>$authtoken);
464 return $e->die_event unless $e->checkauth;
465 return $e->die_event unless $e->allowed('IMPORT_MARC', $e->requestor->ws_ou);
467 if ($self->api_name =~ /override/) {
468 $oargs = { all => 1 } unless defined $oargs;
472 my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
473 $e, $xml, $source, $auto_tcn, $oargs, $strip_grps);
475 return $record if $U->event_code($record);
482 __PACKAGE__->register_method(
483 method => "biblio_record_record_metadata",
484 api_name => "open-ils.cat.biblio.record.metadata.retrieve",
486 argc => 2, #(session_id, list of bre ids )
487 notes => "Returns a list of slim-downed bre objects based on the " .
491 sub biblio_record_record_metadata {
492 my( $self, $client, $authtoken, $ids ) = @_;
494 return [] unless $ids and @$ids;
496 my $editor = new_editor(authtoken => $authtoken);
497 return $editor->event unless $editor->checkauth;
498 return $editor->event unless $editor->allowed('VIEW_USER');
503 return $editor->event unless
504 my $rec = $editor->retrieve_biblio_record_entry($_);
505 $rec->creator($editor->retrieve_actor_user($rec->creator));
506 $rec->editor($editor->retrieve_actor_user($rec->editor));
507 $rec->attrs($U->get_bre_attrs([$rec->id], $editor)->{$rec->id});
508 $rec->clear_marc; # slim the record down
509 push( @results, $rec );
517 __PACKAGE__->register_method(
518 method => "biblio_record_marc_cn",
519 api_name => "open-ils.cat.biblio.record.marc_cn.retrieve",
520 argc => 1, #(bib id )
522 desc => 'Extracts call number candidates from a bibliographic record',
524 {desc => 'Record ID', type => 'number'},
525 {desc => '(Optional) Classification scheme ID', type => 'number'},
526 {desc => '(Optional) Context org unit ID for default classification lookup', type => 'number'},
529 return => {desc => 'Hash of candidate call numbers identified by tag' }
532 sub biblio_record_marc_cn {
533 my( $self, $client, $id, $class, $ctx_org_id ) = @_;
535 my $e = new_editor();
536 my $bre = $e->retrieve_biblio_record_entry($id);
537 my $marc = $bre->marc;
539 my $doc = XML::LibXML->new->parse_string($marc);
540 $doc->documentElement->setNamespace( "http://www.loc.gov/MARC21/slim", "marc", 1 );
543 my $ctx_org = $ctx_org_id || $bre->owner || $U->get_org_tree->id; # root org
544 $class = $U->ou_ancestor_setting_value(
545 $ctx_org, 'cat.default_classification_scheme', $e);
551 # be sure the class ID provided exists.
552 my $cn_class = $e->retrieve_asset_call_number_class($class) or return $e->event;
553 @fields = split(/,/, $cn_class->field);
555 @fields = qw/050ab 055ab 060ab 070ab 080ab 082ab 086ab 088ab 090 092 096 098 099/;
558 # Get field/subfield combos based on acnc value; for example "050ab,055ab"
560 foreach my $field (@fields) {
561 my $tag = substr($field, 0, 3);
562 $logger->debug("Tag = $tag");
563 my @node = $doc->findnodes("//marc:datafield[\@tag='$tag']");
566 # Now parse the subfields and build up the subfield XPath
567 my @subfields = split(//, substr($field, 3));
569 # If they give us no subfields to parse, default to just the 'a'
573 my $xpath = 'marc:subfield[' . join(' or ', map { "\@code='$_'" } @subfields) . ']';
574 $logger->debug("xpath = $xpath");
576 # Find the contents of the specified subfields
577 foreach my $x (@node) {
578 # We can't use find($xpath)->to_literal_delimited here because older 2.x
579 # versions of the XML::LibXML module don't have to_literal_delimited().
582 map { $_->textContent } $x->findnodes($xpath)
584 push @res, {$tag => $cn} if ($cn);
591 __PACKAGE__->register_method(
592 method => 'autogen_barcodes',
593 api_name => "open-ils.cat.item.barcode.autogen",
595 desc => 'Returns N generated barcodes following a specified barcode.',
597 {desc => 'Authentication token', type => 'string'},
598 {desc => 'Barcode which the sequence should follow from', type => 'string'},
599 {desc => 'Number of barcodes to generate', type => 'number'},
600 {desc => 'Options hash. Currently you can pass in checkdigit : false to disable the use of checkdigits.'}
602 return => {desc => 'Array of generated barcodes'}
606 sub autogen_barcodes {
607 my( $self, $client, $auth, $barcode, $num_of_barcodes, $options ) = @_;
608 my $e = new_editor(authtoken => $auth);
609 return $e->event unless $e->checkauth;
610 return $e->event unless $e->allowed('UPDATE_COPY', $e->requestor->ws_ou);
613 my $barcode_text = '';
614 my $barcode_number = 0;
616 if ($barcode =~ /^(\D+)/) { $barcode_text = $1; }
617 if ($barcode =~ /(\d+)$/) { $barcode_number = $1; }
621 for (my $i = 1; $i <= $num_of_barcodes; $i++) {
627 my $calculated_barcode = next_auto_barcode($barcode_number, $iter, $options);
628 $full_barcode = $barcode_text . $calculated_barcode;
630 # If we're not checking dupes, assume the barcode we have is fine.
631 last unless $options->{skip_dupes};
633 my $dupe = $e->search_asset_copy(
634 {barcode => $full_barcode, deleted => 'f'},
638 # If we find a duplicate, circle around again for another try.
642 push @res, $full_barcode;
648 sub next_auto_barcode {
649 my ($barcode_number, $iter, $options) = @_;
651 my $calculated_barcode;
653 # default is to use checkdigits, so looking for an explicit false here
654 if (defined $$options{'checkdigit'} && ! $$options{'checkdigit'}) {
655 $calculated_barcode = $barcode_number + $iter;
657 if ($barcode_number =~ /^\d{8}$/) {
658 $calculated_barcode = add_codabar_checkdigit($barcode_number + $iter, 0);
659 } elsif ($barcode_number =~ /^\d{9}$/) {
660 $calculated_barcode = add_codabar_checkdigit($barcode_number + $iter*10, 1); # strip last digit
661 } elsif ($barcode_number =~ /^\d{13}$/) {
662 $calculated_barcode = add_codabar_checkdigit($barcode_number + $iter, 0);
663 } elsif ($barcode_number =~ /^\d{14}$/) {
664 $calculated_barcode = add_codabar_checkdigit($barcode_number + $iter*10, 1); # strip last digit
666 $calculated_barcode = $barcode_number + $iter;
670 return $calculated_barcode;
673 # Codabar doesn't define a checkdigit algorithm, but this one is typically used by libraries. gmcharlt++
674 sub add_codabar_checkdigit {
676 my $strip_last_digit = shift;
678 return $barcode if $barcode =~ /\D/;
679 $barcode = substr($barcode, 0, length($barcode)-1) if $strip_last_digit;
680 my @digits = split //, $barcode;
682 for (my $i = 1; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 1,3,5,7,9,11
683 $total += $digits[$i];
685 for (my $i = 0; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 0,2,4,6,8,10,12
686 $total += (2 * $digits[$i] >= 10) ? (2 * $digits[$i] - 9) : (2 * $digits[$i]);
688 my $remainder = $total % 10;
689 my $checkdigit = ($remainder == 0) ? $remainder : 10 - $remainder;
690 return $barcode . $checkdigit;
693 __PACKAGE__->register_method(
694 method => "orgs_for_title",
696 api_name => "open-ils.cat.actor.org_unit.retrieve_by_title"
700 my( $self, $client, $record_id ) = @_;
702 my $vols = $U->simple_scalar_request(
704 "open-ils.cstore.direct.asset.call_number.search.atomic",
705 { record => $record_id, deleted => 'f' });
707 my $orgs = { map {$_->owning_lib => 1 } @$vols };
708 return [ keys %$orgs ];
712 __PACKAGE__->register_method(
713 method => "retrieve_copies",
715 api_name => "open-ils.cat.asset.copy_tree.retrieve");
717 __PACKAGE__->register_method(
718 method => "retrieve_copies",
719 api_name => "open-ils.cat.asset.copy_tree.global.retrieve");
721 # user_session may be null/undef
722 sub retrieve_copies {
724 my( $self, $client, $user_session, $docid, @org_ids ) = @_;
726 if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
730 # grabbing copy trees should be available for everyone..
731 if(!@org_ids and $user_session) {
732 my($user_obj, $evt) = OpenILS::Application::AppUtils->checkses($user_session);
734 @org_ids = ($user_obj->home_ou);
737 # Create an editor that can be shared across all iterations of
738 # _build_volume_list(). Otherwise, .authoritative calls can result
739 # in creating too many cstore connections.
740 my $e = new_editor();
742 if( $self->api_name =~ /global/ ) {
743 return _build_volume_list($e, { record => $docid, deleted => 'f', label => { '<>' => '##URI##' } } );
748 for my $orgid (@org_ids) {
749 my $vols = _build_volume_list($e,
750 { record => $docid, owning_lib => $orgid, deleted => 'f', label => { '<>' => '##URI##' } } );
751 push( @all_vols, @$vols );
761 sub _build_volume_list {
763 my $search_hash = shift;
767 $search_hash->{deleted} = 'f';
769 my $vols = $e->search_asset_call_number([
773 flesh_fields => { acn => ['prefix','suffix','label_class'] },
774 'order_by' => { 'acn' => 'oils_text_as_bytea(label_sortkey), oils_text_as_bytea(label), id, owning_lib' }
780 for my $volume (@$vols) {
782 my $copies = $e->search_asset_copy([
783 { call_number => $volume->id , deleted => 'f' },
789 bmp => { type => 'left' }
794 flesh_fields => { acp => ['stat_cat_entries','parts'] },
796 {'class' => 'bmp', 'field' => 'label_sortkey', 'transform' => 'oils_text_as_bytea'},
797 {'class' => 'bmp', 'field' => 'label', 'transform' => 'oils_text_as_bytea'},
798 {'class' => 'acp', 'field' => 'barcode'}
803 for my $c (@$copies) {
804 if( $c->status == OILS_COPY_STATUS_CHECKED_OUT ) {
806 $e->search_action_circulation(
808 { target_copy => $c->id },
810 order_by => { circ => 'xact_start desc' },
819 $volume->copies($copies);
820 push( @volumes, $volume );
823 #$session->disconnect();
829 __PACKAGE__->register_method(
830 method => "fleshed_copy_update",
831 api_name => "open-ils.cat.asset.copy.fleshed.batch.update",);
833 __PACKAGE__->register_method(
834 method => "fleshed_copy_update",
835 api_name => "open-ils.cat.asset.copy.fleshed.batch.update.override",);
838 sub fleshed_copy_update {
839 my( $self, $conn, $auth, $copies, $delete_stats, $oargs, $create_parts ) = @_;
840 return 1 unless ref $copies;
841 my( $reqr, $evt ) = $U->checkses($auth);
843 my $editor = new_editor(requestor => $reqr, xact => 1);
844 if ($self->api_name =~ /override/) {
845 $oargs = { all => 1 } unless defined $oargs;
849 my $retarget_holds = [];
850 $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
851 $editor, $oargs, undef, $copies, $delete_stats, $retarget_holds, undef, $create_parts);
854 $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
860 $logger->info("fleshed copy update successfully updated ".scalar(@$copies)." copies");
861 reset_hold_list($auth, $retarget_holds);
866 sub reset_hold_list {
867 my($auth, $hold_ids) = @_;
868 return unless @$hold_ids;
869 $logger->info("reseting holds after copy status change: @$hold_ids");
870 my $ses = OpenSRF::AppSession->create('open-ils.circ');
871 $ses->request('open-ils.circ.hold.reset.batch', $auth, $hold_ids);
874 __PACKAGE__->register_method(
875 method => "transfer_copies_to_volume",
876 api_name => "open-ils.cat.transfer_copies_to_volume",
879 desc => 'Transfers specified copies to the specified call number, and changes Circ Lib to match the new Owning Lib.',
881 {desc => 'Authtoken', type => 'string'},
882 {desc => 'Call Number ID', type => 'number'},
883 {desc => 'Array of Copy IDs', type => 'array'},
886 return => {desc => '1 on success, Event on error'}
889 __PACKAGE__->register_method(
890 method => "transfer_copies_to_volume",
891 api_name => "open-ils.cat.transfer_copies_to_volume.override",);
893 sub transfer_copies_to_volume {
894 my( $self, $conn, $auth, $volume, $copies, $oargs ) = @_;
895 my $delete_stats = 1;
896 my $force_delete_empty_bib = undef;
897 my $create_parts = undef;
901 return 1 unless ref $copies;
902 my( $reqr, $evt ) = $U->checkses($auth);
904 my $editor = new_editor(requestor => $reqr, xact => 1);
905 if ($self->api_name =~ /override/) {
906 $oargs = { all => 1 } unless defined $oargs;
911 # does the volume exist? good, we also need its owning_lib later
912 my( $cn, $cn_evt ) = $U->fetch_callnumber( $volume, 0, $editor );
913 return $cn_evt if $cn_evt;
915 # flesh and munge the copies
916 my $fleshed_copies = [];
918 foreach my $copy_id ( @{ $copies } ) {
919 $copy = $editor->search_asset_copy([
920 { id => $copy_id , deleted => 'f' },
923 flesh_fields => { acp => ['parts', 'stat_cat_entries'] }
926 return OpenILS::Event->new('ASSET_COPY_NOT_FOUND') if !$copy;
927 $copy->call_number( $volume );
928 $copy->circ_lib( $cn->owning_lib() );
929 $copy->ischanged( 't' );
930 push @$fleshed_copies, $copy;
934 my $retarget_holds = [];
935 $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
936 $editor, $oargs, undef, $fleshed_copies, $delete_stats, $retarget_holds, $force_delete_empty_bib, $create_parts);
939 $logger->info("copy to volume transfer failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
944 # take care of the parts
945 for my $copy (@$fleshed_copies) {
946 my $parts = $copy->parts;
949 foreach my $part (@$parts) {
950 my $part_label = $part->label;
951 my $part_obj = $editor->search_biblio_monograph_part(
959 $part_obj = Fieldmapper::biblio::monograph_part->new();
960 $part_obj->label( $part_label );
961 $part_obj->record( $cn->record );
962 unless($editor->create_biblio_monograph_part($part_obj)) {
963 return $editor->die_event if $editor->die_event;
966 push @$part_objs, $part_obj;
968 $copy->parts( $part_objs );
970 $evt = OpenILS::Application::Cat::AssetCommon->update_copy_parts($editor, $copy, 1); #delete_parts=1
975 $logger->info("copy to volume transfer successfully updated ".scalar(@$copies)." copies");
976 reset_hold_list($auth, $retarget_holds);
981 __PACKAGE__->register_method(
982 method => 'in_db_merge',
983 api_name => 'open-ils.cat.biblio.records.merge',
985 Merges a group of records
986 @param auth The login session key
987 @param master The id of the record all other records should be merged into
988 @param records Array of records to be merged into the master record
989 @return 1 on success, Event on error.
994 my( $self, $conn, $auth, $master, $records ) = @_;
996 my $editor = new_editor( authtoken => $auth, xact => 1 );
997 return $editor->die_event unless $editor->checkauth;
998 return $editor->die_event unless $editor->allowed('MERGE_BIB_RECORDS'); # TODO see below about record ownership
1001 for my $source ( @$records ) {
1002 #XXX we actually /will/ want to check perms for master and sources after record ownership exists
1004 # This stored proc (asset.merge_record_assets(target,source)) has the side effects of
1005 # moving call_number, title-type (and some volume-type) hold_request and uri-mapping
1006 # objects from the source record to the target record, so must be called from within
1009 $count += $editor->json_query({
1013 transform => 'asset.merge_record_assets',
1019 where => { id => $master }
1020 })->[0]->{count}; # count of objects moved, of all types
1028 __PACKAGE__->register_method(
1029 method => 'in_db_auth_merge',
1030 api_name => 'open-ils.cat.authority.records.merge',
1032 Merges a group of authority records
1033 @param auth The login session key
1034 @param master The id of the record all other records should be merged into
1035 @param records Array of records to be merged into the master record
1036 @return 1 on success, Event on error.
1040 sub in_db_auth_merge {
1041 my( $self, $conn, $auth, $master, $records ) = @_;
1043 my $editor = new_editor( authtoken => $auth, xact => 1 );
1044 return $editor->die_event unless $editor->checkauth;
1045 return $editor->die_event unless $editor->allowed('MERGE_AUTH_RECORDS'); # TODO see below about record ownership
1048 for my $source ( @$records ) {
1049 $count += $editor->json_query({
1053 transform => 'authority.merge_records',
1059 where => { id => $master }
1060 })->[0]->{count}; # count of objects moved, of all types
1067 __PACKAGE__->register_method(
1068 method => 'calculate_marc_merge',
1069 api_name => 'open-ils.cat.merge.marc.per_profile',
1071 Calculate the result of merging one or more MARC records
1072 per the specified merge profile
1073 @param auth The login session key
1074 @param merge_profile ID of the record merge profile
1075 @param records Array of two or more MARCXML records to be
1076 merged. If two are supplied, the first
1077 is treated as the record to be overlaid,
1078 and the the incoming record that will
1079 overlay the first. If more than two are
1080 supplied, the first is treated as the
1081 record to be overlaid, and each following
1082 record in turn will be merged into that
1084 @return MARCXML string of the results of the merge
1087 __PACKAGE__->register_method(
1088 method => 'calculate_bib_marc_merge',
1089 api_name => 'open-ils.cat.merge.biblio.per_profile',
1091 Calculate the result of merging one or more bib records
1092 per the specified merge profile
1093 @param auth The login session key
1094 @param merge_profile ID of the record merge profile
1095 @param records Array of two or more bib record IDs of
1096 the bibs to be merged.
1097 @return MARCXML string of the results of the merge
1100 __PACKAGE__->register_method(
1101 method => 'calculate_authority_marc_merge',
1102 api_name => 'open-ils.cat.merge.authority.per_profile',
1104 Calculate the result of merging one or more authority records
1105 per the specified merge profile
1106 @param auth The login session key
1107 @param merge_profile ID of the record merge profile
1108 @param records Array of two or more bib record IDs of
1109 the bibs to be merged.
1110 @return MARCXML string of the results of the merge
1114 sub _handle_marc_merge {
1115 my ($e, $merge_profile_id, $records) = @_;
1117 my $result = shift @$records;
1118 foreach my $incoming (@$records) {
1119 my $response = $e->json_query({
1121 'vandelay.merge_record_xml_using_profile',
1126 return unless ref($response);
1127 $result = $response->[0]->{'vandelay.merge_record_xml_using_profile'};
1132 sub calculate_marc_merge {
1133 my( $self, $conn, $auth, $merge_profile_id, $records ) = @_;
1135 my $e = new_editor(authtoken=>$auth, xact=>1);
1136 return $e->die_event unless $e->checkauth;
1138 my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1139 or return $e->die_event;
1140 return $e->die_event unless ref($records) && @$records >= 2;
1142 return _handle_marc_merge($e, $merge_profile_id, $records)
1145 sub calculate_bib_marc_merge {
1146 my( $self, $conn, $auth, $merge_profile_id, $bib_ids ) = @_;
1148 my $e = new_editor(authtoken=>$auth, xact=>1);
1149 return $e->die_event unless $e->checkauth;
1151 my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1152 or return $e->die_event;
1153 return $e->die_event unless ref($bib_ids) && @$bib_ids >= 2;
1156 foreach my $id (@$bib_ids) {
1157 my $bre = $e->retrieve_biblio_record_entry($id) or return $e->die_event;
1158 push @$records, $bre->marc();
1161 return _handle_marc_merge($e, $merge_profile_id, $records)
1164 sub calculate_authority_marc_merge {
1165 my( $self, $conn, $auth, $merge_profile_id, $authority_ids ) = @_;
1167 my $e = new_editor(authtoken=>$auth, xact=>1);
1168 return $e->die_event unless $e->checkauth;
1170 my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1171 or return $e->die_event;
1172 return $e->die_event unless ref($authority_ids) && @$authority_ids >= 2;
1175 foreach my $id (@$authority_ids) {
1176 my $are = $e->retrieve_authority_record_entry($id) or return $e->die_event;
1177 push @$records, $are->marc();
1180 return _handle_marc_merge($e, $merge_profile_id, $records)
1183 __PACKAGE__->register_method(
1184 method => "fleshed_volume_update",
1185 api_name => "open-ils.cat.asset.volume.fleshed.batch.update",);
1187 __PACKAGE__->register_method(
1188 method => "fleshed_volume_update",
1189 api_name => "open-ils.cat.asset.volume.fleshed.batch.update.override",);
1191 sub fleshed_volume_update {
1192 my( $self, $conn, $auth, $volumes, $delete_stats, $options, $oargs ) = @_;
1193 my( $reqr, $evt ) = $U->checkses($auth);
1194 return $evt if $evt;
1197 if ($self->api_name =~ /override/) {
1198 $oargs = { all => 1 } unless defined $oargs;
1202 my $editor = new_editor( requestor => $reqr, xact => 1 );
1203 my $retarget_holds = [];
1204 my $auto_merge_vols = $options->{auto_merge_vols};
1205 my $create_parts = $options->{create_parts};
1208 for my $vol (@$volumes) {
1209 $logger->info("vol-update: investigating volume ".$vol->id);
1211 $vol->editor($reqr->id);
1212 $vol->edit_date('now');
1214 my $copies = $vol->copies;
1217 $vol->editor($editor->requestor->id);
1218 $vol->edit_date('now');
1220 if( $vol->isdeleted ) {
1222 $logger->info("vol-update: deleting volume");
1223 return $editor->die_event unless
1224 $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
1226 if(my $evt = $assetcom->delete_volume($editor, $vol, $oargs, $$options{force_delete_copies})) {
1231 return $editor->die_event unless
1232 $editor->update_asset_call_number($vol);
1234 } elsif( $vol->isnew ) {
1235 $logger->info("vol-update: creating volume");
1236 ($vol,$evt) = $assetcom->create_volume( $auto_merge_vols ? { all => 1} : $oargs, $editor, $vol );
1237 return $evt if $evt;
1239 } elsif( $vol->ischanged ) {
1240 $logger->info("vol-update: update volume");
1243 # 1) We're editing a volume, and not its copies.
1244 # 2) We're editing a volume, and a subset of its copies.
1245 # 3) We're editing a volume, and all of its copies.
1247 # For 1) and 3), we definitely want to edit the volume
1248 # itself (and possibly auto-merge), but for 2), we want
1249 # to create a new volume (and possibly auto-merge).
1251 if (scalar(@$copies) == 0) { # case 1
1253 my $resp = update_volume($vol, $editor, ($oargs->{all} or grep { $_ eq 'VOLUME_LABEL_EXISTS' } @{$oargs->{events}} or $auto_merge_vols));
1254 return $resp->{evt} if $resp->{evt};
1255 $vol = $resp->{merge_vol} if $resp->{merge_vol};
1259 my $resp = $editor->json_query({
1262 {transform => 'count', aggregate => 1, column => 'id', alias => 'count'}
1267 call_number => $vol->id,
1269 id => {'not in' => [ map { $_->id } @$copies ]}
1272 if ($resp->[0]->{count} && $resp->[0]->{count} > 0) { # case 2
1274 ($vol,$evt) = $assetcom->create_volume( $auto_merge_vols ? { all => 1} : $oargs, $editor, $vol );
1275 return $evt if $evt;
1279 my $resp = update_volume($vol, $editor, ($oargs->{all} or grep { $_ eq 'VOLUME_LABEL_EXISTS' } @{$oargs->{events}} or $auto_merge_vols));
1280 return $resp->{evt} if $resp->{evt};
1281 $vol = $resp->{merge_vol} if $resp->{merge_vol};
1287 # now update any attached copies
1288 if( $copies and @$copies and !$vol->isdeleted ) {
1289 $_->call_number($vol->id) for @$copies;
1290 $evt = $assetcom->update_fleshed_copies(
1291 $editor, $oargs, $vol, $copies, $delete_stats, $retarget_holds, undef, $create_parts);
1292 return $evt if $evt;
1293 push( @$copy_ids, $_->id ) for @$copies;
1298 reset_hold_list($auth, $retarget_holds);
1299 if ($options->{return_copy_ids}) {
1302 return scalar(@$volumes);
1310 my $auto_merge = shift;
1314 return {evt => $editor->event} unless
1315 $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
1317 return {evt => $evt}
1318 if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $vol->owning_lib) );
1320 my $vols = $editor->search_asset_call_number({
1321 owning_lib => $vol->owning_lib,
1322 record => $vol->record,
1323 label => $vol->label,
1324 prefix => $vol->prefix,
1325 suffix => $vol->suffix,
1327 id => {'!=' => $vol->id}
1334 # If the auto-merge option is on, merge our updated volume into the existing
1335 # volume with the same record + owner + label.
1336 ($merge_vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $vols->[0]);
1337 return {evt => $evt, merge_vol => $merge_vol};
1340 return {evt => OpenILS::Event->new('VOLUME_LABEL_EXISTS', payload => $vol->id)};
1344 return {evt => $editor->die_event} unless $editor->update_asset_call_number($vol);
1350 __PACKAGE__->register_method (
1351 method => 'delete_bib_record',
1352 api_name => 'open-ils.cat.biblio.record_entry.delete');
1354 sub delete_bib_record {
1355 my($self, $conn, $auth, $rec_id) = @_;
1356 my $e = new_editor(xact=>1, authtoken=>$auth);
1357 return $e->die_event unless $e->checkauth;
1358 return $e->die_event unless $e->allowed('DELETE_RECORD', $e->requestor->ws_ou);
1359 my $vols = $e->search_asset_call_number({record=>$rec_id, deleted=>'f'});
1360 return OpenILS::Event->new('RECORD_NOT_EMPTY', payload=>$rec_id) if @$vols;
1361 my $acq_li_count = $e->json_query({
1362 select => {jub => [{column => 'id', transform => 'count'}]},
1366 eg_bib_id => $rec_id,
1367 state => ['new','pending-order','on-order']
1371 return OpenILS::Event->new('RECORD_REFERENCED_BY_LINEITEM', payload => $rec_id) if ($acq_li_count->{id} > 0);
1372 my $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $rec_id);
1373 if($evt) { $e->rollback; return $evt; }
1380 __PACKAGE__->register_method (
1381 method => 'batch_volume_transfer',
1382 api_name => 'open-ils.cat.asset.volume.batch.transfer',
1385 __PACKAGE__->register_method (
1386 method => 'batch_volume_transfer',
1387 api_name => 'open-ils.cat.asset.volume.batch.transfer.override',
1391 sub batch_volume_transfer {
1392 my( $self, $conn, $auth, $args, $oargs ) = @_;
1395 my $rec = $$args{docid};
1396 my $o_lib = $$args{lib};
1397 my $vol_ids = $$args{volumes};
1399 my $override = 1 if $self->api_name =~ /override/;
1400 $oargs = { all => 1 } unless defined $oargs;
1402 $logger->info("merge: transferring volumes to lib=$o_lib and record=$rec");
1404 my $e = new_editor(authtoken => $auth, xact =>1);
1405 return $e->event unless $e->checkauth;
1406 return $e->event unless $e->allowed('UPDATE_VOLUME', $o_lib);
1408 my $dorg = $e->retrieve_actor_org_unit($o_lib)
1409 or return $e->event;
1411 my $ou_type = $e->retrieve_actor_org_unit_type($dorg->ou_type)
1412 or return $e->event;
1414 return $evt if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($e, $o_lib) );
1416 my $vols = $e->batch_retrieve_asset_call_number($vol_ids);
1421 for my $vol (@$vols) {
1423 # if we've already looked at this volume, go to the next
1424 next if !$vol or grep { $vol->id == $_ } @seen;
1426 # grab all of the volumes in the list that have
1427 # the same label so they can be merged
1428 my @all = grep { $_->label eq $vol->label } @$vols;
1430 # take note of the fact that we've looked at this set of volumes
1431 push( @seen, $_->id ) for @all;
1432 push( @rec_ids, $_->record ) for @all;
1434 # for each volume, see if there are any copies that have a
1435 # remote circ_lib (circ_lib != vol->owning_lib and != $o_lib ).
1437 unless( $override && ($oargs->{all} || grep { $_ eq 'COPY_REMOTE_CIRC_LIB' } @{$oargs->{events}}) ) {
1440 $logger->debug("merge: searching for copies with remote circ_lib for volume ".$v->id);
1442 call_number => $v->id,
1443 circ_lib => { "not in" => [ $o_lib, $v->owning_lib ] },
1447 my $copies = $e->search_asset_copy($args, {idlist=>1});
1449 # if the copy's circ_lib matches the destination lib,
1451 return OpenILS::Event->new('COPY_REMOTE_CIRC_LIB') if @$copies;
1455 # record the difference between the destination bib and the present bib
1456 my $same_bib = $vol->record == $rec;
1458 # see if there is a volume at the destination lib that
1459 # already has the requested label
1460 my $existing_vol = $e->search_asset_call_number(
1462 label => $vol->label,
1463 prefix => $vol->prefix,
1464 suffix => $vol->suffix,
1466 owning_lib => $o_lib,
1471 if( $existing_vol ) {
1473 if( grep { $_->id == $existing_vol->id } @all ) {
1474 # this volume is already accounted for in our list of volumes to merge
1475 $existing_vol = undef;
1478 # this volume exists on the destination record/owning_lib and must
1479 # be used as the destination for merging
1480 $logger->debug("merge: volume already exists at destination record: ".
1481 $existing_vol->id.' : '.$existing_vol->label) if $existing_vol;
1485 if( @all > 1 || $existing_vol ) {
1486 $logger->info("merge: found collisions in volume transfer");
1487 my @args = ($e, \@all);
1488 @args = ($e, \@all, $existing_vol) if $existing_vol;
1489 ($vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes(@args);
1490 return $evt if $evt;
1493 if( !$existing_vol ) {
1495 $vol->owning_lib($o_lib);
1497 $vol->editor($e->requestor->id);
1498 $vol->edit_date('now');
1500 $logger->info("merge: updating volume ".$vol->id);
1501 $e->update_asset_call_number($vol) or return $e->event;
1504 $logger->info("merge: bypassing volume update because existing volume used as target");
1507 # regardless of what volume was used as the destination,
1508 # update any copies that have moved over to the new lib
1509 my $copies = $e->search_asset_copy([
1510 { call_number => $vol->id , deleted => 'f' },
1513 flesh_fields => { acp => ['parts'] }
1517 # update circ lib on the copies - make this a method flag?
1518 for my $copy (@$copies) {
1519 next if $copy->circ_lib == $o_lib;
1520 $logger->info("merge: transfer moving circ lib on copy ".$copy->id);
1521 $copy->circ_lib($o_lib);
1522 $copy->editor($e->requestor->id);
1523 $copy->edit_date('now');
1524 $e->update_asset_copy($copy) or return $e->event;
1527 # update parts if volume is moving bib records
1529 for my $copy (@$copies) {
1530 my $parts = $copy->parts;
1533 foreach my $part (@$parts) {
1534 my $part_label = $part->label;
1535 my $part_obj = $e->search_biblio_monograph_part(
1544 $part_obj = Fieldmapper::biblio::monograph_part->new();
1545 $part_obj->label( $part_label );
1546 $part_obj->record( $rec );
1547 unless($e->create_biblio_monograph_part($part_obj)) {
1548 return $e->die_event if $e->die_event;
1551 push @$part_objs, $part_obj;
1554 $copy->parts( $part_objs );
1555 $copy->ischanged(1);
1556 $evt = OpenILS::Application::Cat::AssetCommon->update_copy_parts($e, $copy, 1); #delete_parts=1
1557 return $evt if $evt;
1561 # Now see if any empty records need to be deleted after all of this
1562 my $keep_on_empty = $U->ou_ancestor_setting_value($e->requestor->ws_ou, 'cat.bib.keep_on_empty', $e);
1563 unless ($U->is_true($keep_on_empty)) {
1566 $logger->debug("merge: seeing if we should delete record $_...");
1567 if (OpenILS::Application::Cat::BibCommon->title_is_empty($e, $_)) {
1568 # check for any title holds on the bib, bail if so
1569 my $has_holds = OpenILS::Application::Cat::BibCommon->title_has_holds($e, $_);
1570 return OpenILS::Event->new('TITLE_HAS_HOLDS', payload => $_) if $has_holds;
1571 # we're good, delete the record
1572 $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $_);
1573 return $evt if $evt;
1579 $logger->info("merge: transfer succeeded");
1587 __PACKAGE__->register_method(
1588 api_name => 'open-ils.cat.call_number.find_or_create',
1589 method => 'find_or_create_volume',
1592 sub find_or_create_volume {
1593 my( $self, $conn, $auth, $label, $record_id, $org_id, $prefix, $suffix, $label_class ) = @_;
1594 my $e = new_editor(authtoken=>$auth, xact=>1);
1595 return $e->die_event unless $e->checkauth;
1596 my ($vol, $evt, $exists) =
1597 OpenILS::Application::Cat::AssetCommon->find_or_create_volume($e, $label, $record_id, $org_id, $prefix, $suffix, $label_class);
1598 return $evt if $evt;
1599 $e->rollback if $exists;
1601 return { 'acn_id' => $vol->id, 'existed' => $exists };
1605 __PACKAGE__->register_method(
1606 method => "create_serial_record_xml",
1607 api_name => "open-ils.cat.serial.record.xml.create.override",
1608 signature => q/@see open-ils.cat.serial.record.xml.create/);
1610 __PACKAGE__->register_method(
1611 method => "create_serial_record_xml",
1612 api_name => "open-ils.cat.serial.record.xml.create",
1614 Inserts a new serial record with the given XML
1618 sub create_serial_record_xml {
1619 my( $self, $client, $login, $source, $owning_lib, $record_id, $xml, $oargs ) = @_;
1621 my $override = 1 if $self->api_name =~ /override/; # not currently used
1622 $oargs = { all => 1 } unless defined $oargs; # Not currently used, but here for consistency.
1624 my $e = new_editor(xact=>1, authtoken=>$login);
1625 return $e->die_event unless $e->checkauth;
1626 return $e->die_event unless $e->allowed('CREATE_MFHD_RECORD', $owning_lib);
1628 # Auto-populate the location field of a placeholder MFHD record with the library name
1629 my $aou = $e->retrieve_actor_org_unit($owning_lib) or return $e->die_event;
1631 my $mfhd = Fieldmapper::serial::record_entry->new;
1633 $mfhd->source($source) if $source;
1634 $mfhd->record($record_id);
1635 $mfhd->creator($e->requestor->id);
1636 $mfhd->editor($e->requestor->id);
1637 $mfhd->create_date('now');
1638 $mfhd->edit_date('now');
1639 $mfhd->owning_lib($owning_lib);
1641 # If the caller did not pass in MFHD XML, create a placeholder record.
1642 # The placeholder will only contain the name of the owning library.
1643 # The goal is to generate common patterns for the caller in the UI that
1644 # then get passed in here.
1646 my $aou_name = $aou->name;
1649 xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1650 xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
1651 xmlns="http://www.loc.gov/MARC21/slim">
1652 <leader>00307ny a22001094 4500</leader>
1653 <controlfield tag="001">42153</controlfield>
1654 <controlfield tag="005">20090601182414.0</controlfield>
1655 <controlfield tag="004">$record_id</controlfield>
1656 <controlfield tag="008"> 4u####8###l# 4 uueng1 </controlfield>
1657 <datafield tag="852" ind1=" " ind2=" "> <subfield code="b">$aou_name</subfield></datafield>
1661 my $marcxml = XML::LibXML->new->parse_string($xml);
1662 $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim", "marc", 1 );
1663 $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim");
1665 $mfhd->marc($U->entityize($marcxml->documentElement->toString));
1667 $e->create_serial_record_entry($mfhd) or return $e->die_event;
1673 __PACKAGE__->register_method(
1674 method => "create_update_asset_copy_template",
1675 api_name => "open-ils.cat.asset.copy_template.create_or_update"
1678 sub create_update_asset_copy_template {
1679 my ($self, $client, $authtoken, $act) = @_;
1681 my $e = new_editor("xact" => 1, "authtoken" => $authtoken);
1682 return $e->die_event unless $e->checkauth;
1683 return $e->die_event unless $e->allowed(
1684 "ADMIN_ASSET_COPY_TEMPLATE", $act->owning_lib
1687 $act->editor($e->requestor->id);
1688 $act->edit_date("now");
1692 $act->creator($e->requestor->id);
1693 $act->create_date("now");
1695 $e->create_asset_copy_template($act) or return $e->die_event;
1698 $e->update_asset_copy_template($act) or return $e->die_event;
1699 $retval = $e->retrieve_asset_copy_template($e->data);
1701 $e->commit and return $retval;
1704 __PACKAGE__->register_method(
1705 method => "acn_sms_msg",
1706 api_name => "open-ils.cat.acn.send_sms_text",
1708 Send an SMS text from an A/T template for specified call numbers.
1710 First parameter is null or an auth token (whether a null is allowed
1711 depends on the sms.disable_authentication_requirement.callnumbers OU
1714 Second parameter is the id of the context org.
1716 Third parameter is the code of the SMS carrier from the
1717 config.sms_carrier table.
1719 Fourth parameter is the SMS number.
1721 Fifth parameter is the ACN id's to target, though currently only the
1722 first ACN is used by the template (and the UI is only sending one).
1727 my($self, $conn, $auth, $org_id, $carrier, $number, $target_ids) = @_;
1729 my $sms_enable = $U->ou_ancestor_setting_value(
1730 $org_id || $U->get_org_tree->id,
1733 # We could maybe make a Validator for this on the templates
1734 if (! $U->is_true($sms_enable)) {
1738 my $disable_auth = $U->ou_ancestor_setting_value(
1739 $org_id || $U->get_org_tree->id,
1740 'sms.disable_authentication_requirement.callnumbers'
1745 ? (authtoken => $auth, xact => 1)
1748 return $e->event unless $disable_auth || $e->checkauth;
1750 my $targets = $e->batch_retrieve_asset_call_number($target_ids);
1752 $e->rollback; # FIXME using transaction because of pgpool/slony setups, but not
1753 # simply making this method authoritative because of weirdness
1754 # with transaction handling in A/T code that causes rollback
1755 # failure down the line if handling many targets
1757 return undef unless @$targets;
1758 return $U->fire_object_event(
1760 'acn.format.sms_text', # hook
1763 undef, # granularity
1765 sms_carrier => $carrier,
1766 sms_notify => $number
1773 __PACKAGE__->register_method(
1774 method => "fixed_field_values_by_rec_type",
1775 api_name => "open-ils.cat.biblio.fixed_field_values.by_rec_type",
1778 desc => 'Given a record type (as in cmfpm.rec_type), return fixed fields and their possible values as known to the DB',
1780 {desc => 'Record Type', type => 'string'},
1781 {desc => '(Optional) Fixed field', type => 'string'},
1784 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' }
1788 sub fixed_field_values_by_rec_type {
1789 my ($self, $conn, $rec_type, $fixed_field) = @_;
1792 my $values = $e->json_query({
1794 crad => ["fixed_field"],
1795 ccvm => [qw/code value/],
1796 cmfpm => [qw/length default_val/],
1804 fkey => "fixed_field",
1805 field => "fixed_field"
1812 "+cmfpm" => {rec_type => $rec_type},
1813 defined $fixed_field ?
1814 ("+crad" => {fixed_field => $fixed_field}) : ()
1817 {class => "crad", field => "fixed_field"},
1818 {class => "ccvm", field => "code"}
1820 }) or return $e->die_event;
1823 for my $row (@$values) {
1824 $result->{$row->{fixed_field}} ||= [];
1825 push @{$result->{$row->{fixed_field}}}, [@$row{qw/code value length default_val/}];
1831 __PACKAGE__->register_method(
1832 method => "retrieve_tag_table",
1833 api_name => "open-ils.cat.tag_table.all.retrieve.local",
1837 desc => "Retrieve set of MARC tags, subfields, and indicator values for the user's OU",
1839 {desc => 'Authtoken', type => 'string'},
1840 {desc => 'MARC Format', type => 'string'},
1841 {desc => 'MARC Record Type', type => 'string'},
1844 return => {desc => 'Structure representing the tag table available to that user', type => 'object' }
1846 __PACKAGE__->register_method(
1847 method => "retrieve_tag_table",
1848 api_name => "open-ils.cat.tag_table.all.retrieve.stock",
1852 desc => 'Retrieve set of MARC tags, subfields, and indicator values for stock MARC standard',
1854 {desc => 'Authtoken', type => 'string'},
1855 {desc => 'MARC Format', type => 'string'},
1856 {desc => 'MARC Record Type', type => 'string'},
1859 return => {desc => 'Structure representing the stock tag table', type => 'object' }
1861 __PACKAGE__->register_method(
1862 method => "retrieve_tag_table",
1863 api_name => "open-ils.cat.tag_table.field_list.retrieve.local",
1867 desc => "Retrieve set of MARC tags for available to the user's OU",
1869 {desc => 'Authtoken', type => 'string'},
1870 {desc => 'MARC Format', type => 'string'},
1871 {desc => 'MARC Record Type', type => 'string'},
1874 return => {desc => 'Structure representing the tags available to that user', type => 'object' }
1876 __PACKAGE__->register_method(
1877 method => "retrieve_tag_table",
1878 api_name => "open-ils.cat.tag_table.field_list.retrieve.stock",
1882 desc => 'Retrieve set of MARC tags for stock MARC standard',
1884 {desc => 'Authtoken', type => 'string'},
1885 {desc => 'MARC Format', type => 'string'},
1886 {desc => 'MARC Record Type', type => 'string'},
1889 return => {desc => 'Structure representing the stock MARC tags', type => 'object' }
1892 sub retrieve_tag_table {
1893 my( $self, $conn, $auth, $marc_format, $marc_record_type ) = @_;
1894 my $e = new_editor( authtoken=>$auth, xact=>1 );
1895 return $e->die_event unless $e->checkauth;
1897 my $field_list_only = ($self->api_name =~ /\.field_list\./) ? 1 : 0;
1899 if ($self->api_name =~ /\.local$/) {
1900 $context_ou = $e->requestor->ws_ou;
1904 unless ($field_list_only) {
1905 my $subfields = $e->json_query(
1906 { from => [ 'config.ou_marc_subfields', 1, $marc_record_type, $context_ou ] }
1908 foreach my $sf (@$subfields) {
1910 code => $sf->{code},
1911 description => $sf->{description},
1912 mandatory => $sf->{mandatory},
1913 repeatable => $sf->{repeatable},
1915 if ($sf->{value_ctype}) {
1916 $sf_data->{value_list} = $e->json_query({
1917 select => { ccvm => [
1919 { column => 'value', alias => 'description' }
1923 where => { ctype => $sf->{value_ctype} },
1924 order_by => { ccvm => { code => {} } },
1927 push @{ $sf_by_tag{$sf->{tag}} }, $sf_data;
1931 my $fields = $e->json_query(
1932 { from => [ 'config.ou_marc_fields', 1, $marc_record_type, $context_ou ] }
1935 foreach my $field (@$fields) {
1936 next if $field->{hidden} eq 't';
1937 unless ($field_list_only) {
1938 my $tag = $field->{tag};
1939 if ($tag ge '010') {
1940 for my $pos (1..2) {
1941 my $ind_ccvm_key = "${marc_format}_${marc_record_type}_${tag}_ind_${pos}";
1942 my $indvals = $e->json_query({
1943 select => { ccvm => [
1945 { column => 'value', alias => 'description' }
1949 where => { ctype => $ind_ccvm_key }
1951 next unless defined($indvals);
1952 $field->{"ind$pos"} = $indvals;
1954 $field->{subfields} = exists($sf_by_tag{$tag}) ? $sf_by_tag{$tag} : [];
1957 $conn->respond($field);
1961 __PACKAGE__->register_method(
1962 method => "volcopy_data",
1963 api_name => "open-ils.cat.volcopy.data",
1967 desc => q|Returns a batch of org-scoped data types needed by the
1968 volume/copy editor|,
1970 {desc => 'Authtoken', type => 'string'}
1973 return => {desc => 'Stream of various object type lists', type => 'array'}
1977 my ($self, $client, $auth) = @_;
1978 my $e = new_editor(authtoken => $auth);
1980 $e->checkauth or return $e->event;
1981 my $org_ids = $U->get_org_ancestors($e->requestor->ws_ou);
1984 acp_location => $e->search_asset_copy_location([
1985 {deleted => 'f', owning_lib => $org_ids},
1986 {order_by => {acpl => 'name'}}
1990 # Provide a reasonable default copy location. Typically "Stacks"
1992 acp_default_location => $e->search_asset_copy_location([
1993 {deleted => 'f', owning_lib => $org_ids},
1994 {order_by => {acpl => 'id'}, limit => 1}
1999 acp_status => $e->search_config_copy_status([
2000 {id => {'!=' => undef}},
2001 {order_by => {ccs => 'name'}}
2006 acp_age_protect => $e->search_config_rules_age_hold_protect([
2007 {id => {'!=' => undef}},
2008 {order_by => {crahp => 'name'}}
2013 acp_floating_group => $e->search_config_floating_group([
2014 {id => {'!=' => undef}},
2015 {order_by => {cfg => 'name'}}
2020 acp_circ_modifier => $e->search_config_circ_modifier([
2021 {code => {'!=' => undef}},
2022 {order_by => {ccm => 'name'}}
2027 acp_item_type_map => $e->search_config_item_type_map([
2028 {code => {'!=' => undef}},
2029 {order_by => {ccm => 'value'}}
2034 acn_class => $e->search_asset_call_number_class([
2035 {id => {'!=' => undef}},
2036 {order_by => {acnc => 'name'}}
2041 acn_prefix => $e->search_asset_call_number_prefix([
2042 {owning_lib => $org_ids},
2043 {order_by => {acnp => 'label_sortkey'}}
2048 acn_suffix => $e->search_asset_call_number_suffix([
2049 {owning_lib => $org_ids},
2050 {order_by => {acns => 'label_sortkey'}}
2054 # Some object types require more complex sorting, etc.
2056 my $cats = $e->search_asset_stat_cat([
2057 {owner => $org_ids},
2059 flesh_fields => {asc => ['owner', 'entries'], aou => ['ou_type']}
2063 # Sort stat cats by depth then by name within each depth group.
2066 my $d1 = $a->owner->ou_type->depth;
2067 my $d2 = $b->owner->ou_type->depth;
2068 return $a->name cmp $b->name if $d1 == $d2;
2070 # Sort cats closer to the workstation org unit to the front.
2071 return $d1 > $d2 ? -1 : 1;
2076 for my $cat (@$cats) {
2078 $cat->owner($cat->owner->id);
2081 $cat->entries([sort {$a->value cmp $b->value} @{$cat->entries}]);
2084 $client->respond({acp_stat_cat => $cats});