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