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 $num_failed = 0;
 267     my $num_succeeded = 0;
 268
 269     $conn->respond_complete(
 270         $actor->request('open-ils.actor.anon_cache.set_value', $auth, batch_edit_progress => {})->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         if ($success eq 'f') {
 285             $num_failed++;
 286         } else {
 287             $num_succeeded++;
 288         }
 289
 290         if ($actor) {
 291             $actor->request(
 292                 'open-ils.actor.anon_cache.set_value', $auth,
 293                 batch_edit_progress => {
 294                     succeeded => $num_succeeded,
 295                     failed    => $num_failed
 296                 },
 297             );
 298         } else {
 299             $conn->respond({ record => $rec->id, success => $success });
 300         }
 301
 302         if ($success eq 't') {
 303             unless ($e->delete_container_biblio_record_entry_bucket_item($item)) {
 304                 $e->rollback;
 305                 if ($actor) {
 306                     $actor->request(
 307                         'open-ils.actor.anon_cache.set_value', $auth,
 308                         batch_edit_progress => {
 309                             complete => 1,
 310                             success  => 'f',
 311                             succeeded => $num_succeeded,
 312                             failed    => $num_failed,
 313                         }
 314                     );
 315                     return undef;
 316                 } else {
 317                     return { complete => 1, success => 'f' };
 318                 }
 319             }
 320         }
 321     }
 322
 323     if ($titem && !$num_failed) {
 324         return $e->die_event unless ($e->delete_container_biblio_record_entry_bucket_item($titem));
 325     }
 326
 327     if ($e->commit) {
 328         if ($actor) {
 329             $actor->request(
 330                 'open-ils.actor.anon_cache.set_value', $auth,
 331                 batch_edit_progress => {
 332                     complete => 1,
 333                     success  => 't',
 334                     succeeded => $num_succeeded,
 335                     failed    => $num_failed,
 336                 }
 337             );
 338         } else {
 339             return { complete => 1, success => 't' };
 340         }
 341     } else {
 342         if ($actor) {
 343             $actor->request(
 344                 'open-ils.actor.anon_cache.set_value', $auth,
 345                 batch_edit_progress => {
 346                     complete => 1,
 347                     success  => 'f',
 348                     succeeded => $num_succeeded,
 349                     failed    => $num_failed,
 350                 }
 351             );
 352         } else {
 353             return { complete => 1, success => 'f' };
 354         }
 355     }
 356     return undef;
 357 }
 358
 359 __PACKAGE__->register_method(
 360     method    => "update_biblio_record_entry",
 361     api_name  => "open-ils.cat.biblio.record_entry.update",
 362     signature => q/
 363         Updates a biblio.record_entry
 364         @param auth The authtoken
 365         @param record The record with updated values
 366         @return 1 on success, Event on error.
 367     /
 368 );
 369
 370 sub update_biblio_record_entry {
 371     my($self, $conn, $auth, $record) = @_;
 372     my $e = new_editor(authtoken=>$auth, xact=>1);
 373     return $e->die_event unless $e->checkauth;
 374     return $e->die_event unless $e->allowed('UPDATE_RECORD');
 375     $e->update_biblio_record_entry($record) or return $e->die_event;
 376     $e->commit;
 377     return 1;
 378 }
 379
 380 __PACKAGE__->register_method(
 381     method    => "undelete_biblio_record_entry",
 382     api_name  => "open-ils.cat.biblio.record_entry.undelete",
 383     signature => q/
 384         Un-deletes a record and sets active=true
 385         @param auth The authtoken
 386         @param record The record_id to ressurect
 387         @return 1 on success, Event on error.
 388     /
 389 );
 390 sub undelete_biblio_record_entry {
 391     my($self, $conn, $auth, $record_id) = @_;
 392     my $e = new_editor(authtoken=>$auth, xact=>1);
 393     return $e->die_event unless $e->checkauth;
 394     return $e->die_event unless $e->allowed('UPDATE_RECORD');
 395
 396     my $record = $e->retrieve_biblio_record_entry($record_id)
 397         or return $e->die_event;
 398     $record->deleted('f');
 399     $record->active('t');
 400
 401     # Set the leader/05 to indicate that the record has been corrected/revised
 402     my $marc = $record->marc();
 403     $marc =~ s{(<leader>.{5}).}{$1c};
 404     $record->marc($marc);
 405
 406     # no 2 non-deleted records can have the same tcn_value
 407     my $existing = $e->search_biblio_record_entry(
 408         {   deleted => 'f',
 409             tcn_value => $record->tcn_value,
 410             id => {'!=' => $record_id}
 411         }, {idlist => 1});
 412     return OpenILS::Event->new('TCN_EXISTS') if @$existing;
 413
 414     $e->update_biblio_record_entry($record) or return $e->die_event;
 415     $e->commit;
 416     return 1;
 417 }
 418
 419
 420 __PACKAGE__->register_method(
 421     method    => "biblio_record_xml_import",
 422     api_name  => "open-ils.cat.biblio.record.xml.import.override",
 423     signature => q/@see open-ils.cat.biblio.record.xml.import/);
 424
 425 __PACKAGE__->register_method(
 426     method    => "biblio_record_xml_import",
 427     api_name  => "open-ils.cat.biblio.record.xml.import",
 428     notes     => <<"    NOTES");
 429     Takes a marcxml record and imports the record into the database.  In this
 430     case, the marcxml record is assumed to be a complete record (i.e. valid
 431     MARC).  The title control number is taken from (whichever comes first)
 432     tags 001, 039[ab], 020a, 022a, 010, 035a and whichever does not already exist
 433     in the database.
 434     user_session must have IMPORT_MARC permissions
 435     NOTES
 436
 437
 438 sub biblio_record_xml_import {
 439     my( $self, $client, $authtoken, $xml, $source, $auto_tcn, $oargs, $strip_grps) = @_;
 440     my $e = new_editor(xact=>1, authtoken=>$authtoken);
 441     return $e->die_event unless $e->checkauth;
 442     return $e->die_event unless $e->allowed('IMPORT_MARC', $e->requestor->ws_ou);
 443
 444     if ($self->api_name =~ /override/) {
 445         $oargs = { all => 1 } unless defined $oargs;
 446     } else {
 447         $oargs = {};
 448     }
 449     my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
 450         $e, $xml, $source, $auto_tcn, $oargs, $strip_grps);
 451
 452     return $record if $U->event_code($record);
 453
 454     $e->commit;
 455
 456     return $record;
 457 }
 458
 459 __PACKAGE__->register_method(
 460     method        => "biblio_record_record_metadata",
 461     api_name      => "open-ils.cat.biblio.record.metadata.retrieve",
 462     authoritative => 1,
 463     argc          => 2, #(session_id, list of bre ids )
 464     notes         => "Returns a list of slim-downed bre objects based on the " .
 465                      "ids passed in",
 466 );
 467
 468 sub biblio_record_record_metadata {
 469     my( $self, $client, $authtoken, $ids ) = @_;
 470
 471     return [] unless $ids and @$ids;
 472
 473     my $editor = new_editor(authtoken => $authtoken);
 474     return $editor->event unless $editor->checkauth;
 475     return $editor->event unless $editor->allowed('VIEW_USER');
 476
 477     my @results;
 478
 479     for(@$ids) {
 480         return $editor->event unless
 481             my $rec = $editor->retrieve_biblio_record_entry($_);
 482         $rec->creator($editor->retrieve_actor_user($rec->creator));
 483         $rec->editor($editor->retrieve_actor_user($rec->editor));
 484         $rec->attrs($U->get_bre_attrs([$rec->id], $editor)->{$rec->id});
 485         $rec->clear_marc; # slim the record down
 486         push( @results, $rec );
 487     }
 488
 489     return \@results;
 490 }
 491
 492
 493
 494 __PACKAGE__->register_method(
 495     method    => "biblio_record_marc_cn",
 496     api_name  => "open-ils.cat.biblio.record.marc_cn.retrieve",
 497     argc      => 1, #(bib id )
 498     signature => {
 499         desc   => 'Extracts call number candidates from a bibliographic record',
 500         params => [
 501             {desc => 'Record ID', type => 'number'},
 502             {desc => '(Optional) Classification scheme ID', type => 'number'},
 503         ]
 504     },
 505     return => {desc => 'Hash of candidate call numbers identified by tag' }
 506 );
 507
 508 sub biblio_record_marc_cn {
 509     my( $self, $client, $id, $class ) = @_;
 510
 511     my $e = new_editor();
 512     my $marc = $e->retrieve_biblio_record_entry($id)->marc;
 513
 514     my $doc = XML::LibXML->new->parse_string($marc);
 515     $doc->documentElement->setNamespace( "http://www.loc.gov/MARC21/slim", "marc", 1 );
 516
 517     my @fields;
 518     my @res;
 519     if ($class) {
 520         @fields = split(/,/, $e->retrieve_asset_call_number_class($class)->field);
 521     } else {
 522         @fields = qw/050ab 055ab 060ab 070ab 080ab 082ab 086ab 088ab 090 092 096 098 099/;
 523     }
 524
 525     # Get field/subfield combos based on acnc value; for example "050ab,055ab"
 526
 527     foreach my $field (@fields) {
 528         my $tag = substr($field, 0, 3);
 529         $logger->debug("Tag = $tag");
 530         my @node = $doc->findnodes("//marc:datafield[\@tag='$tag']");
 531
 532         # Now parse the subfields and build up the subfield XPath
 533         my @subfields = split(//, substr($field, 3));
 534
 535         # If they give us no subfields to parse, default to just the 'a'
 536         if (!@subfields) {
 537             @subfields = ('a');
 538         }
 539         my $subxpath;
 540         foreach my $sf (@subfields) {
 541             $subxpath .= "\@code='$sf' or ";
 542         }
 543         $subxpath = substr($subxpath, 0, -4);
 544         $logger->debug("subxpath = $subxpath");
 545
 546         # Find the contents of the specified subfields
 547         foreach my $x (@node) {
 548             my $cn = $x->findvalue("marc:subfield[$subxpath]");
 549             push @res, {$tag => $cn} if ($cn);
 550         }
 551     }
 552
 553     return \@res;
 554 }
 555
 556 __PACKAGE__->register_method(
 557     method    => 'autogen_barcodes',
 558     api_name  => "open-ils.cat.item.barcode.autogen",
 559     signature => {
 560         desc   => 'Returns N generated barcodes following a specified barcode.',
 561         params => [
 562             {desc => 'Authentication token', type => 'string'},
 563             {desc => 'Barcode which the sequence should follow from', type => 'string'},
 564             {desc => 'Number of barcodes to generate', type => 'number'},
 565             {desc => 'Options hash.  Currently you can pass in checkdigit : false to disable the use of checkdigits.'}
 566         ],
 567         return => {desc => 'Array of generated barcodes'}
 568     }
 569 );
 570
 571 sub autogen_barcodes {
 572     my( $self, $client, $auth, $barcode, $num_of_barcodes, $options ) = @_;
 573     my $e = new_editor(authtoken => $auth);
 574     return $e->event unless $e->checkauth;
 575     return $e->event unless $e->allowed('UPDATE_COPY', $e->requestor->ws_ou);
 576     $options ||= {};
 577
 578     my $barcode_text = '';
 579     my $barcode_number = 0;
 580
 581     if ($barcode =~ /^(\D+)/) { $barcode_text = $1; }
 582     if ($barcode =~ /(\d+)$/) { $barcode_number = $1; }
 583
 584     my @res;
 585     for (my $i = 1; $i <= $num_of_barcodes; $i++) {
 586         my $calculated_barcode;
 587
 588         # default is to use checkdigits, so looking for an explicit false here
 589         if (defined $$options{'checkdigit'} && ! $$options{'checkdigit'}) {
 590             $calculated_barcode = $barcode_number + $i;
 591         } else {
 592             if ($barcode_number =~ /^\d{8}$/) {
 593                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0);
 594             } elsif ($barcode_number =~ /^\d{9}$/) {
 595                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit
 596             } elsif ($barcode_number =~ /^\d{13}$/) {
 597                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0);
 598             } elsif ($barcode_number =~ /^\d{14}$/) {
 599                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit
 600             } else {
 601                 $calculated_barcode = $barcode_number + $i;
 602             }
 603         }
 604         push @res, $barcode_text . $calculated_barcode;
 605     }
 606     return \@res
 607 }
 608
 609 # Codabar doesn't define a checkdigit algorithm, but this one is typically used by libraries.  gmcharlt++
 610 sub add_codabar_checkdigit {
 611     my $barcode = shift;
 612     my $strip_last_digit = shift;
 613
 614     return $barcode if $barcode =~ /\D/;
 615     $barcode = substr($barcode, 0, length($barcode)-1) if $strip_last_digit;
 616     my @digits = split //, $barcode;
 617     my $total = 0;
 618     for (my $i = 1; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 1,3,5,7,9,11
 619         $total += $digits[$i];
 620     }
 621     for (my $i = 0; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 0,2,4,6,8,10,12
 622         $total += (2 * $digits[$i] >= 10) ? (2 * $digits[$i] - 9) : (2 * $digits[$i]);
 623     }
 624     my $remainder = $total % 10;
 625     my $checkdigit = ($remainder == 0) ? $remainder : 10 - $remainder;
 626     return $barcode . $checkdigit;
 627 }
 628
 629 __PACKAGE__->register_method(
 630     method        => "orgs_for_title",
 631     authoritative => 1,
 632     api_name      => "open-ils.cat.actor.org_unit.retrieve_by_title"
 633 );
 634
 635 sub orgs_for_title {
 636     my( $self, $client, $record_id ) = @_;
 637
 638     my $vols = $U->simple_scalar_request(
 639         "open-ils.cstore",
 640         "open-ils.cstore.direct.asset.call_number.search.atomic",
 641         { record => $record_id, deleted => 'f' });
 642
 643     my $orgs = { map {$_->owning_lib => 1 } @$vols };
 644     return [ keys %$orgs ];
 645 }
 646
 647
 648 __PACKAGE__->register_method(
 649     method        => "retrieve_copies",
 650     authoritative => 1,
 651     api_name      => "open-ils.cat.asset.copy_tree.retrieve");
 652
 653 __PACKAGE__->register_method(
 654     method   => "retrieve_copies",
 655     api_name => "open-ils.cat.asset.copy_tree.global.retrieve");
 656
 657 # user_session may be null/undef
 658 sub retrieve_copies {
 659
 660     my( $self, $client, $user_session, $docid, @org_ids ) = @_;
 661
 662     if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
 663
 664     $docid = "$docid";
 665
 666     # grabbing copy trees should be available for everyone..
 667     if(!@org_ids and $user_session) {
 668         my($user_obj, $evt) = OpenILS::Application::AppUtils->checkses($user_session);
 669         return $evt if $evt;
 670         @org_ids = ($user_obj->home_ou);
 671     }
 672
 673     # Create an editor that can be shared across all iterations of
 674     # _build_volume_list().  Otherwise, .authoritative calls can result
 675     # in creating too many cstore connections.
 676     my $e = new_editor();
 677
 678     if( $self->api_name =~ /global/ ) {
 679         return _build_volume_list($e, { record => $docid, deleted => 'f', label => { '<>' => '##URI##' } } );
 680
 681     } else {
 682
 683         my @all_vols;
 684         for my $orgid (@org_ids) {
 685             my $vols = _build_volume_list($e,
 686                     { record => $docid, owning_lib => $orgid, deleted => 'f', label => { '<>' => '##URI##' } } );
 687             push( @all_vols, @$vols );
 688         }
 689
 690         return \@all_vols;
 691     }
 692
 693     return undef;
 694 }
 695
 696
 697 sub _build_volume_list {
 698     my $e = shift;
 699     my $search_hash = shift;
 700
 701     $e ||= new_editor();
 702
 703     $search_hash->{deleted} = 'f';
 704
 705     my $vols = $e->search_asset_call_number([
 706         $search_hash,
 707         {
 708             flesh => 1,
 709             flesh_fields => { acn => ['prefix','suffix','label_class'] },
 710             'order_by' => { 'acn' => 'oils_text_as_bytea(label_sortkey), oils_text_as_bytea(label), id, owning_lib' }
 711         }
 712     ]);
 713
 714     my @volumes;
 715
 716     for my $volume (@$vols) {
 717
 718         my $copies = $e->search_asset_copy([
 719             { call_number => $volume->id , deleted => 'f' },
 720             {
 721                 join => {
 722                     acpm => {
 723                         type => 'left',
 724                         join => {
 725                             bmp => { type => 'left' }
 726                         }
 727                     }
 728                 },
 729                 flesh => 1,
 730                 flesh_fields => { acp => ['stat_cat_entries','parts'] },
 731                 order_by => [
 732                     {'class' => 'bmp', 'field' => 'label_sortkey', 'transform' => 'oils_text_as_bytea'},
 733                     {'class' => 'bmp', 'field' => 'label', 'transform' => 'oils_text_as_bytea'},
 734                     {'class' => 'acp', 'field' => 'barcode'}
 735                 ]
 736             }
 737         ]);
 738
 739         for my $c (@$copies) {
 740             if( $c->status == OILS_COPY_STATUS_CHECKED_OUT ) {
 741                 $c->circulations(
 742                     $e->search_action_circulation(
 743                         [
 744                             { target_copy => $c->id },
 745                             {
 746                                 order_by => { circ => 'xact_start desc' },
 747                                 limit => 1
 748                             }
 749                         ]
 750                     )
 751                 )
 752             }
 753         }
 754
 755         $volume->copies($copies);
 756         push( @volumes, $volume );
 757     }
 758
 759     #$session->disconnect();
 760     return \@volumes;
 761
 762 }
 763
 764
 765 __PACKAGE__->register_method(
 766     method   => "fleshed_copy_update",
 767     api_name => "open-ils.cat.asset.copy.fleshed.batch.update",);
 768
 769 __PACKAGE__->register_method(
 770     method   => "fleshed_copy_update",
 771     api_name => "open-ils.cat.asset.copy.fleshed.batch.update.override",);
 772
 773
 774 sub fleshed_copy_update {
 775     my( $self, $conn, $auth, $copies, $delete_stats, $oargs, $create_parts ) = @_;
 776     return 1 unless ref $copies;
 777     my( $reqr, $evt ) = $U->checkses($auth);
 778     return $evt if $evt;
 779     my $editor = new_editor(requestor => $reqr, xact => 1);
 780     if ($self->api_name =~ /override/) {
 781         $oargs = { all => 1 } unless defined $oargs;
 782     } else {
 783         $oargs = {};
 784     }
 785     my $retarget_holds = [];
 786     $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
 787         $editor, $oargs, undef, $copies, $delete_stats, $retarget_holds, undef, $create_parts);
 788
 789     if( $evt ) {
 790         $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
 791         $editor->rollback;
 792         return $evt;
 793     }
 794
 795     $editor->commit;
 796     $logger->info("fleshed copy update successfully updated ".scalar(@$copies)." copies");
 797     reset_hold_list($auth, $retarget_holds);
 798
 799     return 1;
 800 }
 801
 802 sub reset_hold_list {
 803     my($auth, $hold_ids) = @_;
 804     return unless @$hold_ids;
 805     $logger->info("reseting holds after copy status change: @$hold_ids");
 806     my $ses = OpenSRF::AppSession->create('open-ils.circ');
 807     $ses->request('open-ils.circ.hold.reset.batch', $auth, $hold_ids);
 808 }
 809
 810 __PACKAGE__->register_method(
 811     method    => "transfer_copies_to_volume",
 812     api_name  => "open-ils.cat.transfer_copies_to_volume",
 813     argc      => 3,
 814     signature => {
 815         desc   => 'Transfers specified copies to the specified call number, and changes Circ Lib to match the new Owning Lib.',
 816         params => [
 817             {desc => 'Authtoken', type => 'string'},
 818             {desc => 'Call Number ID', type => 'number'},
 819             {desc => 'Array of Copy IDs', type => 'array'},
 820         ]
 821     },
 822     return => {desc => '1 on success, Event on error'}
 823 );
 824
 825 __PACKAGE__->register_method(
 826     method   => "transfer_copies_to_volume",
 827     api_name => "open-ils.cat.transfer_copies_to_volume.override",);
 828
 829 sub transfer_copies_to_volume {
 830     my( $self, $conn, $auth, $volume, $copies, $oargs ) = @_;
 831     my $delete_stats = 1;
 832     my $force_delete_empty_bib = undef;
 833     my $create_parts = undef;
 834
 835     # initial tests
 836
 837     return 1 unless ref $copies;
 838     my( $reqr, $evt ) = $U->checkses($auth);
 839     return $evt if $evt;
 840     my $editor = new_editor(requestor => $reqr, xact => 1);
 841     if ($self->api_name =~ /override/) {
 842         $oargs = { all => 1 } unless defined $oargs;
 843     } else {
 844         $oargs = {};
 845     }
 846
 847     # does the volume exist?  good, we also need its owning_lib later
 848     my( $cn, $cn_evt ) = $U->fetch_callnumber( $volume, 0, $editor );
 849     return $cn_evt if $cn_evt;
 850
 851     # flesh and munge the copies
 852     my $fleshed_copies = [];
 853     my $copy;
 854     foreach my $copy_id ( @{ $copies } ) {
 855         $copy = $editor->search_asset_copy([
 856             { id => $copy_id , deleted => 'f' },
 857             {
 858                 flesh => 1,
 859                 flesh_fields => { acp => ['parts'] }
 860             }
 861         ])->[0];
 862         return OpenILS::Event->new('ASSET_COPY_NOT_FOUND') if !$copy;
 863         $copy->call_number( $volume );
 864         $copy->circ_lib( $cn->owning_lib() );
 865         $copy->ischanged( 't' );
 866         push @$fleshed_copies, $copy;
 867     }
 868
 869     # actual work
 870     my $retarget_holds = [];
 871     $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
 872         $editor, $oargs, undef, $fleshed_copies, $delete_stats, $retarget_holds, $force_delete_empty_bib, $create_parts);
 873
 874     if( $evt ) {
 875         $logger->info("copy to volume transfer failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
 876         $editor->rollback;
 877         return $evt;
 878     }
 879
 880     # take care of the parts
 881     for my $copy (@$fleshed_copies) {
 882         my $parts = $copy->parts;
 883         next unless $parts;
 884         my $part_objs = [];
 885         foreach my $part (@$parts) {
 886             my $part_label = $part->label;
 887             my $part_obj = $editor->search_biblio_monograph_part(
 888               {
 889                    label=>$part_label,
 890                    record=>$cn->record,
 891                    deleted=>'f'
 892               }
 893            )->[0];
 894            if (!$part_obj) {
 895                $part_obj = Fieldmapper::biblio::monograph_part->new();
 896                $part_obj->label( $part_label );
 897                $part_obj->record( $cn->record );
 898                unless($editor->create_biblio_monograph_part($part_obj)) {
 899                  return $editor->die_event if $editor->die_event;
 900                }
 901            }
 902            push @$part_objs, $part_obj;
 903         }
 904         $copy->parts( $part_objs );
 905         $copy->ischanged(1);
 906         $evt = OpenILS::Application::Cat::AssetCommon->update_copy_parts($editor, $copy, 1); #delete_parts=1
 907         return $evt if $evt;
 908     }
 909
 910     $editor->commit;
 911     $logger->info("copy to volume transfer successfully updated ".scalar(@$copies)." copies");
 912     reset_hold_list($auth, $retarget_holds);
 913
 914     return 1;
 915 }
 916
 917 __PACKAGE__->register_method(
 918     method    => 'in_db_merge',
 919     api_name  => 'open-ils.cat.biblio.records.merge',
 920     signature => q/
 921         Merges a group of records
 922         @param auth The login session key
 923         @param master The id of the record all other records should be merged into
 924         @param records Array of records to be merged into the master record
 925         @return 1 on success, Event on error.
 926     /
 927 );
 928
 929 sub in_db_merge {
 930     my( $self, $conn, $auth, $master, $records ) = @_;
 931
 932     my $editor = new_editor( authtoken => $auth, xact => 1 );
 933     return $editor->die_event unless $editor->checkauth;
 934     return $editor->die_event unless $editor->allowed('MERGE_BIB_RECORDS'); # TODO see below about record ownership
 935
 936     my $count = 0;
 937     for my $source ( @$records ) {
 938         #XXX we actually /will/ want to check perms for master and sources after record ownership exists
 939
 940         # This stored proc (asset.merge_record_assets(target,source)) has the side effects of
 941         # moving call_number, title-type (and some volume-type) hold_request and uri-mapping
 942         # objects from the source record to the target record, so must be called from within
 943         # a transaction.
 944
 945         $count += $editor->json_query({
 946             select => {
 947                 bre => [{
 948                     alias => 'count',
 949                     transform => 'asset.merge_record_assets',
 950                     column => 'id',
 951                     params => [$source]
 952                 }]
 953             },
 954             from   => 'bre',
 955             where  => { id => $master }
 956         })->[0]->{count}; # count of objects moved, of all types
 957
 958     }
 959
 960     $editor->commit;
 961     return $count;
 962 }
 963
 964 __PACKAGE__->register_method(
 965     method    => 'in_db_auth_merge',
 966     api_name  => 'open-ils.cat.authority.records.merge',
 967     signature => q/
 968         Merges a group of authority records
 969         @param auth The login session key
 970         @param master The id of the record all other records should be merged into
 971         @param records Array of records to be merged into the master record
 972         @return 1 on success, Event on error.
 973     /
 974 );
 975
 976 sub in_db_auth_merge {
 977     my( $self, $conn, $auth, $master, $records ) = @_;
 978
 979     my $editor = new_editor( authtoken => $auth, xact => 1 );
 980     return $editor->die_event unless $editor->checkauth;
 981     return $editor->die_event unless $editor->allowed('MERGE_AUTH_RECORDS'); # TODO see below about record ownership
 982
 983     my $count = 0;
 984     for my $source ( @$records ) {
 985         $count += $editor->json_query({
 986             select => {
 987                 are => [{
 988                     alias => 'count',
 989                     transform => 'authority.merge_records',
 990                     column => 'id',
 991                     params => [$source]
 992                 }]
 993             },
 994             from   => 'are',
 995             where  => { id => $master }
 996         })->[0]->{count}; # count of objects moved, of all types
 997     }
 998
 999     $editor->commit;
1000     return $count;
1001 }
1002
1003 __PACKAGE__->register_method(
1004     method    => 'calculate_marc_merge',
1005     api_name  => 'open-ils.cat.merge.marc.per_profile',
1006     signature => q/
1007         Calculate the result of merging one or more MARC records
1008         per the specified merge profile
1009         @param auth The login session key
1010         @param merge_profile ID of the record merge profile
1011         @param records Array of two or more MARCXML records to be
1012                        merged. If two are supplied, the first
1013                        is treated as the record to be overlaid,
1014                        and the the incoming record that will
1015                        overlay the first. If more than two are
1016                        supplied, the first is treated as the
1017                        record to be overlaid, and each following
1018                        record in turn will be merged into that
1019                        record.
1020         @return MARCXML string of the results of the merge
1021     /
1022 );
1023 __PACKAGE__->register_method(
1024     method    => 'calculate_bib_marc_merge',
1025     api_name  => 'open-ils.cat.merge.biblio.per_profile',
1026     signature => q/
1027         Calculate the result of merging one or more bib records
1028         per the specified merge profile
1029         @param auth The login session key
1030         @param merge_profile ID of the record merge profile
1031         @param records Array of two or more bib record IDs of
1032                        the bibs to be merged.
1033         @return MARCXML string of the results of the merge
1034     /
1035 );
1036 __PACKAGE__->register_method(
1037     method    => 'calculate_authority_marc_merge',
1038     api_name  => 'open-ils.cat.merge.authority.per_profile',
1039     signature => q/
1040         Calculate the result of merging one or more authority records
1041         per the specified merge profile
1042         @param auth The login session key
1043         @param merge_profile ID of the record merge profile
1044         @param records Array of two or more bib record IDs of
1045                        the bibs to be merged.
1046         @return MARCXML string of the results of the merge
1047     /
1048 );
1049
1050 sub _handle_marc_merge {
1051     my ($e, $merge_profile_id, $records) = @_;
1052
1053     my $result = shift @$records;
1054     foreach my $incoming (@$records) {
1055         my $response = $e->json_query({
1056             from => [
1057                 'vandelay.merge_record_xml_using_profile',
1058                 $incoming, $result,
1059                 $merge_profile_id
1060             ]
1061         });
1062         return unless ref($response);
1063         $result = $response->[0]->{'vandelay.merge_record_xml_using_profile'};
1064     }
1065     return $result;
1066 }
1067
1068 sub calculate_marc_merge {
1069     my( $self, $conn, $auth, $merge_profile_id, $records ) = @_;
1070
1071     my $e = new_editor(authtoken=>$auth, xact=>1);
1072     return $e->die_event unless $e->checkauth;
1073
1074     my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1075         or return $e->die_event;
1076     return $e->die_event unless ref($records) && @$records >= 2;
1077
1078     return _handle_marc_merge($e, $merge_profile_id, $records)
1079 }
1080
1081 sub calculate_bib_marc_merge {
1082     my( $self, $conn, $auth, $merge_profile_id, $bib_ids ) = @_;
1083
1084     my $e = new_editor(authtoken=>$auth, xact=>1);
1085     return $e->die_event unless $e->checkauth;
1086
1087     my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1088         or return $e->die_event;
1089     return $e->die_event unless ref($bib_ids) && @$bib_ids >= 2;
1090
1091     my $records = [];
1092     foreach my $id (@$bib_ids) {
1093         my $bre = $e->retrieve_biblio_record_entry($id) or return $e->die_event;
1094         push @$records, $bre->marc();
1095     }
1096
1097     return _handle_marc_merge($e, $merge_profile_id, $records)
1098 }
1099
1100 sub calculate_authority_marc_merge {
1101     my( $self, $conn, $auth, $merge_profile_id, $authority_ids ) = @_;
1102
1103     my $e = new_editor(authtoken=>$auth, xact=>1);
1104     return $e->die_event unless $e->checkauth;
1105
1106     my $merge_profile = $e->retrieve_vandelay_merge_profile($merge_profile_id)
1107         or return $e->die_event;
1108     return $e->die_event unless ref($authority_ids) && @$authority_ids >= 2;
1109
1110     my $records = [];
1111     foreach my $id (@$authority_ids) {
1112         my $are = $e->retrieve_authority_record_entry($id) or return $e->die_event;
1113         push @$records, $are->marc();
1114     }
1115
1116     return _handle_marc_merge($e, $merge_profile_id, $records)
1117 }
1118
1119 __PACKAGE__->register_method(
1120     method   => "fleshed_volume_update",
1121     api_name => "open-ils.cat.asset.volume.fleshed.batch.update",);
1122
1123 __PACKAGE__->register_method(
1124     method   => "fleshed_volume_update",
1125     api_name => "open-ils.cat.asset.volume.fleshed.batch.update.override",);
1126
1127 sub fleshed_volume_update {
1128     my( $self, $conn, $auth, $volumes, $delete_stats, $options, $oargs ) = @_;
1129     my( $reqr, $evt ) = $U->checkses($auth);
1130     return $evt if $evt;
1131     $options ||= {};
1132
1133     if ($self->api_name =~ /override/) {
1134         $oargs = { all => 1 } unless defined $oargs;
1135     } else {
1136         $oargs = {};
1137     }
1138     my $editor = new_editor( requestor => $reqr, xact => 1 );
1139     my $retarget_holds = [];
1140     my $auto_merge_vols = $options->{auto_merge_vols};
1141     my $create_parts = $options->{create_parts};
1142     my $copy_ids = [];
1143
1144     for my $vol (@$volumes) {
1145         $logger->info("vol-update: investigating volume ".$vol->id);
1146
1147         $vol->editor($reqr->id);
1148         $vol->edit_date('now');
1149
1150         my $copies = $vol->copies;
1151         $vol->clear_copies;
1152
1153         $vol->editor($editor->requestor->id);
1154         $vol->edit_date('now');
1155
1156         if( $vol->isdeleted ) {
1157
1158             $logger->info("vol-update: deleting volume");
1159             return $editor->die_event unless
1160                 $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
1161
1162             if(my $evt = $assetcom->delete_volume($editor, $vol, $oargs, $$options{force_delete_copies})) {
1163                 $editor->rollback;
1164                 return $evt;
1165             }
1166
1167             return $editor->die_event unless
1168                 $editor->update_asset_call_number($vol);
1169
1170         } elsif( $vol->isnew ) {
1171             $logger->info("vol-update: creating volume");
1172             ($vol,$evt) = $assetcom->create_volume( $auto_merge_vols ? { all => 1} : $oargs, $editor, $vol );
1173             return $evt if $evt;
1174
1175         } elsif( $vol->ischanged ) {
1176             $logger->info("vol-update: update volume");
1177             my $resp = update_volume($vol, $editor, ($oargs->{all} or grep { $_ eq 'VOLUME_LABEL_EXISTS' } @{$oargs->{events}} or $auto_merge_vols));
1178             return $resp->{evt} if $resp->{evt};
1179             $vol = $resp->{merge_vol} if $resp->{merge_vol};
1180         }
1181
1182         # now update any attached copies
1183         if( $copies and @$copies and !$vol->isdeleted ) {
1184             $_->call_number($vol->id) for @$copies;
1185             $evt = $assetcom->update_fleshed_copies(
1186                 $editor, $oargs, $vol, $copies, $delete_stats, $retarget_holds, undef, $create_parts);
1187             return $evt if $evt;
1188             push( @$copy_ids, $_->id ) for @$copies;
1189         }
1190     }
1191
1192     $editor->finish;
1193     reset_hold_list($auth, $retarget_holds);
1194     if ($options->{return_copy_ids}) {
1195         return $copy_ids;
1196     } else {
1197         return scalar(@$volumes);
1198     }
1199 }
1200
1201
1202 sub update_volume {
1203     my $vol = shift;
1204     my $editor = shift;
1205     my $auto_merge = shift;
1206     my $evt;
1207     my $merge_vol;
1208
1209     return {evt => $editor->event} unless
1210         $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
1211
1212     return {evt => $evt}
1213         if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $vol->owning_lib) );
1214
1215     my $vols = $editor->search_asset_call_number({
1216         owning_lib => $vol->owning_lib,
1217         record     => $vol->record,
1218         label      => $vol->label,
1219         prefix     => $vol->prefix,
1220         suffix     => $vol->suffix,
1221         deleted    => 'f',
1222         id         => {'!=' => $vol->id}
1223     });
1224
1225     if(@$vols) {
1226
1227         if($auto_merge) {
1228
1229             # If the auto-merge option is on, merge our updated volume into the existing
1230             # volume with the same record + owner + label.
1231             ($merge_vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $vols->[0]);
1232             return {evt => $evt, merge_vol => $merge_vol};
1233
1234         } else {
1235             return {evt => OpenILS::Event->new('VOLUME_LABEL_EXISTS', payload => $vol->id)};
1236         }
1237     }
1238
1239     return {evt => $editor->die_event} unless $editor->update_asset_call_number($vol);
1240     return {};
1241 }
1242
1243
1244
1245 __PACKAGE__->register_method (
1246     method   => 'delete_bib_record',
1247     api_name => 'open-ils.cat.biblio.record_entry.delete');
1248
1249 sub delete_bib_record {
1250     my($self, $conn, $auth, $rec_id) = @_;
1251     my $e = new_editor(xact=>1, authtoken=>$auth);
1252     return $e->die_event unless $e->checkauth;
1253     return $e->die_event unless $e->allowed('DELETE_RECORD', $e->requestor->ws_ou);
1254     my $vols = $e->search_asset_call_number({record=>$rec_id, deleted=>'f'});
1255     return OpenILS::Event->new('RECORD_NOT_EMPTY', payload=>$rec_id) if @$vols;
1256     my $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $rec_id);
1257     if($evt) { $e->rollback; return $evt; }
1258     $e->commit;
1259     return 1;
1260 }
1261
1262
1263
1264 __PACKAGE__->register_method (
1265     method   => 'batch_volume_transfer',
1266     api_name => 'open-ils.cat.asset.volume.batch.transfer',
1267 );
1268
1269 __PACKAGE__->register_method (
1270     method   => 'batch_volume_transfer',
1271     api_name => 'open-ils.cat.asset.volume.batch.transfer.override',
1272 );
1273
1274
1275 sub batch_volume_transfer {
1276     my( $self, $conn, $auth, $args, $oargs ) = @_;
1277
1278     my $evt;
1279     my $rec     = $$args{docid};
1280     my $o_lib   = $$args{lib};
1281     my $vol_ids = $$args{volumes};
1282
1283     my $override = 1 if $self->api_name =~ /override/;
1284     $oargs = { all => 1 } unless defined $oargs;
1285
1286     $logger->info("merge: transferring volumes to lib=$o_lib and record=$rec");
1287
1288     my $e = new_editor(authtoken => $auth, xact =>1);
1289     return $e->event unless $e->checkauth;
1290     return $e->event unless $e->allowed('UPDATE_VOLUME', $o_lib);
1291
1292     my $dorg = $e->retrieve_actor_org_unit($o_lib)
1293         or return $e->event;
1294
1295     my $ou_type = $e->retrieve_actor_org_unit_type($dorg->ou_type)
1296         or return $e->event;
1297
1298     return $evt if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($e, $o_lib) );
1299
1300     my $vols = $e->batch_retrieve_asset_call_number($vol_ids);
1301     my @seen;
1302
1303    my @rec_ids;
1304
1305     for my $vol (@$vols) {
1306
1307         # if we've already looked at this volume, go to the next
1308         next if !$vol or grep { $vol->id == $_ } @seen;
1309
1310         # grab all of the volumes in the list that have
1311         # the same label so they can be merged
1312         my @all = grep { $_->label eq $vol->label } @$vols;
1313
1314         # take note of the fact that we've looked at this set of volumes
1315         push( @seen, $_->id ) for @all;
1316         push( @rec_ids, $_->record ) for @all;
1317
1318         # for each volume, see if there are any copies that have a
1319         # remote circ_lib (circ_lib != vol->owning_lib and != $o_lib ).
1320         # if so, warn them
1321         unless( $override && ($oargs->{all} || grep { $_ eq 'COPY_REMOTE_CIRC_LIB' } @{$oargs->{events}}) ) {
1322             for my $v (@all) {
1323
1324                 $logger->debug("merge: searching for copies with remote circ_lib for volume ".$v->id);
1325                 my $args = {
1326                     call_number => $v->id,
1327                     circ_lib    => { "not in" => [ $o_lib, $v->owning_lib ] },
1328                     deleted     => 'f'
1329                 };
1330
1331                 my $copies = $e->search_asset_copy($args, {idlist=>1});
1332
1333                 # if the copy's circ_lib matches the destination lib,
1334                 # that's ok too
1335                 return OpenILS::Event->new('COPY_REMOTE_CIRC_LIB') if @$copies;
1336             }
1337         }
1338
1339         # record the difference between the destination bib and the present bib
1340         my $same_bib = $vol->record == $rec;
1341
1342         # see if there is a volume at the destination lib that
1343         # already has the requested label
1344         my $existing_vol = $e->search_asset_call_number(
1345             {
1346                 label      => $vol->label,
1347                 prefix     => $vol->prefix,
1348                 suffix     => $vol->suffix,
1349                 record     => $rec,
1350                 owning_lib => $o_lib,
1351                 deleted    => 'f'
1352             }
1353         )->[0];
1354
1355         if( $existing_vol ) {
1356
1357             if( grep { $_->id == $existing_vol->id } @all ) {
1358                 # this volume is already accounted for in our list of volumes to merge
1359                 $existing_vol = undef;
1360
1361             } else {
1362                 # this volume exists on the destination record/owning_lib and must
1363                 # be used as the destination for merging
1364                 $logger->debug("merge: volume already exists at destination record: ".
1365                     $existing_vol->id.' : '.$existing_vol->label) if $existing_vol;
1366             }
1367         }
1368
1369         if( @all > 1 || $existing_vol ) {
1370             $logger->info("merge: found collisions in volume transfer");
1371             my @args = ($e, \@all);
1372             @args = ($e, \@all, $existing_vol) if $existing_vol;
1373             ($vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes(@args);
1374             return $evt if $evt;
1375         }
1376
1377         if( !$existing_vol ) {
1378
1379             $vol->owning_lib($o_lib);
1380             $vol->record($rec);
1381             $vol->editor($e->requestor->id);
1382             $vol->edit_date('now');
1383
1384             $logger->info("merge: updating volume ".$vol->id);
1385             $e->update_asset_call_number($vol) or return $e->event;
1386
1387         } else {
1388             $logger->info("merge: bypassing volume update because existing volume used as target");
1389         }
1390
1391         # regardless of what volume was used as the destination,
1392         # update any copies that have moved over to the new lib
1393         my $copies = $e->search_asset_copy([
1394             { call_number => $vol->id , deleted => 'f' },
1395             {
1396                 flesh => 1,
1397                 flesh_fields => { acp => ['parts'] }
1398             }
1399         ]);
1400
1401         # update circ lib on the copies - make this a method flag?
1402         for my $copy (@$copies) {
1403             next if $copy->circ_lib == $o_lib;
1404             $logger->info("merge: transfer moving circ lib on copy ".$copy->id);
1405             $copy->circ_lib($o_lib);
1406             $copy->editor($e->requestor->id);
1407             $copy->edit_date('now');
1408             $e->update_asset_copy($copy) or return $e->event;
1409         }
1410
1411         # update parts if volume is moving bib records
1412         if( !$same_bib ) {
1413             for my $copy (@$copies) {
1414                 my $parts = $copy->parts;
1415                 next unless $parts;
1416                 my $part_objs = [];
1417                 foreach my $part (@$parts) {
1418                     my $part_label = $part->label;
1419                     my $part_obj = $e->search_biblio_monograph_part(
1420                        {
1421                             label=>$part_label,
1422                             record=>$rec,
1423                             deleted=>'f'
1424                        }
1425                     )->[0];
1426
1427                     if (!$part_obj) {
1428                         $part_obj = Fieldmapper::biblio::monograph_part->new();
1429                         $part_obj->label( $part_label );
1430                         $part_obj->record( $rec );
1431                         unless($e->create_biblio_monograph_part($part_obj)) {
1432                           return $e->die_event if $e->die_event;
1433                         }
1434                     }
1435                     push @$part_objs, $part_obj;
1436                 }
1437
1438                 $copy->parts( $part_objs );
1439                 $copy->ischanged(1);
1440                 $evt = OpenILS::Application::Cat::AssetCommon->update_copy_parts($e, $copy, 1); #delete_parts=1
1441                 return $evt if $evt;
1442             }
1443         }
1444
1445         # Now see if any empty records need to be deleted after all of this
1446
1447         for(@rec_ids) {
1448             $logger->debug("merge: seeing if we should delete record $_...");
1449             $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $_)
1450                 if OpenILS::Application::Cat::BibCommon->title_is_empty($e, $_);
1451             return $evt if $evt;
1452         }
1453     }
1454
1455     $logger->info("merge: transfer succeeded");
1456     $e->commit;
1457     return 1;
1458 }
1459
1460
1461
1462
1463 __PACKAGE__->register_method(
1464     api_name => 'open-ils.cat.call_number.find_or_create',
1465     method   => 'find_or_create_volume',
1466 );
1467
1468 sub find_or_create_volume {
1469     my( $self, $conn, $auth, $label, $record_id, $org_id, $prefix, $suffix, $label_class ) = @_;
1470     my $e = new_editor(authtoken=>$auth, xact=>1);
1471     return $e->die_event unless $e->checkauth;
1472     my ($vol, $evt, $exists) =
1473         OpenILS::Application::Cat::AssetCommon->find_or_create_volume($e, $label, $record_id, $org_id, $prefix, $suffix, $label_class);
1474     return $evt if $evt;
1475     $e->rollback if $exists;
1476     $e->commit if $vol;
1477     return { 'acn_id' => $vol->id, 'existed' => $exists };
1478 }
1479
1480
1481 __PACKAGE__->register_method(
1482     method    => "create_serial_record_xml",
1483     api_name  => "open-ils.cat.serial.record.xml.create.override",
1484     signature => q/@see open-ils.cat.serial.record.xml.create/);
1485
1486 __PACKAGE__->register_method(
1487     method    => "create_serial_record_xml",
1488     api_name  => "open-ils.cat.serial.record.xml.create",
1489     signature => q/
1490         Inserts a new serial record with the given XML
1491     /
1492 );
1493
1494 sub create_serial_record_xml {
1495     my( $self, $client, $login, $source, $owning_lib, $record_id, $xml, $oargs ) = @_;
1496
1497     my $override = 1 if $self->api_name =~ /override/; # not currently used
1498     $oargs = { all => 1 } unless defined $oargs; # Not currently used, but here for consistency.
1499
1500     my $e = new_editor(xact=>1, authtoken=>$login);
1501     return $e->die_event unless $e->checkauth;
1502     return $e->die_event unless $e->allowed('CREATE_MFHD_RECORD', $owning_lib);
1503
1504     # Auto-populate the location field of a placeholder MFHD record with the library name
1505     my $aou = $e->retrieve_actor_org_unit($owning_lib) or return $e->die_event;
1506
1507     my $mfhd = Fieldmapper::serial::record_entry->new;
1508
1509     $mfhd->source($source) if $source;
1510     $mfhd->record($record_id);
1511     $mfhd->creator($e->requestor->id);
1512     $mfhd->editor($e->requestor->id);
1513     $mfhd->create_date('now');
1514     $mfhd->edit_date('now');
1515     $mfhd->owning_lib($owning_lib);
1516
1517     # If the caller did not pass in MFHD XML, create a placeholder record.
1518     # The placeholder will only contain the name of the owning library.
1519     # The goal is to generate common patterns for the caller in the UI that
1520     # then get passed in here.
1521     if (!$xml) {
1522         my $aou_name = $aou->name;
1523         $xml = <<HERE;
1524 <record
1525  xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1526  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
1527  xmlns="http://www.loc.gov/MARC21/slim">
1528 <leader>00307ny  a22001094  4500</leader>
1529 <controlfield tag="001">42153</controlfield>
1530 <controlfield tag="005">20090601182414.0</controlfield>
1531 <controlfield tag="004">$record_id</controlfield>
1532 <controlfield tag="008">      4u####8###l# 4   uueng1      </controlfield>
1533 <datafield tag="852" ind1=" " ind2=" "> <subfield code="b">$aou_name</subfield></datafield>
1534 </record>
1535 HERE
1536     }
1537     my $marcxml = XML::LibXML->new->parse_string($xml);
1538     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim", "marc", 1 );
1539     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim");
1540
1541     $mfhd->marc($U->entityize($marcxml->documentElement->toString));
1542
1543     $e->create_serial_record_entry($mfhd) or return $e->die_event;
1544
1545     $e->commit;
1546     return $mfhd->id;
1547 }
1548
1549 __PACKAGE__->register_method(
1550     method   => "create_update_asset_copy_template",
1551     api_name => "open-ils.cat.asset.copy_template.create_or_update"
1552 );
1553
1554 sub create_update_asset_copy_template {
1555     my ($self, $client, $authtoken, $act) = @_;
1556
1557     my $e = new_editor("xact" => 1, "authtoken" => $authtoken);
1558     return $e->die_event unless $e->checkauth;
1559     return $e->die_event unless $e->allowed(
1560         "ADMIN_ASSET_COPY_TEMPLATE", $act->owning_lib
1561     );
1562
1563     $act->editor($e->requestor->id);
1564     $act->edit_date("now");
1565
1566     my $retval;
1567     if (!$act->id) {
1568         $act->creator($e->requestor->id);
1569         $act->create_date("now");
1570
1571         $e->create_asset_copy_template($act) or return $e->die_event;
1572         $retval = $e->data;
1573     } else {
1574         $e->update_asset_copy_template($act) or return $e->die_event;
1575         $retval = $e->retrieve_asset_copy_template($e->data);
1576     }
1577     $e->commit and return $retval;
1578 }
1579
1580 __PACKAGE__->register_method(
1581     method      => "acn_sms_msg",
1582     api_name    => "open-ils.cat.acn.send_sms_text",
1583     signature   => q^
1584         Send an SMS text from an A/T template for specified call numbers.
1585
1586         First parameter is null or an auth token (whether a null is allowed
1587         depends on the sms.disable_authentication_requirement.callnumbers OU
1588         setting).
1589
1590         Second parameter is the id of the context org.
1591
1592         Third parameter is the code of the SMS carrier from the
1593         config.sms_carrier table.
1594
1595         Fourth parameter is the SMS number.
1596
1597         Fifth parameter is the ACN id's to target, though currently only the
1598         first ACN is used by the template (and the UI is only sending one).
1599     ^
1600 );
1601
1602 sub acn_sms_msg {
1603     my($self, $conn, $auth, $org_id, $carrier, $number, $target_ids) = @_;
1604
1605     my $sms_enable = $U->ou_ancestor_setting_value(
1606         $org_id || $U->get_org_tree->id,
1607         'sms.enable'
1608     );
1609     # We could maybe make a Validator for this on the templates
1610     if (! $U->is_true($sms_enable)) {
1611         return -1;
1612     }
1613
1614     my $disable_auth = $U->ou_ancestor_setting_value(
1615         $org_id || $U->get_org_tree->id,
1616         'sms.disable_authentication_requirement.callnumbers'
1617     );
1618
1619     my $e = new_editor(
1620         (defined $auth)
1621         ? (authtoken => $auth, xact => 1)
1622         : (xact => 1)
1623     );
1624     return $e->event unless $disable_auth || $e->checkauth;
1625
1626     my $targets = $e->batch_retrieve_asset_call_number($target_ids);
1627
1628     $e->rollback; # FIXME using transaction because of pgpool/slony setups, but not
1629                   # simply making this method authoritative because of weirdness
1630                   # with transaction handling in A/T code that causes rollback
1631                   # failure down the line if handling many targets
1632
1633     return undef unless @$targets;
1634     return $U->fire_object_event(
1635         undef,                    # event_def
1636         'acn.format.sms_text',    # hook
1637         $targets,
1638         $org_id,
1639         undef,                    # granularity
1640         {                         # user_data
1641             sms_carrier => $carrier,
1642             sms_notify => $number
1643         }
1644     );
1645 }
1646
1647
1648
1649 __PACKAGE__->register_method(
1650     method    => "fixed_field_values_by_rec_type",
1651     api_name  => "open-ils.cat.biblio.fixed_field_values.by_rec_type",
1652     argc      => 2,
1653     signature => {
1654         desc   => 'Given a record type (as in cmfpm.rec_type), return fixed fields and their possible values as known to the DB',
1655         params => [
1656             {desc => 'Record Type', type => 'string'},
1657             {desc => '(Optional) Fixed field', type => 'string'},
1658         ]
1659     },
1660     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' }
1661 );
1662
1663
1664 sub fixed_field_values_by_rec_type {
1665     my ($self, $conn, $rec_type, $fixed_field) = @_;
1666
1667     my $e = new_editor;
1668     my $values = $e->json_query({
1669         select => {
1670             crad  => ["fixed_field"],
1671             ccvm  => [qw/code value/],
1672             cmfpm => [qw/length default_val/],
1673         },
1674         distinct => 1,
1675         from => {
1676             ccvm => {
1677                 crad => {
1678                     join => {
1679                         cmfpm => {
1680                             fkey => "fixed_field",
1681                             field => "fixed_field"
1682                         }
1683                     }
1684                 }
1685             }
1686         },
1687         where => {
1688             "+cmfpm" => {rec_type => $rec_type},
1689             defined $fixed_field ?
1690                 ("+crad" => {fixed_field => $fixed_field}) : ()
1691         },
1692         order_by => [
1693             {class => "crad", field => "fixed_field"},
1694             {class => "ccvm", field => "code"}
1695         ]
1696     }) or return $e->die_event;
1697
1698     my $result = {};
1699     for my $row (@$values) {
1700         $result->{$row->{fixed_field}} ||= [];
1701         push @{$result->{$row->{fixed_field}}}, [@$row{qw/code value length default_val/}];
1702     }
1703
1704     return $result;
1705 }
1706
1707 __PACKAGE__->register_method(
1708     method    => "retrieve_tag_table",
1709     api_name  => "open-ils.cat.tag_table.all.retrieve.local",
1710     stream    => 1,
1711     argc      => 3,
1712     signature => {
1713         desc   => "Retrieve set of MARC tags, subfields, and indicator values for the user's OU",
1714         params => [
1715             {desc => 'Authtoken', type => 'string'},
1716             {desc => 'MARC Format', type => 'string'},
1717             {desc => 'MARC Record Type', type => 'string'},
1718         ]
1719     },
1720     return => {desc => 'Structure representing the tag table available to that user', type => 'object' }
1721 );
1722 __PACKAGE__->register_method(
1723     method    => "retrieve_tag_table",
1724     api_name  => "open-ils.cat.tag_table.all.retrieve.stock",
1725     stream    => 1,
1726     argc      => 3,
1727     signature => {
1728         desc   => 'Retrieve set of MARC tags, subfields, and indicator values for stock MARC standard',
1729         params => [
1730             {desc => 'Authtoken', type => 'string'},
1731             {desc => 'MARC Format', type => 'string'},
1732             {desc => 'MARC Record Type', type => 'string'},
1733         ]
1734     },
1735     return => {desc => 'Structure representing the stock tag table', type => 'object' }
1736 );
1737 __PACKAGE__->register_method(
1738     method    => "retrieve_tag_table",
1739     api_name  => "open-ils.cat.tag_table.field_list.retrieve.local",
1740     stream    => 1,
1741     argc      => 3,
1742     signature => {
1743         desc   => "Retrieve set of MARC tags for available to the user's OU",
1744         params => [
1745             {desc => 'Authtoken', type => 'string'},
1746             {desc => 'MARC Format', type => 'string'},
1747             {desc => 'MARC Record Type', type => 'string'},
1748         ]
1749     },
1750     return => {desc => 'Structure representing the tags available to that user', type => 'object' }
1751 );
1752 __PACKAGE__->register_method(
1753     method    => "retrieve_tag_table",
1754     api_name  => "open-ils.cat.tag_table.field_list.retrieve.stock",
1755     stream    => 1,
1756     argc      => 3,
1757     signature => {
1758         desc   => 'Retrieve set of MARC tags for stock MARC standard',
1759         params => [
1760             {desc => 'Authtoken', type => 'string'},
1761             {desc => 'MARC Format', type => 'string'},
1762             {desc => 'MARC Record Type', type => 'string'},
1763         ]
1764     },
1765     return => {desc => 'Structure representing the stock MARC tags', type => 'object' }
1766 );
1767
1768 sub retrieve_tag_table {
1769     my( $self, $conn, $auth, $marc_format, $marc_record_type ) = @_;
1770     my $e = new_editor( authtoken=>$auth, xact=>1 );
1771     return $e->die_event unless $e->checkauth;
1772
1773     my $field_list_only = ($self->api_name =~ /\.field_list\./) ? 1 : 0;
1774     my $context_ou;
1775     if ($self->api_name =~ /\.local$/) {
1776         $context_ou = $e->requestor->ws_ou;
1777     }
1778
1779     my %sf_by_tag;
1780     unless ($field_list_only) {
1781         my $subfields = $e->json_query(
1782             { from => [ 'config.ou_marc_subfields', 1, $marc_record_type, $context_ou ] }
1783         );
1784         foreach my $sf (@$subfields) {
1785             my $sf_data = {
1786                 code        => $sf->{code},
1787                 description => $sf->{description},
1788                 mandatory   => $sf->{mandatory},
1789                 repeatable   => $sf->{repeatable},
1790             };
1791             if ($sf->{value_ctype}) {
1792                 $sf_data->{value_list} = $e->json_query({
1793                     select => { ccvm => [
1794                                             'code',
1795                                             { column => 'value', alias => 'description' }
1796                                         ]
1797                               },
1798                     from   => 'ccvm',
1799                     where  => { ctype => $sf->{value_ctype} },
1800                     order_by => { ccvm => { code => {} } },
1801                 });
1802             }
1803             push @{ $sf_by_tag{$sf->{tag}} }, $sf_data;
1804         }
1805     }
1806
1807     my $fields = $e->json_query(
1808         { from => [ 'config.ou_marc_fields', 1, $marc_record_type, $context_ou ] }
1809     );
1810
1811     foreach my $field (@$fields) {
1812         next if $field->{hidden} eq 't';
1813         unless ($field_list_only) {
1814             my $tag = $field->{tag};
1815             if ($tag ge '010') {
1816                 for my $pos (1..2) {
1817                     my $ind_ccvm_key = "${marc_format}_${marc_record_type}_${tag}_ind_${pos}";
1818                     my $indvals = $e->json_query({
1819                         select => { ccvm => [
1820                                                 'code',
1821                                                 { column => 'value', alias => 'description' }
1822                                             ]
1823                                   },
1824                         from   => 'ccvm',
1825                         where  => { ctype => $ind_ccvm_key }
1826                     });
1827                     next unless defined($indvals);
1828                     $field->{"ind$pos"} = $indvals;
1829                 }
1830                 $field->{subfields} = exists($sf_by_tag{$tag}) ? $sf_by_tag{$tag} : [];
1831             }
1832         }
1833         $conn->respond($field);
1834     }
1835 }
1836
1837 1;
1838
1839 # vi:et:ts=4:sw=4