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
1180             # Three cases here:
1181             #   1) We're editing a volume, and not its copies.
1182             #   2) We're editing a volume, and a subset of its copies.
1183             #   3) We're editing a volume, and all of its copies.
1184             #
1185             # For 1) and 3), we definitely want to edit the volume
1186             # itself (and possibly auto-merge), but for 2), we want
1187             # to create a new volume (and possibly auto-merge).
1188
1189             if (scalar(@$copies) == 0) { # case 1
1190
1191                 my $resp = update_volume($vol, $editor, ($oargs->{all} or grep { $_ eq 'VOLUME_LABEL_EXISTS' } @{$oargs->{events}} or $auto_merge_vols));
1192                 return $resp->{evt} if $resp->{evt};
1193                 $vol = $resp->{merge_vol} if $resp->{merge_vol};
1194
1195             } else {
1196
1197                 my $resp = $editor->json_query({
1198                   select => {
1199                     acp => [
1200                       {transform => 'count', aggregate => 1, column => 'id', alias => 'count'}
1201                     ]
1202                   },
1203                   from => 'acp',
1204                   where => {
1205                     call_number => $vol->id,
1206                     deleted => 'f',
1207                     id => {'not in' => [ map { $_->id } @$copies ]}
1208                   }
1209                 });
1210                 if ($resp->[0]->{count} && $resp->[0]->{count} > 0) { # case 2
1211
1212                     ($vol,$evt) = $assetcom->create_volume( $auto_merge_vols ? { all => 1} : $oargs, $editor, $vol );
1213                     return $evt if $evt;
1214
1215                 } else { # case 3
1216
1217                     my $resp = update_volume($vol, $editor, ($oargs->{all} or grep { $_ eq 'VOLUME_LABEL_EXISTS' } @{$oargs->{events}} or $auto_merge_vols));
1218                     return $resp->{evt} if $resp->{evt};
1219                     $vol = $resp->{merge_vol} if $resp->{merge_vol};
1220                 }
1221
1222             }
1223         }
1224
1225         # now update any attached copies
1226         if( $copies and @$copies and !$vol->isdeleted ) {
1227             $_->call_number($vol->id) for @$copies;
1228             $evt = $assetcom->update_fleshed_copies(
1229                 $editor, $oargs, $vol, $copies, $delete_stats, $retarget_holds, undef, $create_parts);
1230             return $evt if $evt;
1231             push( @$copy_ids, $_->id ) for @$copies;
1232         }
1233     }
1234
1235     $editor->finish;
1236     reset_hold_list($auth, $retarget_holds);
1237     if ($options->{return_copy_ids}) {
1238         return $copy_ids;
1239     } else {
1240         return scalar(@$volumes);
1241     }
1242 }
1243
1244
1245 sub update_volume {
1246     my $vol = shift;
1247     my $editor = shift;
1248     my $auto_merge = shift;
1249     my $evt;
1250     my $merge_vol;
1251
1252     return {evt => $editor->event} unless
1253         $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
1254
1255     return {evt => $evt}
1256         if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $vol->owning_lib) );
1257
1258     my $vols = $editor->search_asset_call_number({
1259         owning_lib => $vol->owning_lib,
1260         record     => $vol->record,
1261         label      => $vol->label,
1262         prefix     => $vol->prefix,
1263         suffix     => $vol->suffix,
1264         deleted    => 'f',
1265         id         => {'!=' => $vol->id}
1266     });
1267
1268     if(@$vols) {
1269
1270         if($auto_merge) {
1271
1272             # If the auto-merge option is on, merge our updated volume into the existing
1273             # volume with the same record + owner + label.
1274             ($merge_vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $vols->[0]);
1275             return {evt => $evt, merge_vol => $merge_vol};
1276
1277         } else {
1278             return {evt => OpenILS::Event->new('VOLUME_LABEL_EXISTS', payload => $vol->id)};
1279         }
1280     }
1281
1282     return {evt => $editor->die_event} unless $editor->update_asset_call_number($vol);
1283     return {};
1284 }
1285
1286
1287
1288 __PACKAGE__->register_method (
1289     method   => 'delete_bib_record',
1290     api_name => 'open-ils.cat.biblio.record_entry.delete');
1291
1292 sub delete_bib_record {
1293     my($self, $conn, $auth, $rec_id) = @_;
1294     my $e = new_editor(xact=>1, authtoken=>$auth);
1295     return $e->die_event unless $e->checkauth;
1296     return $e->die_event unless $e->allowed('DELETE_RECORD', $e->requestor->ws_ou);
1297     my $vols = $e->search_asset_call_number({record=>$rec_id, deleted=>'f'});
1298     return OpenILS::Event->new('RECORD_NOT_EMPTY', payload=>$rec_id) if @$vols;
1299     my $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $rec_id);
1300     if($evt) { $e->rollback; return $evt; }
1301     $e->commit;
1302     return 1;
1303 }
1304
1305
1306
1307 __PACKAGE__->register_method (
1308     method   => 'batch_volume_transfer',
1309     api_name => 'open-ils.cat.asset.volume.batch.transfer',
1310 );
1311
1312 __PACKAGE__->register_method (
1313     method   => 'batch_volume_transfer',
1314     api_name => 'open-ils.cat.asset.volume.batch.transfer.override',
1315 );
1316
1317
1318 sub batch_volume_transfer {
1319     my( $self, $conn, $auth, $args, $oargs ) = @_;
1320
1321     my $evt;
1322     my $rec     = $$args{docid};
1323     my $o_lib   = $$args{lib};
1324     my $vol_ids = $$args{volumes};
1325
1326     my $override = 1 if $self->api_name =~ /override/;
1327     $oargs = { all => 1 } unless defined $oargs;
1328
1329     $logger->info("merge: transferring volumes to lib=$o_lib and record=$rec");
1330
1331     my $e = new_editor(authtoken => $auth, xact =>1);
1332     return $e->event unless $e->checkauth;
1333     return $e->event unless $e->allowed('UPDATE_VOLUME', $o_lib);
1334
1335     my $dorg = $e->retrieve_actor_org_unit($o_lib)
1336         or return $e->event;
1337
1338     my $ou_type = $e->retrieve_actor_org_unit_type($dorg->ou_type)
1339         or return $e->event;
1340
1341     return $evt if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($e, $o_lib) );
1342
1343     my $vols = $e->batch_retrieve_asset_call_number($vol_ids);
1344     my @seen;
1345
1346    my @rec_ids;
1347
1348     for my $vol (@$vols) {
1349
1350         # if we've already looked at this volume, go to the next
1351         next if !$vol or grep { $vol->id == $_ } @seen;
1352
1353         # grab all of the volumes in the list that have
1354         # the same label so they can be merged
1355         my @all = grep { $_->label eq $vol->label } @$vols;
1356
1357         # take note of the fact that we've looked at this set of volumes
1358         push( @seen, $_->id ) for @all;
1359         push( @rec_ids, $_->record ) for @all;
1360
1361         # for each volume, see if there are any copies that have a
1362         # remote circ_lib (circ_lib != vol->owning_lib and != $o_lib ).
1363         # if so, warn them
1364         unless( $override && ($oargs->{all} || grep { $_ eq 'COPY_REMOTE_CIRC_LIB' } @{$oargs->{events}}) ) {
1365             for my $v (@all) {
1366
1367                 $logger->debug("merge: searching for copies with remote circ_lib for volume ".$v->id);
1368                 my $args = {
1369                     call_number => $v->id,
1370                     circ_lib    => { "not in" => [ $o_lib, $v->owning_lib ] },
1371                     deleted     => 'f'
1372                 };
1373
1374                 my $copies = $e->search_asset_copy($args, {idlist=>1});
1375
1376                 # if the copy's circ_lib matches the destination lib,
1377                 # that's ok too
1378                 return OpenILS::Event->new('COPY_REMOTE_CIRC_LIB') if @$copies;
1379             }
1380         }
1381
1382         # record the difference between the destination bib and the present bib
1383         my $same_bib = $vol->record == $rec;
1384
1385         # see if there is a volume at the destination lib that
1386         # already has the requested label
1387         my $existing_vol = $e->search_asset_call_number(
1388             {
1389                 label      => $vol->label,
1390                 prefix     => $vol->prefix,
1391                 suffix     => $vol->suffix,
1392                 record     => $rec,
1393                 owning_lib => $o_lib,
1394                 deleted    => 'f'
1395             }
1396         )->[0];
1397
1398         if( $existing_vol ) {
1399
1400             if( grep { $_->id == $existing_vol->id } @all ) {
1401                 # this volume is already accounted for in our list of volumes to merge
1402                 $existing_vol = undef;
1403
1404             } else {
1405                 # this volume exists on the destination record/owning_lib and must
1406                 # be used as the destination for merging
1407                 $logger->debug("merge: volume already exists at destination record: ".
1408                     $existing_vol->id.' : '.$existing_vol->label) if $existing_vol;
1409             }
1410         }
1411
1412         if( @all > 1 || $existing_vol ) {
1413             $logger->info("merge: found collisions in volume transfer");
1414             my @args = ($e, \@all);
1415             @args = ($e, \@all, $existing_vol) if $existing_vol;
1416             ($vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes(@args);
1417             return $evt if $evt;
1418         }
1419
1420         if( !$existing_vol ) {
1421
1422             $vol->owning_lib($o_lib);
1423             $vol->record($rec);
1424             $vol->editor($e->requestor->id);
1425             $vol->edit_date('now');
1426
1427             $logger->info("merge: updating volume ".$vol->id);
1428             $e->update_asset_call_number($vol) or return $e->event;
1429
1430         } else {
1431             $logger->info("merge: bypassing volume update because existing volume used as target");
1432         }
1433
1434         # regardless of what volume was used as the destination,
1435         # update any copies that have moved over to the new lib
1436         my $copies = $e->search_asset_copy([
1437             { call_number => $vol->id , deleted => 'f' },
1438             {
1439                 flesh => 1,
1440                 flesh_fields => { acp => ['parts'] }
1441             }
1442         ]);
1443
1444         # update circ lib on the copies - make this a method flag?
1445         for my $copy (@$copies) {
1446             next if $copy->circ_lib == $o_lib;
1447             $logger->info("merge: transfer moving circ lib on copy ".$copy->id);
1448             $copy->circ_lib($o_lib);
1449             $copy->editor($e->requestor->id);
1450             $copy->edit_date('now');
1451             $e->update_asset_copy($copy) or return $e->event;
1452         }
1453
1454         # update parts if volume is moving bib records
1455         if( !$same_bib ) {
1456             for my $copy (@$copies) {
1457                 my $parts = $copy->parts;
1458                 next unless $parts;
1459                 my $part_objs = [];
1460                 foreach my $part (@$parts) {
1461                     my $part_label = $part->label;
1462                     my $part_obj = $e->search_biblio_monograph_part(
1463                        {
1464                             label=>$part_label,
1465                             record=>$rec,
1466                             deleted=>'f'
1467                        }
1468                     )->[0];
1469
1470                     if (!$part_obj) {
1471                         $part_obj = Fieldmapper::biblio::monograph_part->new();
1472                         $part_obj->label( $part_label );
1473                         $part_obj->record( $rec );
1474                         unless($e->create_biblio_monograph_part($part_obj)) {
1475                           return $e->die_event if $e->die_event;
1476                         }
1477                     }
1478                     push @$part_objs, $part_obj;
1479                 }
1480
1481                 $copy->parts( $part_objs );
1482                 $copy->ischanged(1);
1483                 $evt = OpenILS::Application::Cat::AssetCommon->update_copy_parts($e, $copy, 1); #delete_parts=1
1484                 return $evt if $evt;
1485             }
1486         }
1487
1488         # Now see if any empty records need to be deleted after all of this
1489
1490         for(@rec_ids) {
1491             $logger->debug("merge: seeing if we should delete record $_...");
1492             $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $_)
1493                 if OpenILS::Application::Cat::BibCommon->title_is_empty($e, $_);
1494             return $evt if $evt;
1495         }
1496     }
1497
1498     $logger->info("merge: transfer succeeded");
1499     $e->commit;
1500     return 1;
1501 }
1502
1503
1504
1505
1506 __PACKAGE__->register_method(
1507     api_name => 'open-ils.cat.call_number.find_or_create',
1508     method   => 'find_or_create_volume',
1509 );
1510
1511 sub find_or_create_volume {
1512     my( $self, $conn, $auth, $label, $record_id, $org_id, $prefix, $suffix, $label_class ) = @_;
1513     my $e = new_editor(authtoken=>$auth, xact=>1);
1514     return $e->die_event unless $e->checkauth;
1515     my ($vol, $evt, $exists) =
1516         OpenILS::Application::Cat::AssetCommon->find_or_create_volume($e, $label, $record_id, $org_id, $prefix, $suffix, $label_class);
1517     return $evt if $evt;
1518     $e->rollback if $exists;
1519     $e->commit if $vol;
1520     return { 'acn_id' => $vol->id, 'existed' => $exists };
1521 }
1522
1523
1524 __PACKAGE__->register_method(
1525     method    => "create_serial_record_xml",
1526     api_name  => "open-ils.cat.serial.record.xml.create.override",
1527     signature => q/@see open-ils.cat.serial.record.xml.create/);
1528
1529 __PACKAGE__->register_method(
1530     method    => "create_serial_record_xml",
1531     api_name  => "open-ils.cat.serial.record.xml.create",
1532     signature => q/
1533         Inserts a new serial record with the given XML
1534     /
1535 );
1536
1537 sub create_serial_record_xml {
1538     my( $self, $client, $login, $source, $owning_lib, $record_id, $xml, $oargs ) = @_;
1539
1540     my $override = 1 if $self->api_name =~ /override/; # not currently used
1541     $oargs = { all => 1 } unless defined $oargs; # Not currently used, but here for consistency.
1542
1543     my $e = new_editor(xact=>1, authtoken=>$login);
1544     return $e->die_event unless $e->checkauth;
1545     return $e->die_event unless $e->allowed('CREATE_MFHD_RECORD', $owning_lib);
1546
1547     # Auto-populate the location field of a placeholder MFHD record with the library name
1548     my $aou = $e->retrieve_actor_org_unit($owning_lib) or return $e->die_event;
1549
1550     my $mfhd = Fieldmapper::serial::record_entry->new;
1551
1552     $mfhd->source($source) if $source;
1553     $mfhd->record($record_id);
1554     $mfhd->creator($e->requestor->id);
1555     $mfhd->editor($e->requestor->id);
1556     $mfhd->create_date('now');
1557     $mfhd->edit_date('now');
1558     $mfhd->owning_lib($owning_lib);
1559
1560     # If the caller did not pass in MFHD XML, create a placeholder record.
1561     # The placeholder will only contain the name of the owning library.
1562     # The goal is to generate common patterns for the caller in the UI that
1563     # then get passed in here.
1564     if (!$xml) {
1565         my $aou_name = $aou->name;
1566         $xml = <<HERE;
1567 <record
1568  xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1569  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
1570  xmlns="http://www.loc.gov/MARC21/slim">
1571 <leader>00307ny  a22001094  4500</leader>
1572 <controlfield tag="001">42153</controlfield>
1573 <controlfield tag="005">20090601182414.0</controlfield>
1574 <controlfield tag="004">$record_id</controlfield>
1575 <controlfield tag="008">      4u####8###l# 4   uueng1      </controlfield>
1576 <datafield tag="852" ind1=" " ind2=" "> <subfield code="b">$aou_name</subfield></datafield>
1577 </record>
1578 HERE
1579     }
1580     my $marcxml = XML::LibXML->new->parse_string($xml);
1581     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim", "marc", 1 );
1582     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim");
1583
1584     $mfhd->marc($U->entityize($marcxml->documentElement->toString));
1585
1586     $e->create_serial_record_entry($mfhd) or return $e->die_event;
1587
1588     $e->commit;
1589     return $mfhd->id;
1590 }
1591
1592 __PACKAGE__->register_method(
1593     method   => "create_update_asset_copy_template",
1594     api_name => "open-ils.cat.asset.copy_template.create_or_update"
1595 );
1596
1597 sub create_update_asset_copy_template {
1598     my ($self, $client, $authtoken, $act) = @_;
1599
1600     my $e = new_editor("xact" => 1, "authtoken" => $authtoken);
1601     return $e->die_event unless $e->checkauth;
1602     return $e->die_event unless $e->allowed(
1603         "ADMIN_ASSET_COPY_TEMPLATE", $act->owning_lib
1604     );
1605
1606     $act->editor($e->requestor->id);
1607     $act->edit_date("now");
1608
1609     my $retval;
1610     if (!$act->id) {
1611         $act->creator($e->requestor->id);
1612         $act->create_date("now");
1613
1614         $e->create_asset_copy_template($act) or return $e->die_event;
1615         $retval = $e->data;
1616     } else {
1617         $e->update_asset_copy_template($act) or return $e->die_event;
1618         $retval = $e->retrieve_asset_copy_template($e->data);
1619     }
1620     $e->commit and return $retval;
1621 }
1622
1623 __PACKAGE__->register_method(
1624     method      => "acn_sms_msg",
1625     api_name    => "open-ils.cat.acn.send_sms_text",
1626     signature   => q^
1627         Send an SMS text from an A/T template for specified call numbers.
1628
1629         First parameter is null or an auth token (whether a null is allowed
1630         depends on the sms.disable_authentication_requirement.callnumbers OU
1631         setting).
1632
1633         Second parameter is the id of the context org.
1634
1635         Third parameter is the code of the SMS carrier from the
1636         config.sms_carrier table.
1637
1638         Fourth parameter is the SMS number.
1639
1640         Fifth parameter is the ACN id's to target, though currently only the
1641         first ACN is used by the template (and the UI is only sending one).
1642     ^
1643 );
1644
1645 sub acn_sms_msg {
1646     my($self, $conn, $auth, $org_id, $carrier, $number, $target_ids) = @_;
1647
1648     my $sms_enable = $U->ou_ancestor_setting_value(
1649         $org_id || $U->get_org_tree->id,
1650         'sms.enable'
1651     );
1652     # We could maybe make a Validator for this on the templates
1653     if (! $U->is_true($sms_enable)) {
1654         return -1;
1655     }
1656
1657     my $disable_auth = $U->ou_ancestor_setting_value(
1658         $org_id || $U->get_org_tree->id,
1659         'sms.disable_authentication_requirement.callnumbers'
1660     );
1661
1662     my $e = new_editor(
1663         (defined $auth)
1664         ? (authtoken => $auth, xact => 1)
1665         : (xact => 1)
1666     );
1667     return $e->event unless $disable_auth || $e->checkauth;
1668
1669     my $targets = $e->batch_retrieve_asset_call_number($target_ids);
1670
1671     $e->rollback; # FIXME using transaction because of pgpool/slony setups, but not
1672                   # simply making this method authoritative because of weirdness
1673                   # with transaction handling in A/T code that causes rollback
1674                   # failure down the line if handling many targets
1675
1676     return undef unless @$targets;
1677     return $U->fire_object_event(
1678         undef,                    # event_def
1679         'acn.format.sms_text',    # hook
1680         $targets,
1681         $org_id,
1682         undef,                    # granularity
1683         {                         # user_data
1684             sms_carrier => $carrier,
1685             sms_notify => $number
1686         }
1687     );
1688 }
1689
1690
1691
1692 __PACKAGE__->register_method(
1693     method    => "fixed_field_values_by_rec_type",
1694     api_name  => "open-ils.cat.biblio.fixed_field_values.by_rec_type",
1695     argc      => 2,
1696     signature => {
1697         desc   => 'Given a record type (as in cmfpm.rec_type), return fixed fields and their possible values as known to the DB',
1698         params => [
1699             {desc => 'Record Type', type => 'string'},
1700             {desc => '(Optional) Fixed field', type => 'string'},
1701         ]
1702     },
1703     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' }
1704 );
1705
1706
1707 sub fixed_field_values_by_rec_type {
1708     my ($self, $conn, $rec_type, $fixed_field) = @_;
1709
1710     my $e = new_editor;
1711     my $values = $e->json_query({
1712         select => {
1713             crad  => ["fixed_field"],
1714             ccvm  => [qw/code value/],
1715             cmfpm => [qw/length default_val/],
1716         },
1717         distinct => 1,
1718         from => {
1719             ccvm => {
1720                 crad => {
1721                     join => {
1722                         cmfpm => {
1723                             fkey => "fixed_field",
1724                             field => "fixed_field"
1725                         }
1726                     }
1727                 }
1728             }
1729         },
1730         where => {
1731             "+cmfpm" => {rec_type => $rec_type},
1732             defined $fixed_field ?
1733                 ("+crad" => {fixed_field => $fixed_field}) : ()
1734         },
1735         order_by => [
1736             {class => "crad", field => "fixed_field"},
1737             {class => "ccvm", field => "code"}
1738         ]
1739     }) or return $e->die_event;
1740
1741     my $result = {};
1742     for my $row (@$values) {
1743         $result->{$row->{fixed_field}} ||= [];
1744         push @{$result->{$row->{fixed_field}}}, [@$row{qw/code value length default_val/}];
1745     }
1746
1747     return $result;
1748 }
1749
1750 __PACKAGE__->register_method(
1751     method    => "retrieve_tag_table",
1752     api_name  => "open-ils.cat.tag_table.all.retrieve.local",
1753     stream    => 1,
1754     argc      => 3,
1755     signature => {
1756         desc   => "Retrieve set of MARC tags, subfields, and indicator values for the user's OU",
1757         params => [
1758             {desc => 'Authtoken', type => 'string'},
1759             {desc => 'MARC Format', type => 'string'},
1760             {desc => 'MARC Record Type', type => 'string'},
1761         ]
1762     },
1763     return => {desc => 'Structure representing the tag table available to that user', type => 'object' }
1764 );
1765 __PACKAGE__->register_method(
1766     method    => "retrieve_tag_table",
1767     api_name  => "open-ils.cat.tag_table.all.retrieve.stock",
1768     stream    => 1,
1769     argc      => 3,
1770     signature => {
1771         desc   => 'Retrieve set of MARC tags, subfields, and indicator values for stock MARC standard',
1772         params => [
1773             {desc => 'Authtoken', type => 'string'},
1774             {desc => 'MARC Format', type => 'string'},
1775             {desc => 'MARC Record Type', type => 'string'},
1776         ]
1777     },
1778     return => {desc => 'Structure representing the stock tag table', type => 'object' }
1779 );
1780 __PACKAGE__->register_method(
1781     method    => "retrieve_tag_table",
1782     api_name  => "open-ils.cat.tag_table.field_list.retrieve.local",
1783     stream    => 1,
1784     argc      => 3,
1785     signature => {
1786         desc   => "Retrieve set of MARC tags for available to the user's OU",
1787         params => [
1788             {desc => 'Authtoken', type => 'string'},
1789             {desc => 'MARC Format', type => 'string'},
1790             {desc => 'MARC Record Type', type => 'string'},
1791         ]
1792     },
1793     return => {desc => 'Structure representing the tags available to that user', type => 'object' }
1794 );
1795 __PACKAGE__->register_method(
1796     method    => "retrieve_tag_table",
1797     api_name  => "open-ils.cat.tag_table.field_list.retrieve.stock",
1798     stream    => 1,
1799     argc      => 3,
1800     signature => {
1801         desc   => 'Retrieve set of MARC tags for stock MARC standard',
1802         params => [
1803             {desc => 'Authtoken', type => 'string'},
1804             {desc => 'MARC Format', type => 'string'},
1805             {desc => 'MARC Record Type', type => 'string'},
1806         ]
1807     },
1808     return => {desc => 'Structure representing the stock MARC tags', type => 'object' }
1809 );
1810
1811 sub retrieve_tag_table {
1812     my( $self, $conn, $auth, $marc_format, $marc_record_type ) = @_;
1813     my $e = new_editor( authtoken=>$auth, xact=>1 );
1814     return $e->die_event unless $e->checkauth;
1815
1816     my $field_list_only = ($self->api_name =~ /\.field_list\./) ? 1 : 0;
1817     my $context_ou;
1818     if ($self->api_name =~ /\.local$/) {
1819         $context_ou = $e->requestor->ws_ou;
1820     }
1821
1822     my %sf_by_tag;
1823     unless ($field_list_only) {
1824         my $subfields = $e->json_query(
1825             { from => [ 'config.ou_marc_subfields', 1, $marc_record_type, $context_ou ] }
1826         );
1827         foreach my $sf (@$subfields) {
1828             my $sf_data = {
1829                 code        => $sf->{code},
1830                 description => $sf->{description},
1831                 mandatory   => $sf->{mandatory},
1832                 repeatable   => $sf->{repeatable},
1833             };
1834             if ($sf->{value_ctype}) {
1835                 $sf_data->{value_list} = $e->json_query({
1836                     select => { ccvm => [
1837                                             'code',
1838                                             { column => 'value', alias => 'description' }
1839                                         ]
1840                               },
1841                     from   => 'ccvm',
1842                     where  => { ctype => $sf->{value_ctype} },
1843                     order_by => { ccvm => { code => {} } },
1844                 });
1845             }
1846             push @{ $sf_by_tag{$sf->{tag}} }, $sf_data;
1847         }
1848     }
1849
1850     my $fields = $e->json_query(
1851         { from => [ 'config.ou_marc_fields', 1, $marc_record_type, $context_ou ] }
1852     );
1853
1854     foreach my $field (@$fields) {
1855         next if $field->{hidden} eq 't';
1856         unless ($field_list_only) {
1857             my $tag = $field->{tag};
1858             if ($tag ge '010') {
1859                 for my $pos (1..2) {
1860                     my $ind_ccvm_key = "${marc_format}_${marc_record_type}_${tag}_ind_${pos}";
1861                     my $indvals = $e->json_query({
1862                         select => { ccvm => [
1863                                                 'code',
1864                                                 { column => 'value', alias => 'description' }
1865                                             ]
1866                                   },
1867                         from   => 'ccvm',
1868                         where  => { ctype => $ind_ccvm_key }
1869                     });
1870                     next unless defined($indvals);
1871                     $field->{"ind$pos"} = $indvals;
1872                 }
1873                 $field->{subfields} = exists($sf_by_tag{$tag}) ? $sf_by_tag{$tag} : [];
1874             }
1875         }
1876         $conn->respond($field);
1877     }
1878 }
1879
1880 1;
1881
1882 # vi:et:ts=4:sw=4