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);
179 __PACKAGE__->register_method(
180 method => "template_overlay_biblio_record_entry",
181 api_name => "open-ils.cat.biblio.record_entry.template_overlay",
184 Overlays biblio.record_entry MARC values
185 @param auth The authtoken
186 @param records The record ids to be updated by the template
187 @param template The overlay template
188 @return Stream of hashes record id in the key "record" and t or f for the success of the overlay operation in key "success"
192 sub template_overlay_biblio_record_entry {
193 my($self, $conn, $auth, $records, $template) = @_;
194 my $e = new_editor(authtoken=>$auth, xact=>1);
195 return $e->die_event unless $e->checkauth;
197 $records = [$records] if (!ref($records));
199 for my $rid ( @$records ) {
200 my $rec = $e->retrieve_biblio_record_entry($rid);
203 unless ($e->allowed('UPDATE_RECORD', $rec->owner, $rec)) {
204 $conn->respond({ record => $rid, success => 'f' });
208 my $success = $e->json_query(
209 { from => [ 'vandelay.template_overlay_bib_record', $template, $rid ] }
210 )->[0]->{'vandelay.template_overlay_bib_record'};
212 $conn->respond({ record => $rid, success => $success });
219 __PACKAGE__->register_method(
220 method => "template_overlay_container",
221 api_name => "open-ils.cat.container.template_overlay",
224 Overlays biblio.record_entry MARC values
225 @param auth The authtoken
226 @param container The container, um, containing the records to be updated by the template
227 @param template The overlay template, or nothing and the method will look for a negative bib id in the container
228 @return Stream of hashes record id in the key "record" and t or f for the success of the overlay operation in key "success"
232 __PACKAGE__->register_method(
233 method => "template_overlay_container",
234 api_name => "open-ils.cat.container.template_overlay.background",
237 Overlays biblio.record_entry MARC values
238 @param auth The authtoken
239 @param container The container, um, containing the records to be updated by the template
240 @param template The overlay template, or nothing and the method will look for a negative bib id in the container
241 @return Cache key to check for status of the container overlay
245 sub template_overlay_container {
246 my($self, $conn, $auth, $container, $template) = @_;
247 my $e = new_editor(authtoken=>$auth, xact=>1);
248 return $e->die_event unless $e->checkauth;
250 my $actor = OpenSRF::AppSession->create('open-ils.actor') if ($self->api_name =~ /background$/);
252 my $items = $e->search_container_biblio_record_entry_bucket_item({ bucket => $container });
256 ($titem) = grep { $_->target_biblio_record_entry < 0 } @$items;
261 $items = [grep { $_->target_biblio_record_entry > 0 } @$items];
263 $template = $e->retrieve_biblio_record_entry( $titem->target_biblio_record_entry )->marc;
269 $conn->respond_complete(
270 $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses)->gather(1)
273 for my $item ( @$items ) {
274 my $rec = $e->retrieve_biblio_record_entry($item->target_biblio_record_entry);
278 if ($e->allowed('UPDATE_RECORD', $rec->owner, $rec)) {
279 $success = $e->json_query(
280 { from => [ 'vandelay.template_overlay_bib_record', $template, $rec->id ] }
281 )->[0]->{'vandelay.template_overlay_bib_record'};
284 $some_failed++ if ($success eq 'f');
287 push @$responses, { record => $rec->id, success => $success };
288 $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
290 $conn->respond({ record => $rec->id, success => $success });
293 if ($success eq 't') {
294 unless ($e->delete_container_biblio_record_entry_bucket_item($item)) {
297 push @$responses, { complete => 1, success => 'f' };
298 $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
301 return { complete => 1, success => 'f' };
307 if ($titem && !$some_failed) {
308 return $e->die_event unless ($e->delete_container_biblio_record_entry_bucket_item($titem));
313 push @$responses, { complete => 1, success => 't' };
314 $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
316 return { complete => 1, success => 't' };
320 push @$responses, { complete => 1, success => 'f' };
321 $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
323 return { complete => 1, success => 'f' };
329 __PACKAGE__->register_method(
330 method => "update_biblio_record_entry",
331 api_name => "open-ils.cat.biblio.record_entry.update",
333 Updates a biblio.record_entry
334 @param auth The authtoken
335 @param record The record with updated values
336 @return 1 on success, Event on error.
340 sub update_biblio_record_entry {
341 my($self, $conn, $auth, $record) = @_;
342 my $e = new_editor(authtoken=>$auth, xact=>1);
343 return $e->die_event unless $e->checkauth;
344 return $e->die_event unless $e->allowed('UPDATE_RECORD');
345 $e->update_biblio_record_entry($record) or return $e->die_event;
350 __PACKAGE__->register_method(
351 method => "undelete_biblio_record_entry",
352 api_name => "open-ils.cat.biblio.record_entry.undelete",
354 Un-deletes a record and sets active=true
355 @param auth The authtoken
356 @param record The record_id to ressurect
357 @return 1 on success, Event on error.
360 sub undelete_biblio_record_entry {
361 my($self, $conn, $auth, $record_id) = @_;
362 my $e = new_editor(authtoken=>$auth, xact=>1);
363 return $e->die_event unless $e->checkauth;
364 return $e->die_event unless $e->allowed('UPDATE_RECORD');
366 my $record = $e->retrieve_biblio_record_entry($record_id)
367 or return $e->die_event;
368 $record->deleted('f');
369 $record->active('t');
371 # Set the leader/05 to indicate that the record has been corrected/revised
372 my $marc = $record->marc();
373 $marc =~ s{(<leader>.{5}).}{$1c};
374 $record->marc($marc);
376 # no 2 non-deleted records can have the same tcn_value
377 my $existing = $e->search_biblio_record_entry(
379 tcn_value => $record->tcn_value,
380 id => {'!=' => $record_id}
382 return OpenILS::Event->new('TCN_EXISTS') if @$existing;
384 $e->update_biblio_record_entry($record) or return $e->die_event;
390 __PACKAGE__->register_method(
391 method => "biblio_record_xml_import",
392 api_name => "open-ils.cat.biblio.record.xml.import.override",
393 signature => q/@see open-ils.cat.biblio.record.xml.import/);
395 __PACKAGE__->register_method(
396 method => "biblio_record_xml_import",
397 api_name => "open-ils.cat.biblio.record.xml.import",
398 notes => <<" NOTES");
399 Takes a marcxml record and imports the record into the database. In this
400 case, the marcxml record is assumed to be a complete record (i.e. valid
401 MARC). The title control number is taken from (whichever comes first)
402 tags 001, 039[ab], 020a, 022a, 010, 035a and whichever does not already exist
404 user_session must have IMPORT_MARC permissions
408 sub biblio_record_xml_import {
409 my( $self, $client, $authtoken, $xml, $source, $auto_tcn, $oargs, $strip_grps) = @_;
410 my $e = new_editor(xact=>1, authtoken=>$authtoken);
411 return $e->die_event unless $e->checkauth;
412 return $e->die_event unless $e->allowed('IMPORT_MARC', $e->requestor->ws_ou);
414 if ($self->api_name =~ /override/) {
415 $oargs = { all => 1 } unless defined $oargs;
419 my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
420 $e, $xml, $source, $auto_tcn, $oargs, $strip_grps);
422 return $record if $U->event_code($record);
429 __PACKAGE__->register_method(
430 method => "biblio_record_record_metadata",
431 api_name => "open-ils.cat.biblio.record.metadata.retrieve",
433 argc => 2, #(session_id, list of bre ids )
434 notes => "Returns a list of slim-downed bre objects based on the " .
438 sub biblio_record_record_metadata {
439 my( $self, $client, $authtoken, $ids ) = @_;
441 return [] unless $ids and @$ids;
443 my $editor = new_editor(authtoken => $authtoken);
444 return $editor->event unless $editor->checkauth;
445 return $editor->event unless $editor->allowed('VIEW_USER');
450 return $editor->event unless
451 my $rec = $editor->retrieve_biblio_record_entry($_);
452 $rec->creator($editor->retrieve_actor_user($rec->creator));
453 $rec->editor($editor->retrieve_actor_user($rec->editor));
454 $rec->attrs($U->get_bre_attrs([$rec->id], $editor)->{$rec->id});
455 $rec->clear_marc; # slim the record down
456 push( @results, $rec );
464 __PACKAGE__->register_method(
465 method => "biblio_record_marc_cn",
466 api_name => "open-ils.cat.biblio.record.marc_cn.retrieve",
467 argc => 1, #(bib id )
469 desc => 'Extracts call number candidates from a bibliographic record',
471 {desc => 'Record ID', type => 'number'},
472 {desc => '(Optional) Classification scheme ID', type => 'number'},
475 return => {desc => 'Hash of candidate call numbers identified by tag' }
478 sub biblio_record_marc_cn {
479 my( $self, $client, $id, $class ) = @_;
481 my $e = new_editor();
482 my $marc = $e->retrieve_biblio_record_entry($id)->marc;
484 my $doc = XML::LibXML->new->parse_string($marc);
485 $doc->documentElement->setNamespace( "http://www.loc.gov/MARC21/slim", "marc", 1 );
490 @fields = split(/,/, $e->retrieve_asset_call_number_class($class)->field);
492 @fields = qw/050ab 055ab 060ab 070ab 080ab 082ab 086ab 088ab 090 092 096 098 099/;
495 # Get field/subfield combos based on acnc value; for example "050ab,055ab"
497 foreach my $field (@fields) {
498 my $tag = substr($field, 0, 3);
499 $logger->debug("Tag = $tag");
500 my @node = $doc->findnodes("//marc:datafield[\@tag='$tag']");
502 # Now parse the subfields and build up the subfield XPath
503 my @subfields = split(//, substr($field, 3));
505 # If they give us no subfields to parse, default to just the 'a'
510 foreach my $sf (@subfields) {
511 $subxpath .= "\@code='$sf' or ";
513 $subxpath = substr($subxpath, 0, -4);
514 $logger->debug("subxpath = $subxpath");
516 # Find the contents of the specified subfields
517 foreach my $x (@node) {
518 my $cn = $x->findvalue("marc:subfield[$subxpath]");
519 push @res, {$tag => $cn} if ($cn);
526 __PACKAGE__->register_method(
527 method => 'autogen_barcodes',
528 api_name => "open-ils.cat.item.barcode.autogen",
530 desc => 'Returns N generated barcodes following a specified barcode.',
532 {desc => 'Authentication token', type => 'string'},
533 {desc => 'Barcode which the sequence should follow from', type => 'string'},
534 {desc => 'Number of barcodes to generate', type => 'number'},
535 {desc => 'Options hash. Currently you can pass in checkdigit : false to disable the use of checkdigits.'}
537 return => {desc => 'Array of generated barcodes'}
541 sub autogen_barcodes {
542 my( $self, $client, $auth, $barcode, $num_of_barcodes, $options ) = @_;
543 my $e = new_editor(authtoken => $auth);
544 return $e->event unless $e->checkauth;
545 return $e->event unless $e->allowed('UPDATE_COPY', $e->requestor->ws_ou);
548 my $barcode_text = '';
549 my $barcode_number = 0;
551 if ($barcode =~ /^(\D+)/) { $barcode_text = $1; }
552 if ($barcode =~ /(\d+)$/) { $barcode_number = $1; }
555 for (my $i = 1; $i <= $num_of_barcodes; $i++) {
556 my $calculated_barcode;
558 # default is to use checkdigits, so looking for an explicit false here
559 if (defined $$options{'checkdigit'} && ! $$options{'checkdigit'}) {
560 $calculated_barcode = $barcode_number + $i;
562 if ($barcode_number =~ /^\d{8}$/) {
563 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0);
564 } elsif ($barcode_number =~ /^\d{9}$/) {
565 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit
566 } elsif ($barcode_number =~ /^\d{13}$/) {
567 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0);
568 } elsif ($barcode_number =~ /^\d{14}$/) {
569 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit
571 $calculated_barcode = $barcode_number + $i;
574 push @res, $barcode_text . $calculated_barcode;
579 # Codabar doesn't define a checkdigit algorithm, but this one is typically used by libraries. gmcharlt++
580 sub add_codabar_checkdigit {
582 my $strip_last_digit = shift;
584 return $barcode if $barcode =~ /\D/;
585 $barcode = substr($barcode, 0, length($barcode)-1) if $strip_last_digit;
586 my @digits = split //, $barcode;
588 for (my $i = 1; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 1,3,5,7,9,11
589 $total += $digits[$i];
591 for (my $i = 0; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 0,2,4,6,8,10,12
592 $total += (2 * $digits[$i] >= 10) ? (2 * $digits[$i] - 9) : (2 * $digits[$i]);
594 my $remainder = $total % 10;
595 my $checkdigit = ($remainder == 0) ? $remainder : 10 - $remainder;
596 return $barcode . $checkdigit;
599 __PACKAGE__->register_method(
600 method => "orgs_for_title",
602 api_name => "open-ils.cat.actor.org_unit.retrieve_by_title"
606 my( $self, $client, $record_id ) = @_;
608 my $vols = $U->simple_scalar_request(
610 "open-ils.cstore.direct.asset.call_number.search.atomic",
611 { record => $record_id, deleted => 'f' });
613 my $orgs = { map {$_->owning_lib => 1 } @$vols };
614 return [ keys %$orgs ];
618 __PACKAGE__->register_method(
619 method => "retrieve_copies",
621 api_name => "open-ils.cat.asset.copy_tree.retrieve");
623 __PACKAGE__->register_method(
624 method => "retrieve_copies",
625 api_name => "open-ils.cat.asset.copy_tree.global.retrieve");
627 # user_session may be null/undef
628 sub retrieve_copies {
630 my( $self, $client, $user_session, $docid, @org_ids ) = @_;
632 if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
636 # grabbing copy trees should be available for everyone..
637 if(!@org_ids and $user_session) {
638 my($user_obj, $evt) = OpenILS::Application::AppUtils->checkses($user_session);
640 @org_ids = ($user_obj->home_ou);
643 # Create an editor that can be shared across all iterations of
644 # _build_volume_list(). Otherwise, .authoritative calls can result
645 # in creating too many cstore connections.
646 my $e = new_editor();
648 if( $self->api_name =~ /global/ ) {
649 return _build_volume_list($e, { record => $docid, deleted => 'f', label => { '<>' => '##URI##' } } );
654 for my $orgid (@org_ids) {
655 my $vols = _build_volume_list($e,
656 { record => $docid, owning_lib => $orgid, deleted => 'f', label => { '<>' => '##URI##' } } );
657 push( @all_vols, @$vols );
667 sub _build_volume_list {
669 my $search_hash = shift;
673 $search_hash->{deleted} = 'f';
675 my $vols = $e->search_asset_call_number([
679 flesh_fields => { acn => ['prefix','suffix','label_class'] },
680 'order_by' => { 'acn' => 'oils_text_as_bytea(label_sortkey), oils_text_as_bytea(label), id, owning_lib' }
686 for my $volume (@$vols) {
688 my $copies = $e->search_asset_copy([
689 { call_number => $volume->id , deleted => 'f' },
695 bmp => { type => 'left' }
700 flesh_fields => { acp => ['stat_cat_entries','parts'] },
702 {'class' => 'bmp', 'field' => 'label_sortkey', 'transform' => 'oils_text_as_bytea'},
703 {'class' => 'bmp', 'field' => 'label', 'transform' => 'oils_text_as_bytea'},
704 {'class' => 'acp', 'field' => 'barcode'}
709 for my $c (@$copies) {
710 if( $c->status == OILS_COPY_STATUS_CHECKED_OUT ) {
712 $e->search_action_circulation(
714 { target_copy => $c->id },
716 order_by => { circ => 'xact_start desc' },
725 $volume->copies($copies);
726 push( @volumes, $volume );
729 #$session->disconnect();
735 __PACKAGE__->register_method(
736 method => "fleshed_copy_update",
737 api_name => "open-ils.cat.asset.copy.fleshed.batch.update",);
739 __PACKAGE__->register_method(
740 method => "fleshed_copy_update",
741 api_name => "open-ils.cat.asset.copy.fleshed.batch.update.override",);
744 sub fleshed_copy_update {
745 my( $self, $conn, $auth, $copies, $delete_stats, $oargs, $create_parts ) = @_;
746 return 1 unless ref $copies;
747 my( $reqr, $evt ) = $U->checkses($auth);
749 my $editor = new_editor(requestor => $reqr, xact => 1);
750 if ($self->api_name =~ /override/) {
751 $oargs = { all => 1 } unless defined $oargs;
755 my $retarget_holds = [];
756 $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
757 $editor, $oargs, undef, $copies, $delete_stats, $retarget_holds, undef, $create_parts);
760 $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
766 $logger->info("fleshed copy update successfully updated ".scalar(@$copies)." copies");
767 reset_hold_list($auth, $retarget_holds);
772 sub reset_hold_list {
773 my($auth, $hold_ids) = @_;
774 return unless @$hold_ids;
775 $logger->info("reseting holds after copy status change: @$hold_ids");
776 my $ses = OpenSRF::AppSession->create('open-ils.circ');
777 $ses->request('open-ils.circ.hold.reset.batch', $auth, $hold_ids);
780 __PACKAGE__->register_method(
781 method => "transfer_copies_to_volume",
782 api_name => "open-ils.cat.transfer_copies_to_volume",
785 desc => 'Transfers specified copies to the specified call number, and changes Circ Lib to match the new Owning Lib.',
787 {desc => 'Authtoken', type => 'string'},
788 {desc => 'Call Number ID', type => 'number'},
789 {desc => 'Array of Copy IDs', type => 'array'},
792 return => {desc => '1 on success, Event on error'}
795 __PACKAGE__->register_method(
796 method => "transfer_copies_to_volume",
797 api_name => "open-ils.cat.transfer_copies_to_volume.override",);
799 sub transfer_copies_to_volume {
800 my( $self, $conn, $auth, $volume, $copies, $oargs ) = @_;
801 my $delete_stats = 1;
802 my $force_delete_empty_bib = undef;
803 my $create_parts = undef;
807 return 1 unless ref $copies;
808 my( $reqr, $evt ) = $U->checkses($auth);
810 my $editor = new_editor(requestor => $reqr, xact => 1);
811 if ($self->api_name =~ /override/) {
812 $oargs = { all => 1 } unless defined $oargs;
817 # does the volume exist? good, we also need its owning_lib later
818 my( $cn, $cn_evt ) = $U->fetch_callnumber( $volume, 0, $editor );
819 return $cn_evt if $cn_evt;
821 # flesh and munge the copies
822 my $fleshed_copies = [];
823 my ($copy, $copy_evt);
824 foreach my $copy_id ( @{ $copies } ) {
825 ($copy, $copy_evt) = $U->fetch_copy($copy_id);
826 return $copy_evt if $copy_evt;
827 $copy->call_number( $volume );
828 $copy->circ_lib( $cn->owning_lib() );
829 $copy->ischanged( 't' );
830 push @$fleshed_copies, $copy;
834 my $retarget_holds = [];
835 $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
836 $editor, $oargs, undef, $fleshed_copies, $delete_stats, $retarget_holds, $force_delete_empty_bib, $create_parts);
839 $logger->info("copy to volume transfer failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
845 $logger->info("copy to volume transfer successfully updated ".scalar(@$copies)." copies");
846 reset_hold_list($auth, $retarget_holds);
851 __PACKAGE__->register_method(
852 method => 'in_db_merge',
853 api_name => 'open-ils.cat.biblio.records.merge',
855 Merges a group of records
856 @param auth The login session key
857 @param master The id of the record all other records should be merged into
858 @param records Array of records to be merged into the master record
859 @return 1 on success, Event on error.
864 my( $self, $conn, $auth, $master, $records ) = @_;
866 my $editor = new_editor( authtoken => $auth, xact => 1 );
867 return $editor->die_event unless $editor->checkauth;
868 return $editor->die_event unless $editor->allowed('MERGE_BIB_RECORDS'); # TODO see below about record ownership
871 for my $source ( @$records ) {
872 #XXX we actually /will/ want to check perms for master and sources after record ownership exists
874 # This stored proc (asset.merge_record_assets(target,source)) has the side effects of
875 # moving call_number, title-type (and some volume-type) hold_request and uri-mapping
876 # objects from the source record to the target record, so must be called from within
879 $count += $editor->json_query({
883 transform => 'asset.merge_record_assets',
889 where => { id => $master }
890 })->[0]->{count}; # count of objects moved, of all types
898 __PACKAGE__->register_method(
899 method => 'in_db_auth_merge',
900 api_name => 'open-ils.cat.authority.records.merge',
902 Merges a group of authority records
903 @param auth The login session key
904 @param master The id of the record all other records should be merged into
905 @param records Array of records to be merged into the master record
906 @return 1 on success, Event on error.
910 sub in_db_auth_merge {
911 my( $self, $conn, $auth, $master, $records ) = @_;
913 my $editor = new_editor( authtoken => $auth, xact => 1 );
914 return $editor->die_event unless $editor->checkauth;
915 return $editor->die_event unless $editor->allowed('MERGE_AUTH_RECORDS'); # TODO see below about record ownership
918 for my $source ( @$records ) {
919 $count += $editor->json_query({
923 transform => 'authority.merge_records',
929 where => { id => $master }
930 })->[0]->{count}; # count of objects moved, of all types
937 __PACKAGE__->register_method(
938 method => 'calculate_marc_merge',
939 api_name => 'open-ils.cat.merge.marc.per_profile',
941 Calculate the result of merging one or more MARC records
942 per the specified merge profile
943 @param auth The login session key
944 @param merge_profile ID of the record merge profile
945 @param records Array of two or more MARCXML records to be
946 merged. If two are supplied, the first
947 is treated as the record to be overlaid,
948 and the the incoming record that will
949 overlay the first. If more than two are
950 supplied, the first is treated as the
951 record to be overlaid, and each following
952 record in turn will be merged into that
954 @return MARCXML string of the results of the merge
957 __PACKAGE__->register_method(
958 method => 'calculate_bib_marc_merge',
959 api_name => 'open-ils.cat.merge.biblio.per_profile',
961 Calculate the result of merging one or more bib records
962 per the specified merge profile
963 @param auth The login session key
964 @param merge_profile ID of the record merge profile
965 @param records Array of two or more bib record IDs of
966 the bibs to be merged.
967 @return MARCXML string of the results of the merge
970 __PACKAGE__->register_method(
971 method => 'calculate_authority_marc_merge',
972 api_name => 'open-ils.cat.merge.authority.per_profile',
974 Calculate the result of merging one or more authority records
975 per the specified merge profile
976 @param auth The login session key
977 @param merge_profile ID of the record merge profile
978 @param records Array of two or more bib record IDs of
979 the bibs to be merged.
980 @return MARCXML string of the results of the merge
984 sub _handle_marc_merge {
985 my ($e, $merge_profile_id, $records) = @_;
987 my $result = shift @$records;
988 foreach my $incoming (@$records) {
989 my $response = $e->json_query({
991 'vandelay.merge_record_xml_using_profile',
996 return unless ref($response);
997 $result = $response->[0]->{'vandelay.merge_record_xml_using_profile'};
1002 sub calculate_marc_merge {
1003 my( $self, $conn, $auth, $merge_profile_id, $records ) = @_;
1005 my $e = new_editor(authtoken=>$auth, xact=>1);
1006 return $e->die_event unless $e->checkauth;
1008 my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1009 or return $e->die_event;
1010 return $e->die_event unless ref($records) && @$records >= 2;
1012 return _handle_marc_merge($e, $merge_profile_id, $records)
1015 sub calculate_bib_marc_merge {
1016 my( $self, $conn, $auth, $merge_profile_id, $bib_ids ) = @_;
1018 my $e = new_editor(authtoken=>$auth, xact=>1);
1019 return $e->die_event unless $e->checkauth;
1021 my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1022 or return $e->die_event;
1023 return $e->die_event unless ref($bib_ids) && @$bib_ids >= 2;
1026 foreach my $id (@$bib_ids) {
1027 my $bre = $e->retrieve_biblio_record_entry($id) or return $e->die_event;
1028 push @$records, $bre->marc();
1031 return _handle_marc_merge($e, $merge_profile_id, $records)
1034 sub calculate_authority_marc_merge {
1035 my( $self, $conn, $auth, $merge_profile_id, $authority_ids ) = @_;
1037 my $e = new_editor(authtoken=>$auth, xact=>1);
1038 return $e->die_event unless $e->checkauth;
1040 my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1041 or return $e->die_event;
1042 return $e->die_event unless ref($authority_ids) && @$authority_ids >= 2;
1045 foreach my $id (@$authority_ids) {
1046 my $are = $e->retrieve_authority_record_entry($id) or return $e->die_event;
1047 push @$records, $are->marc();
1050 return _handle_marc_merge($e, $merge_profile_id, $records)
1053 __PACKAGE__->register_method(
1054 method => "fleshed_volume_update",
1055 api_name => "open-ils.cat.asset.volume.fleshed.batch.update",);
1057 __PACKAGE__->register_method(
1058 method => "fleshed_volume_update",
1059 api_name => "open-ils.cat.asset.volume.fleshed.batch.update.override",);
1061 sub fleshed_volume_update {
1062 my( $self, $conn, $auth, $volumes, $delete_stats, $options, $oargs ) = @_;
1063 my( $reqr, $evt ) = $U->checkses($auth);
1064 return $evt if $evt;
1067 if ($self->api_name =~ /override/) {
1068 $oargs = { all => 1 } unless defined $oargs;
1072 my $editor = new_editor( requestor => $reqr, xact => 1 );
1073 my $retarget_holds = [];
1074 my $auto_merge_vols = $options->{auto_merge_vols};
1075 my $create_parts = $options->{create_parts};
1077 for my $vol (@$volumes) {
1078 $logger->info("vol-update: investigating volume ".$vol->id);
1080 $vol->editor($reqr->id);
1081 $vol->edit_date('now');
1083 my $copies = $vol->copies;
1086 $vol->editor($editor->requestor->id);
1087 $vol->edit_date('now');
1089 if( $vol->isdeleted ) {
1091 $logger->info("vol-update: deleting volume");
1092 return $editor->die_event unless
1093 $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
1095 if(my $evt = $assetcom->delete_volume($editor, $vol, $oargs, $$options{force_delete_copies})) {
1100 return $editor->die_event unless
1101 $editor->update_asset_call_number($vol);
1103 } elsif( $vol->isnew ) {
1104 $logger->info("vol-update: creating volume");
1105 $evt = $assetcom->create_volume( $oargs, $editor, $vol );
1106 return $evt if $evt;
1108 } elsif( $vol->ischanged ) {
1109 $logger->info("vol-update: update volume");
1110 my $resp = update_volume($vol, $editor, ($oargs->{all} or grep { $_ eq 'VOLUME_LABEL_EXISTS' } @{$oargs->{events}} or $auto_merge_vols));
1111 return $resp->{evt} if $resp->{evt};
1112 $vol = $resp->{merge_vol} if $resp->{merge_vol};
1115 # now update any attached copies
1116 if( $copies and @$copies and !$vol->isdeleted ) {
1117 $_->call_number($vol->id) for @$copies;
1118 $evt = $assetcom->update_fleshed_copies(
1119 $editor, $oargs, $vol, $copies, $delete_stats, $retarget_holds, undef, $create_parts);
1120 return $evt if $evt;
1125 reset_hold_list($auth, $retarget_holds);
1126 return scalar(@$volumes);
1133 my $auto_merge = shift;
1137 return {evt => $editor->event} unless
1138 $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
1140 return {evt => $evt}
1141 if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $vol->owning_lib) );
1143 my $vols = $editor->search_asset_call_number({
1144 owning_lib => $vol->owning_lib,
1145 record => $vol->record,
1146 label => $vol->label,
1147 prefix => $vol->prefix,
1148 suffix => $vol->suffix,
1150 id => {'!=' => $vol->id}
1157 # If the auto-merge option is on, merge our updated volume into the existing
1158 # volume with the same record + owner + label.
1159 ($merge_vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $vols->[0]);
1160 return {evt => $evt, merge_vol => $merge_vol};
1163 return {evt => OpenILS::Event->new('VOLUME_LABEL_EXISTS', payload => $vol->id)};
1167 return {evt => $editor->die_event} unless $editor->update_asset_call_number($vol);
1173 __PACKAGE__->register_method (
1174 method => 'delete_bib_record',
1175 api_name => 'open-ils.cat.biblio.record_entry.delete');
1177 sub delete_bib_record {
1178 my($self, $conn, $auth, $rec_id) = @_;
1179 my $e = new_editor(xact=>1, authtoken=>$auth);
1180 return $e->die_event unless $e->checkauth;
1181 return $e->die_event unless $e->allowed('DELETE_RECORD', $e->requestor->ws_ou);
1182 my $vols = $e->search_asset_call_number({record=>$rec_id, deleted=>'f'});
1183 return OpenILS::Event->new('RECORD_NOT_EMPTY', payload=>$rec_id) if @$vols;
1184 my $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $rec_id);
1185 if($evt) { $e->rollback; return $evt; }
1192 __PACKAGE__->register_method (
1193 method => 'batch_volume_transfer',
1194 api_name => 'open-ils.cat.asset.volume.batch.transfer',
1197 __PACKAGE__->register_method (
1198 method => 'batch_volume_transfer',
1199 api_name => 'open-ils.cat.asset.volume.batch.transfer.override',
1203 sub batch_volume_transfer {
1204 my( $self, $conn, $auth, $args, $oargs ) = @_;
1207 my $rec = $$args{docid};
1208 my $o_lib = $$args{lib};
1209 my $vol_ids = $$args{volumes};
1211 my $override = 1 if $self->api_name =~ /override/;
1212 $oargs = { all => 1 } unless defined $oargs;
1214 $logger->info("merge: transferring volumes to lib=$o_lib and record=$rec");
1216 my $e = new_editor(authtoken => $auth, xact =>1);
1217 return $e->event unless $e->checkauth;
1218 return $e->event unless $e->allowed('UPDATE_VOLUME', $o_lib);
1220 my $dorg = $e->retrieve_actor_org_unit($o_lib)
1221 or return $e->event;
1223 my $ou_type = $e->retrieve_actor_org_unit_type($dorg->ou_type)
1224 or return $e->event;
1226 return $evt if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($e, $o_lib) );
1228 my $vols = $e->batch_retrieve_asset_call_number($vol_ids);
1233 for my $vol (@$vols) {
1235 # if we've already looked at this volume, go to the next
1236 next if !$vol or grep { $vol->id == $_ } @seen;
1238 # grab all of the volumes in the list that have
1239 # the same label so they can be merged
1240 my @all = grep { $_->label eq $vol->label } @$vols;
1242 # take note of the fact that we've looked at this set of volumes
1243 push( @seen, $_->id ) for @all;
1244 push( @rec_ids, $_->record ) for @all;
1246 # for each volume, see if there are any copies that have a
1247 # remote circ_lib (circ_lib != vol->owning_lib and != $o_lib ).
1249 unless( $override && ($oargs->{all} || grep { $_ eq 'COPY_REMOTE_CIRC_LIB' } @{$oargs->{events}}) ) {
1252 $logger->debug("merge: searching for copies with remote circ_lib for volume ".$v->id);
1254 call_number => $v->id,
1255 circ_lib => { "not in" => [ $o_lib, $v->owning_lib ] },
1259 my $copies = $e->search_asset_copy($args, {idlist=>1});
1261 # if the copy's circ_lib matches the destination lib,
1263 return OpenILS::Event->new('COPY_REMOTE_CIRC_LIB') if @$copies;
1267 # see if there is a volume at the destination lib that
1268 # already has the requested label
1269 my $existing_vol = $e->search_asset_call_number(
1271 label => $vol->label,
1272 prefix => $vol->prefix,
1273 suffix => $vol->suffix,
1275 owning_lib => $o_lib,
1280 if( $existing_vol ) {
1282 if( grep { $_->id == $existing_vol->id } @all ) {
1283 # this volume is already accounted for in our list of volumes to merge
1284 $existing_vol = undef;
1287 # this volume exists on the destination record/owning_lib and must
1288 # be used as the destination for merging
1289 $logger->debug("merge: volume already exists at destination record: ".
1290 $existing_vol->id.' : '.$existing_vol->label) if $existing_vol;
1294 if( @all > 1 || $existing_vol ) {
1295 $logger->info("merge: found collisions in volume transfer");
1296 my @args = ($e, \@all);
1297 @args = ($e, \@all, $existing_vol) if $existing_vol;
1298 ($vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes(@args);
1299 return $evt if $evt;
1302 if( !$existing_vol ) {
1304 $vol->owning_lib($o_lib);
1306 $vol->editor($e->requestor->id);
1307 $vol->edit_date('now');
1309 $logger->info("merge: updating volume ".$vol->id);
1310 $e->update_asset_call_number($vol) or return $e->event;
1313 $logger->info("merge: bypassing volume update because existing volume used as target");
1316 # regardless of what volume was used as the destination,
1317 # update any copies that have moved over to the new lib
1318 my $copies = $e->search_asset_copy({call_number=>$vol->id, deleted => 'f'});
1320 # update circ lib on the copies - make this a method flag?
1321 for my $copy (@$copies) {
1322 next if $copy->circ_lib == $o_lib;
1323 $logger->info("merge: transfer moving circ lib on copy ".$copy->id);
1324 $copy->circ_lib($o_lib);
1325 $copy->editor($e->requestor->id);
1326 $copy->edit_date('now');
1327 $e->update_asset_copy($copy) or return $e->event;
1330 # Now see if any empty records need to be deleted after all of this
1333 $logger->debug("merge: seeing if we should delete record $_...");
1334 $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $_)
1335 if OpenILS::Application::Cat::BibCommon->title_is_empty($e, $_);
1336 return $evt if $evt;
1340 $logger->info("merge: transfer succeeded");
1348 __PACKAGE__->register_method(
1349 api_name => 'open-ils.cat.call_number.find_or_create',
1350 method => 'find_or_create_volume',
1353 sub find_or_create_volume {
1354 my( $self, $conn, $auth, $label, $record_id, $org_id, $prefix, $suffix, $label_class ) = @_;
1355 my $e = new_editor(authtoken=>$auth, xact=>1);
1356 return $e->die_event unless $e->checkauth;
1357 my ($vol, $evt, $exists) =
1358 OpenILS::Application::Cat::AssetCommon->find_or_create_volume($e, $label, $record_id, $org_id, $prefix, $suffix, $label_class);
1359 return $evt if $evt;
1360 $e->rollback if $exists;
1362 return { 'acn_id' => $vol->id, 'existed' => $exists };
1366 __PACKAGE__->register_method(
1367 method => "create_serial_record_xml",
1368 api_name => "open-ils.cat.serial.record.xml.create.override",
1369 signature => q/@see open-ils.cat.serial.record.xml.create/);
1371 __PACKAGE__->register_method(
1372 method => "create_serial_record_xml",
1373 api_name => "open-ils.cat.serial.record.xml.create",
1375 Inserts a new serial record with the given XML
1379 sub create_serial_record_xml {
1380 my( $self, $client, $login, $source, $owning_lib, $record_id, $xml, $oargs ) = @_;
1382 my $override = 1 if $self->api_name =~ /override/; # not currently used
1383 $oargs = { all => 1 } unless defined $oargs; # Not currently used, but here for consistency.
1385 my $e = new_editor(xact=>1, authtoken=>$login);
1386 return $e->die_event unless $e->checkauth;
1387 return $e->die_event unless $e->allowed('CREATE_MFHD_RECORD', $owning_lib);
1389 # Auto-populate the location field of a placeholder MFHD record with the library name
1390 my $aou = $e->retrieve_actor_org_unit($owning_lib) or return $e->die_event;
1392 my $mfhd = Fieldmapper::serial::record_entry->new;
1394 $mfhd->source($source) if $source;
1395 $mfhd->record($record_id);
1396 $mfhd->creator($e->requestor->id);
1397 $mfhd->editor($e->requestor->id);
1398 $mfhd->create_date('now');
1399 $mfhd->edit_date('now');
1400 $mfhd->owning_lib($owning_lib);
1402 # If the caller did not pass in MFHD XML, create a placeholder record.
1403 # The placeholder will only contain the name of the owning library.
1404 # The goal is to generate common patterns for the caller in the UI that
1405 # then get passed in here.
1407 my $aou_name = $aou->name;
1410 xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1411 xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
1412 xmlns="http://www.loc.gov/MARC21/slim">
1413 <leader>00307ny a22001094 4500</leader>
1414 <controlfield tag="001">42153</controlfield>
1415 <controlfield tag="005">20090601182414.0</controlfield>
1416 <controlfield tag="004">$record_id</controlfield>
1417 <controlfield tag="008"> 4u####8###l# 4 uueng1 </controlfield>
1418 <datafield tag="852" ind1=" " ind2=" "> <subfield code="b">$aou_name</subfield></datafield>
1422 my $marcxml = XML::LibXML->new->parse_string($xml);
1423 $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim", "marc", 1 );
1424 $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim");
1426 $mfhd->marc($U->entityize($marcxml->documentElement->toString));
1428 $e->create_serial_record_entry($mfhd) or return $e->die_event;
1434 __PACKAGE__->register_method(
1435 method => "create_update_asset_copy_template",
1436 api_name => "open-ils.cat.asset.copy_template.create_or_update"
1439 sub create_update_asset_copy_template {
1440 my ($self, $client, $authtoken, $act) = @_;
1442 my $e = new_editor("xact" => 1, "authtoken" => $authtoken);
1443 return $e->die_event unless $e->checkauth;
1444 return $e->die_event unless $e->allowed(
1445 "ADMIN_ASSET_COPY_TEMPLATE", $act->owning_lib
1448 $act->editor($e->requestor->id);
1449 $act->edit_date("now");
1453 $act->creator($e->requestor->id);
1454 $act->create_date("now");
1456 $e->create_asset_copy_template($act) or return $e->die_event;
1459 $e->update_asset_copy_template($act) or return $e->die_event;
1460 $retval = $e->retrieve_asset_copy_template($e->data);
1462 $e->commit and return $retval;
1465 __PACKAGE__->register_method(
1466 method => "acn_sms_msg",
1467 api_name => "open-ils.cat.acn.send_sms_text",
1469 Send an SMS text from an A/T template for specified call numbers.
1471 First parameter is null or an auth token (whether a null is allowed
1472 depends on the sms.disable_authentication_requirement.callnumbers OU
1475 Second parameter is the id of the context org.
1477 Third parameter is the code of the SMS carrier from the
1478 config.sms_carrier table.
1480 Fourth parameter is the SMS number.
1482 Fifth parameter is the ACN id's to target, though currently only the
1483 first ACN is used by the template (and the UI is only sending one).
1488 my($self, $conn, $auth, $org_id, $carrier, $number, $target_ids) = @_;
1490 my $sms_enable = $U->ou_ancestor_setting_value(
1491 $org_id || $U->get_org_tree->id,
1494 # We could maybe make a Validator for this on the templates
1495 if (! $U->is_true($sms_enable)) {
1499 my $disable_auth = $U->ou_ancestor_setting_value(
1500 $org_id || $U->get_org_tree->id,
1501 'sms.disable_authentication_requirement.callnumbers'
1506 ? (authtoken => $auth, xact => 1)
1509 return $e->event unless $disable_auth || $e->checkauth;
1511 my $targets = $e->batch_retrieve_asset_call_number($target_ids);
1513 $e->rollback; # FIXME using transaction because of pgpool/slony setups, but not
1514 # simply making this method authoritative because of weirdness
1515 # with transaction handling in A/T code that causes rollback
1516 # failure down the line if handling many targets
1518 return undef unless @$targets;
1519 return $U->fire_object_event(
1521 'acn.format.sms_text', # hook
1524 undef, # granularity
1526 sms_carrier => $carrier,
1527 sms_notify => $number
1534 __PACKAGE__->register_method(
1535 method => "fixed_field_values_by_rec_type",
1536 api_name => "open-ils.cat.biblio.fixed_field_values.by_rec_type",
1539 desc => 'Given a record type (as in cmfpm.rec_type), return fixed fields and their possible values as known to the DB',
1541 {desc => 'Record Type', type => 'string'},
1542 {desc => '(Optional) Fixed field', type => 'string'},
1545 return => {desc => 'an object in which the keys are fixed fields and the values are arrays representing the set of all unique values for that fixed field in that record type', type => 'object' }
1549 sub fixed_field_values_by_rec_type {
1550 my ($self, $conn, $rec_type, $fixed_field) = @_;
1553 my $values = $e->json_query({
1555 crad => ["fixed_field"],
1556 ccvm => [qw/code value/],
1557 cmfpm => [qw/length default_val/],
1565 fkey => "fixed_field",
1566 field => "fixed_field"
1573 "+cmfpm" => {rec_type => $rec_type},
1574 defined $fixed_field ?
1575 ("+crad" => {fixed_field => $fixed_field}) : ()
1578 {class => "crad", field => "fixed_field"},
1579 {class => "ccvm", field => "code"}
1581 }) or return $e->die_event;
1584 for my $row (@$values) {
1585 $result->{$row->{fixed_field}} ||= [];
1586 push @{$result->{$row->{fixed_field}}}, [@$row{qw/code value length default_val/}];
1592 __PACKAGE__->register_method(
1593 method => "retrieve_tag_table",
1594 api_name => "open-ils.cat.tag_table.all.retrieve.local",
1598 desc => "Retrieve set of MARC tags, subfields, and indicator values for the user's OU",
1600 {desc => 'Authtoken', type => 'string'},
1601 {desc => 'MARC Format', type => 'string'},
1602 {desc => 'MARC Record Type', type => 'string'},
1605 return => {desc => 'Structure representing the tag table available to that user', type => 'object' }
1607 __PACKAGE__->register_method(
1608 method => "retrieve_tag_table",
1609 api_name => "open-ils.cat.tag_table.all.retrieve.stock",
1613 desc => 'Retrieve set of MARC tags, subfields, and indicator values for stock MARC standard',
1615 {desc => 'Authtoken', type => 'string'},
1616 {desc => 'MARC Format', type => 'string'},
1617 {desc => 'MARC Record Type', type => 'string'},
1620 return => {desc => 'Structure representing the stock tag table', type => 'object' }
1622 __PACKAGE__->register_method(
1623 method => "retrieve_tag_table",
1624 api_name => "open-ils.cat.tag_table.field_list.retrieve.local",
1628 desc => "Retrieve set of MARC tags for available to the user's OU",
1630 {desc => 'Authtoken', type => 'string'},
1631 {desc => 'MARC Format', type => 'string'},
1632 {desc => 'MARC Record Type', type => 'string'},
1635 return => {desc => 'Structure representing the tags available to that user', type => 'object' }
1637 __PACKAGE__->register_method(
1638 method => "retrieve_tag_table",
1639 api_name => "open-ils.cat.tag_table.field_list.retrieve.stock",
1643 desc => 'Retrieve set of MARC tags for stock MARC standard',
1645 {desc => 'Authtoken', type => 'string'},
1646 {desc => 'MARC Format', type => 'string'},
1647 {desc => 'MARC Record Type', type => 'string'},
1650 return => {desc => 'Structure representing the stock MARC tags', type => 'object' }
1653 sub retrieve_tag_table {
1654 my( $self, $conn, $auth, $marc_format, $marc_record_type ) = @_;
1655 my $e = new_editor( authtoken=>$auth, xact=>1 );
1656 return $e->die_event unless $e->checkauth;
1657 return $e->die_event unless $e->allowed('UPDATE_MARC', $e->requestor->ws_ou);
1659 my $field_list_only = ($self->api_name =~ /\.field_list\./) ? 1 : 0;
1661 if ($self->api_name =~ /\.local$/) {
1662 $context_ou = $e->requestor->ws_ou;
1666 unless ($field_list_only) {
1667 my $subfields = $e->json_query(
1668 { from => [ 'config.ou_marc_subfields', 1, $marc_record_type, $context_ou ] }
1670 foreach my $sf (@$subfields) {
1672 code => $sf->{code},
1673 description => $sf->{description},
1674 mandatory => $sf->{mandatory},
1675 repeatable => $sf->{repeatable},
1677 if ($sf->{value_ctype}) {
1678 $sf_data->{value_list} = $e->json_query({
1679 select => { ccvm => [
1681 { column => 'value', alias => 'description' }
1685 where => { ctype => $sf->{value_ctype} },
1686 order_by => { ccvm => { code => {} } },
1689 push @{ $sf_by_tag{$sf->{tag}} }, $sf_data;
1693 my $fields = $e->json_query(
1694 { from => [ 'config.ou_marc_fields', 1, $marc_record_type, $context_ou ] }
1697 foreach my $field (@$fields) {
1698 next if $field->{hidden} eq 't';
1699 unless ($field_list_only) {
1700 my $tag = $field->{tag};
1701 if ($tag ge '010') {
1702 for my $pos (1..2) {
1703 my $ind_ccvm_key = "${marc_format}_${marc_record_type}_${tag}_ind_${pos}";
1704 my $indvals = $e->json_query({
1705 select => { ccvm => [
1707 { column => 'value', alias => 'description' }
1711 where => { ctype => $ind_ccvm_key }
1713 next unless defined($indvals);
1714 $field->{"ind$pos"} = $indvals;
1716 $field->{subfields} = exists($sf_by_tag{$tag}) ? $sf_by_tag{$tag} : [];
1719 $conn->respond($field);