Open-ILS/src/perlmods/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::FlatXML;
  21 use OpenILS::Utils::CStoreEditor q/:funcs/;
  22 use OpenILS::Perm;
  23 use OpenSRF::Utils::SettingsClient;
  24 use OpenSRF::Utils::Logger qw($logger);
  25 use OpenSRF::AppSession;
  26
  27 my $U = "OpenILS::Application::AppUtils";
  28 my $conf;
  29 my %marctemplates;
  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  => "update_biblio_record_entry",
 179         api_name        => "open-ils.cat.biblio.record_entry.update",
 180     signature => q/
 181         Updates a biblio.record_entry
 182         @param auth The authtoken
 183         @param record The record with updated values
 184         @return 1 on success, Event on error.
 185     /
 186 );
 187
 188 sub update_biblio_record_entry {
 189     my($self, $conn, $auth, $record) = @_;
 190     my $e = new_editor(authtoken=>$auth, xact=>1);
 191     return $e->die_event unless $e->checkauth;
 192     return $e->die_event unless $e->allowed('UPDATE_RECORD');
 193     $e->update_biblio_record_entry($record) or return $e->die_event;
 194     $e->commit;
 195     return 1;
 196 }
 197
 198 __PACKAGE__->register_method(
 199         method  => "undelete_biblio_record_entry",
 200         api_name        => "open-ils.cat.biblio.record_entry.undelete",
 201     signature => q/
 202         Un-deletes a record and sets active=true
 203         @param auth The authtoken
 204         @param record The record_id to ressurect
 205         @return 1 on success, Event on error.
 206     /
 207 );
 208 sub undelete_biblio_record_entry {
 209     my($self, $conn, $auth, $record_id) = @_;
 210     my $e = new_editor(authtoken=>$auth, xact=>1);
 211     return $e->die_event unless $e->checkauth;
 212     return $e->die_event unless $e->allowed('UPDATE_RECORD');
 213
 214     my $record = $e->retrieve_biblio_record_entry($record_id)
 215         or return $e->die_event;
 216     $record->deleted('f');
 217     $record->active('t');
 218
 219     # Set the leader/05 to indicate that the record has been corrected/revised
 220     my $marc = $record->marc();
 221     $marc =~ s{(<leader>.{5}).}{$1c};
 222     $record->marc($marc);
 223
 224     # no 2 non-deleted records can have the same tcn_value
 225     my $existing = $e->search_biblio_record_entry(
 226         {   deleted => 'f',
 227             tcn_value => $record->tcn_value,
 228             id => {'!=' => $record_id}
 229         }, {idlist => 1});
 230     return OpenILS::Event->new('TCN_EXISTS') if @$existing;
 231
 232     $e->update_biblio_record_entry($record) or return $e->die_event;
 233     $e->commit;
 234     return 1;
 235 }
 236
 237
 238 __PACKAGE__->register_method(
 239         method  => "biblio_record_xml_import",
 240         api_name        => "open-ils.cat.biblio.record.xml.import.override",
 241         signature       => q/@see open-ils.cat.biblio.record.xml.import/);
 242
 243 __PACKAGE__->register_method(
 244         method  => "biblio_record_xml_import",
 245         api_name        => "open-ils.cat.biblio.record.xml.import",
 246         notes           => <<"  NOTES");
 247         Takes a marcxml record and imports the record into the database.  In this
 248         case, the marcxml record is assumed to be a complete record (i.e. valid
 249         MARC).  The title control number is taken from (whichever comes first)
 250         tags 001, 039[ab], 020a, 022a, 010, 035a and whichever does not already exist
 251         in the database.
 252         user_session must have IMPORT_MARC permissions
 253         NOTES
 254
 255
 256 sub biblio_record_xml_import {
 257         my( $self, $client, $authtoken, $xml, $source, $auto_tcn) = @_;
 258     my $e = new_editor(xact=>1, authtoken=>$authtoken);
 259     return $e->die_event unless $e->checkauth;
 260     return $e->die_event unless $e->allowed('IMPORT_MARC', $e->requestor->ws_ou);
 261
 262         my $override = $self->api_name =~ /override/;
 263     my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
 264         $e, $xml, $source, $auto_tcn, $override);
 265
 266     return $record if $U->event_code($record);
 267
 268     $e->commit;
 269
 270     #my $ses = OpenSRF::AppSession->create('open-ils.ingest');
 271     #$ses->request('open-ils.ingest.full.biblio.record', $record->id);
 272
 273     return $record;
 274 }
 275
 276 __PACKAGE__->register_method(
 277         method  => "biblio_record_record_metadata",
 278         api_name        => "open-ils.cat.biblio.record.metadata.retrieve",
 279     authoritative => 1,
 280         argc            => 1, #(session_id, biblio_tree )
 281         notes           => "Walks the tree and commits any changed nodes " .
 282                                         "adds any new nodes, and deletes any deleted nodes",
 283 );
 284
 285 sub biblio_record_record_metadata {
 286         my( $self, $client, $authtoken, $ids ) = @_;
 287
 288         return [] unless $ids and @$ids;
 289
 290         my $editor = new_editor(authtoken => $authtoken);
 291         return $editor->event unless $editor->checkauth;
 292         return $editor->event unless $editor->allowed('VIEW_USER');
 293
 294         my @results;
 295
 296         for(@$ids) {
 297                 return $editor->event unless
 298                         my $rec = $editor->retrieve_biblio_record_entry($_);
 299                 $rec->creator($editor->retrieve_actor_user($rec->creator));
 300                 $rec->editor($editor->retrieve_actor_user($rec->editor));
 301                 $rec->clear_marc; # slim the record down
 302                 push( @results, $rec );
 303         }
 304
 305         return \@results;
 306 }
 307
 308
 309
 310 __PACKAGE__->register_method(
 311         method  => "biblio_record_marc_cn",
 312         api_name        => "open-ils.cat.biblio.record.marc_cn.retrieve",
 313         argc            => 1, #(bib id )
 314 );
 315
 316 sub biblio_record_marc_cn {
 317         my( $self, $client, $id ) = @_;
 318
 319         my $session = OpenSRF::AppSession->create("open-ils.cstore");
 320         my $marc = $session
 321                 ->request("open-ils.cstore.direct.biblio.record_entry.retrieve", $id )
 322                 ->gather(1)
 323                 ->marc;
 324
 325         my $doc = XML::LibXML->new->parse_string($marc);
 326         $doc->documentElement->setNamespace( "http://www.loc.gov/MARC21/slim", "marc", 1 );
 327
 328         my @res;
 329         for my $tag ( qw/050 055 060 070 080 082 086 088 090 092 096 098 099/ ) {
 330                 my @node = $doc->findnodes("//marc:datafield[\@tag='$tag']");
 331                 for my $x (@node) {
 332                         my $cn = $x->findvalue("marc:subfield[\@code='a' or \@code='b']");
 333                         push @res, {$tag => $cn} if ($cn);
 334                 }
 335         }
 336
 337         return \@res
 338 }
 339
 340 __PACKAGE__->register_method(
 341     method => 'autogen_barcodes',
 342     api_name    => "open-ils.cat.item.barcode.autogen",
 343     signature => {
 344         desc => 'Returns N generated barcodes following a specified barcode.',
 345         params => [
 346             {desc => 'Authentication token', type => 'string'},
 347             {desc => 'Barcode which the sequence should follow from', type => 'string'},
 348             {desc => 'Number of barcodes to generate', type => 'number'},
 349             {desc => 'Options hash.  Currently you can pass in checkdigit : false to disable the use of checkdigits.'}
 350         ],
 351         return => {desc => 'Array of generated barcodes'}
 352     }
 353 );
 354
 355 sub autogen_barcodes {
 356     my( $self, $client, $auth, $barcode, $num_of_barcodes, $options ) = @_;
 357     my $e = new_editor(authtoken => $auth);
 358     return $e->event unless $e->checkauth;
 359     return $e->event unless $e->allowed('UPDATE_COPY', $e->requestor->ws_ou);
 360     $options ||= {};
 361
 362     my @res;
 363     for (my $i = 1; $i <= $num_of_barcodes; $i++) {
 364         # default is to use checkdigits, so looking for an explicit false here
 365         if (defined $$options{'checkdigit'} && ! $$options{'checkdigit'}) {
 366             push @res, $barcode + $i;
 367         } else {
 368             if ($barcode !~ /^\d{13,14}$/) {
 369                 push @res, $barcode + $i;
 370             } else {
 371                 push @res, add_codabar_checkdigit($barcode + $i*10);
 372             }
 373         }
 374     }
 375     return \@res
 376 }
 377
 378 # Codabar doesn't define a checkdigit algorithm, but this one is typically used by libraries.  gmcharlt++
 379 sub add_codabar_checkdigit {
 380     my $barcode = shift;
 381
 382     return $barcode if $barcode !~ /^\d{13,14}$/;
 383     $barcode = substr($barcode, 0, 13); # ignore 14th digit
 384     my @digits = split //, $barcode;
 385     my $total = 0;
 386     $total += $digits[$_] foreach (1, 3, 5, 7, 9, 11);
 387     $total += (2 * $digits[$_] >= 10) ? (2 * $digits[$_] - 9) : (2 * $digits[$_]) foreach (0, 2, 4, 6, 8, 10, 12);
 388     my $remainder = $total % 10;
 389     my $checkdigit = ($remainder == 0) ? $remainder : 10 - $remainder;
 390     return $barcode . $checkdigit;
 391 }
 392
 393 __PACKAGE__->register_method(
 394         method  => "orgs_for_title",
 395     authoritative => 1,
 396         api_name        => "open-ils.cat.actor.org_unit.retrieve_by_title"
 397 );
 398
 399 sub orgs_for_title {
 400         my( $self, $client, $record_id ) = @_;
 401
 402         my $vols = $U->simple_scalar_request(
 403                 "open-ils.cstore",
 404                 "open-ils.cstore.direct.asset.call_number.search.atomic",
 405                 { record => $record_id, deleted => 'f' });
 406
 407         my $orgs = { map {$_->owning_lib => 1 } @$vols };
 408         return [ keys %$orgs ];
 409 }
 410
 411
 412 __PACKAGE__->register_method(
 413         method  => "retrieve_copies",
 414     authoritative => 1,
 415         api_name        => "open-ils.cat.asset.copy_tree.retrieve");
 416
 417 __PACKAGE__->register_method(
 418         method  => "retrieve_copies",
 419         api_name        => "open-ils.cat.asset.copy_tree.global.retrieve");
 420
 421 # user_session may be null/undef
 422 sub retrieve_copies {
 423
 424         my( $self, $client, $user_session, $docid, @org_ids ) = @_;
 425
 426         if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
 427
 428         $docid = "$docid";
 429
 430         # grabbing copy trees should be available for everyone..
 431         if(!@org_ids and $user_session) {
 432         my($user_obj, $evt) = OpenILS::Application::AppUtils->checkses($user_session);
 433         return $evt if $evt;
 434         @org_ids = ($user_obj->home_ou);
 435         }
 436
 437         if( $self->api_name =~ /global/ ) {
 438                 return _build_volume_list( { record => $docid, deleted => 'f', label => { '<>' => '##URI##' } } );
 439
 440         } else {
 441
 442                 my @all_vols;
 443                 for my $orgid (@org_ids) {
 444                         my $vols = _build_volume_list(
 445                                         { record => $docid, owning_lib => $orgid, deleted => 'f', label => { '<>' => '##URI##' } } );
 446                         push( @all_vols, @$vols );
 447                 }
 448
 449                 return \@all_vols;
 450         }
 451
 452         return undef;
 453 }
 454
 455
 456 sub _build_volume_list {
 457         my $search_hash = shift;
 458
 459         $search_hash->{deleted} = 'f';
 460         my $e = new_editor();
 461
 462         my $vols = $e->search_asset_call_number($search_hash);
 463
 464         my @volumes;
 465
 466         for my $volume (@$vols) {
 467
 468                 my $copies = $e->search_asset_copy(
 469                         { call_number => $volume->id , deleted => 'f' });
 470
 471                 $copies = [ sort { $a->barcode cmp $b->barcode } @$copies  ];
 472
 473                 for my $c (@$copies) {
 474                         if( $c->status == OILS_COPY_STATUS_CHECKED_OUT ) {
 475                                 $c->circulations(
 476                                         $e->search_action_circulation(
 477                                                 [
 478                                                         { target_copy => $c->id },
 479                                                         {
 480                                                                 order_by => { circ => 'xact_start desc' },
 481                                                                 limit => 1
 482                                                         }
 483                                                 ]
 484                                         )
 485                                 )
 486                         }
 487                 }
 488
 489                 $volume->copies($copies);
 490                 push( @volumes, $volume );
 491         }
 492
 493         #$session->disconnect();
 494         return \@volumes;
 495
 496 }
 497
 498
 499 __PACKAGE__->register_method(
 500         method  => "fleshed_copy_update",
 501         api_name        => "open-ils.cat.asset.copy.fleshed.batch.update",);
 502
 503 __PACKAGE__->register_method(
 504         method  => "fleshed_copy_update",
 505         api_name        => "open-ils.cat.asset.copy.fleshed.batch.update.override",);
 506
 507
 508 sub fleshed_copy_update {
 509         my( $self, $conn, $auth, $copies, $delete_stats ) = @_;
 510         return 1 unless ref $copies;
 511         my( $reqr, $evt ) = $U->checkses($auth);
 512         return $evt if $evt;
 513         my $editor = new_editor(requestor => $reqr, xact => 1);
 514         my $override = $self->api_name =~ /override/;
 515     my $retarget_holds = [];
 516         $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
 517         $editor, $override, undef, $copies, $delete_stats, $retarget_holds, undef);
 518
 519         if( $evt ) {
 520                 $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
 521                 $editor->rollback;
 522                 return $evt;
 523         }
 524
 525         $editor->commit;
 526         $logger->info("fleshed copy update successfully updated ".scalar(@$copies)." copies");
 527     reset_hold_list($auth, $retarget_holds);
 528
 529         return 1;
 530 }
 531
 532 sub reset_hold_list {
 533     my($auth, $hold_ids) = @_;
 534     return unless @$hold_ids;
 535     $logger->info("reseting holds after copy status change: @$hold_ids");
 536     my $ses = OpenSRF::AppSession->create('open-ils.circ');
 537     $ses->request('open-ils.circ.hold.reset.batch', $auth, $hold_ids);
 538 }
 539
 540
 541 __PACKAGE__->register_method(
 542         method => 'in_db_merge',
 543         api_name        => 'open-ils.cat.biblio.records.merge',
 544         signature       => q/
 545                 Merges a group of records
 546                 @param auth The login session key
 547                 @param master The id of the record all other records should be merged into
 548                 @param records Array of records to be merged into the master record
 549                 @return 1 on success, Event on error.
 550         /
 551 );
 552
 553 sub in_db_merge {
 554         my( $self, $conn, $auth, $master, $records ) = @_;
 555
 556         my $editor = new_editor( authtoken => $auth, xact => 1 );
 557     return $editor->die_event unless $editor->checkauth;
 558     return $editor->die_event unless $editor->allowed('MERGE_BIB_RECORDS'); # TODO see below about record ownership
 559
 560     my $count = 0;
 561     for my $source ( @$records ) {
 562         #XXX we actually /will/ want to check perms for master and sources after record ownership exists
 563
 564         # This stored proc (asset.merge_record_assets(target,source)) has the side effects of
 565         # moving call_number, title-type (and some volume-type) hold_request and uri-mapping
 566         # objects from the source record to the target record, so must be called from within
 567         # a transaction.
 568
 569         $count += $editor->json_query({
 570             select => {
 571                 bre => [{
 572                     alias => 'count',
 573                     transform => 'asset.merge_record_assets',
 574                     column => 'id',
 575                     params => [$source]
 576                 }]
 577             },
 578             from   => 'bre',
 579             where  => { id => $master }
 580         })->[0]->{count}; # count of objects moved, of all types
 581
 582     }
 583
 584         $editor->commit;
 585     return $count;
 586 }
 587
 588
 589 __PACKAGE__->register_method(
 590         method  => "fleshed_volume_update",
 591         api_name        => "open-ils.cat.asset.volume.fleshed.batch.update",);
 592
 593 __PACKAGE__->register_method(
 594         method  => "fleshed_volume_update",
 595         api_name        => "open-ils.cat.asset.volume.fleshed.batch.update.override",);
 596
 597 sub fleshed_volume_update {
 598         my( $self, $conn, $auth, $volumes, $delete_stats, $options ) = @_;
 599         my( $reqr, $evt ) = $U->checkses($auth);
 600         return $evt if $evt;
 601     $options ||= {};
 602
 603         my $override = ($self->api_name =~ /override/);
 604         my $editor = new_editor( requestor => $reqr, xact => 1 );
 605     my $retarget_holds = [];
 606     my $auto_merge_vols = $options->{auto_merge_vols};
 607
 608         for my $vol (@$volumes) {
 609                 $logger->info("vol-update: investigating volume ".$vol->id);
 610
 611                 $vol->editor($reqr->id);
 612                 $vol->edit_date('now');
 613
 614                 my $copies = $vol->copies;
 615                 $vol->clear_copies;
 616
 617                 $vol->editor($editor->requestor->id);
 618                 $vol->edit_date('now');
 619
 620                 if( $vol->isdeleted ) {
 621
 622                         $logger->info("vol-update: deleting volume");
 623                         my $cs = $editor->search_asset_copy(
 624                                 { call_number => $vol->id, deleted => 'f' } );
 625                         return OpenILS::Event->new(
 626                                 'VOLUME_NOT_EMPTY', payload => $vol->id ) if @$cs;
 627
 628                         $vol->deleted('t');
 629                         return $editor->event unless
 630                                 $editor->update_asset_call_number($vol);
 631
 632
 633                 } elsif( $vol->isnew ) {
 634                         $logger->info("vol-update: creating volume");
 635                         $evt = OpenILS::Application::Cat::AssetCommon->create_volume( $override, $editor, $vol );
 636                         return $evt if $evt;
 637
 638                 } elsif( $vol->ischanged ) {
 639                         $logger->info("vol-update: update volume");
 640                         my $resp = update_volume($vol, $editor, ($override or $auto_merge_vols));
 641                         return $resp->{evt} if $resp->{evt};
 642             $vol = $resp->{merge_vol};
 643                 }
 644
 645                 # now update any attached copies
 646                 if( $copies and @$copies and !$vol->isdeleted ) {
 647                         $_->call_number($vol->id) for @$copies;
 648                         $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
 649                 $editor, $override, $vol, $copies, $delete_stats, $retarget_holds, undef);
 650                         return $evt if $evt;
 651                 }
 652         }
 653
 654         $editor->finish;
 655     reset_hold_list($auth, $retarget_holds);
 656         return scalar(@$volumes);
 657 }
 658
 659
 660 sub update_volume {
 661         my $vol = shift;
 662         my $editor = shift;
 663     my $auto_merge = shift;
 664         my $evt;
 665     my $merge_vol;
 666
 667         return {evt => $evt}
 668         if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $vol->owning_lib) );
 669
 670         my $vols = $editor->search_asset_call_number({
 671         owning_lib      => $vol->owning_lib,
 672         record          => $vol->record,
 673         label           => $vol->label,
 674         deleted         => 'f',
 675         id          => {'!=' => $vol->id}
 676     });
 677
 678     if(@$vols) {
 679
 680         if($auto_merge) {
 681
 682             # If the auto-merge option is on, merge our updated volume into the existing
 683             # volume with the same record + owner + label.
 684             ($merge_vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $vols->[0]);
 685             return {evt => $evt, merge_vol => $merge_vol};
 686
 687         } else {
 688                 return {evt => OpenILS::Event->new('VOLUME_LABEL_EXISTS', payload => $vol->id)};
 689         }
 690     }
 691
 692         return {evt => $editor->die_event} unless $editor->update_asset_call_number($vol);
 693         return {};
 694 }
 695
 696
 697
 698 __PACKAGE__->register_method (
 699         method => 'delete_bib_record',
 700         api_name => 'open-ils.cat.biblio.record_entry.delete');
 701
 702 sub delete_bib_record {
 703     my($self, $conn, $auth, $rec_id) = @_;
 704     my $e = new_editor(xact=>1, authtoken=>$auth);
 705     return $e->die_event unless $e->checkauth;
 706     return $e->die_event unless $e->allowed('DELETE_RECORD', $e->requestor->ws_ou);
 707     my $vols = $e->search_asset_call_number({record=>$rec_id, deleted=>'f'});
 708     return OpenILS::Event->new('RECORD_NOT_EMPTY', payload=>$rec_id) if @$vols;
 709     my $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $rec_id);
 710     if($evt) { $e->rollback; return $evt; }
 711     $e->commit;
 712     return 1;
 713 }
 714
 715
 716
 717 __PACKAGE__->register_method (
 718         method => 'batch_volume_transfer',
 719         api_name => 'open-ils.cat.asset.volume.batch.transfer',
 720 );
 721
 722 __PACKAGE__->register_method (
 723         method => 'batch_volume_transfer',
 724         api_name => 'open-ils.cat.asset.volume.batch.transfer.override',
 725 );
 726
 727
 728 sub batch_volume_transfer {
 729         my( $self, $conn, $auth, $args ) = @_;
 730
 731         my $evt;
 732         my $rec         = $$args{docid};
 733         my $o_lib       = $$args{lib};
 734         my $vol_ids = $$args{volumes};
 735
 736         my $override = 1 if $self->api_name =~ /override/;
 737
 738         $logger->info("merge: transferring volumes to lib=$o_lib and record=$rec");
 739
 740         my $e = new_editor(authtoken => $auth, xact =>1);
 741         return $e->event unless $e->checkauth;
 742         return $e->event unless $e->allowed('UPDATE_VOLUME', $o_lib);
 743
 744         my $dorg = $e->retrieve_actor_org_unit($o_lib)
 745                 or return $e->event;
 746
 747         my $ou_type = $e->retrieve_actor_org_unit_type($dorg->ou_type)
 748                 or return $e->event;
 749
 750         return $evt if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($e, $o_lib) );
 751
 752         my $vols = $e->batch_retrieve_asset_call_number($vol_ids);
 753         my @seen;
 754
 755    my @rec_ids;
 756
 757         for my $vol (@$vols) {
 758
 759         # if we've already looked at this volume, go to the next
 760         next if !$vol or grep { $vol->id == $_ } @seen;
 761
 762                 # grab all of the volumes in the list that have
 763                 # the same label so they can be merged
 764                 my @all = grep { $_->label eq $vol->label } @$vols;
 765
 766                 # take note of the fact that we've looked at this set of volumes
 767                 push( @seen, $_->id ) for @all;
 768         push( @rec_ids, $_->record ) for @all;
 769
 770                 # for each volume, see if there are any copies that have a
 771                 # remote circ_lib (circ_lib != vol->owning_lib and != $o_lib ).
 772                 # if so, warn them
 773                 unless( $override ) {
 774                         for my $v (@all) {
 775
 776                                 $logger->debug("merge: searching for copies with remote circ_lib for volume ".$v->id);
 777                                 my $args = {
 778                                         call_number     => $v->id,
 779                                         circ_lib                => { "not in" => [ $o_lib, $v->owning_lib ] },
 780                                         deleted         => 'f'
 781                                 };
 782
 783                                 my $copies = $e->search_asset_copy($args, {idlist=>1});
 784
 785                                 # if the copy's circ_lib matches the destination lib,
 786                                 # that's ok too
 787                                 return OpenILS::Event->new('COPY_REMOTE_CIRC_LIB') if @$copies;
 788                         }
 789                 }
 790
 791                 # see if there is a volume at the destination lib that
 792                 # already has the requested label
 793                 my $existing_vol = $e->search_asset_call_number(
 794                         {
 795                                 label                   => $vol->label,
 796                                 record          =>$rec,
 797                                 owning_lib      =>$o_lib,
 798                                 deleted         => 'f'
 799                         }
 800                 )->[0];
 801
 802                 if( $existing_vol ) {
 803
 804                         if( grep { $_->id == $existing_vol->id } @all ) {
 805                                 # this volume is already accounted for in our list of volumes to merge
 806                                 $existing_vol = undef;
 807
 808                         } else {
 809                                 # this volume exists on the destination record/owning_lib and must
 810                                 # be used as the destination for merging
 811                                 $logger->debug("merge: volume already exists at destination record: ".
 812                                         $existing_vol->id.' : '.$existing_vol->label) if $existing_vol;
 813                         }
 814                 }
 815
 816                 if( @all > 1 || $existing_vol ) {
 817                         $logger->info("merge: found collisions in volume transfer");
 818                         my @args = ($e, \@all);
 819                         @args = ($e, \@all, $existing_vol) if $existing_vol;
 820                         ($vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes(@args);
 821                         return $evt if $evt;
 822                 }
 823
 824                 if( !$existing_vol ) {
 825
 826                         $vol->owning_lib($o_lib);
 827                         $vol->record($rec);
 828                         $vol->editor($e->requestor->id);
 829                         $vol->edit_date('now');
 830
 831                         $logger->info("merge: updating volume ".$vol->id);
 832                         $e->update_asset_call_number($vol) or return $e->event;
 833
 834                 } else {
 835                         $logger->info("merge: bypassing volume update because existing volume used as target");
 836                 }
 837
 838                 # regardless of what volume was used as the destination,
 839                 # update any copies that have moved over to the new lib
 840                 my $copies = $e->search_asset_copy({call_number=>$vol->id, deleted => 'f'});
 841
 842                 # update circ lib on the copies - make this a method flag?
 843                 for my $copy (@$copies) {
 844                         next if $copy->circ_lib == $o_lib;
 845                         $logger->info("merge: transfer moving circ lib on copy ".$copy->id);
 846                         $copy->circ_lib($o_lib);
 847                         $copy->editor($e->requestor->id);
 848                         $copy->edit_date('now');
 849                         $e->update_asset_copy($copy) or return $e->event;
 850                 }
 851
 852                 # Now see if any empty records need to be deleted after all of this
 853
 854         for(@rec_ids) {
 855             $logger->debug("merge: seeing if we should delete record $_...");
 856             $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $_)
 857                 if OpenILS::Application::Cat::BibCommon->title_is_empty($e, $_);
 858             return $evt if $evt;
 859         }
 860         }
 861
 862         $logger->info("merge: transfer succeeded");
 863         $e->commit;
 864         return 1;
 865 }
 866
 867
 868
 869
 870 __PACKAGE__->register_method(
 871         api_name => 'open-ils.cat.call_number.find_or_create',
 872         method => 'find_or_create_volume',
 873 );
 874
 875 sub find_or_create_volume {
 876         my( $self, $conn, $auth, $label, $record_id, $org_id ) = @_;
 877         my $e = new_editor(authtoken=>$auth, xact=>1);
 878         return $e->die_event unless $e->checkauth;
 879     my ($vol, $evt, $exists) =
 880         OpenILS::Application::Cat::AssetCommon->find_or_create_volume($e, $label, $record_id, $org_id);
 881     return $evt if $evt;
 882     $e->rollback if $exists;
 883     $e->commit if $vol;
 884     return $vol->id;
 885 }
 886
 887
 888 __PACKAGE__->register_method(
 889         method  => "create_serial_record_xml",
 890         api_name        => "open-ils.cat.serial.record.xml.create.override",
 891         signature       => q/@see open-ils.cat.serial.record.xml.create/);
 892
 893 __PACKAGE__->register_method(
 894         method          => "create_serial_record_xml",
 895         api_name                => "open-ils.cat.serial.record.xml.create",
 896         signature       => q/
 897                 Inserts a new serial record with the given XML
 898         /
 899 );
 900
 901 sub create_serial_record_xml {
 902         my( $self, $client, $login, $source, $owning_lib, $record_id, $xml ) = @_;
 903
 904         my $override = 1 if $self->api_name =~ /override/; # not currently used
 905
 906         my $e = new_editor(xact=>1, authtoken=>$login);
 907         return $e->die_event unless $e->checkauth;
 908         return $e->die_event unless $e->allowed('CREATE_MFHD_RECORD', $owning_lib);
 909
 910         # Auto-populate the location field of a placeholder MFHD record with the library name
 911         my $aou = $e->retrieve_actor_org_unit($owning_lib) or return $e->die_event;
 912
 913         my $mfhd = Fieldmapper::serial::record_entry->new;
 914
 915         $mfhd->source($source) if $source;
 916         $mfhd->record($record_id);
 917         $mfhd->creator($e->requestor->id);
 918         $mfhd->editor($e->requestor->id);
 919         $mfhd->create_date('now');
 920         $mfhd->edit_date('now');
 921         $mfhd->owning_lib($owning_lib);
 922
 923         # If the caller did not pass in MFHD XML, create a placeholder record.
 924         # The placeholder will only contain the name of the owning library.
 925         # The goal is to generate common patterns for the caller in the UI that
 926         # then get passed in here.
 927         if (!$xml) {
 928                 $xml = "<record xsi:schemaLocation=\"http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd\" xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" xmlns=\"http://www.loc.gov/MARC21/slim\"> <leader>00307ny  a22001094  4500</leader> <controlfield tag=\"001\">42153</controlfield> <controlfield tag=\"005\">20090601182414.0</controlfield> <controlfield tag=\"008\">      4u####8###l# 4   uueng1      </controlfield> <datafield tag=\"852\" ind1=\" \" ind2=\" \"> <subfield code=\"b\">" . $aou->name . "</subfield> </datafield></record>";
 929         }
 930         my $marcxml = XML::LibXML->new->parse_string($xml);
 931         $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim", "marc", 1 );
 932         $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim");
 933
 934         $mfhd->marc($U->entityize($marcxml->documentElement->toString));
 935
 936         $e->create_serial_record_entry($mfhd) or return $e->die_event;
 937
 938         $e->commit;
 939         return $mfhd->id;
 940 }
 941
 942 1;