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          => 2, #(session_id, list of bre ids )
 431     notes         => "Returns a list of slim-downed bre objects based on the " .
 432                      "ids passed in",
 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->attrs($editor->retrieve_metabib_record_attr($rec->id));
 452         $rec->clear_marc; # slim the record down
 453         push( @results, $rec );
 454     }
 455
 456     return \@results;
 457 }
 458
 459
 460
 461 __PACKAGE__->register_method(
 462     method    => "biblio_record_marc_cn",
 463     api_name  => "open-ils.cat.biblio.record.marc_cn.retrieve",
 464     argc      => 1, #(bib id )
 465     signature => {
 466         desc   => 'Extracts call number candidates from a bibliographic record',
 467         params => [
 468             {desc => 'Record ID', type => 'number'},
 469             {desc => '(Optional) Classification scheme ID', type => 'number'},
 470         ]
 471     },
 472     return => {desc => 'Hash of candidate call numbers identified by tag' }
 473 );
 474
 475 sub biblio_record_marc_cn {
 476     my( $self, $client, $id, $class ) = @_;
 477
 478     my $e = new_editor();
 479     my $marc = $e->retrieve_biblio_record_entry($id)->marc;
 480
 481     my $doc = XML::LibXML->new->parse_string($marc);
 482     $doc->documentElement->setNamespace( "http://www.loc.gov/MARC21/slim", "marc", 1 );
 483
 484     my @fields;
 485     my @res;
 486     if ($class) {
 487         @fields = split(/,/, $e->retrieve_asset_call_number_class($class)->field);
 488     } else {
 489         @fields = qw/050ab 055ab 060ab 070ab 080ab 082ab 086ab 088ab 090 092 096 098 099/;
 490     }
 491
 492     # Get field/subfield combos based on acnc value; for example "050ab,055ab"
 493
 494     foreach my $field (@fields) {
 495         my $tag = substr($field, 0, 3);
 496         $logger->debug("Tag = $tag");
 497         my @node = $doc->findnodes("//marc:datafield[\@tag='$tag']");
 498
 499         # Now parse the subfields and build up the subfield XPath
 500         my @subfields = split(//, substr($field, 3));
 501
 502         # If they give us no subfields to parse, default to just the 'a'
 503         if (!@subfields) {
 504             @subfields = ('a');
 505         }
 506         my $subxpath;
 507         foreach my $sf (@subfields) {
 508             $subxpath .= "\@code='$sf' or ";
 509         }
 510         $subxpath = substr($subxpath, 0, -4);
 511         $logger->debug("subxpath = $subxpath");
 512
 513         # Find the contents of the specified subfields
 514         foreach my $x (@node) {
 515             my $cn = $x->findvalue("marc:subfield[$subxpath]");
 516             push @res, {$tag => $cn} if ($cn);
 517         }
 518     }
 519
 520     return \@res;
 521 }
 522
 523 __PACKAGE__->register_method(
 524     method    => 'autogen_barcodes',
 525     api_name  => "open-ils.cat.item.barcode.autogen",
 526     signature => {
 527         desc   => 'Returns N generated barcodes following a specified barcode.',
 528         params => [
 529             {desc => 'Authentication token', type => 'string'},
 530             {desc => 'Barcode which the sequence should follow from', type => 'string'},
 531             {desc => 'Number of barcodes to generate', type => 'number'},
 532             {desc => 'Options hash.  Currently you can pass in checkdigit : false to disable the use of checkdigits.'}
 533         ],
 534         return => {desc => 'Array of generated barcodes'}
 535     }
 536 );
 537
 538 sub autogen_barcodes {
 539     my( $self, $client, $auth, $barcode, $num_of_barcodes, $options ) = @_;
 540     my $e = new_editor(authtoken => $auth);
 541     return $e->event unless $e->checkauth;
 542     return $e->event unless $e->allowed('UPDATE_COPY', $e->requestor->ws_ou);
 543     $options ||= {};
 544
 545     my $barcode_text = '';
 546     my $barcode_number = 0;
 547
 548     if ($barcode =~ /^(\D+)/) { $barcode_text = $1; }
 549     if ($barcode =~ /(\d+)$/) { $barcode_number = $1; }
 550
 551     my @res;
 552     for (my $i = 1; $i <= $num_of_barcodes; $i++) {
 553         my $calculated_barcode;
 554
 555         # default is to use checkdigits, so looking for an explicit false here
 556         if (defined $$options{'checkdigit'} && ! $$options{'checkdigit'}) {
 557             $calculated_barcode = $barcode_number + $i;
 558         } else {
 559             if ($barcode_number =~ /^\d{8}$/) {
 560                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0);
 561             } elsif ($barcode_number =~ /^\d{9}$/) {
 562                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit
 563             } elsif ($barcode_number =~ /^\d{13}$/) {
 564                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0);
 565             } elsif ($barcode_number =~ /^\d{14}$/) {
 566                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit
 567             } else {
 568                 $calculated_barcode = $barcode_number + $i;
 569             }
 570         }
 571         push @res, $barcode_text . $calculated_barcode;
 572     }
 573     return \@res
 574 }
 575
 576 # Codabar doesn't define a checkdigit algorithm, but this one is typically used by libraries.  gmcharlt++
 577 sub add_codabar_checkdigit {
 578     my $barcode = shift;
 579     my $strip_last_digit = shift;
 580
 581     return $barcode if $barcode =~ /\D/;
 582     $barcode = substr($barcode, 0, length($barcode)-1) if $strip_last_digit;
 583     my @digits = split //, $barcode;
 584     my $total = 0;
 585     for (my $i = 1; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 1,3,5,7,9,11
 586         $total += $digits[$i];
 587     }
 588     for (my $i = 0; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 0,2,4,6,8,10,12
 589         $total += (2 * $digits[$i] >= 10) ? (2 * $digits[$i] - 9) : (2 * $digits[$i]);
 590     }
 591     my $remainder = $total % 10;
 592     my $checkdigit = ($remainder == 0) ? $remainder : 10 - $remainder;
 593     return $barcode . $checkdigit;
 594 }
 595
 596 __PACKAGE__->register_method(
 597     method        => "orgs_for_title",
 598     authoritative => 1,
 599     api_name      => "open-ils.cat.actor.org_unit.retrieve_by_title"
 600 );
 601
 602 sub orgs_for_title {
 603     my( $self, $client, $record_id ) = @_;
 604
 605     my $vols = $U->simple_scalar_request(
 606         "open-ils.cstore",
 607         "open-ils.cstore.direct.asset.call_number.search.atomic",
 608         { record => $record_id, deleted => 'f' });
 609
 610     my $orgs = { map {$_->owning_lib => 1 } @$vols };
 611     return [ keys %$orgs ];
 612 }
 613
 614
 615 __PACKAGE__->register_method(
 616     method        => "retrieve_copies",
 617     authoritative => 1,
 618     api_name      => "open-ils.cat.asset.copy_tree.retrieve");
 619
 620 __PACKAGE__->register_method(
 621     method   => "retrieve_copies",
 622     api_name => "open-ils.cat.asset.copy_tree.global.retrieve");
 623
 624 # user_session may be null/undef
 625 sub retrieve_copies {
 626
 627     my( $self, $client, $user_session, $docid, @org_ids ) = @_;
 628
 629     if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
 630
 631     $docid = "$docid";
 632
 633     # grabbing copy trees should be available for everyone..
 634     if(!@org_ids and $user_session) {
 635         my($user_obj, $evt) = OpenILS::Application::AppUtils->checkses($user_session);
 636         return $evt if $evt;
 637         @org_ids = ($user_obj->home_ou);
 638     }
 639
 640     if( $self->api_name =~ /global/ ) {
 641         return _build_volume_list( { record => $docid, deleted => 'f', label => { '<>' => '##URI##' } } );
 642
 643     } else {
 644
 645         my @all_vols;
 646         for my $orgid (@org_ids) {
 647             my $vols = _build_volume_list(
 648                     { record => $docid, owning_lib => $orgid, deleted => 'f', label => { '<>' => '##URI##' } } );
 649             push( @all_vols, @$vols );
 650         }
 651
 652         return \@all_vols;
 653     }
 654
 655     return undef;
 656 }
 657
 658
 659 sub _build_volume_list {
 660     my $search_hash = shift;
 661
 662     $search_hash->{deleted} = 'f';
 663     my $e = new_editor();
 664
 665     my $vols = $e->search_asset_call_number([
 666         $search_hash,
 667         {
 668             flesh => 1,
 669             flesh_fields => { acn => ['prefix','suffix','label_class'] },
 670             'order_by' => { 'acn' => 'oils_text_as_bytea(label_sortkey), oils_text_as_bytea(label), id, owning_lib' }
 671         }
 672     ]);
 673
 674     my @volumes;
 675
 676     for my $volume (@$vols) {
 677
 678         my $copies = $e->search_asset_copy([
 679             { call_number => $volume->id , deleted => 'f' },
 680             { flesh => 1, flesh_fields => { acp => ['stat_cat_entries','parts'] } }
 681         ]);
 682
 683         $copies = [ sort { $a->barcode cmp $b->barcode } @$copies  ];
 684
 685         for my $c (@$copies) {
 686             if( $c->status == OILS_COPY_STATUS_CHECKED_OUT ) {
 687                 $c->circulations(
 688                     $e->search_action_circulation(
 689                         [
 690                             { target_copy => $c->id },
 691                             {
 692                                 order_by => { circ => 'xact_start desc' },
 693                                 limit => 1
 694                             }
 695                         ]
 696                     )
 697                 )
 698             }
 699         }
 700
 701         $volume->copies($copies);
 702         push( @volumes, $volume );
 703     }
 704
 705     #$session->disconnect();
 706     return \@volumes;
 707
 708 }
 709
 710
 711 __PACKAGE__->register_method(
 712     method   => "fleshed_copy_update",
 713     api_name => "open-ils.cat.asset.copy.fleshed.batch.update",);
 714
 715 __PACKAGE__->register_method(
 716     method   => "fleshed_copy_update",
 717     api_name => "open-ils.cat.asset.copy.fleshed.batch.update.override",);
 718
 719
 720 sub fleshed_copy_update {
 721     my( $self, $conn, $auth, $copies, $delete_stats ) = @_;
 722     return 1 unless ref $copies;
 723     my( $reqr, $evt ) = $U->checkses($auth);
 724     return $evt if $evt;
 725     my $editor = new_editor(requestor => $reqr, xact => 1);
 726     my $override = $self->api_name =~ /override/;
 727     my $retarget_holds = [];
 728     $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
 729         $editor, $override, undef, $copies, $delete_stats, $retarget_holds, undef);
 730
 731     if( $evt ) {
 732         $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
 733         $editor->rollback;
 734         return $evt;
 735     }
 736
 737     $editor->commit;
 738     $logger->info("fleshed copy update successfully updated ".scalar(@$copies)." copies");
 739     reset_hold_list($auth, $retarget_holds);
 740
 741     return 1;
 742 }
 743
 744 sub reset_hold_list {
 745     my($auth, $hold_ids) = @_;
 746     return unless @$hold_ids;
 747     $logger->info("reseting holds after copy status change: @$hold_ids");
 748     my $ses = OpenSRF::AppSession->create('open-ils.circ');
 749     $ses->request('open-ils.circ.hold.reset.batch', $auth, $hold_ids);
 750 }
 751
 752
 753 __PACKAGE__->register_method(
 754     method    => 'in_db_merge',
 755     api_name  => 'open-ils.cat.biblio.records.merge',
 756     signature => q/
 757         Merges a group of records
 758         @param auth The login session key
 759         @param master The id of the record all other records should be merged into
 760         @param records Array of records to be merged into the master record
 761         @return 1 on success, Event on error.
 762     /
 763 );
 764
 765 sub in_db_merge {
 766     my( $self, $conn, $auth, $master, $records ) = @_;
 767
 768     my $editor = new_editor( authtoken => $auth, xact => 1 );
 769     return $editor->die_event unless $editor->checkauth;
 770     return $editor->die_event unless $editor->allowed('MERGE_BIB_RECORDS'); # TODO see below about record ownership
 771
 772     my $count = 0;
 773     for my $source ( @$records ) {
 774         #XXX we actually /will/ want to check perms for master and sources after record ownership exists
 775
 776         # This stored proc (asset.merge_record_assets(target,source)) has the side effects of
 777         # moving call_number, title-type (and some volume-type) hold_request and uri-mapping
 778         # objects from the source record to the target record, so must be called from within
 779         # a transaction.
 780
 781         $count += $editor->json_query({
 782             select => {
 783                 bre => [{
 784                     alias => 'count',
 785                     transform => 'asset.merge_record_assets',
 786                     column => 'id',
 787                     params => [$source]
 788                 }]
 789             },
 790             from   => 'bre',
 791             where  => { id => $master }
 792         })->[0]->{count}; # count of objects moved, of all types
 793
 794     }
 795
 796     $editor->commit;
 797     return $count;
 798 }
 799
 800 __PACKAGE__->register_method(
 801     method    => 'in_db_auth_merge',
 802     api_name  => 'open-ils.cat.authority.records.merge',
 803     signature => q/
 804         Merges a group of authority records
 805         @param auth The login session key
 806         @param master The id of the record all other records should be merged into
 807         @param records Array of records to be merged into the master record
 808         @return 1 on success, Event on error.
 809     /
 810 );
 811
 812 sub in_db_auth_merge {
 813     my( $self, $conn, $auth, $master, $records ) = @_;
 814
 815     my $editor = new_editor( authtoken => $auth, xact => 1 );
 816     return $editor->die_event unless $editor->checkauth;
 817     return $editor->die_event unless $editor->allowed('MERGE_AUTH_RECORDS'); # TODO see below about record ownership
 818
 819     my $count = 0;
 820     for my $source ( @$records ) {
 821         $count += $editor->json_query({
 822             select => {
 823                 are => [{
 824                     alias => 'count',
 825                     transform => 'authority.merge_records',
 826                     column => 'id',
 827                     params => [$source]
 828                 }]
 829             },
 830             from   => 'are',
 831             where  => { id => $master }
 832         })->[0]->{count}; # count of objects moved, of all types
 833     }
 834
 835     $editor->commit;
 836     return $count;
 837 }
 838
 839 __PACKAGE__->register_method(
 840     method   => "fleshed_volume_update",
 841     api_name => "open-ils.cat.asset.volume.fleshed.batch.update",);
 842
 843 __PACKAGE__->register_method(
 844     method   => "fleshed_volume_update",
 845     api_name => "open-ils.cat.asset.volume.fleshed.batch.update.override",);
 846
 847 sub fleshed_volume_update {
 848     my( $self, $conn, $auth, $volumes, $delete_stats, $options ) = @_;
 849     my( $reqr, $evt ) = $U->checkses($auth);
 850     return $evt if $evt;
 851     $options ||= {};
 852
 853     my $override = ($self->api_name =~ /override/);
 854     my $editor = new_editor( requestor => $reqr, xact => 1 );
 855     my $retarget_holds = [];
 856     my $auto_merge_vols = $options->{auto_merge_vols};
 857
 858     for my $vol (@$volumes) {
 859         $logger->info("vol-update: investigating volume ".$vol->id);
 860
 861         $vol->editor($reqr->id);
 862         $vol->edit_date('now');
 863
 864         my $copies = $vol->copies;
 865         $vol->clear_copies;
 866
 867         $vol->editor($editor->requestor->id);
 868         $vol->edit_date('now');
 869
 870         if( $vol->isdeleted ) {
 871
 872             $logger->info("vol-update: deleting volume");
 873             return $editor->die_event unless
 874                 $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
 875
 876             if(my $evt = $assetcom->delete_volume($editor, $vol, $override, $$options{force_delete_copies})) {
 877                 $editor->rollback;
 878                 return $evt;
 879             }
 880
 881             return $editor->die_event unless
 882                 $editor->update_asset_call_number($vol);
 883
 884         } elsif( $vol->isnew ) {
 885             $logger->info("vol-update: creating volume");
 886             $evt = $assetcom->create_volume( $override, $editor, $vol );
 887             return $evt if $evt;
 888
 889         } elsif( $vol->ischanged ) {
 890             $logger->info("vol-update: update volume");
 891             my $resp = update_volume($vol, $editor, ($override or $auto_merge_vols));
 892             return $resp->{evt} if $resp->{evt};
 893             $vol = $resp->{merge_vol};
 894         }
 895
 896         # now update any attached copies
 897         if( $copies and @$copies and !$vol->isdeleted ) {
 898             $_->call_number($vol->id) for @$copies;
 899             $evt = $assetcom->update_fleshed_copies(
 900                 $editor, $override, $vol, $copies, $delete_stats, $retarget_holds, undef);
 901             return $evt if $evt;
 902         }
 903     }
 904
 905     $editor->finish;
 906     reset_hold_list($auth, $retarget_holds);
 907     return scalar(@$volumes);
 908 }
 909
 910
 911 sub update_volume {
 912     my $vol = shift;
 913     my $editor = shift;
 914     my $auto_merge = shift;
 915     my $evt;
 916     my $merge_vol;
 917
 918     return {evt => $editor->event} unless
 919         $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
 920
 921     return {evt => $evt}
 922         if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $vol->owning_lib) );
 923
 924     my $vols = $editor->search_asset_call_number({
 925         owning_lib => $vol->owning_lib,
 926         record     => $vol->record,
 927         label      => $vol->label,
 928         prefix     => $vol->prefix,
 929         suffix     => $vol->suffix,
 930         deleted    => 'f',
 931         id         => {'!=' => $vol->id}
 932     });
 933
 934     if(@$vols) {
 935
 936         if($auto_merge) {
 937
 938             # If the auto-merge option is on, merge our updated volume into the existing
 939             # volume with the same record + owner + label.
 940             ($merge_vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $vols->[0]);
 941             return {evt => $evt, merge_vol => $merge_vol};
 942
 943         } else {
 944             return {evt => OpenILS::Event->new('VOLUME_LABEL_EXISTS', payload => $vol->id)};
 945         }
 946     }
 947
 948     return {evt => $editor->die_event} unless $editor->update_asset_call_number($vol);
 949     return {};
 950 }
 951
 952
 953
 954 __PACKAGE__->register_method (
 955     method   => 'delete_bib_record',
 956     api_name => 'open-ils.cat.biblio.record_entry.delete');
 957
 958 sub delete_bib_record {
 959     my($self, $conn, $auth, $rec_id) = @_;
 960     my $e = new_editor(xact=>1, authtoken=>$auth);
 961     return $e->die_event unless $e->checkauth;
 962     return $e->die_event unless $e->allowed('DELETE_RECORD', $e->requestor->ws_ou);
 963     my $vols = $e->search_asset_call_number({record=>$rec_id, deleted=>'f'});
 964     return OpenILS::Event->new('RECORD_NOT_EMPTY', payload=>$rec_id) if @$vols;
 965     my $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $rec_id);
 966     if($evt) { $e->rollback; return $evt; }
 967     $e->commit;
 968     return 1;
 969 }
 970
 971
 972
 973 __PACKAGE__->register_method (
 974     method   => 'batch_volume_transfer',
 975     api_name => 'open-ils.cat.asset.volume.batch.transfer',
 976 );
 977
 978 __PACKAGE__->register_method (
 979     method   => 'batch_volume_transfer',
 980     api_name => 'open-ils.cat.asset.volume.batch.transfer.override',
 981 );
 982
 983
 984 sub batch_volume_transfer {
 985     my( $self, $conn, $auth, $args ) = @_;
 986
 987     my $evt;
 988     my $rec     = $$args{docid};
 989     my $o_lib   = $$args{lib};
 990     my $vol_ids = $$args{volumes};
 991
 992     my $override = 1 if $self->api_name =~ /override/;
 993
 994     $logger->info("merge: transferring volumes to lib=$o_lib and record=$rec");
 995
 996     my $e = new_editor(authtoken => $auth, xact =>1);
 997     return $e->event unless $e->checkauth;
 998     return $e->event unless $e->allowed('UPDATE_VOLUME', $o_lib);
 999
1000     my $dorg = $e->retrieve_actor_org_unit($o_lib)
1001         or return $e->event;
1002
1003     my $ou_type = $e->retrieve_actor_org_unit_type($dorg->ou_type)
1004         or return $e->event;
1005
1006     return $evt if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($e, $o_lib) );
1007
1008     my $vols = $e->batch_retrieve_asset_call_number($vol_ids);
1009     my @seen;
1010
1011    my @rec_ids;
1012
1013     for my $vol (@$vols) {
1014
1015         # if we've already looked at this volume, go to the next
1016         next if !$vol or grep { $vol->id == $_ } @seen;
1017
1018         # grab all of the volumes in the list that have
1019         # the same label so they can be merged
1020         my @all = grep { $_->label eq $vol->label } @$vols;
1021
1022         # take note of the fact that we've looked at this set of volumes
1023         push( @seen, $_->id ) for @all;
1024         push( @rec_ids, $_->record ) for @all;
1025
1026         # for each volume, see if there are any copies that have a
1027         # remote circ_lib (circ_lib != vol->owning_lib and != $o_lib ).
1028         # if so, warn them
1029         unless( $override ) {
1030             for my $v (@all) {
1031
1032                 $logger->debug("merge: searching for copies with remote circ_lib for volume ".$v->id);
1033                 my $args = {
1034                     call_number => $v->id,
1035                     circ_lib    => { "not in" => [ $o_lib, $v->owning_lib ] },
1036                     deleted     => 'f'
1037                 };
1038
1039                 my $copies = $e->search_asset_copy($args, {idlist=>1});
1040
1041                 # if the copy's circ_lib matches the destination lib,
1042                 # that's ok too
1043                 return OpenILS::Event->new('COPY_REMOTE_CIRC_LIB') if @$copies;
1044             }
1045         }
1046
1047         # see if there is a volume at the destination lib that
1048         # already has the requested label
1049         my $existing_vol = $e->search_asset_call_number(
1050             {
1051                 label      => $vol->label,
1052                 prefix     => $vol->prefix,
1053                 suffix     => $vol->suffix,
1054                 record     => $rec,
1055                 owning_lib => $o_lib,
1056                 deleted    => 'f'
1057             }
1058         )->[0];
1059
1060         if( $existing_vol ) {
1061
1062             if( grep { $_->id == $existing_vol->id } @all ) {
1063                 # this volume is already accounted for in our list of volumes to merge
1064                 $existing_vol = undef;
1065
1066             } else {
1067                 # this volume exists on the destination record/owning_lib and must
1068                 # be used as the destination for merging
1069                 $logger->debug("merge: volume already exists at destination record: ".
1070                     $existing_vol->id.' : '.$existing_vol->label) if $existing_vol;
1071             }
1072         }
1073
1074         if( @all > 1 || $existing_vol ) {
1075             $logger->info("merge: found collisions in volume transfer");
1076             my @args = ($e, \@all);
1077             @args = ($e, \@all, $existing_vol) if $existing_vol;
1078             ($vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes(@args);
1079             return $evt if $evt;
1080         }
1081
1082         if( !$existing_vol ) {
1083
1084             $vol->owning_lib($o_lib);
1085             $vol->record($rec);
1086             $vol->editor($e->requestor->id);
1087             $vol->edit_date('now');
1088
1089             $logger->info("merge: updating volume ".$vol->id);
1090             $e->update_asset_call_number($vol) or return $e->event;
1091
1092         } else {
1093             $logger->info("merge: bypassing volume update because existing volume used as target");
1094         }
1095
1096         # regardless of what volume was used as the destination,
1097         # update any copies that have moved over to the new lib
1098         my $copies = $e->search_asset_copy({call_number=>$vol->id, deleted => 'f'});
1099
1100         # update circ lib on the copies - make this a method flag?
1101         for my $copy (@$copies) {
1102             next if $copy->circ_lib == $o_lib;
1103             $logger->info("merge: transfer moving circ lib on copy ".$copy->id);
1104             $copy->circ_lib($o_lib);
1105             $copy->editor($e->requestor->id);
1106             $copy->edit_date('now');
1107             $e->update_asset_copy($copy) or return $e->event;
1108         }
1109
1110         # Now see if any empty records need to be deleted after all of this
1111
1112         for(@rec_ids) {
1113             $logger->debug("merge: seeing if we should delete record $_...");
1114             $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $_)
1115                 if OpenILS::Application::Cat::BibCommon->title_is_empty($e, $_);
1116             return $evt if $evt;
1117         }
1118     }
1119
1120     $logger->info("merge: transfer succeeded");
1121     $e->commit;
1122     return 1;
1123 }
1124
1125
1126
1127
1128 __PACKAGE__->register_method(
1129     api_name => 'open-ils.cat.call_number.find_or_create',
1130     method   => 'find_or_create_volume',
1131 );
1132
1133 sub find_or_create_volume {
1134     my( $self, $conn, $auth, $label, $record_id, $org_id, $prefix, $suffix, $label_class ) = @_;
1135     my $e = new_editor(authtoken=>$auth, xact=>1);
1136     return $e->die_event unless $e->checkauth;
1137     my ($vol, $evt, $exists) =
1138         OpenILS::Application::Cat::AssetCommon->find_or_create_volume($e, $label, $record_id, $org_id, $prefix, $suffix, $label_class);
1139     return $evt if $evt;
1140     $e->rollback if $exists;
1141     $e->commit if $vol;
1142     return { 'acn_id' => $vol->id, 'existed' => $exists };
1143 }
1144
1145
1146 __PACKAGE__->register_method(
1147     method    => "create_serial_record_xml",
1148     api_name  => "open-ils.cat.serial.record.xml.create.override",
1149     signature => q/@see open-ils.cat.serial.record.xml.create/);
1150
1151 __PACKAGE__->register_method(
1152     method    => "create_serial_record_xml",
1153     api_name  => "open-ils.cat.serial.record.xml.create",
1154     signature => q/
1155         Inserts a new serial record with the given XML
1156     /
1157 );
1158
1159 sub create_serial_record_xml {
1160     my( $self, $client, $login, $source, $owning_lib, $record_id, $xml ) = @_;
1161
1162     my $override = 1 if $self->api_name =~ /override/; # not currently used
1163
1164     my $e = new_editor(xact=>1, authtoken=>$login);
1165     return $e->die_event unless $e->checkauth;
1166     return $e->die_event unless $e->allowed('CREATE_MFHD_RECORD', $owning_lib);
1167
1168     # Auto-populate the location field of a placeholder MFHD record with the library name
1169     my $aou = $e->retrieve_actor_org_unit($owning_lib) or return $e->die_event;
1170
1171     my $mfhd = Fieldmapper::serial::record_entry->new;
1172
1173     $mfhd->source($source) if $source;
1174     $mfhd->record($record_id);
1175     $mfhd->creator($e->requestor->id);
1176     $mfhd->editor($e->requestor->id);
1177     $mfhd->create_date('now');
1178     $mfhd->edit_date('now');
1179     $mfhd->owning_lib($owning_lib);
1180
1181     # If the caller did not pass in MFHD XML, create a placeholder record.
1182     # The placeholder will only contain the name of the owning library.
1183     # The goal is to generate common patterns for the caller in the UI that
1184     # then get passed in here.
1185     if (!$xml) {
1186         my $aou_name = $aou->name;
1187         $xml = <<HERE;
1188 <record
1189  xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1190  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
1191  xmlns="http://www.loc.gov/MARC21/slim">
1192 <leader>00307ny  a22001094  4500</leader>
1193 <controlfield tag="001">42153</controlfield>
1194 <controlfield tag="005">20090601182414.0</controlfield>
1195 <controlfield tag="004">$record_id</controlfield>
1196 <controlfield tag="008">      4u####8###l# 4   uueng1      </controlfield>
1197 <datafield tag="852" ind1=" " ind2=" "> <subfield code="b">$aou_name</subfield></datafield>
1198 </record>
1199 HERE
1200     }
1201     my $marcxml = XML::LibXML->new->parse_string($xml);
1202     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim", "marc", 1 );
1203     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim");
1204
1205     $mfhd->marc($U->entityize($marcxml->documentElement->toString));
1206
1207     $e->create_serial_record_entry($mfhd) or return $e->die_event;
1208
1209     $e->commit;
1210     return $mfhd->id;
1211 }
1212
1213 __PACKAGE__->register_method(
1214     method   => "create_update_asset_copy_template",
1215     api_name => "open-ils.cat.asset.copy_template.create_or_update"
1216 );
1217
1218 sub create_update_asset_copy_template {
1219     my ($self, $client, $authtoken, $act) = @_;
1220
1221     my $e = new_editor("xact" => 1, "authtoken" => $authtoken);
1222     return $e->die_event unless $e->checkauth;
1223     return $e->die_event unless $e->allowed(
1224         "ADMIN_ASSET_COPY_TEMPLATE", $act->owning_lib
1225     );
1226
1227     $act->editor($e->requestor->id);
1228     $act->edit_date("now");
1229
1230     my $retval;
1231     if (!$act->id) {
1232         $act->creator($e->requestor->id);
1233         $act->create_date("now");
1234
1235         $e->create_asset_copy_template($act) or return $e->die_event;
1236         $retval = $e->data;
1237     } else {
1238         $e->update_asset_copy_template($act) or return $e->die_event;
1239         $retval = $e->retrieve_asset_copy_template($e->data);
1240     }
1241     $e->commit and return $retval;
1242 }
1243
1244 1;
1245
1246 # vi:et:ts=4:sw=4