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