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    => 'calculate_marc_merge',
 939     api_name  => 'open-ils.cat.merge.marc.per_profile',
 940     signature => q/
 941         Calculate the result of merging one or more MARC records
 942         per the specified merge profile
 943         @param auth The login session key
 944         @param merge_profile ID of the record merge profile
 945         @param records Array of two or more MARCXML records to be
 946                        merged. If two are supplied, the first
 947                        is treated as the record to be overlaid,
 948                        and the the incoming record that will
 949                        overlay the first. If more than two are
 950                        supplied, the first is treated as the
 951                        record to be overlaid, and each following
 952                        record in turn will be merged into that
 953                        record.
 954         @return MARCXML string of the results of the merge
 955     /
 956 );
 957 __PACKAGE__->register_method(
 958     method    => 'calculate_bib_marc_merge',
 959     api_name  => 'open-ils.cat.merge.biblio.per_profile',
 960     signature => q/
 961         Calculate the result of merging one or more bib records
 962         per the specified merge profile
 963         @param auth The login session key
 964         @param merge_profile ID of the record merge profile
 965         @param records Array of two or more bib record IDs of
 966                        the bibs to be merged.
 967         @return MARCXML string of the results of the merge
 968     /
 969 );
 970 __PACKAGE__->register_method(
 971     method    => 'calculate_authority_marc_merge',
 972     api_name  => 'open-ils.cat.merge.authority.per_profile',
 973     signature => q/
 974         Calculate the result of merging one or more authority records
 975         per the specified merge profile
 976         @param auth The login session key
 977         @param merge_profile ID of the record merge profile
 978         @param records Array of two or more bib record IDs of
 979                        the bibs to be merged.
 980         @return MARCXML string of the results of the merge
 981     /
 982 );
 983
 984 sub _handle_marc_merge {
 985     my ($e, $merge_profile_id, $records) = @_;
 986
 987     my $result = shift @$records;
 988     foreach my $incoming (@$records) {
 989         my $response = $e->json_query({
 990             from => [
 991                 'vandelay.merge_record_xml_using_profile',
 992                 $incoming, $result,
 993                 $merge_profile_id
 994             ]
 995         });
 996         return unless ref($response);
 997         $result = $response->[0]->{'vandelay.merge_record_xml_using_profile'};
 998     }
 999     return $result;
1000 }
1001
1002 sub calculate_marc_merge {
1003     my( $self, $conn, $auth, $merge_profile_id, $records ) = @_;
1004
1005     my $e = new_editor(authtoken=>$auth, xact=>1);
1006     return $e->die_event unless $e->checkauth;
1007
1008     my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1009         or return $e->die_event;
1010     return $e->die_event unless ref($records) && @$records >= 2;
1011
1012     return _handle_marc_merge($e, $merge_profile_id, $records)
1013 }
1014
1015 sub calculate_bib_marc_merge {
1016     my( $self, $conn, $auth, $merge_profile_id, $bib_ids ) = @_;
1017
1018     my $e = new_editor(authtoken=>$auth, xact=>1);
1019     return $e->die_event unless $e->checkauth;
1020
1021     my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1022         or return $e->die_event;
1023     return $e->die_event unless ref($bib_ids) && @$bib_ids >= 2;
1024
1025     my $records = [];
1026     foreach my $id (@$bib_ids) {
1027         my $bre = $e->retrieve_biblio_record_entry($id) or return $e->die_event;
1028         push @$records, $bre->marc();
1029     }
1030
1031     return _handle_marc_merge($e, $merge_profile_id, $records)
1032 }
1033
1034 sub calculate_authority_marc_merge {
1035     my( $self, $conn, $auth, $merge_profile_id, $authority_ids ) = @_;
1036
1037     my $e = new_editor(authtoken=>$auth, xact=>1);
1038     return $e->die_event unless $e->checkauth;
1039
1040     my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1041         or return $e->die_event;
1042     return $e->die_event unless ref($authority_ids) && @$authority_ids >= 2;
1043
1044     my $records = [];
1045     foreach my $id (@$authority_ids) {
1046         my $are = $e->retrieve_authority_record_entry($id) or return $e->die_event;
1047         push @$records, $are->marc();
1048     }
1049
1050     return _handle_marc_merge($e, $merge_profile_id, $records)
1051 }
1052
1053 __PACKAGE__->register_method(
1054     method   => "fleshed_volume_update",
1055     api_name => "open-ils.cat.asset.volume.fleshed.batch.update",);
1056
1057 __PACKAGE__->register_method(
1058     method   => "fleshed_volume_update",
1059     api_name => "open-ils.cat.asset.volume.fleshed.batch.update.override",);
1060
1061 sub fleshed_volume_update {
1062     my( $self, $conn, $auth, $volumes, $delete_stats, $options, $oargs ) = @_;
1063     my( $reqr, $evt ) = $U->checkses($auth);
1064     return $evt if $evt;
1065     $options ||= {};
1066
1067     if ($self->api_name =~ /override/) {
1068         $oargs = { all => 1 } unless defined $oargs;
1069     } else {
1070         $oargs = {};
1071     }
1072     my $editor = new_editor( requestor => $reqr, xact => 1 );
1073     my $retarget_holds = [];
1074     my $auto_merge_vols = $options->{auto_merge_vols};
1075     my $create_parts = $options->{create_parts};
1076
1077     for my $vol (@$volumes) {
1078         $logger->info("vol-update: investigating volume ".$vol->id);
1079
1080         $vol->editor($reqr->id);
1081         $vol->edit_date('now');
1082
1083         my $copies = $vol->copies;
1084         $vol->clear_copies;
1085
1086         $vol->editor($editor->requestor->id);
1087         $vol->edit_date('now');
1088
1089         if( $vol->isdeleted ) {
1090
1091             $logger->info("vol-update: deleting volume");
1092             return $editor->die_event unless
1093                 $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
1094
1095             if(my $evt = $assetcom->delete_volume($editor, $vol, $oargs, $$options{force_delete_copies})) {
1096                 $editor->rollback;
1097                 return $evt;
1098             }
1099
1100             return $editor->die_event unless
1101                 $editor->update_asset_call_number($vol);
1102
1103         } elsif( $vol->isnew ) {
1104             $logger->info("vol-update: creating volume");
1105             $evt = $assetcom->create_volume( $oargs, $editor, $vol );
1106             return $evt if $evt;
1107
1108         } elsif( $vol->ischanged ) {
1109             $logger->info("vol-update: update volume");
1110             my $resp = update_volume($vol, $editor, ($oargs->{all} or grep { $_ eq 'VOLUME_LABEL_EXISTS' } @{$oargs->{events}} or $auto_merge_vols));
1111             return $resp->{evt} if $resp->{evt};
1112             $vol = $resp->{merge_vol} if $resp->{merge_vol};
1113         }
1114
1115         # now update any attached copies
1116         if( $copies and @$copies and !$vol->isdeleted ) {
1117             $_->call_number($vol->id) for @$copies;
1118             $evt = $assetcom->update_fleshed_copies(
1119                 $editor, $oargs, $vol, $copies, $delete_stats, $retarget_holds, undef, $create_parts);
1120             return $evt if $evt;
1121         }
1122     }
1123
1124     $editor->finish;
1125     reset_hold_list($auth, $retarget_holds);
1126     return scalar(@$volumes);
1127 }
1128
1129
1130 sub update_volume {
1131     my $vol = shift;
1132     my $editor = shift;
1133     my $auto_merge = shift;
1134     my $evt;
1135     my $merge_vol;
1136
1137     return {evt => $editor->event} unless
1138         $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
1139
1140     return {evt => $evt}
1141         if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $vol->owning_lib) );
1142
1143     my $vols = $editor->search_asset_call_number({
1144         owning_lib => $vol->owning_lib,
1145         record     => $vol->record,
1146         label      => $vol->label,
1147         prefix     => $vol->prefix,
1148         suffix     => $vol->suffix,
1149         deleted    => 'f',
1150         id         => {'!=' => $vol->id}
1151     });
1152
1153     if(@$vols) {
1154
1155         if($auto_merge) {
1156
1157             # If the auto-merge option is on, merge our updated volume into the existing
1158             # volume with the same record + owner + label.
1159             ($merge_vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $vols->[0]);
1160             return {evt => $evt, merge_vol => $merge_vol};
1161
1162         } else {
1163             return {evt => OpenILS::Event->new('VOLUME_LABEL_EXISTS', payload => $vol->id)};
1164         }
1165     }
1166
1167     return {evt => $editor->die_event} unless $editor->update_asset_call_number($vol);
1168     return {};
1169 }
1170
1171
1172
1173 __PACKAGE__->register_method (
1174     method   => 'delete_bib_record',
1175     api_name => 'open-ils.cat.biblio.record_entry.delete');
1176
1177 sub delete_bib_record {
1178     my($self, $conn, $auth, $rec_id) = @_;
1179     my $e = new_editor(xact=>1, authtoken=>$auth);
1180     return $e->die_event unless $e->checkauth;
1181     return $e->die_event unless $e->allowed('DELETE_RECORD', $e->requestor->ws_ou);
1182     my $vols = $e->search_asset_call_number({record=>$rec_id, deleted=>'f'});
1183     return OpenILS::Event->new('RECORD_NOT_EMPTY', payload=>$rec_id) if @$vols;
1184     my $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $rec_id);
1185     if($evt) { $e->rollback; return $evt; }
1186     $e->commit;
1187     return 1;
1188 }
1189
1190
1191
1192 __PACKAGE__->register_method (
1193     method   => 'batch_volume_transfer',
1194     api_name => 'open-ils.cat.asset.volume.batch.transfer',
1195 );
1196
1197 __PACKAGE__->register_method (
1198     method   => 'batch_volume_transfer',
1199     api_name => 'open-ils.cat.asset.volume.batch.transfer.override',
1200 );
1201
1202
1203 sub batch_volume_transfer {
1204     my( $self, $conn, $auth, $args, $oargs ) = @_;
1205
1206     my $evt;
1207     my $rec     = $$args{docid};
1208     my $o_lib   = $$args{lib};
1209     my $vol_ids = $$args{volumes};
1210
1211     my $override = 1 if $self->api_name =~ /override/;
1212     $oargs = { all => 1 } unless defined $oargs;
1213
1214     $logger->info("merge: transferring volumes to lib=$o_lib and record=$rec");
1215
1216     my $e = new_editor(authtoken => $auth, xact =>1);
1217     return $e->event unless $e->checkauth;
1218     return $e->event unless $e->allowed('UPDATE_VOLUME', $o_lib);
1219
1220     my $dorg = $e->retrieve_actor_org_unit($o_lib)
1221         or return $e->event;
1222
1223     my $ou_type = $e->retrieve_actor_org_unit_type($dorg->ou_type)
1224         or return $e->event;
1225
1226     return $evt if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($e, $o_lib) );
1227
1228     my $vols = $e->batch_retrieve_asset_call_number($vol_ids);
1229     my @seen;
1230
1231    my @rec_ids;
1232
1233     for my $vol (@$vols) {
1234
1235         # if we've already looked at this volume, go to the next
1236         next if !$vol or grep { $vol->id == $_ } @seen;
1237
1238         # grab all of the volumes in the list that have
1239         # the same label so they can be merged
1240         my @all = grep { $_->label eq $vol->label } @$vols;
1241
1242         # take note of the fact that we've looked at this set of volumes
1243         push( @seen, $_->id ) for @all;
1244         push( @rec_ids, $_->record ) for @all;
1245
1246         # for each volume, see if there are any copies that have a
1247         # remote circ_lib (circ_lib != vol->owning_lib and != $o_lib ).
1248         # if so, warn them
1249         unless( $override && ($oargs->{all} || grep { $_ eq 'COPY_REMOTE_CIRC_LIB' } @{$oargs->{events}}) ) {
1250             for my $v (@all) {
1251
1252                 $logger->debug("merge: searching for copies with remote circ_lib for volume ".$v->id);
1253                 my $args = {
1254                     call_number => $v->id,
1255                     circ_lib    => { "not in" => [ $o_lib, $v->owning_lib ] },
1256                     deleted     => 'f'
1257                 };
1258
1259                 my $copies = $e->search_asset_copy($args, {idlist=>1});
1260
1261                 # if the copy's circ_lib matches the destination lib,
1262                 # that's ok too
1263                 return OpenILS::Event->new('COPY_REMOTE_CIRC_LIB') if @$copies;
1264             }
1265         }
1266
1267         # see if there is a volume at the destination lib that
1268         # already has the requested label
1269         my $existing_vol = $e->search_asset_call_number(
1270             {
1271                 label      => $vol->label,
1272                 prefix     => $vol->prefix,
1273                 suffix     => $vol->suffix,
1274                 record     => $rec,
1275                 owning_lib => $o_lib,
1276                 deleted    => 'f'
1277             }
1278         )->[0];
1279
1280         if( $existing_vol ) {
1281
1282             if( grep { $_->id == $existing_vol->id } @all ) {
1283                 # this volume is already accounted for in our list of volumes to merge
1284                 $existing_vol = undef;
1285
1286             } else {
1287                 # this volume exists on the destination record/owning_lib and must
1288                 # be used as the destination for merging
1289                 $logger->debug("merge: volume already exists at destination record: ".
1290                     $existing_vol->id.' : '.$existing_vol->label) if $existing_vol;
1291             }
1292         }
1293
1294         if( @all > 1 || $existing_vol ) {
1295             $logger->info("merge: found collisions in volume transfer");
1296             my @args = ($e, \@all);
1297             @args = ($e, \@all, $existing_vol) if $existing_vol;
1298             ($vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes(@args);
1299             return $evt if $evt;
1300         }
1301
1302         if( !$existing_vol ) {
1303
1304             $vol->owning_lib($o_lib);
1305             $vol->record($rec);
1306             $vol->editor($e->requestor->id);
1307             $vol->edit_date('now');
1308
1309             $logger->info("merge: updating volume ".$vol->id);
1310             $e->update_asset_call_number($vol) or return $e->event;
1311
1312         } else {
1313             $logger->info("merge: bypassing volume update because existing volume used as target");
1314         }
1315
1316         # regardless of what volume was used as the destination,
1317         # update any copies that have moved over to the new lib
1318         my $copies = $e->search_asset_copy({call_number=>$vol->id, deleted => 'f'});
1319
1320         # update circ lib on the copies - make this a method flag?
1321         for my $copy (@$copies) {
1322             next if $copy->circ_lib == $o_lib;
1323             $logger->info("merge: transfer moving circ lib on copy ".$copy->id);
1324             $copy->circ_lib($o_lib);
1325             $copy->editor($e->requestor->id);
1326             $copy->edit_date('now');
1327             $e->update_asset_copy($copy) or return $e->event;
1328         }
1329
1330         # Now see if any empty records need to be deleted after all of this
1331
1332         for(@rec_ids) {
1333             $logger->debug("merge: seeing if we should delete record $_...");
1334             $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $_)
1335                 if OpenILS::Application::Cat::BibCommon->title_is_empty($e, $_);
1336             return $evt if $evt;
1337         }
1338     }
1339
1340     $logger->info("merge: transfer succeeded");
1341     $e->commit;
1342     return 1;
1343 }
1344
1345
1346
1347
1348 __PACKAGE__->register_method(
1349     api_name => 'open-ils.cat.call_number.find_or_create',
1350     method   => 'find_or_create_volume',
1351 );
1352
1353 sub find_or_create_volume {
1354     my( $self, $conn, $auth, $label, $record_id, $org_id, $prefix, $suffix, $label_class ) = @_;
1355     my $e = new_editor(authtoken=>$auth, xact=>1);
1356     return $e->die_event unless $e->checkauth;
1357     my ($vol, $evt, $exists) =
1358         OpenILS::Application::Cat::AssetCommon->find_or_create_volume($e, $label, $record_id, $org_id, $prefix, $suffix, $label_class);
1359     return $evt if $evt;
1360     $e->rollback if $exists;
1361     $e->commit if $vol;
1362     return { 'acn_id' => $vol->id, 'existed' => $exists };
1363 }
1364
1365
1366 __PACKAGE__->register_method(
1367     method    => "create_serial_record_xml",
1368     api_name  => "open-ils.cat.serial.record.xml.create.override",
1369     signature => q/@see open-ils.cat.serial.record.xml.create/);
1370
1371 __PACKAGE__->register_method(
1372     method    => "create_serial_record_xml",
1373     api_name  => "open-ils.cat.serial.record.xml.create",
1374     signature => q/
1375         Inserts a new serial record with the given XML
1376     /
1377 );
1378
1379 sub create_serial_record_xml {
1380     my( $self, $client, $login, $source, $owning_lib, $record_id, $xml, $oargs ) = @_;
1381
1382     my $override = 1 if $self->api_name =~ /override/; # not currently used
1383     $oargs = { all => 1 } unless defined $oargs; # Not currently used, but here for consistency.
1384
1385     my $e = new_editor(xact=>1, authtoken=>$login);
1386     return $e->die_event unless $e->checkauth;
1387     return $e->die_event unless $e->allowed('CREATE_MFHD_RECORD', $owning_lib);
1388
1389     # Auto-populate the location field of a placeholder MFHD record with the library name
1390     my $aou = $e->retrieve_actor_org_unit($owning_lib) or return $e->die_event;
1391
1392     my $mfhd = Fieldmapper::serial::record_entry->new;
1393
1394     $mfhd->source($source) if $source;
1395     $mfhd->record($record_id);
1396     $mfhd->creator($e->requestor->id);
1397     $mfhd->editor($e->requestor->id);
1398     $mfhd->create_date('now');
1399     $mfhd->edit_date('now');
1400     $mfhd->owning_lib($owning_lib);
1401
1402     # If the caller did not pass in MFHD XML, create a placeholder record.
1403     # The placeholder will only contain the name of the owning library.
1404     # The goal is to generate common patterns for the caller in the UI that
1405     # then get passed in here.
1406     if (!$xml) {
1407         my $aou_name = $aou->name;
1408         $xml = <<HERE;
1409 <record
1410  xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1411  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
1412  xmlns="http://www.loc.gov/MARC21/slim">
1413 <leader>00307ny  a22001094  4500</leader>
1414 <controlfield tag="001">42153</controlfield>
1415 <controlfield tag="005">20090601182414.0</controlfield>
1416 <controlfield tag="004">$record_id</controlfield>
1417 <controlfield tag="008">      4u####8###l# 4   uueng1      </controlfield>
1418 <datafield tag="852" ind1=" " ind2=" "> <subfield code="b">$aou_name</subfield></datafield>
1419 </record>
1420 HERE
1421     }
1422     my $marcxml = XML::LibXML->new->parse_string($xml);
1423     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim", "marc", 1 );
1424     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim");
1425
1426     $mfhd->marc($U->entityize($marcxml->documentElement->toString));
1427
1428     $e->create_serial_record_entry($mfhd) or return $e->die_event;
1429
1430     $e->commit;
1431     return $mfhd->id;
1432 }
1433
1434 __PACKAGE__->register_method(
1435     method   => "create_update_asset_copy_template",
1436     api_name => "open-ils.cat.asset.copy_template.create_or_update"
1437 );
1438
1439 sub create_update_asset_copy_template {
1440     my ($self, $client, $authtoken, $act) = @_;
1441
1442     my $e = new_editor("xact" => 1, "authtoken" => $authtoken);
1443     return $e->die_event unless $e->checkauth;
1444     return $e->die_event unless $e->allowed(
1445         "ADMIN_ASSET_COPY_TEMPLATE", $act->owning_lib
1446     );
1447
1448     $act->editor($e->requestor->id);
1449     $act->edit_date("now");
1450
1451     my $retval;
1452     if (!$act->id) {
1453         $act->creator($e->requestor->id);
1454         $act->create_date("now");
1455
1456         $e->create_asset_copy_template($act) or return $e->die_event;
1457         $retval = $e->data;
1458     } else {
1459         $e->update_asset_copy_template($act) or return $e->die_event;
1460         $retval = $e->retrieve_asset_copy_template($e->data);
1461     }
1462     $e->commit and return $retval;
1463 }
1464
1465 __PACKAGE__->register_method(
1466     method      => "acn_sms_msg",
1467     api_name    => "open-ils.cat.acn.send_sms_text",
1468     signature   => q^
1469         Send an SMS text from an A/T template for specified call numbers.
1470
1471         First parameter is null or an auth token (whether a null is allowed
1472         depends on the sms.disable_authentication_requirement.callnumbers OU
1473         setting).
1474
1475         Second parameter is the id of the context org.
1476
1477         Third parameter is the code of the SMS carrier from the
1478         config.sms_carrier table.
1479
1480         Fourth parameter is the SMS number.
1481
1482         Fifth parameter is the ACN id's to target, though currently only the
1483         first ACN is used by the template (and the UI is only sending one).
1484     ^
1485 );
1486
1487 sub acn_sms_msg {
1488     my($self, $conn, $auth, $org_id, $carrier, $number, $target_ids) = @_;
1489
1490     my $sms_enable = $U->ou_ancestor_setting_value(
1491         $org_id || $U->get_org_tree->id,
1492         'sms.enable'
1493     );
1494     # We could maybe make a Validator for this on the templates
1495     if (! $U->is_true($sms_enable)) {
1496         return -1;
1497     }
1498
1499     my $disable_auth = $U->ou_ancestor_setting_value(
1500         $org_id || $U->get_org_tree->id,
1501         'sms.disable_authentication_requirement.callnumbers'
1502     );
1503
1504     my $e = new_editor(
1505         (defined $auth)
1506         ? (authtoken => $auth, xact => 1)
1507         : (xact => 1)
1508     );
1509     return $e->event unless $disable_auth || $e->checkauth;
1510
1511     my $targets = $e->batch_retrieve_asset_call_number($target_ids);
1512
1513     $e->rollback; # FIXME using transaction because of pgpool/slony setups, but not
1514                   # simply making this method authoritative because of weirdness
1515                   # with transaction handling in A/T code that causes rollback
1516                   # failure down the line if handling many targets
1517
1518     return undef unless @$targets;
1519     return $U->fire_object_event(
1520         undef,                    # event_def
1521         'acn.format.sms_text',    # hook
1522         $targets,
1523         $org_id,
1524         undef,                    # granularity
1525         {                         # user_data
1526             sms_carrier => $carrier,
1527             sms_notify => $number
1528         }
1529     );
1530 }
1531
1532
1533
1534 __PACKAGE__->register_method(
1535     method    => "fixed_field_values_by_rec_type",
1536     api_name  => "open-ils.cat.biblio.fixed_field_values.by_rec_type",
1537     argc      => 2,
1538     signature => {
1539         desc   => 'Given a record type (as in cmfpm.rec_type), return fixed fields and their possible values as known to the DB',
1540         params => [
1541             {desc => 'Record Type', type => 'string'},
1542             {desc => '(Optional) Fixed field', type => 'string'},
1543         ]
1544     },
1545     return => {desc => 'an object in which the keys are fixed fields and the values are arrays representing the set of all unique values for that fixed field in that record type', type => 'object' }
1546 );
1547
1548
1549 sub fixed_field_values_by_rec_type {
1550     my ($self, $conn, $rec_type, $fixed_field) = @_;
1551
1552     my $e = new_editor;
1553     my $values = $e->json_query({
1554         select => {
1555             crad  => ["fixed_field"],
1556             ccvm  => [qw/code value/],
1557             cmfpm => [qw/length default_val/],
1558         },
1559         distinct => 1,
1560         from => {
1561             ccvm => {
1562                 crad => {
1563                     join => {
1564                         cmfpm => {
1565                             fkey => "fixed_field",
1566                             field => "fixed_field"
1567                         }
1568                     }
1569                 }
1570             }
1571         },
1572         where => {
1573             "+cmfpm" => {rec_type => $rec_type},
1574             defined $fixed_field ?
1575                 ("+crad" => {fixed_field => $fixed_field}) : ()
1576         },
1577         order_by => [
1578             {class => "crad", field => "fixed_field"},
1579             {class => "ccvm", field => "code"}
1580         ]
1581     }) or return $e->die_event;
1582
1583     my $result = {};
1584     for my $row (@$values) {
1585         $result->{$row->{fixed_field}} ||= [];
1586         push @{$result->{$row->{fixed_field}}}, [@$row{qw/code value length default_val/}];
1587     }
1588
1589     return $result;
1590 }
1591
1592 __PACKAGE__->register_method(
1593     method    => "retrieve_tag_table",
1594     api_name  => "open-ils.cat.tag_table.all.retrieve.local",
1595     stream    => 1,
1596     argc      => 3,
1597     signature => {
1598         desc   => "Retrieve set of MARC tags, subfields, and indicator values for the user's OU",
1599         params => [
1600             {desc => 'Authtoken', type => 'string'},
1601             {desc => 'MARC Format', type => 'string'},
1602             {desc => 'MARC Record Type', type => 'string'},
1603         ]
1604     },
1605     return => {desc => 'Structure representing the tag table available to that user', type => 'object' }
1606 );
1607 __PACKAGE__->register_method(
1608     method    => "retrieve_tag_table",
1609     api_name  => "open-ils.cat.tag_table.all.retrieve.stock",
1610     stream    => 1,
1611     argc      => 3,
1612     signature => {
1613         desc   => 'Retrieve set of MARC tags, subfields, and indicator values for stock MARC standard',
1614         params => [
1615             {desc => 'Authtoken', type => 'string'},
1616             {desc => 'MARC Format', type => 'string'},
1617             {desc => 'MARC Record Type', type => 'string'},
1618         ]
1619     },
1620     return => {desc => 'Structure representing the stock tag table', type => 'object' }
1621 );
1622 __PACKAGE__->register_method(
1623     method    => "retrieve_tag_table",
1624     api_name  => "open-ils.cat.tag_table.field_list.retrieve.local",
1625     stream    => 1,
1626     argc      => 3,
1627     signature => {
1628         desc   => "Retrieve set of MARC tags for available to the user's OU",
1629         params => [
1630             {desc => 'Authtoken', type => 'string'},
1631             {desc => 'MARC Format', type => 'string'},
1632             {desc => 'MARC Record Type', type => 'string'},
1633         ]
1634     },
1635     return => {desc => 'Structure representing the tags available to that user', type => 'object' }
1636 );
1637 __PACKAGE__->register_method(
1638     method    => "retrieve_tag_table",
1639     api_name  => "open-ils.cat.tag_table.field_list.retrieve.stock",
1640     stream    => 1,
1641     argc      => 3,
1642     signature => {
1643         desc   => 'Retrieve set of MARC tags for stock MARC standard',
1644         params => [
1645             {desc => 'Authtoken', type => 'string'},
1646             {desc => 'MARC Format', type => 'string'},
1647             {desc => 'MARC Record Type', type => 'string'},
1648         ]
1649     },
1650     return => {desc => 'Structure representing the stock MARC tags', type => 'object' }
1651 );
1652
1653 sub retrieve_tag_table {
1654     my( $self, $conn, $auth, $marc_format, $marc_record_type ) = @_;
1655     my $e = new_editor( authtoken=>$auth, xact=>1 );
1656     return $e->die_event unless $e->checkauth;
1657
1658     my $field_list_only = ($self->api_name =~ /\.field_list\./) ? 1 : 0;
1659     my $context_ou;
1660     if ($self->api_name =~ /\.local$/) {
1661         $context_ou = $e->requestor->ws_ou;
1662     }
1663
1664     my %sf_by_tag;
1665     unless ($field_list_only) {
1666         my $subfields = $e->json_query(
1667             { from => [ 'config.ou_marc_subfields', 1, $marc_record_type, $context_ou ] }
1668         );
1669         foreach my $sf (@$subfields) {
1670             my $sf_data = {
1671                 code        => $sf->{code},
1672                 description => $sf->{description},
1673                 mandatory   => $sf->{mandatory},
1674                 repeatable   => $sf->{repeatable},
1675             };
1676             if ($sf->{value_ctype}) {
1677                 $sf_data->{value_list} = $e->json_query({
1678                     select => { ccvm => [
1679                                             'code',
1680                                             { column => 'value', alias => 'description' }
1681                                         ]
1682                               },
1683                     from   => 'ccvm',
1684                     where  => { ctype => $sf->{value_ctype} },
1685                     order_by => { ccvm => { code => {} } },
1686                 });
1687             }
1688             push @{ $sf_by_tag{$sf->{tag}} }, $sf_data;
1689         }
1690     }
1691
1692     my $fields = $e->json_query(
1693         { from => [ 'config.ou_marc_fields', 1, $marc_record_type, $context_ou ] }
1694     );
1695
1696     foreach my $field (@$fields) {
1697         next if $field->{hidden} eq 't';
1698         unless ($field_list_only) {
1699             my $tag = $field->{tag};
1700             if ($tag ge '010') {
1701                 for my $pos (1..2) {
1702                     my $ind_ccvm_key = "${marc_format}_${marc_record_type}_${tag}_ind_${pos}";
1703                     my $indvals = $e->json_query({
1704                         select => { ccvm => [
1705                                                 'code',
1706                                                 { column => 'value', alias => 'description' }
1707                                             ]
1708                                   },
1709                         from   => 'ccvm',
1710                         where  => { ctype => $ind_ccvm_key }
1711                     });
1712                     next unless defined($indvals);
1713                     $field->{"ind$pos"} = $indvals;
1714                 }
1715                 $field->{subfields} = exists($sf_by_tag{$tag}) ? $sf_by_tag{$tag} : [];
1716             }
1717         }
1718         $conn->respond($field);
1719     }
1720 }
1721
1722 1;
1723
1724 # vi:et:ts=4:sw=4