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