Open-ILS/src/perlmods/lib/OpenILS/Application/Cat.pm

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