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

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