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