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 ) = @_;
 110
 111     my $override = 1 if $self->api_name =~ /override/;
 112
 113     my( $user_obj, $evt ) = $U->checksesperm($login, 'CREATE_MARC');
 114     return $evt if $evt;
 115
 116     $logger->activity("user ".$user_obj->id." creating new MARC record");
 117
 118     my $meth = $self->method_lookup("open-ils.cat.biblio.record.xml.import");
 119
 120     $meth = $self->method_lookup(
 121         "open-ils.cat.biblio.record.xml.import.override") if $override;
 122
 123     my ($s) = $meth->run($login, $xml, $source);
 124     return $s;
 125 }
 126
 127
 128
 129 __PACKAGE__->register_method(
 130     method    => "biblio_record_replace_marc",
 131     api_name  => "open-ils.cat.biblio.record.xml.update",
 132     argc      => 3,
 133     signature => q/
 134         Updates the XML for a given biblio record.
 135         This does not change any other aspect of the record entry
 136         exception the XML, the editor, and the edit date.
 137         @return The update record object
 138     /
 139 );
 140
 141 __PACKAGE__->register_method(
 142     method    => 'biblio_record_replace_marc',
 143     api_name  => 'open-ils.cat.biblio.record.marc.replace',
 144     signature => q/
 145         @param auth The authtoken
 146         @param recid The record whose MARC we're replacing
 147         @param newxml The new xml to use
 148     /
 149 );
 150
 151 __PACKAGE__->register_method(
 152     method    => 'biblio_record_replace_marc',
 153     api_name  => 'open-ils.cat.biblio.record.marc.replace.override',
 154     signature => q/@see open-ils.cat.biblio.record.marc.replace/
 155 );
 156
 157 sub biblio_record_replace_marc  {
 158     my( $self, $conn, $auth, $recid, $newxml, $source ) = @_;
 159     my $e = new_editor(authtoken=>$auth, xact=>1);
 160     return $e->die_event unless $e->checkauth;
 161     return $e->die_event unless $e->allowed('CREATE_MARC', $e->requestor->ws_ou);
 162
 163     my $fix_tcn = $self->api_name =~ /replace/o;
 164     my $override = $self->api_name =~ /override/o;
 165
 166     my $res = OpenILS::Application::Cat::BibCommon->biblio_record_replace_marc(
 167         $e, $recid, $newxml, $source, $fix_tcn, $override);
 168
 169     $e->commit unless $U->event_code($res);
 170
 171     #my $ses = OpenSRF::AppSession->create('open-ils.ingest');
 172     #$ses->request('open-ils.ingest.full.biblio.record', $recid);
 173
 174     return $res;
 175 }
 176
 177 __PACKAGE__->register_method(
 178     method    => "template_overlay_biblio_record_entry",
 179     api_name  => "open-ils.cat.biblio.record_entry.template_overlay",
 180     stream    => 1,
 181     signature => q#
 182         Overlays biblio.record_entry MARC values
 183         @param auth The authtoken
 184         @param records The record ids to be updated by the template
 185         @param template The overlay template
 186         @return Stream of hashes record id in the key "record" and t or f for the success of the overlay operation in key "success"
 187     #
 188 );
 189
 190 sub template_overlay_biblio_record_entry {
 191     my($self, $conn, $auth, $records, $template) = @_;
 192     my $e = new_editor(authtoken=>$auth, xact=>1);
 193     return $e->die_event unless $e->checkauth;
 194
 195     $records = [$records] if (!ref($records));
 196
 197     for my $rid ( @$records ) {
 198         my $rec = $e->retrieve_biblio_record_entry($rid);
 199         next unless $rec;
 200
 201         unless ($e->allowed('UPDATE_RECORD', $rec->owner, $rec)) {
 202             $conn->respond({ record => $rid, success => 'f' });
 203             next;
 204         }
 205
 206         my $success = $e->json_query(
 207             { from => [ 'vandelay.template_overlay_bib_record', $template, $rid ] }
 208         )->[0]->{'vandelay.template_overlay_bib_record'};
 209
 210         $conn->respond({ record => $rid, success => $success });
 211     }
 212
 213     $e->commit;
 214     return undef;
 215 }
 216
 217 __PACKAGE__->register_method(
 218     method    => "template_overlay_container",
 219     api_name  => "open-ils.cat.container.template_overlay",
 220     stream    => 1,
 221     signature => q#
 222         Overlays biblio.record_entry MARC values
 223         @param auth The authtoken
 224         @param container The container, um, containing the records to be updated by the template
 225         @param template The overlay template, or nothing and the method will look for a negative bib id in the container
 226         @return Stream of hashes record id in the key "record" and t or f for the success of the overlay operation in key "success"
 227     #
 228 );
 229
 230 __PACKAGE__->register_method(
 231     method    => "template_overlay_container",
 232     api_name  => "open-ils.cat.container.template_overlay.background",
 233     stream    => 1,
 234     signature => q#
 235         Overlays biblio.record_entry MARC values
 236         @param auth The authtoken
 237         @param container The container, um, containing the records to be updated by the template
 238         @param template The overlay template, or nothing and the method will look for a negative bib id in the container
 239         @return Cache key to check for status of the container overlay
 240     #
 241 );
 242
 243 sub template_overlay_container {
 244     my($self, $conn, $auth, $container, $template) = @_;
 245     my $e = new_editor(authtoken=>$auth, xact=>1);
 246     return $e->die_event unless $e->checkauth;
 247
 248     my $actor = OpenSRF::AppSession->create('open-ils.actor') if ($self->api_name =~ /background$/);
 249
 250     my $items = $e->search_container_biblio_record_entry_bucket_item({ bucket => $container });
 251
 252     my $titem;
 253     if (!$template) {
 254         ($titem) = grep { $_->target_biblio_record_entry < 0 } @$items;
 255         if (!$titem) {
 256             $e->rollback;
 257             return undef;
 258         }
 259         $items = [grep { $_->target_biblio_record_entry > 0 } @$items];
 260
 261         $template = $e->retrieve_biblio_record_entry( $titem->target_biblio_record_entry )->marc;
 262     }
 263
 264     my $responses = [];
 265     my $some_failed = 0;
 266
 267     $self->respond_complete(
 268         $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses)->gather(1)
 269     ) if ($actor);
 270
 271     for my $item ( @$items ) {
 272         my $rec = $e->retrieve_biblio_record_entry($item->target_biblio_record_entry);
 273         next unless $rec;
 274
 275         my $success = 'f';
 276         if ($e->allowed('UPDATE_RECORD', $rec->owner, $rec)) {
 277             $success = $e->json_query(
 278                 { from => [ 'vandelay.template_overlay_bib_record', $template, $rec->id ] }
 279             )->[0]->{'vandelay.template_overlay_bib_record'};
 280         }
 281
 282         $some_failed++ if ($success eq 'f');
 283
 284         if ($actor) {
 285             push @$responses, { record => $rec->id, success => $success };
 286             $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
 287         } else {
 288             $conn->respond({ record => $rec->id, success => $success });
 289         }
 290
 291         if ($success eq 't') {
 292             unless ($e->delete_container_biblio_record_entry_bucket_item($item)) {
 293                 $e->rollback;
 294                 if ($actor) {
 295                     push @$responses, { complete => 1, success => 'f' };
 296                     $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
 297                     return undef;
 298                 } else {
 299                     return { complete => 1, success => 'f' };
 300                 }
 301             }
 302         }
 303     }
 304
 305     if ($titem && !$some_failed) {
 306         return $e->die_event unless ($e->delete_container_biblio_record_entry_bucket_item($titem));
 307     }
 308
 309     if ($e->commit) {
 310         if ($actor) {
 311             push @$responses, { complete => 1, success => 't' };
 312             $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
 313         } else {
 314             return { complete => 1, success => 't' };
 315         }
 316     } else {
 317         if ($actor) {
 318             push @$responses, { complete => 1, success => 'f' };
 319             $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
 320         } else {
 321             return { complete => 1, success => 'f' };
 322         }
 323     }
 324     return undef;
 325 }
 326
 327 __PACKAGE__->register_method(
 328     method    => "update_biblio_record_entry",
 329     api_name  => "open-ils.cat.biblio.record_entry.update",
 330     signature => q/
 331         Updates a biblio.record_entry
 332         @param auth The authtoken
 333         @param record The record with updated values
 334         @return 1 on success, Event on error.
 335     /
 336 );
 337
 338 sub update_biblio_record_entry {
 339     my($self, $conn, $auth, $record) = @_;
 340     my $e = new_editor(authtoken=>$auth, xact=>1);
 341     return $e->die_event unless $e->checkauth;
 342     return $e->die_event unless $e->allowed('UPDATE_RECORD');
 343     $e->update_biblio_record_entry($record) or return $e->die_event;
 344     $e->commit;
 345     return 1;
 346 }
 347
 348 __PACKAGE__->register_method(
 349     method    => "undelete_biblio_record_entry",
 350     api_name  => "open-ils.cat.biblio.record_entry.undelete",
 351     signature => q/
 352         Un-deletes a record and sets active=true
 353         @param auth The authtoken
 354         @param record The record_id to ressurect
 355         @return 1 on success, Event on error.
 356     /
 357 );
 358 sub undelete_biblio_record_entry {
 359     my($self, $conn, $auth, $record_id) = @_;
 360     my $e = new_editor(authtoken=>$auth, xact=>1);
 361     return $e->die_event unless $e->checkauth;
 362     return $e->die_event unless $e->allowed('UPDATE_RECORD');
 363
 364     my $record = $e->retrieve_biblio_record_entry($record_id)
 365         or return $e->die_event;
 366     $record->deleted('f');
 367     $record->active('t');
 368
 369     # Set the leader/05 to indicate that the record has been corrected/revised
 370     my $marc = $record->marc();
 371     $marc =~ s{(<leader>.{5}).}{$1c};
 372     $record->marc($marc);
 373
 374     # no 2 non-deleted records can have the same tcn_value
 375     my $existing = $e->search_biblio_record_entry(
 376         {   deleted => 'f',
 377             tcn_value => $record->tcn_value,
 378             id => {'!=' => $record_id}
 379         }, {idlist => 1});
 380     return OpenILS::Event->new('TCN_EXISTS') if @$existing;
 381
 382     $e->update_biblio_record_entry($record) or return $e->die_event;
 383     $e->commit;
 384     return 1;
 385 }
 386
 387
 388 __PACKAGE__->register_method(
 389     method    => "biblio_record_xml_import",
 390     api_name  => "open-ils.cat.biblio.record.xml.import.override",
 391     signature => q/@see open-ils.cat.biblio.record.xml.import/);
 392
 393 __PACKAGE__->register_method(
 394     method    => "biblio_record_xml_import",
 395     api_name  => "open-ils.cat.biblio.record.xml.import",
 396     notes     => <<"    NOTES");
 397     Takes a marcxml record and imports the record into the database.  In this
 398     case, the marcxml record is assumed to be a complete record (i.e. valid
 399     MARC).  The title control number is taken from (whichever comes first)
 400     tags 001, 039[ab], 020a, 022a, 010, 035a and whichever does not already exist
 401     in the database.
 402     user_session must have IMPORT_MARC permissions
 403     NOTES
 404
 405
 406 sub biblio_record_xml_import {
 407     my( $self, $client, $authtoken, $xml, $source, $auto_tcn) = @_;
 408     my $e = new_editor(xact=>1, authtoken=>$authtoken);
 409     return $e->die_event unless $e->checkauth;
 410     return $e->die_event unless $e->allowed('IMPORT_MARC', $e->requestor->ws_ou);
 411
 412     my $override = $self->api_name =~ /override/;
 413     my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
 414         $e, $xml, $source, $auto_tcn, $override);
 415
 416     return $record if $U->event_code($record);
 417
 418     $e->commit;
 419
 420     #my $ses = OpenSRF::AppSession->create('open-ils.ingest');
 421     #$ses->request('open-ils.ingest.full.biblio.record', $record->id);
 422
 423     return $record;
 424 }
 425
 426 __PACKAGE__->register_method(
 427     method        => "biblio_record_record_metadata",
 428     api_name      => "open-ils.cat.biblio.record.metadata.retrieve",
 429     authoritative => 1,
 430     argc          => 1, #(session_id, biblio_tree )
 431     notes         => "Walks the tree and commits any changed nodes " .
 432                      "adds any new nodes, and deletes any deleted nodes",
 433 );
 434
 435 sub biblio_record_record_metadata {
 436     my( $self, $client, $authtoken, $ids ) = @_;
 437
 438     return [] unless $ids and @$ids;
 439
 440     my $editor = new_editor(authtoken => $authtoken);
 441     return $editor->event unless $editor->checkauth;
 442     return $editor->event unless $editor->allowed('VIEW_USER');
 443
 444     my @results;
 445
 446     for(@$ids) {
 447         return $editor->event unless
 448             my $rec = $editor->retrieve_biblio_record_entry($_);
 449         $rec->creator($editor->retrieve_actor_user($rec->creator));
 450         $rec->editor($editor->retrieve_actor_user($rec->editor));
 451         $rec->clear_marc; # slim the record down
 452         push( @results, $rec );
 453     }
 454
 455     return \@results;
 456 }
 457
 458
 459
 460 __PACKAGE__->register_method(
 461     method    => "biblio_record_marc_cn",
 462     api_name  => "open-ils.cat.biblio.record.marc_cn.retrieve",
 463     argc      => 1, #(bib id )
 464     signature => {
 465         desc   => 'Extracts call number candidates from a bibliographic record',
 466         params => [
 467             {desc => 'Record ID', type => 'number'},
 468             {desc => '(Optional) Classification scheme ID', type => 'number'},
 469         ]
 470     },
 471     return => {desc => 'Hash of candidate call numbers identified by tag' }
 472 );
 473
 474 sub biblio_record_marc_cn {
 475     my( $self, $client, $id, $class ) = @_;
 476
 477     my $e = new_editor();
 478     my $marc = $e->retrieve_biblio_record_entry($id)->marc;
 479
 480     my $doc = XML::LibXML->new->parse_string($marc);
 481     $doc->documentElement->setNamespace( "http://www.loc.gov/MARC21/slim", "marc", 1 );
 482
 483     my @fields;
 484     my @res;
 485     if ($class) {
 486         @fields = split(/,/, $e->retrieve_asset_call_number_class($class)->field);
 487     } else {
 488         @fields = qw/050ab 055ab 060ab 070ab 080ab 082ab 086ab 088ab 090 092 096 098 099/;
 489     }
 490
 491     # Get field/subfield combos based on acnc value; for example "050ab,055ab"
 492
 493     foreach my $field (@fields) {
 494         my $tag = substr($field, 0, 3);
 495         $logger->debug("Tag = $tag");
 496         my @node = $doc->findnodes("//marc:datafield[\@tag='$tag']");
 497
 498         # Now parse the subfields and build up the subfield XPath
 499         my @subfields = split(//, substr($field, 3));
 500
 501         # If they give us no subfields to parse, default to just the 'a'
 502         if (!@subfields) {
 503             @subfields = ('a');
 504         }
 505         my $subxpath;
 506         foreach my $sf (@subfields) {
 507             $subxpath .= "\@code='$sf' or ";
 508         }
 509         $subxpath = substr($subxpath, 0, -4);
 510         $logger->debug("subxpath = $subxpath");
 511
 512         # Find the contents of the specified subfields
 513         foreach my $x (@node) {
 514             my $cn = $x->findvalue("marc:subfield[$subxpath]");
 515             push @res, {$tag => $cn} if ($cn);
 516         }
 517     }
 518
 519     return \@res;
 520 }
 521
 522 __PACKAGE__->register_method(
 523     method    => 'autogen_barcodes',
 524     api_name  => "open-ils.cat.item.barcode.autogen",
 525     signature => {
 526         desc   => 'Returns N generated barcodes following a specified barcode.',
 527         params => [
 528             {desc => 'Authentication token', type => 'string'},
 529             {desc => 'Barcode which the sequence should follow from', type => 'string'},
 530             {desc => 'Number of barcodes to generate', type => 'number'},
 531             {desc => 'Options hash.  Currently you can pass in checkdigit : false to disable the use of checkdigits.'}
 532         ],
 533         return => {desc => 'Array of generated barcodes'}
 534     }
 535 );
 536
 537 sub autogen_barcodes {
 538     my( $self, $client, $auth, $barcode, $num_of_barcodes, $options ) = @_;
 539     my $e = new_editor(authtoken => $auth);
 540     return $e->event unless $e->checkauth;
 541     return $e->event unless $e->allowed('UPDATE_COPY', $e->requestor->ws_ou);
 542     $options ||= {};
 543
 544     my $barcode_text = '';
 545     my $barcode_number = 0;
 546
 547     if ($barcode =~ /^(\D+)/) { $barcode_text = $1; }
 548     if ($barcode =~ /(\d+)$/) { $barcode_number = $1; }
 549
 550     my @res;
 551     for (my $i = 1; $i <= $num_of_barcodes; $i++) {
 552         my $calculated_barcode;
 553
 554         # default is to use checkdigits, so looking for an explicit false here
 555         if (defined $$options{'checkdigit'} && ! $$options{'checkdigit'}) {
 556             $calculated_barcode = $barcode_number + $i;
 557         } else {
 558             if ($barcode_number =~ /^\d{8}$/) {
 559                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0);
 560             } elsif ($barcode_number =~ /^\d{9}$/) {
 561                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit
 562             } elsif ($barcode_number =~ /^\d{13}$/) {
 563                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0);
 564             } elsif ($barcode_number =~ /^\d{14}$/) {
 565                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit
 566             } else {
 567                 $calculated_barcode = $barcode_number + $i;
 568             }
 569         }
 570         push @res, $barcode_text . $calculated_barcode;
 571     }
 572     return \@res
 573 }
 574
 575 # Codabar doesn't define a checkdigit algorithm, but this one is typically used by libraries.  gmcharlt++
 576 sub add_codabar_checkdigit {
 577     my $barcode = shift;
 578     my $strip_last_digit = shift;
 579
 580     return $barcode if $barcode =~ /\D/;
 581     $barcode = substr($barcode, 0, length($barcode)-1) if $strip_last_digit;
 582     my @digits = split //, $barcode;
 583     my $total = 0;
 584     for (my $i = 1; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 1,3,5,7,9,11
 585         $total += $digits[$i];
 586     }
 587     for (my $i = 0; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 0,2,4,6,8,10,12
 588         $total += (2 * $digits[$i] >= 10) ? (2 * $digits[$i] - 9) : (2 * $digits[$i]);
 589     }
 590     my $remainder = $total % 10;
 591     my $checkdigit = ($remainder == 0) ? $remainder : 10 - $remainder;
 592     return $barcode . $checkdigit;
 593 }
 594
 595 __PACKAGE__->register_method(
 596     method        => "orgs_for_title",
 597     authoritative => 1,
 598     api_name      => "open-ils.cat.actor.org_unit.retrieve_by_title"
 599 );
 600
 601 sub orgs_for_title {
 602     my( $self, $client, $record_id ) = @_;
 603
 604     my $vols = $U->simple_scalar_request(
 605         "open-ils.cstore",
 606         "open-ils.cstore.direct.asset.call_number.search.atomic",
 607         { record => $record_id, deleted => 'f' });
 608
 609     my $orgs = { map {$_->owning_lib => 1 } @$vols };
 610     return [ keys %$orgs ];
 611 }
 612
 613
 614 __PACKAGE__->register_method(
 615     method        => "retrieve_copies",
 616     authoritative => 1,
 617     api_name      => "open-ils.cat.asset.copy_tree.retrieve");
 618
 619 __PACKAGE__->register_method(
 620     method   => "retrieve_copies",
 621     api_name => "open-ils.cat.asset.copy_tree.global.retrieve");
 622
 623 # user_session may be null/undef
 624 sub retrieve_copies {
 625
 626     my( $self, $client, $user_session, $docid, @org_ids ) = @_;
 627
 628     if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
 629
 630     $docid = "$docid";
 631
 632     # grabbing copy trees should be available for everyone..
 633     if(!@org_ids and $user_session) {
 634         my($user_obj, $evt) = OpenILS::Application::AppUtils->checkses($user_session);
 635         return $evt if $evt;
 636         @org_ids = ($user_obj->home_ou);
 637     }
 638
 639     if( $self->api_name =~ /global/ ) {
 640         return _build_volume_list( { record => $docid, deleted => 'f', label => { '<>' => '##URI##' } } );
 641
 642     } else {
 643
 644         my @all_vols;
 645         for my $orgid (@org_ids) {
 646             my $vols = _build_volume_list(
 647                     { record => $docid, owning_lib => $orgid, deleted => 'f', label => { '<>' => '##URI##' } } );
 648             push( @all_vols, @$vols );
 649         }
 650
 651         return \@all_vols;
 652     }
 653
 654     return undef;
 655 }
 656
 657
 658 sub _build_volume_list {
 659     my $search_hash = shift;
 660
 661     $search_hash->{deleted} = 'f';
 662     my $e = new_editor();
 663
 664     my $vols = $e->search_asset_call_number([
 665         $search_hash,
 666         {
 667             flesh => 1,
 668             flesh_fields => { acn => ['prefix','suffix','label_class'] },
 669             'order_by' => { 'acn' => 'oils_text_as_bytea(label_sortkey), oils_text_as_bytea(label), id, owning_lib' }
 670         }
 671     ]);
 672
 673     my @volumes;
 674
 675     for my $volume (@$vols) {
 676
 677         my $copies = $e->search_asset_copy([
 678             { call_number => $volume->id , deleted => 'f' },
 679             { flesh => 1, flesh_fields => { acp => ['stat_cat_entries','parts'] } }
 680         ]);
 681
 682         $copies = [ sort { $a->barcode cmp $b->barcode } @$copies  ];
 683
 684         for my $c (@$copies) {
 685             if( $c->status == OILS_COPY_STATUS_CHECKED_OUT ) {
 686                 $c->circulations(
 687                     $e->search_action_circulation(
 688                         [
 689                             { target_copy => $c->id },
 690                             {
 691                                 order_by => { circ => 'xact_start desc' },
 692                                 limit => 1
 693                             }
 694                         ]
 695                     )
 696                 )
 697             }
 698         }
 699
 700         $volume->copies($copies);
 701         push( @volumes, $volume );
 702     }
 703
 704     #$session->disconnect();
 705     return \@volumes;
 706
 707 }
 708
 709
 710 __PACKAGE__->register_method(
 711     method   => "fleshed_copy_update",
 712     api_name => "open-ils.cat.asset.copy.fleshed.batch.update",);
 713
 714 __PACKAGE__->register_method(
 715     method   => "fleshed_copy_update",
 716     api_name => "open-ils.cat.asset.copy.fleshed.batch.update.override",);
 717
 718
 719 sub fleshed_copy_update {
 720     my( $self, $conn, $auth, $copies, $delete_stats ) = @_;
 721     return 1 unless ref $copies;
 722     my( $reqr, $evt ) = $U->checkses($auth);
 723     return $evt if $evt;
 724     my $editor = new_editor(requestor => $reqr, xact => 1);
 725     my $override = $self->api_name =~ /override/;
 726     my $retarget_holds = [];
 727     $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
 728         $editor, $override, undef, $copies, $delete_stats, $retarget_holds, undef);
 729
 730     if( $evt ) {
 731         $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
 732         $editor->rollback;
 733         return $evt;
 734     }
 735
 736     $editor->commit;
 737     $logger->info("fleshed copy update successfully updated ".scalar(@$copies)." copies");
 738     reset_hold_list($auth, $retarget_holds);
 739
 740     return 1;
 741 }
 742
 743 sub reset_hold_list {
 744     my($auth, $hold_ids) = @_;
 745     return unless @$hold_ids;
 746     $logger->info("reseting holds after copy status change: @$hold_ids");
 747     my $ses = OpenSRF::AppSession->create('open-ils.circ');
 748     $ses->request('open-ils.circ.hold.reset.batch', $auth, $hold_ids);
 749 }
 750
 751
 752 __PACKAGE__->register_method(
 753     method    => 'in_db_merge',
 754     api_name  => 'open-ils.cat.biblio.records.merge',
 755     signature => q/
 756         Merges a group of records
 757         @param auth The login session key
 758         @param master The id of the record all other records should be merged into
 759         @param records Array of records to be merged into the master record
 760         @return 1 on success, Event on error.
 761     /
 762 );
 763
 764 sub in_db_merge {
 765     my( $self, $conn, $auth, $master, $records ) = @_;
 766
 767     my $editor = new_editor( authtoken => $auth, xact => 1 );
 768     return $editor->die_event unless $editor->checkauth;
 769     return $editor->die_event unless $editor->allowed('MERGE_BIB_RECORDS'); # TODO see below about record ownership
 770
 771     my $count = 0;
 772     for my $source ( @$records ) {
 773         #XXX we actually /will/ want to check perms for master and sources after record ownership exists
 774
 775         # This stored proc (asset.merge_record_assets(target,source)) has the side effects of
 776         # moving call_number, title-type (and some volume-type) hold_request and uri-mapping
 777         # objects from the source record to the target record, so must be called from within
 778         # a transaction.
 779
 780         $count += $editor->json_query({
 781             select => {
 782                 bre => [{
 783                     alias => 'count',
 784                     transform => 'asset.merge_record_assets',
 785                     column => 'id',
 786                     params => [$source]
 787                 }]
 788             },
 789             from   => 'bre',
 790             where  => { id => $master }
 791         })->[0]->{count}; # count of objects moved, of all types
 792
 793     }
 794
 795     $editor->commit;
 796     return $count;
 797 }
 798
 799 __PACKAGE__->register_method(
 800     method    => 'in_db_auth_merge',
 801     api_name  => 'open-ils.cat.authority.records.merge',
 802     signature => q/
 803         Merges a group of authority records
 804         @param auth The login session key
 805         @param master The id of the record all other records should be merged into
 806         @param records Array of records to be merged into the master record
 807         @return 1 on success, Event on error.
 808     /
 809 );
 810
 811 sub in_db_auth_merge {
 812     my( $self, $conn, $auth, $master, $records ) = @_;
 813
 814     my $editor = new_editor( authtoken => $auth, xact => 1 );
 815     return $editor->die_event unless $editor->checkauth;
 816     return $editor->die_event unless $editor->allowed('MERGE_AUTH_RECORDS'); # TODO see below about record ownership
 817
 818     my $count = 0;
 819     for my $source ( @$records ) {
 820         $count += $editor->json_query({
 821             select => {
 822                 are => [{
 823                     alias => 'count',
 824                     transform => 'authority.merge_records',
 825                     column => 'id',
 826                     params => [$source]
 827                 }]
 828             },
 829             from   => 'are',
 830             where  => { id => $master }
 831         })->[0]->{count}; # count of objects moved, of all types
 832     }
 833
 834     $editor->commit;
 835     return $count;
 836 }
 837
 838 __PACKAGE__->register_method(
 839     method   => "fleshed_volume_update",
 840     api_name => "open-ils.cat.asset.volume.fleshed.batch.update",);
 841
 842 __PACKAGE__->register_method(
 843     method   => "fleshed_volume_update",
 844     api_name => "open-ils.cat.asset.volume.fleshed.batch.update.override",);
 845
 846 sub fleshed_volume_update {
 847     my( $self, $conn, $auth, $volumes, $delete_stats, $options ) = @_;
 848     my( $reqr, $evt ) = $U->checkses($auth);
 849     return $evt if $evt;
 850     $options ||= {};
 851
 852     my $override = ($self->api_name =~ /override/);
 853     my $editor = new_editor( requestor => $reqr, xact => 1 );
 854     my $retarget_holds = [];
 855     my $auto_merge_vols = $options->{auto_merge_vols};
 856
 857     for my $vol (@$volumes) {
 858         $logger->info("vol-update: investigating volume ".$vol->id);
 859
 860         $vol->editor($reqr->id);
 861         $vol->edit_date('now');
 862
 863         my $copies = $vol->copies;
 864         $vol->clear_copies;
 865
 866         $vol->editor($editor->requestor->id);
 867         $vol->edit_date('now');
 868
 869         if( $vol->isdeleted ) {
 870
 871             $logger->info("vol-update: deleting volume");
 872             return $editor->die_event unless
 873                 $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
 874
 875             if(my $evt = $assetcom->delete_volume($editor, $vol, $override, $$options{force_delete_copies})) {
 876                 $editor->rollback;
 877                 return $evt;
 878             }
 879
 880             return $editor->die_event unless
 881                 $editor->update_asset_call_number($vol);
 882
 883         } elsif( $vol->isnew ) {
 884             $logger->info("vol-update: creating volume");
 885             $evt = $assetcom->create_volume( $override, $editor, $vol );
 886             return $evt if $evt;
 887
 888         } elsif( $vol->ischanged ) {
 889             $logger->info("vol-update: update volume");
 890             my $resp = update_volume($vol, $editor, ($override or $auto_merge_vols));
 891             return $resp->{evt} if $resp->{evt};
 892             $vol = $resp->{merge_vol};
 893         }
 894
 895         # now update any attached copies
 896         if( $copies and @$copies and !$vol->isdeleted ) {
 897             $_->call_number($vol->id) for @$copies;
 898             $evt = $assetcom->update_fleshed_copies(
 899                 $editor, $override, $vol, $copies, $delete_stats, $retarget_holds, undef);
 900             return $evt if $evt;
 901         }
 902     }
 903
 904     $editor->finish;
 905     reset_hold_list($auth, $retarget_holds);
 906     return scalar(@$volumes);
 907 }
 908
 909
 910 sub update_volume {
 911     my $vol = shift;
 912     my $editor = shift;
 913     my $auto_merge = shift;
 914     my $evt;
 915     my $merge_vol;
 916
 917     return {evt => $editor->event} unless
 918         $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
 919
 920     return {evt => $evt}
 921         if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $vol->owning_lib) );
 922
 923     my $vols = $editor->search_asset_call_number({
 924         owning_lib => $vol->owning_lib,
 925         record     => $vol->record,
 926         label      => $vol->label,
 927         prefix     => $vol->prefix,
 928         suffix     => $vol->suffix,
 929         deleted    => 'f',
 930         id         => {'!=' => $vol->id}
 931     });
 932
 933     if(@$vols) {
 934
 935         if($auto_merge) {
 936
 937             # If the auto-merge option is on, merge our updated volume into the existing
 938             # volume with the same record + owner + label.
 939             ($merge_vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $vols->[0]);
 940             return {evt => $evt, merge_vol => $merge_vol};
 941
 942         } else {
 943             return {evt => OpenILS::Event->new('VOLUME_LABEL_EXISTS', payload => $vol->id)};
 944         }
 945     }
 946
 947     return {evt => $editor->die_event} unless $editor->update_asset_call_number($vol);
 948     return {};
 949 }
 950
 951
 952
 953 __PACKAGE__->register_method (
 954     method   => 'delete_bib_record',
 955     api_name => 'open-ils.cat.biblio.record_entry.delete');
 956
 957 sub delete_bib_record {
 958     my($self, $conn, $auth, $rec_id) = @_;
 959     my $e = new_editor(xact=>1, authtoken=>$auth);
 960     return $e->die_event unless $e->checkauth;
 961     return $e->die_event unless $e->allowed('DELETE_RECORD', $e->requestor->ws_ou);
 962     my $vols = $e->search_asset_call_number({record=>$rec_id, deleted=>'f'});
 963     return OpenILS::Event->new('RECORD_NOT_EMPTY', payload=>$rec_id) if @$vols;
 964     my $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $rec_id);
 965     if($evt) { $e->rollback; return $evt; }
 966     $e->commit;
 967     return 1;
 968 }
 969
 970
 971
 972 __PACKAGE__->register_method (
 973     method   => 'batch_volume_transfer',
 974     api_name => 'open-ils.cat.asset.volume.batch.transfer',
 975 );
 976
 977 __PACKAGE__->register_method (
 978     method   => 'batch_volume_transfer',
 979     api_name => 'open-ils.cat.asset.volume.batch.transfer.override',
 980 );
 981
 982
 983 sub batch_volume_transfer {
 984     my( $self, $conn, $auth, $args ) = @_;
 985
 986     my $evt;
 987     my $rec     = $$args{docid};
 988     my $o_lib   = $$args{lib};
 989     my $vol_ids = $$args{volumes};
 990
 991     my $override = 1 if $self->api_name =~ /override/;
 992
 993     $logger->info("merge: transferring volumes to lib=$o_lib and record=$rec");
 994
 995     my $e = new_editor(authtoken => $auth, xact =>1);
 996     return $e->event unless $e->checkauth;
 997     return $e->event unless $e->allowed('UPDATE_VOLUME', $o_lib);
 998
 999     my $dorg = $e->retrieve_actor_org_unit($o_lib)
1000         or return $e->event;
1001
1002     my $ou_type = $e->retrieve_actor_org_unit_type($dorg->ou_type)
1003         or return $e->event;
1004
1005     return $evt if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($e, $o_lib) );
1006
1007     my $vols = $e->batch_retrieve_asset_call_number($vol_ids);
1008     my @seen;
1009
1010    my @rec_ids;
1011
1012     for my $vol (@$vols) {
1013
1014         # if we've already looked at this volume, go to the next
1015         next if !$vol or grep { $vol->id == $_ } @seen;
1016
1017         # grab all of the volumes in the list that have
1018         # the same label so they can be merged
1019         my @all = grep { $_->label eq $vol->label } @$vols;
1020
1021         # take note of the fact that we've looked at this set of volumes
1022         push( @seen, $_->id ) for @all;
1023         push( @rec_ids, $_->record ) for @all;
1024
1025         # for each volume, see if there are any copies that have a
1026         # remote circ_lib (circ_lib != vol->owning_lib and != $o_lib ).
1027         # if so, warn them
1028         unless( $override ) {
1029             for my $v (@all) {
1030
1031                 $logger->debug("merge: searching for copies with remote circ_lib for volume ".$v->id);
1032                 my $args = {
1033                     call_number => $v->id,
1034                     circ_lib    => { "not in" => [ $o_lib, $v->owning_lib ] },
1035                     deleted     => 'f'
1036                 };
1037
1038                 my $copies = $e->search_asset_copy($args, {idlist=>1});
1039
1040                 # if the copy's circ_lib matches the destination lib,
1041                 # that's ok too
1042                 return OpenILS::Event->new('COPY_REMOTE_CIRC_LIB') if @$copies;
1043             }
1044         }
1045
1046         # see if there is a volume at the destination lib that
1047         # already has the requested label
1048         my $existing_vol = $e->search_asset_call_number(
1049             {
1050                 label      => $vol->label,
1051                 prefix     => $vol->prefix,
1052                 suffix     => $vol->suffix,
1053                 record     => $rec,
1054                 owning_lib => $o_lib,
1055                 deleted    => 'f'
1056             }
1057         )->[0];
1058
1059         if( $existing_vol ) {
1060
1061             if( grep { $_->id == $existing_vol->id } @all ) {
1062                 # this volume is already accounted for in our list of volumes to merge
1063                 $existing_vol = undef;
1064
1065             } else {
1066                 # this volume exists on the destination record/owning_lib and must
1067                 # be used as the destination for merging
1068                 $logger->debug("merge: volume already exists at destination record: ".
1069                     $existing_vol->id.' : '.$existing_vol->label) if $existing_vol;
1070             }
1071         }
1072
1073         if( @all > 1 || $existing_vol ) {
1074             $logger->info("merge: found collisions in volume transfer");
1075             my @args = ($e, \@all);
1076             @args = ($e, \@all, $existing_vol) if $existing_vol;
1077             ($vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes(@args);
1078             return $evt if $evt;
1079         }
1080
1081         if( !$existing_vol ) {
1082
1083             $vol->owning_lib($o_lib);
1084             $vol->record($rec);
1085             $vol->editor($e->requestor->id);
1086             $vol->edit_date('now');
1087
1088             $logger->info("merge: updating volume ".$vol->id);
1089             $e->update_asset_call_number($vol) or return $e->event;
1090
1091         } else {
1092             $logger->info("merge: bypassing volume update because existing volume used as target");
1093         }
1094
1095         # regardless of what volume was used as the destination,
1096         # update any copies that have moved over to the new lib
1097         my $copies = $e->search_asset_copy({call_number=>$vol->id, deleted => 'f'});
1098
1099         # update circ lib on the copies - make this a method flag?
1100         for my $copy (@$copies) {
1101             next if $copy->circ_lib == $o_lib;
1102             $logger->info("merge: transfer moving circ lib on copy ".$copy->id);
1103             $copy->circ_lib($o_lib);
1104             $copy->editor($e->requestor->id);
1105             $copy->edit_date('now');
1106             $e->update_asset_copy($copy) or return $e->event;
1107         }
1108
1109         # Now see if any empty records need to be deleted after all of this
1110
1111         for(@rec_ids) {
1112             $logger->debug("merge: seeing if we should delete record $_...");
1113             $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $_)
1114                 if OpenILS::Application::Cat::BibCommon->title_is_empty($e, $_);
1115             return $evt if $evt;
1116         }
1117     }
1118
1119     $logger->info("merge: transfer succeeded");
1120     $e->commit;
1121     return 1;
1122 }
1123
1124
1125
1126
1127 __PACKAGE__->register_method(
1128     api_name => 'open-ils.cat.call_number.find_or_create',
1129     method   => 'find_or_create_volume',
1130 );
1131
1132 sub find_or_create_volume {
1133     my( $self, $conn, $auth, $label, $record_id, $org_id, $prefix, $suffix, $label_class ) = @_;
1134     my $e = new_editor(authtoken=>$auth, xact=>1);
1135     return $e->die_event unless $e->checkauth;
1136     my ($vol, $evt, $exists) =
1137         OpenILS::Application::Cat::AssetCommon->find_or_create_volume($e, $label, $record_id, $org_id, $prefix, $suffix, $label_class);
1138     return $evt if $evt;
1139     $e->rollback if $exists;
1140     $e->commit if $vol;
1141     return { 'acn_id' => $vol->id, 'existed' => $exists };
1142 }
1143
1144
1145 __PACKAGE__->register_method(
1146     method    => "create_serial_record_xml",
1147     api_name  => "open-ils.cat.serial.record.xml.create.override",
1148     signature => q/@see open-ils.cat.serial.record.xml.create/);
1149
1150 __PACKAGE__->register_method(
1151     method    => "create_serial_record_xml",
1152     api_name  => "open-ils.cat.serial.record.xml.create",
1153     signature => q/
1154         Inserts a new serial record with the given XML
1155     /
1156 );
1157
1158 sub create_serial_record_xml {
1159     my( $self, $client, $login, $source, $owning_lib, $record_id, $xml ) = @_;
1160
1161     my $override = 1 if $self->api_name =~ /override/; # not currently used
1162
1163     my $e = new_editor(xact=>1, authtoken=>$login);
1164     return $e->die_event unless $e->checkauth;
1165     return $e->die_event unless $e->allowed('CREATE_MFHD_RECORD', $owning_lib);
1166
1167     # Auto-populate the location field of a placeholder MFHD record with the library name
1168     my $aou = $e->retrieve_actor_org_unit($owning_lib) or return $e->die_event;
1169
1170     my $mfhd = Fieldmapper::serial::record_entry->new;
1171
1172     $mfhd->source($source) if $source;
1173     $mfhd->record($record_id);
1174     $mfhd->creator($e->requestor->id);
1175     $mfhd->editor($e->requestor->id);
1176     $mfhd->create_date('now');
1177     $mfhd->edit_date('now');
1178     $mfhd->owning_lib($owning_lib);
1179
1180     # If the caller did not pass in MFHD XML, create a placeholder record.
1181     # The placeholder will only contain the name of the owning library.
1182     # The goal is to generate common patterns for the caller in the UI that
1183     # then get passed in here.
1184     if (!$xml) {
1185         my $aou_name = $aou->name;
1186         $xml = <<HERE;
1187 <record
1188  xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1189  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
1190  xmlns="http://www.loc.gov/MARC21/slim">
1191 <leader>00307ny  a22001094  4500</leader>
1192 <controlfield tag="001">42153</controlfield>
1193 <controlfield tag="005">20090601182414.0</controlfield>
1194 <controlfield tag="004">$record_id</controlfield>
1195 <controlfield tag="008">      4u####8###l# 4   uueng1      </controlfield>
1196 <datafield tag="852" ind1=" " ind2=" "> <subfield code="b">$aou_name</subfield></datafield>
1197 </record>
1198 HERE
1199     }
1200     my $marcxml = XML::LibXML->new->parse_string($xml);
1201     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim", "marc", 1 );
1202     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim");
1203
1204     $mfhd->marc($U->entityize($marcxml->documentElement->toString));
1205
1206     $e->create_serial_record_entry($mfhd) or return $e->die_event;
1207
1208     $e->commit;
1209     return $mfhd->id;
1210 }
1211
1212 __PACKAGE__->register_method(
1213     method   => "create_update_asset_copy_template",
1214     api_name => "open-ils.cat.asset.copy_template.create_or_update"
1215 );
1216
1217 sub create_update_asset_copy_template {
1218     my ($self, $client, $authtoken, $act) = @_;
1219
1220     my $e = new_editor("xact" => 1, "authtoken" => $authtoken);
1221     return $e->die_event unless $e->checkauth;
1222     return $e->die_event unless $e->allowed(
1223         "ADMIN_ASSET_COPY_TEMPLATE", $act->owning_lib
1224     );
1225
1226     $act->editor($e->requestor->id);
1227     $act->edit_date("now");
1228
1229     my $retval;
1230     if (!$act->id) {
1231         $act->creator($e->requestor->id);
1232         $act->create_date("now");
1233
1234         $e->create_asset_copy_template($act) or return $e->die_event;
1235         $retval = $e->data;
1236     } else {
1237         $e->update_asset_copy_template($act) or return $e->die_event;
1238         $retval = $e->retrieve_asset_copy_template($e->data);
1239     }
1240     $e->commit and return $retval;
1241 }
1242
1243 1;
1244
1245 # vi:et:ts=4:sw=4