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