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     # Create an editor that can be shared across all iterations of
 644     # _build_volume_list().  Otherwise, .authoritative calls can result
 645     # in creating too many cstore connections.
 646     my $e = new_editor();
 647
 648     if( $self->api_name =~ /global/ ) {
 649         return _build_volume_list($e, { record => $docid, deleted => 'f', label => { '<>' => '##URI##' } } );
 650
 651     } else {
 652
 653         my @all_vols;
 654         for my $orgid (@org_ids) {
 655             my $vols = _build_volume_list($e,
 656                     { record => $docid, owning_lib => $orgid, deleted => 'f', label => { '<>' => '##URI##' } } );
 657             push( @all_vols, @$vols );
 658         }
 659
 660         return \@all_vols;
 661     }
 662
 663     return undef;
 664 }
 665
 666
 667 sub _build_volume_list {
 668     my $e = shift;
 669     my $search_hash = shift;
 670
 671     $e ||= new_editor();
 672
 673     $search_hash->{deleted} = 'f';
 674
 675     my $vols = $e->search_asset_call_number([
 676         $search_hash,
 677         {
 678             flesh => 1,
 679             flesh_fields => { acn => ['prefix','suffix','label_class'] },
 680             'order_by' => { 'acn' => 'oils_text_as_bytea(label_sortkey), oils_text_as_bytea(label), id, owning_lib' }
 681         }
 682     ]);
 683
 684     my @volumes;
 685
 686     for my $volume (@$vols) {
 687
 688         my $copies = $e->search_asset_copy([
 689             { call_number => $volume->id , deleted => 'f' },
 690             {
 691                 join => {
 692                     acpm => {
 693                         type => 'left',
 694                         join => {
 695                             bmp => { type => 'left' }
 696                         }
 697                     }
 698                 },
 699                 flesh => 1,
 700                 flesh_fields => { acp => ['stat_cat_entries','parts'] },
 701                 order_by => [
 702                     {'class' => 'bmp', 'field' => 'label_sortkey', 'transform' => 'oils_text_as_bytea'},
 703                     {'class' => 'bmp', 'field' => 'label', 'transform' => 'oils_text_as_bytea'},
 704                     {'class' => 'acp', 'field' => 'barcode'}
 705                 ]
 706             }
 707         ]);
 708
 709         for my $c (@$copies) {
 710             if( $c->status == OILS_COPY_STATUS_CHECKED_OUT ) {
 711                 $c->circulations(
 712                     $e->search_action_circulation(
 713                         [
 714                             { target_copy => $c->id },
 715                             {
 716                                 order_by => { circ => 'xact_start desc' },
 717                                 limit => 1
 718                             }
 719                         ]
 720                     )
 721                 )
 722             }
 723         }
 724
 725         $volume->copies($copies);
 726         push( @volumes, $volume );
 727     }
 728
 729     #$session->disconnect();
 730     return \@volumes;
 731
 732 }
 733
 734
 735 __PACKAGE__->register_method(
 736     method   => "fleshed_copy_update",
 737     api_name => "open-ils.cat.asset.copy.fleshed.batch.update",);
 738
 739 __PACKAGE__->register_method(
 740     method   => "fleshed_copy_update",
 741     api_name => "open-ils.cat.asset.copy.fleshed.batch.update.override",);
 742
 743
 744 sub fleshed_copy_update {
 745     my( $self, $conn, $auth, $copies, $delete_stats, $oargs, $create_parts ) = @_;
 746     return 1 unless ref $copies;
 747     my( $reqr, $evt ) = $U->checkses($auth);
 748     return $evt if $evt;
 749     my $editor = new_editor(requestor => $reqr, xact => 1);
 750     if ($self->api_name =~ /override/) {
 751         $oargs = { all => 1 } unless defined $oargs;
 752     } else {
 753         $oargs = {};
 754     }
 755     my $retarget_holds = [];
 756     $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
 757         $editor, $oargs, undef, $copies, $delete_stats, $retarget_holds, undef, $create_parts);
 758
 759     if( $evt ) {
 760         $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
 761         $editor->rollback;
 762         return $evt;
 763     }
 764
 765     $editor->commit;
 766     $logger->info("fleshed copy update successfully updated ".scalar(@$copies)." copies");
 767     reset_hold_list($auth, $retarget_holds);
 768
 769     return 1;
 770 }
 771
 772 sub reset_hold_list {
 773     my($auth, $hold_ids) = @_;
 774     return unless @$hold_ids;
 775     $logger->info("reseting holds after copy status change: @$hold_ids");
 776     my $ses = OpenSRF::AppSession->create('open-ils.circ');
 777     $ses->request('open-ils.circ.hold.reset.batch', $auth, $hold_ids);
 778 }
 779
 780 __PACKAGE__->register_method(
 781     method    => "transfer_copies_to_volume",
 782     api_name  => "open-ils.cat.transfer_copies_to_volume",
 783     argc      => 3,
 784     signature => {
 785         desc   => 'Transfers specified copies to the specified call number, and changes Circ Lib to match the new Owning Lib.',
 786         params => [
 787             {desc => 'Authtoken', type => 'string'},
 788             {desc => 'Call Number ID', type => 'number'},
 789             {desc => 'Array of Copy IDs', type => 'array'},
 790         ]
 791     },
 792     return => {desc => '1 on success, Event on error'}
 793 );
 794
 795 __PACKAGE__->register_method(
 796     method   => "transfer_copies_to_volume",
 797     api_name => "open-ils.cat.transfer_copies_to_volume.override",);
 798
 799 sub transfer_copies_to_volume {
 800     my( $self, $conn, $auth, $volume, $copies, $oargs ) = @_;
 801     my $delete_stats = 1;
 802     my $force_delete_empty_bib = undef;
 803     my $create_parts = undef;
 804
 805     # initial tests
 806
 807     return 1 unless ref $copies;
 808     my( $reqr, $evt ) = $U->checkses($auth);
 809     return $evt if $evt;
 810     my $editor = new_editor(requestor => $reqr, xact => 1);
 811     if ($self->api_name =~ /override/) {
 812         $oargs = { all => 1 } unless defined $oargs;
 813     } else {
 814         $oargs = {};
 815     }
 816
 817     # does the volume exist?  good, we also need its owning_lib later
 818     my( $cn, $cn_evt ) = $U->fetch_callnumber( $volume, 0, $editor );
 819     return $cn_evt if $cn_evt;
 820
 821     # flesh and munge the copies
 822     my $fleshed_copies = [];
 823     my ($copy, $copy_evt);
 824     foreach my $copy_id ( @{ $copies } ) {
 825         ($copy, $copy_evt) = $U->fetch_copy($copy_id);
 826         return $copy_evt if $copy_evt;
 827         $copy->call_number( $volume );
 828         $copy->circ_lib( $cn->owning_lib() );
 829         $copy->ischanged( 't' );
 830         push @$fleshed_copies, $copy;
 831     }
 832
 833     # actual work
 834     my $retarget_holds = [];
 835     $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
 836         $editor, $oargs, undef, $fleshed_copies, $delete_stats, $retarget_holds, $force_delete_empty_bib, $create_parts);
 837
 838     if( $evt ) {
 839         $logger->info("copy to volume transfer failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
 840         $editor->rollback;
 841         return $evt;
 842     }
 843
 844     $editor->commit;
 845     $logger->info("copy to volume transfer successfully updated ".scalar(@$copies)." copies");
 846     reset_hold_list($auth, $retarget_holds);
 847
 848     return 1;
 849 }
 850
 851 __PACKAGE__->register_method(
 852     method    => 'in_db_merge',
 853     api_name  => 'open-ils.cat.biblio.records.merge',
 854     signature => q/
 855         Merges a group of records
 856         @param auth The login session key
 857         @param master The id of the record all other records should be merged into
 858         @param records Array of records to be merged into the master record
 859         @return 1 on success, Event on error.
 860     /
 861 );
 862
 863 sub in_db_merge {
 864     my( $self, $conn, $auth, $master, $records ) = @_;
 865
 866     my $editor = new_editor( authtoken => $auth, xact => 1 );
 867     return $editor->die_event unless $editor->checkauth;
 868     return $editor->die_event unless $editor->allowed('MERGE_BIB_RECORDS'); # TODO see below about record ownership
 869
 870     my $count = 0;
 871     for my $source ( @$records ) {
 872         #XXX we actually /will/ want to check perms for master and sources after record ownership exists
 873
 874         # This stored proc (asset.merge_record_assets(target,source)) has the side effects of
 875         # moving call_number, title-type (and some volume-type) hold_request and uri-mapping
 876         # objects from the source record to the target record, so must be called from within
 877         # a transaction.
 878
 879         $count += $editor->json_query({
 880             select => {
 881                 bre => [{
 882                     alias => 'count',
 883                     transform => 'asset.merge_record_assets',
 884                     column => 'id',
 885                     params => [$source]
 886                 }]
 887             },
 888             from   => 'bre',
 889             where  => { id => $master }
 890         })->[0]->{count}; # count of objects moved, of all types
 891
 892     }
 893
 894     $editor->commit;
 895     return $count;
 896 }
 897
 898 __PACKAGE__->register_method(
 899     method    => 'in_db_auth_merge',
 900     api_name  => 'open-ils.cat.authority.records.merge',
 901     signature => q/
 902         Merges a group of authority records
 903         @param auth The login session key
 904         @param master The id of the record all other records should be merged into
 905         @param records Array of records to be merged into the master record
 906         @return 1 on success, Event on error.
 907     /
 908 );
 909
 910 sub in_db_auth_merge {
 911     my( $self, $conn, $auth, $master, $records ) = @_;
 912
 913     my $editor = new_editor( authtoken => $auth, xact => 1 );
 914     return $editor->die_event unless $editor->checkauth;
 915     return $editor->die_event unless $editor->allowed('MERGE_AUTH_RECORDS'); # TODO see below about record ownership
 916
 917     my $count = 0;
 918     for my $source ( @$records ) {
 919         $count += $editor->json_query({
 920             select => {
 921                 are => [{
 922                     alias => 'count',
 923                     transform => 'authority.merge_records',
 924                     column => 'id',
 925                     params => [$source]
 926                 }]
 927             },
 928             from   => 'are',
 929             where  => { id => $master }
 930         })->[0]->{count}; # count of objects moved, of all types
 931     }
 932
 933     $editor->commit;
 934     return $count;
 935 }
 936
 937 __PACKAGE__->register_method(
 938     method   => "fleshed_volume_update",
 939     api_name => "open-ils.cat.asset.volume.fleshed.batch.update",);
 940
 941 __PACKAGE__->register_method(
 942     method   => "fleshed_volume_update",
 943     api_name => "open-ils.cat.asset.volume.fleshed.batch.update.override",);
 944
 945 sub fleshed_volume_update {
 946     my( $self, $conn, $auth, $volumes, $delete_stats, $options, $oargs ) = @_;
 947     my( $reqr, $evt ) = $U->checkses($auth);
 948     return $evt if $evt;
 949     $options ||= {};
 950
 951     if ($self->api_name =~ /override/) {
 952         $oargs = { all => 1 } unless defined $oargs;
 953     } else {
 954         $oargs = {};
 955     }
 956     my $editor = new_editor( requestor => $reqr, xact => 1 );
 957     my $retarget_holds = [];
 958     my $auto_merge_vols = $options->{auto_merge_vols};
 959     my $create_parts = $options->{create_parts};
 960
 961     for my $vol (@$volumes) {
 962         $logger->info("vol-update: investigating volume ".$vol->id);
 963
 964         $vol->editor($reqr->id);
 965         $vol->edit_date('now');
 966
 967         my $copies = $vol->copies;
 968         $vol->clear_copies;
 969
 970         $vol->editor($editor->requestor->id);
 971         $vol->edit_date('now');
 972
 973         if( $vol->isdeleted ) {
 974
 975             $logger->info("vol-update: deleting volume");
 976             return $editor->die_event unless
 977                 $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
 978
 979             if(my $evt = $assetcom->delete_volume($editor, $vol, $oargs, $$options{force_delete_copies})) {
 980                 $editor->rollback;
 981                 return $evt;
 982             }
 983
 984             return $editor->die_event unless
 985                 $editor->update_asset_call_number($vol);
 986
 987         } elsif( $vol->isnew ) {
 988             $logger->info("vol-update: creating volume");
 989             $evt = $assetcom->create_volume( $oargs, $editor, $vol );
 990             return $evt if $evt;
 991
 992         } elsif( $vol->ischanged ) {
 993             $logger->info("vol-update: update volume");
 994             my $resp = update_volume($vol, $editor, ($oargs->{all} or grep { $_ eq 'VOLUME_LABEL_EXISTS' } @{$oargs->{events}} or $auto_merge_vols));
 995             return $resp->{evt} if $resp->{evt};
 996             $vol = $resp->{merge_vol} if $resp->{merge_vol};
 997         }
 998
 999         # now update any attached copies
1000         if( $copies and @$copies and !$vol->isdeleted ) {
1001             $_->call_number($vol->id) for @$copies;
1002             $evt = $assetcom->update_fleshed_copies(
1003                 $editor, $oargs, $vol, $copies, $delete_stats, $retarget_holds, undef, $create_parts);
1004             return $evt if $evt;
1005         }
1006     }
1007
1008     $editor->finish;
1009     reset_hold_list($auth, $retarget_holds);
1010     return scalar(@$volumes);
1011 }
1012
1013
1014 sub update_volume {
1015     my $vol = shift;
1016     my $editor = shift;
1017     my $auto_merge = shift;
1018     my $evt;
1019     my $merge_vol;
1020
1021     return {evt => $editor->event} unless
1022         $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
1023
1024     return {evt => $evt}
1025         if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $vol->owning_lib) );
1026
1027     my $vols = $editor->search_asset_call_number({
1028         owning_lib => $vol->owning_lib,
1029         record     => $vol->record,
1030         label      => $vol->label,
1031         prefix     => $vol->prefix,
1032         suffix     => $vol->suffix,
1033         deleted    => 'f',
1034         id         => {'!=' => $vol->id}
1035     });
1036
1037     if(@$vols) {
1038
1039         if($auto_merge) {
1040
1041             # If the auto-merge option is on, merge our updated volume into the existing
1042             # volume with the same record + owner + label.
1043             ($merge_vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $vols->[0]);
1044             return {evt => $evt, merge_vol => $merge_vol};
1045
1046         } else {
1047             return {evt => OpenILS::Event->new('VOLUME_LABEL_EXISTS', payload => $vol->id)};
1048         }
1049     }
1050
1051     return {evt => $editor->die_event} unless $editor->update_asset_call_number($vol);
1052     return {};
1053 }
1054
1055
1056
1057 __PACKAGE__->register_method (
1058     method   => 'delete_bib_record',
1059     api_name => 'open-ils.cat.biblio.record_entry.delete');
1060
1061 sub delete_bib_record {
1062     my($self, $conn, $auth, $rec_id) = @_;
1063     my $e = new_editor(xact=>1, authtoken=>$auth);
1064     return $e->die_event unless $e->checkauth;
1065     return $e->die_event unless $e->allowed('DELETE_RECORD', $e->requestor->ws_ou);
1066     my $vols = $e->search_asset_call_number({record=>$rec_id, deleted=>'f'});
1067     return OpenILS::Event->new('RECORD_NOT_EMPTY', payload=>$rec_id) if @$vols;
1068     my $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $rec_id);
1069     if($evt) { $e->rollback; return $evt; }
1070     $e->commit;
1071     return 1;
1072 }
1073
1074
1075
1076 __PACKAGE__->register_method (
1077     method   => 'batch_volume_transfer',
1078     api_name => 'open-ils.cat.asset.volume.batch.transfer',
1079 );
1080
1081 __PACKAGE__->register_method (
1082     method   => 'batch_volume_transfer',
1083     api_name => 'open-ils.cat.asset.volume.batch.transfer.override',
1084 );
1085
1086
1087 sub batch_volume_transfer {
1088     my( $self, $conn, $auth, $args, $oargs ) = @_;
1089
1090     my $evt;
1091     my $rec     = $$args{docid};
1092     my $o_lib   = $$args{lib};
1093     my $vol_ids = $$args{volumes};
1094
1095     my $override = 1 if $self->api_name =~ /override/;
1096     $oargs = { all => 1 } unless defined $oargs;
1097
1098     $logger->info("merge: transferring volumes to lib=$o_lib and record=$rec");
1099
1100     my $e = new_editor(authtoken => $auth, xact =>1);
1101     return $e->event unless $e->checkauth;
1102     return $e->event unless $e->allowed('UPDATE_VOLUME', $o_lib);
1103
1104     my $dorg = $e->retrieve_actor_org_unit($o_lib)
1105         or return $e->event;
1106
1107     my $ou_type = $e->retrieve_actor_org_unit_type($dorg->ou_type)
1108         or return $e->event;
1109
1110     return $evt if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($e, $o_lib) );
1111
1112     my $vols = $e->batch_retrieve_asset_call_number($vol_ids);
1113     my @seen;
1114
1115    my @rec_ids;
1116
1117     for my $vol (@$vols) {
1118
1119         # if we've already looked at this volume, go to the next
1120         next if !$vol or grep { $vol->id == $_ } @seen;
1121
1122         # grab all of the volumes in the list that have
1123         # the same label so they can be merged
1124         my @all = grep { $_->label eq $vol->label } @$vols;
1125
1126         # take note of the fact that we've looked at this set of volumes
1127         push( @seen, $_->id ) for @all;
1128         push( @rec_ids, $_->record ) for @all;
1129
1130         # for each volume, see if there are any copies that have a
1131         # remote circ_lib (circ_lib != vol->owning_lib and != $o_lib ).
1132         # if so, warn them
1133         unless( $override && ($oargs->{all} || grep { $_ eq 'COPY_REMOTE_CIRC_LIB' } @{$oargs->{events}}) ) {
1134             for my $v (@all) {
1135
1136                 $logger->debug("merge: searching for copies with remote circ_lib for volume ".$v->id);
1137                 my $args = {
1138                     call_number => $v->id,
1139                     circ_lib    => { "not in" => [ $o_lib, $v->owning_lib ] },
1140                     deleted     => 'f'
1141                 };
1142
1143                 my $copies = $e->search_asset_copy($args, {idlist=>1});
1144
1145                 # if the copy's circ_lib matches the destination lib,
1146                 # that's ok too
1147                 return OpenILS::Event->new('COPY_REMOTE_CIRC_LIB') if @$copies;
1148             }
1149         }
1150
1151         # see if there is a volume at the destination lib that
1152         # already has the requested label
1153         my $existing_vol = $e->search_asset_call_number(
1154             {
1155                 label      => $vol->label,
1156                 prefix     => $vol->prefix,
1157                 suffix     => $vol->suffix,
1158                 record     => $rec,
1159                 owning_lib => $o_lib,
1160                 deleted    => 'f'
1161             }
1162         )->[0];
1163
1164         if( $existing_vol ) {
1165
1166             if( grep { $_->id == $existing_vol->id } @all ) {
1167                 # this volume is already accounted for in our list of volumes to merge
1168                 $existing_vol = undef;
1169
1170             } else {
1171                 # this volume exists on the destination record/owning_lib and must
1172                 # be used as the destination for merging
1173                 $logger->debug("merge: volume already exists at destination record: ".
1174                     $existing_vol->id.' : '.$existing_vol->label) if $existing_vol;
1175             }
1176         }
1177
1178         if( @all > 1 || $existing_vol ) {
1179             $logger->info("merge: found collisions in volume transfer");
1180             my @args = ($e, \@all);
1181             @args = ($e, \@all, $existing_vol) if $existing_vol;
1182             ($vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes(@args);
1183             return $evt if $evt;
1184         }
1185
1186         if( !$existing_vol ) {
1187
1188             $vol->owning_lib($o_lib);
1189             $vol->record($rec);
1190             $vol->editor($e->requestor->id);
1191             $vol->edit_date('now');
1192
1193             $logger->info("merge: updating volume ".$vol->id);
1194             $e->update_asset_call_number($vol) or return $e->event;
1195
1196         } else {
1197             $logger->info("merge: bypassing volume update because existing volume used as target");
1198         }
1199
1200         # regardless of what volume was used as the destination,
1201         # update any copies that have moved over to the new lib
1202         my $copies = $e->search_asset_copy({call_number=>$vol->id, deleted => 'f'});
1203
1204         # update circ lib on the copies - make this a method flag?
1205         for my $copy (@$copies) {
1206             next if $copy->circ_lib == $o_lib;
1207             $logger->info("merge: transfer moving circ lib on copy ".$copy->id);
1208             $copy->circ_lib($o_lib);
1209             $copy->editor($e->requestor->id);
1210             $copy->edit_date('now');
1211             $e->update_asset_copy($copy) or return $e->event;
1212         }
1213
1214         # Now see if any empty records need to be deleted after all of this
1215
1216         for(@rec_ids) {
1217             $logger->debug("merge: seeing if we should delete record $_...");
1218             $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $_)
1219                 if OpenILS::Application::Cat::BibCommon->title_is_empty($e, $_);
1220             return $evt if $evt;
1221         }
1222     }
1223
1224     $logger->info("merge: transfer succeeded");
1225     $e->commit;
1226     return 1;
1227 }
1228
1229
1230
1231
1232 __PACKAGE__->register_method(
1233     api_name => 'open-ils.cat.call_number.find_or_create',
1234     method   => 'find_or_create_volume',
1235 );
1236
1237 sub find_or_create_volume {
1238     my( $self, $conn, $auth, $label, $record_id, $org_id, $prefix, $suffix, $label_class ) = @_;
1239     my $e = new_editor(authtoken=>$auth, xact=>1);
1240     return $e->die_event unless $e->checkauth;
1241     my ($vol, $evt, $exists) =
1242         OpenILS::Application::Cat::AssetCommon->find_or_create_volume($e, $label, $record_id, $org_id, $prefix, $suffix, $label_class);
1243     return $evt if $evt;
1244     $e->rollback if $exists;
1245     $e->commit if $vol;
1246     return { 'acn_id' => $vol->id, 'existed' => $exists };
1247 }
1248
1249
1250 __PACKAGE__->register_method(
1251     method    => "create_serial_record_xml",
1252     api_name  => "open-ils.cat.serial.record.xml.create.override",
1253     signature => q/@see open-ils.cat.serial.record.xml.create/);
1254
1255 __PACKAGE__->register_method(
1256     method    => "create_serial_record_xml",
1257     api_name  => "open-ils.cat.serial.record.xml.create",
1258     signature => q/
1259         Inserts a new serial record with the given XML
1260     /
1261 );
1262
1263 sub create_serial_record_xml {
1264     my( $self, $client, $login, $source, $owning_lib, $record_id, $xml, $oargs ) = @_;
1265
1266     my $override = 1 if $self->api_name =~ /override/; # not currently used
1267     $oargs = { all => 1 } unless defined $oargs; # Not currently used, but here for consistency.
1268
1269     my $e = new_editor(xact=>1, authtoken=>$login);
1270     return $e->die_event unless $e->checkauth;
1271     return $e->die_event unless $e->allowed('CREATE_MFHD_RECORD', $owning_lib);
1272
1273     # Auto-populate the location field of a placeholder MFHD record with the library name
1274     my $aou = $e->retrieve_actor_org_unit($owning_lib) or return $e->die_event;
1275
1276     my $mfhd = Fieldmapper::serial::record_entry->new;
1277
1278     $mfhd->source($source) if $source;
1279     $mfhd->record($record_id);
1280     $mfhd->creator($e->requestor->id);
1281     $mfhd->editor($e->requestor->id);
1282     $mfhd->create_date('now');
1283     $mfhd->edit_date('now');
1284     $mfhd->owning_lib($owning_lib);
1285
1286     # If the caller did not pass in MFHD XML, create a placeholder record.
1287     # The placeholder will only contain the name of the owning library.
1288     # The goal is to generate common patterns for the caller in the UI that
1289     # then get passed in here.
1290     if (!$xml) {
1291         my $aou_name = $aou->name;
1292         $xml = <<HERE;
1293 <record
1294  xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1295  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
1296  xmlns="http://www.loc.gov/MARC21/slim">
1297 <leader>00307ny  a22001094  4500</leader>
1298 <controlfield tag="001">42153</controlfield>
1299 <controlfield tag="005">20090601182414.0</controlfield>
1300 <controlfield tag="004">$record_id</controlfield>
1301 <controlfield tag="008">      4u####8###l# 4   uueng1      </controlfield>
1302 <datafield tag="852" ind1=" " ind2=" "> <subfield code="b">$aou_name</subfield></datafield>
1303 </record>
1304 HERE
1305     }
1306     my $marcxml = XML::LibXML->new->parse_string($xml);
1307     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim", "marc", 1 );
1308     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim");
1309
1310     $mfhd->marc($U->entityize($marcxml->documentElement->toString));
1311
1312     $e->create_serial_record_entry($mfhd) or return $e->die_event;
1313
1314     $e->commit;
1315     return $mfhd->id;
1316 }
1317
1318 __PACKAGE__->register_method(
1319     method   => "create_update_asset_copy_template",
1320     api_name => "open-ils.cat.asset.copy_template.create_or_update"
1321 );
1322
1323 sub create_update_asset_copy_template {
1324     my ($self, $client, $authtoken, $act) = @_;
1325
1326     my $e = new_editor("xact" => 1, "authtoken" => $authtoken);
1327     return $e->die_event unless $e->checkauth;
1328     return $e->die_event unless $e->allowed(
1329         "ADMIN_ASSET_COPY_TEMPLATE", $act->owning_lib
1330     );
1331
1332     $act->editor($e->requestor->id);
1333     $act->edit_date("now");
1334
1335     my $retval;
1336     if (!$act->id) {
1337         $act->creator($e->requestor->id);
1338         $act->create_date("now");
1339
1340         $e->create_asset_copy_template($act) or return $e->die_event;
1341         $retval = $e->data;
1342     } else {
1343         $e->update_asset_copy_template($act) or return $e->die_event;
1344         $retval = $e->retrieve_asset_copy_template($e->data);
1345     }
1346     $e->commit and return $retval;
1347 }
1348
1349 __PACKAGE__->register_method(
1350     method      => "acn_sms_msg",
1351     api_name    => "open-ils.cat.acn.send_sms_text",
1352     signature   => q^
1353         Send an SMS text from an A/T template for specified call numbers.
1354
1355         First parameter is null or an auth token (whether a null is allowed
1356         depends on the sms.disable_authentication_requirement.callnumbers OU
1357         setting).
1358
1359         Second parameter is the id of the context org.
1360
1361         Third parameter is the code of the SMS carrier from the
1362         config.sms_carrier table.
1363
1364         Fourth parameter is the SMS number.
1365
1366         Fifth parameter is the ACN id's to target, though currently only the
1367         first ACN is used by the template (and the UI is only sending one).
1368     ^
1369 );
1370
1371 sub acn_sms_msg {
1372     my($self, $conn, $auth, $org_id, $carrier, $number, $target_ids) = @_;
1373
1374     my $sms_enable = $U->ou_ancestor_setting_value(
1375         $org_id || $U->get_org_tree->id,
1376         'sms.enable'
1377     );
1378     # We could maybe make a Validator for this on the templates
1379     if (! $U->is_true($sms_enable)) {
1380         return -1;
1381     }
1382
1383     my $disable_auth = $U->ou_ancestor_setting_value(
1384         $org_id || $U->get_org_tree->id,
1385         'sms.disable_authentication_requirement.callnumbers'
1386     );
1387
1388     my $e = new_editor(
1389         (defined $auth)
1390         ? (authtoken => $auth, xact => 1)
1391         : (xact => 1)
1392     );
1393     return $e->event unless $disable_auth || $e->checkauth;
1394
1395     my $targets = $e->batch_retrieve_asset_call_number($target_ids);
1396
1397     $e->rollback; # FIXME using transaction because of pgpool/slony setups, but not
1398                   # simply making this method authoritative because of weirdness
1399                   # with transaction handling in A/T code that causes rollback
1400                   # failure down the line if handling many targets
1401
1402     return undef unless @$targets;
1403     return $U->fire_object_event(
1404         undef,                    # event_def
1405         'acn.format.sms_text',    # hook
1406         $targets,
1407         $org_id,
1408         undef,                    # granularity
1409         {                         # user_data
1410             sms_carrier => $carrier,
1411             sms_notify => $number
1412         }
1413     );
1414 }
1415
1416
1417
1418 __PACKAGE__->register_method(
1419     method    => "fixed_field_values_by_rec_type",
1420     api_name  => "open-ils.cat.biblio.fixed_field_values.by_rec_type",
1421     argc      => 2,
1422     signature => {
1423         desc   => 'Given a record type (as in cmfpm.rec_type), return fixed fields and their possible values as known to the DB',
1424         params => [
1425             {desc => 'Record Type', type => 'string'},
1426             {desc => '(Optional) Fixed field', type => 'string'},
1427         ]
1428     },
1429     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' }
1430 );
1431
1432
1433 sub fixed_field_values_by_rec_type {
1434     my ($self, $conn, $rec_type, $fixed_field) = @_;
1435
1436     my $e = new_editor;
1437     my $values = $e->json_query({
1438         select => {
1439             crad  => ["fixed_field"],
1440             ccvm  => [qw/code value/],
1441             cmfpm => [qw/length default_val/],
1442         },
1443         distinct => 1,
1444         from => {
1445             ccvm => {
1446                 crad => {
1447                     join => {
1448                         cmfpm => {
1449                             fkey => "fixed_field",
1450                             field => "fixed_field"
1451                         }
1452                     }
1453                 }
1454             }
1455         },
1456         where => {
1457             "+cmfpm" => {rec_type => $rec_type},
1458             defined $fixed_field ?
1459                 ("+crad" => {fixed_field => $fixed_field}) : ()
1460         },
1461         order_by => [
1462             {class => "crad", field => "fixed_field"},
1463             {class => "ccvm", field => "code"}
1464         ]
1465     }) or return $e->die_event;
1466
1467     my $result = {};
1468     for my $row (@$values) {
1469         $result->{$row->{fixed_field}} ||= [];
1470         push @{$result->{$row->{fixed_field}}}, [@$row{qw/code value length default_val/}];
1471     }
1472
1473     return $result;
1474 }
1475
1476 __PACKAGE__->register_method(
1477     method    => "retrieve_tag_table",
1478     api_name  => "open-ils.cat.tag_table.all.retrieve.local",
1479     stream    => 1,
1480     argc      => 3,
1481     signature => {
1482         desc   => "Retrieve set of MARC tags, subfields, and indicator values for the user's OU",
1483         params => [
1484             {desc => 'Authtoken', type => 'string'},
1485             {desc => 'MARC Format', type => 'string'},
1486             {desc => 'MARC Record Type', type => 'string'},
1487         ]
1488     },
1489     return => {desc => 'Structure representing the tag table available to that user', type => 'object' }
1490 );
1491 __PACKAGE__->register_method(
1492     method    => "retrieve_tag_table",
1493     api_name  => "open-ils.cat.tag_table.all.retrieve.stock",
1494     stream    => 1,
1495     argc      => 3,
1496     signature => {
1497         desc   => 'Retrieve set of MARC tags, subfields, and indicator values for stock MARC standard',
1498         params => [
1499             {desc => 'Authtoken', type => 'string'},
1500             {desc => 'MARC Format', type => 'string'},
1501             {desc => 'MARC Record Type', type => 'string'},
1502         ]
1503     },
1504     return => {desc => 'Structure representing the stock tag table', type => 'object' }
1505 );
1506 __PACKAGE__->register_method(
1507     method    => "retrieve_tag_table",
1508     api_name  => "open-ils.cat.tag_table.field_list.retrieve.local",
1509     stream    => 1,
1510     argc      => 3,
1511     signature => {
1512         desc   => "Retrieve set of MARC tags for available to the user's OU",
1513         params => [
1514             {desc => 'Authtoken', type => 'string'},
1515             {desc => 'MARC Format', type => 'string'},
1516             {desc => 'MARC Record Type', type => 'string'},
1517         ]
1518     },
1519     return => {desc => 'Structure representing the tags available to that user', type => 'object' }
1520 );
1521 __PACKAGE__->register_method(
1522     method    => "retrieve_tag_table",
1523     api_name  => "open-ils.cat.tag_table.field_list.retrieve.stock",
1524     stream    => 1,
1525     argc      => 3,
1526     signature => {
1527         desc   => 'Retrieve set of MARC tags for stock MARC standard',
1528         params => [
1529             {desc => 'Authtoken', type => 'string'},
1530             {desc => 'MARC Format', type => 'string'},
1531             {desc => 'MARC Record Type', type => 'string'},
1532         ]
1533     },
1534     return => {desc => 'Structure representing the stock MARC tags', type => 'object' }
1535 );
1536
1537 sub retrieve_tag_table {
1538     my( $self, $conn, $auth, $marc_format, $marc_record_type ) = @_;
1539     my $e = new_editor( authtoken=>$auth, xact=>1 );
1540     return $e->die_event unless $e->checkauth;
1541     return $e->die_event unless $e->allowed('UPDATE_MARC', $e->requestor->ws_ou);
1542
1543     my $field_list_only = ($self->api_name =~ /\.field_list\./) ? 1 : 0;
1544     my $context_ou;
1545     if ($self->api_name =~ /\.local$/) {
1546         $context_ou = $e->requestor->ws_ou;
1547     }
1548
1549     my %sf_by_tag;
1550     unless ($field_list_only) {
1551         my $subfields = $e->json_query(
1552             { from => [ 'config.ou_marc_subfields', 1, $marc_record_type, $context_ou ] }
1553         );
1554         foreach my $sf (@$subfields) {
1555             my $sf_data = {
1556                 code        => $sf->{code},
1557                 description => $sf->{description},
1558                 mandatory   => $sf->{mandatory},
1559                 repeatable   => $sf->{repeatable},
1560             };
1561             if ($sf->{value_ctype}) {
1562                 $sf_data->{value_list} = $e->json_query({
1563                     select => { ccvm => [
1564                                             'code',
1565                                             { column => 'value', alias => 'description' }
1566                                         ]
1567                               },
1568                     from   => 'ccvm',
1569                     where  => { ctype => $sf->{value_ctype} },
1570                     order_by => { ccvm => { code => {} } },
1571                 });
1572             }
1573             push @{ $sf_by_tag{$sf->{tag}} }, $sf_data;
1574         }
1575     }
1576
1577     my $fields = $e->json_query(
1578         { from => [ 'config.ou_marc_fields', 1, $marc_record_type, $context_ou ] }
1579     );
1580
1581     foreach my $field (@$fields) {
1582         next if $field->{hidden} eq 't';
1583         unless ($field_list_only) {
1584             my $tag = $field->{tag};
1585             if ($tag ge '010') {
1586                 for my $pos (1..2) {
1587                     my $ind_ccvm_key = "${marc_format}_${marc_record_type}_${tag}_ind_${pos}";
1588                     my $indvals = $e->json_query({
1589                         select => { ccvm => [
1590                                                 'code',
1591                                                 { column => 'value', alias => 'description' }
1592                                             ]
1593                                   },
1594                         from   => 'ccvm',
1595                         where  => { ctype => $ind_ccvm_key }
1596                     });
1597                     next unless defined($indvals);
1598                     $field->{"ind$pos"} = $indvals;
1599                 }
1600                 $field->{subfields} = exists($sf_by_tag{$tag}) ? $sf_by_tag{$tag} : [];
1601             }
1602         }
1603         $conn->respond($field);
1604     }
1605 }
1606
1607 1;
1608
1609 # vi:et:ts=4:sw=4