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