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 base qw/OpenILS::Application/;
   9 use Time::HiRes qw(time);
  10 use OpenSRF::EX qw(:try);
  11 use OpenSRF::Utils::JSON;
  12 use OpenILS::Utils::Fieldmapper;
  13 use OpenILS::Event;
  14 use OpenILS::Const qw/:const/;
  15
  16 use XML::LibXML;
  17 use Unicode::Normalize;
  18 use Data::Dumper;
  19 use OpenILS::Utils::FlatXML;
  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 $res = OpenILS::Application::Cat::BibCommon->biblio_record_replace_marc(
 163         $e, $recid, $newxml, $source,
 164         $self->api_name =~ /replace/o,
 165         $self->api_name =~ /override/o);
 166
 167     $e->commit unless $U->event_code($res);
 168     return $res;
 169 }
 170
 171 __PACKAGE__->register_method(
 172         method  => "update_biblio_record_entry",
 173         api_name        => "open-ils.cat.biblio.record_entry.update",
 174     signature => q/
 175         Updates a biblio.record_entry
 176         @param auth The authtoken
 177         @param record The record with updated values
 178         @return 1 on success, Event on error.
 179     /
 180 );
 181
 182 sub update_biblio_record_entry {
 183     my($self, $conn, $auth, $record) = @_;
 184     my $e = new_editor(authtoken=>$auth, xact=>1);
 185     return $e->die_event unless $e->checkauth;
 186     return $e->die_event unless $e->allowed('UPDATE_RECORD');
 187     $e->update_biblio_record_entry($record) or return $e->die_event;
 188     $e->commit;
 189     return 1;
 190 }
 191
 192 __PACKAGE__->register_method(
 193         method  => "undelete_biblio_record_entry",
 194         api_name        => "open-ils.cat.biblio.record_entry.undelete",
 195     signature => q/
 196         Un-deletes a record and sets active=true
 197         @param auth The authtoken
 198         @param record The record_id to ressurect
 199         @return 1 on success, Event on error.
 200     /
 201 );
 202 sub undelete_biblio_record_entry {
 203     my($self, $conn, $auth, $record_id) = @_;
 204     my $e = new_editor(authtoken=>$auth, xact=>1);
 205     return $e->die_event unless $e->checkauth;
 206     return $e->die_event unless $e->allowed('UPDATE_RECORD');
 207
 208     my $record = $e->retrieve_biblio_record_entry($record_id)
 209         or return $e->die_event;
 210     $record->deleted('f');
 211     $record->active('t');
 212
 213     # no 2 non-deleted records can have the same tcn_value
 214     my $existing = $e->search_biblio_record_entry(
 215         {   deleted => 'f',
 216             tcn_value => $record->tcn_value,
 217             id => {'!=' => $record_id}
 218         }, {idlist => 1});
 219     return OpenILS::Event->new('TCN_EXISTS') if @$existing;
 220
 221     $e->update_biblio_record_entry($record) or return $e->die_event;
 222     $e->commit;
 223     return 1;
 224 }
 225
 226
 227 __PACKAGE__->register_method(
 228         method  => "biblio_record_xml_import",
 229         api_name        => "open-ils.cat.biblio.record.xml.import.override",
 230         signature       => q/@see open-ils.cat.biblio.record.xml.import/);
 231
 232 __PACKAGE__->register_method(
 233         method  => "biblio_record_xml_import",
 234         api_name        => "open-ils.cat.biblio.record.xml.import",
 235         notes           => <<"  NOTES");
 236         Takes a marcxml record and imports the record into the database.  In this
 237         case, the marcxml record is assumed to be a complete record (i.e. valid
 238         MARC).  The title control number is taken from (whichever comes first)
 239         tags 001, 039[ab], 020a, 022a, 010, 035a and whichever does not already exist
 240         in the database.
 241         user_session must have IMPORT_MARC permissions
 242         NOTES
 243
 244
 245 sub biblio_record_xml_import {
 246         my( $self, $client, $authtoken, $xml, $source, $auto_tcn) = @_;
 247     my $e = new_editor(xact=>1, authtoken=>$authtoken);
 248     return $e->die_event unless $e->checkauth;
 249     return $e->die_event unless $e->allowed('IMPORT_MARC', $e->requestor->ws_ou);
 250
 251     my $res = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
 252         $e, $xml, $source, $auto_tcn, $self->api_name =~ /override/);
 253
 254     $e->commit unless $U->event_code($res);
 255     return $res;
 256 }
 257
 258 __PACKAGE__->register_method(
 259         method  => "biblio_record_record_metadata",
 260         api_name        => "open-ils.cat.biblio.record.metadata.retrieve",
 261     authoritative => 1,
 262         argc            => 1, #(session_id, biblio_tree )
 263         notes           => "Walks the tree and commits any changed nodes " .
 264                                         "adds any new nodes, and deletes any deleted nodes",
 265 );
 266
 267 sub biblio_record_record_metadata {
 268         my( $self, $client, $authtoken, $ids ) = @_;
 269
 270         return [] unless $ids and @$ids;
 271
 272         my $editor = new_editor(authtoken => $authtoken);
 273         return $editor->event unless $editor->checkauth;
 274         return $editor->event unless $editor->allowed('VIEW_USER');
 275
 276         my @results;
 277
 278         for(@$ids) {
 279                 return $editor->event unless
 280                         my $rec = $editor->retrieve_biblio_record_entry($_);
 281                 $rec->creator($editor->retrieve_actor_user($rec->creator));
 282                 $rec->editor($editor->retrieve_actor_user($rec->editor));
 283                 $rec->clear_marc; # slim the record down
 284                 push( @results, $rec );
 285         }
 286
 287         return \@results;
 288 }
 289
 290
 291
 292 __PACKAGE__->register_method(
 293         method  => "biblio_record_marc_cn",
 294         api_name        => "open-ils.cat.biblio.record.marc_cn.retrieve",
 295         argc            => 1, #(bib id )
 296 );
 297
 298 sub biblio_record_marc_cn {
 299         my( $self, $client, $id ) = @_;
 300
 301         my $session = OpenSRF::AppSession->create("open-ils.cstore");
 302         my $marc = $session
 303                 ->request("open-ils.cstore.direct.biblio.record_entry.retrieve", $id )
 304                 ->gather(1)
 305                 ->marc;
 306
 307         my $doc = XML::LibXML->new->parse_string($marc);
 308         $doc->documentElement->setNamespace( "http://www.loc.gov/MARC21/slim", "marc", 1 );
 309
 310         my @res;
 311         for my $tag ( qw/050 055 060 070 080 082 086 088 090 092 096 098 099/ ) {
 312                 my @node = $doc->findnodes("//marc:datafield[\@tag='$tag']");
 313                 for my $x (@node) {
 314                         my $cn = $x->findvalue("marc:subfield[\@code='a' or \@code='b']");
 315                         push @res, {$tag => $cn} if ($cn);
 316                 }
 317         }
 318
 319         return \@res
 320 }
 321
 322
 323 __PACKAGE__->register_method(
 324         method  => "orgs_for_title",
 325     authoritative => 1,
 326         api_name        => "open-ils.cat.actor.org_unit.retrieve_by_title"
 327 );
 328
 329 sub orgs_for_title {
 330         my( $self, $client, $record_id ) = @_;
 331
 332         my $vols = $U->simple_scalar_request(
 333                 "open-ils.cstore",
 334                 "open-ils.cstore.direct.asset.call_number.search.atomic",
 335                 { record => $record_id, deleted => 'f' });
 336
 337         my $orgs = { map {$_->owning_lib => 1 } @$vols };
 338         return [ keys %$orgs ];
 339 }
 340
 341
 342 __PACKAGE__->register_method(
 343         method  => "retrieve_copies",
 344     authoritative => 1,
 345         api_name        => "open-ils.cat.asset.copy_tree.retrieve");
 346
 347 __PACKAGE__->register_method(
 348         method  => "retrieve_copies",
 349         api_name        => "open-ils.cat.asset.copy_tree.global.retrieve");
 350
 351 # user_session may be null/undef
 352 sub retrieve_copies {
 353
 354         my( $self, $client, $user_session, $docid, @org_ids ) = @_;
 355
 356         if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
 357
 358         $docid = "$docid";
 359
 360         # grabbing copy trees should be available for everyone..
 361         if(!@org_ids and $user_session) {
 362                 my $user_obj =
 363                         OpenILS::Application::AppUtils->check_user_session( $user_session ); #throws EX on error
 364                         @org_ids = ($user_obj->home_ou);
 365         }
 366
 367         if( $self->api_name =~ /global/ ) {
 368                 return _build_volume_list( { record => $docid, deleted => 'f' } );
 369
 370         } else {
 371
 372                 my @all_vols;
 373                 for my $orgid (@org_ids) {
 374                         my $vols = _build_volume_list(
 375                                         { record => $docid, owning_lib => $orgid, deleted => 'f' } );
 376                         push( @all_vols, @$vols );
 377                 }
 378
 379                 return \@all_vols;
 380         }
 381
 382         return undef;
 383 }
 384
 385
 386 sub _build_volume_list {
 387         my $search_hash = shift;
 388
 389         $search_hash->{deleted} = 'f';
 390         my $e = new_editor();
 391
 392         my $vols = $e->search_asset_call_number($search_hash);
 393
 394         my @volumes;
 395
 396         for my $volume (@$vols) {
 397
 398                 my $copies = $e->search_asset_copy(
 399                         { call_number => $volume->id , deleted => 'f' });
 400
 401                 $copies = [ sort { $a->barcode cmp $b->barcode } @$copies  ];
 402
 403                 for my $c (@$copies) {
 404                         if( $c->status == OILS_COPY_STATUS_CHECKED_OUT ) {
 405                                 $c->circulations(
 406                                         $e->search_action_circulation(
 407                                                 [
 408                                                         { target_copy => $c->id },
 409                                                         {
 410                                                                 order_by => { circ => 'xact_start desc' },
 411                                                                 limit => 1
 412                                                         }
 413                                                 ]
 414                                         )
 415                                 )
 416                         }
 417                 }
 418
 419                 $volume->copies($copies);
 420                 push( @volumes, $volume );
 421         }
 422
 423         #$session->disconnect();
 424         return \@volumes;
 425
 426 }
 427
 428
 429 __PACKAGE__->register_method(
 430         method  => "fleshed_copy_update",
 431         api_name        => "open-ils.cat.asset.copy.fleshed.batch.update",);
 432
 433 __PACKAGE__->register_method(
 434         method  => "fleshed_copy_update",
 435         api_name        => "open-ils.cat.asset.copy.fleshed.batch.update.override",);
 436
 437
 438 sub fleshed_copy_update {
 439         my( $self, $conn, $auth, $copies, $delete_stats ) = @_;
 440         return 1 unless ref $copies;
 441         my( $reqr, $evt ) = $U->checkses($auth);
 442         return $evt if $evt;
 443         my $editor = new_editor(requestor => $reqr, xact => 1);
 444         my $override = $self->api_name =~ /override/;
 445         $evt = update_fleshed_copies($editor, $override, undef, $copies, $delete_stats);
 446         if( $evt ) {
 447                 $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
 448                 $editor->rollback;
 449                 return $evt;
 450         }
 451         $editor->commit;
 452         $logger->info("fleshed copy update successfully updated ".scalar(@$copies)." copies");
 453         return 1;
 454 }
 455
 456
 457 __PACKAGE__->register_method(
 458         method => 'merge',
 459         api_name        => 'open-ils.cat.biblio.records.merge',
 460         signature       => q/
 461                 Merges a group of records
 462                 @param auth The login session key
 463                 @param master The id of the record all other records should be merged into
 464                 @param records Array of records to be merged into the master record
 465                 @return 1 on success, Event on error.
 466         /
 467 );
 468
 469 sub merge {
 470         my( $self, $conn, $auth, $master, $records ) = @_;
 471         my( $reqr, $evt ) = $U->checkses($auth);
 472         return $evt if $evt;
 473         my $editor = new_editor( requestor => $reqr, xact => 1 );
 474         my $v = OpenILS::Application::Cat::Merge::merge_records($editor, $master, $records);
 475         return $v if $v;
 476         $editor->commit;
 477     # tell the client the merge is complete, then merge the holds
 478     $conn->respond_complete(1);
 479     merge_holds($master, $records);
 480         return undef;
 481 }
 482
 483 sub merge_holds {
 484     my($master, $records) = @_;
 485     return unless $master and @$records;
 486     return if @$records == 1 and $master == $$records[0];
 487
 488     my $e = new_editor(xact=>1);
 489     my $holds = $e->search_action_hold_request(
 490         {   cancel_time => undef,
 491             fulfillment_time => undef,
 492             hold_type => 'T',
 493             target => $records
 494         },
 495         {idlist=>1}
 496     );
 497
 498     for my $hold_id (@$holds) {
 499
 500         my $hold = $e->retrieve_action_hold_request($hold_id);
 501
 502         $logger->info("Changing hold ".$hold->id.
 503             " target from ".$hold->target." to $master in record merge");
 504
 505         $hold->target($master);
 506         unless($e->update_action_hold_request($hold)) {
 507             my $evt = $e->event;
 508             $logger->error("Error updating hold ". $evt->textcode .":". $evt->desc .":". $evt->stacktrace);
 509         }
 510     }
 511
 512     $e->commit;
 513     return undef;
 514 }
 515
 516
 517
 518
 519 # ---------------------------------------------------------------------------
 520 # returns true if the given title (id) has no un-deleted volumes or
 521 # copies attached.  If a context volume is defined, a record
 522 # is considered empty only if the context volume is the only
 523 # remaining volume on the record.
 524 # ---------------------------------------------------------------------------
 525 sub title_is_empty {
 526         my( $editor, $rid, $vol_id ) = @_;
 527
 528         return 0 if $rid == OILS_PRECAT_RECORD;
 529
 530         my $cnlist = $editor->search_asset_call_number(
 531                 { record => $rid, deleted => 'f' }, { idlist => 1 } );
 532
 533         return 1 unless @$cnlist; # no attached volumes
 534     return 0 if @$cnlist > 1; # multiple attached volumes
 535     return 0 unless $$cnlist[0] == $vol_id; # attached volume is not the context vol.
 536
 537     # see if the sole remaining context volume has any attached copies
 538         for my $cn (@$cnlist) {
 539                 my $copylist = $editor->search_asset_copy(
 540                         [
 541                                 { call_number => $cn, deleted => 'f' },
 542                                 { limit => 1 },
 543                         ], { idlist => 1 });
 544                 return 0 if @$copylist; # false if we find any copies
 545         }
 546
 547         return 1;
 548 }
 549
 550
 551 __PACKAGE__->register_method(
 552         method  => "fleshed_volume_update",
 553         api_name        => "open-ils.cat.asset.volume.fleshed.batch.update",);
 554
 555 __PACKAGE__->register_method(
 556         method  => "fleshed_volume_update",
 557         api_name        => "open-ils.cat.asset.volume.fleshed.batch.update.override",);
 558
 559 sub fleshed_volume_update {
 560         my( $self, $conn, $auth, $volumes, $delete_stats ) = @_;
 561         my( $reqr, $evt ) = $U->checkses($auth);
 562         return $evt if $evt;
 563
 564         my $override = ($self->api_name =~ /override/);
 565         my $editor = new_editor( requestor => $reqr, xact => 1 );
 566
 567         for my $vol (@$volumes) {
 568                 $logger->info("vol-update: investigating volume ".$vol->id);
 569
 570                 $vol->editor($reqr->id);
 571                 $vol->edit_date('now');
 572
 573                 my $copies = $vol->copies;
 574                 $vol->clear_copies;
 575
 576                 $vol->editor($editor->requestor->id);
 577                 $vol->edit_date('now');
 578
 579                 if( $vol->isdeleted ) {
 580
 581                         $logger->info("vol-update: deleting volume");
 582                         my $cs = $editor->search_asset_copy(
 583                                 { call_number => $vol->id, deleted => 'f' } );
 584                         return OpenILS::Event->new(
 585                                 'VOLUME_NOT_EMPTY', payload => $vol->id ) if @$cs;
 586
 587                         $vol->deleted('t');
 588                         return $editor->event unless
 589                                 $editor->update_asset_call_number($vol);
 590
 591
 592                 } elsif( $vol->isnew ) {
 593                         $logger->info("vol-update: creating volume");
 594                         $evt = create_volume( $override, $editor, $vol );
 595                         return $evt if $evt;
 596
 597                 } elsif( $vol->ischanged ) {
 598                         $logger->info("vol-update: update volume");
 599                         $evt = update_volume($vol, $editor);
 600                         return $evt if $evt;
 601                 }
 602
 603                 # now update any attached copies
 604                 if( $copies and @$copies and !$vol->isdeleted ) {
 605                         $_->call_number($vol->id) for @$copies;
 606                         $evt = update_fleshed_copies( $editor, $override, $vol, $copies, $delete_stats );
 607                         return $evt if $evt;
 608                 }
 609         }
 610
 611         $editor->finish;
 612         return scalar(@$volumes);
 613 }
 614
 615
 616 sub update_volume {
 617         my $vol = shift;
 618         my $editor = shift;
 619         my $evt;
 620
 621         return $evt if ( $evt = org_cannot_have_vols($editor, $vol->owning_lib) );
 622
 623         my $vols = $editor->search_asset_call_number( {
 624                         owning_lib      => $vol->owning_lib,
 625                         record          => $vol->record,
 626                         label                   => $vol->label,
 627                         deleted         => 'f'
 628                 }
 629         );
 630
 631         # There exists a different volume in the DB with the same properties
 632         return OpenILS::Event->new('VOLUME_LABEL_EXISTS', payload => $vol->id)
 633                 if grep { $_->id ne $vol->id } @$vols;
 634
 635         return $editor->event unless $editor->update_asset_call_number($vol);
 636         return undef;
 637 }
 638
 639
 640
 641 sub copy_perm_org {
 642         my( $vol, $copy ) = @_;
 643         my $org = $vol->owning_lib;
 644         if( $vol->id == OILS_PRECAT_CALL_NUMBER ) {
 645                 $org = ref($copy->circ_lib) ? $copy->circ_lib->id : $copy->circ_lib;
 646         }
 647         $logger->debug("using copy perm org $org");
 648         return $org;
 649 }
 650
 651
 652 # this does the actual work
 653 sub update_fleshed_copies {
 654         my( $editor, $override, $vol, $copies, $delete_stats ) = @_;
 655
 656         my $evt;
 657         my $fetchvol = ($vol) ? 0 : 1;
 658
 659         my %cache;
 660         $cache{$vol->id} = $vol if $vol;
 661
 662         for my $copy (@$copies) {
 663
 664                 my $copyid = $copy->id;
 665                 $logger->info("vol-update: inspecting copy $copyid");
 666
 667                 if( !($vol = $cache{$copy->call_number}) ) {
 668                         $vol = $cache{$copy->call_number} =
 669                                 $editor->retrieve_asset_call_number($copy->call_number);
 670                         return $editor->event unless $vol;
 671                 }
 672
 673                 return $editor->event unless
 674                         $editor->allowed('UPDATE_COPY', copy_perm_org($vol, $copy));
 675
 676                 $copy->editor($editor->requestor->id);
 677                 $copy->edit_date('now');
 678
 679                 $copy->status( $copy->status->id ) if ref($copy->status);
 680                 $copy->location( $copy->location->id ) if ref($copy->location);
 681                 $copy->circ_lib( $copy->circ_lib->id ) if ref($copy->circ_lib);
 682
 683                 my $sc_entries = $copy->stat_cat_entries;
 684                 $copy->clear_stat_cat_entries;
 685
 686                 if( $copy->isdeleted ) {
 687                         $evt = delete_copy($editor, $override, $vol, $copy);
 688                         return $evt if $evt;
 689
 690                 } elsif( $copy->isnew ) {
 691                         $evt = create_copy( $editor, $vol, $copy );
 692                         return $evt if $evt;
 693
 694                 } elsif( $copy->ischanged ) {
 695
 696                         $evt = update_copy( $editor, $override, $vol, $copy );
 697                         return $evt if $evt;
 698                 }
 699
 700                 $copy->stat_cat_entries( $sc_entries );
 701                 $evt = update_copy_stat_entries($editor, $copy, $delete_stats);
 702                 return $evt if $evt;
 703         }
 704
 705         $logger->debug("vol-update: done updating copy batch");
 706
 707         return undef;
 708 }
 709
 710 sub fix_copy_price {
 711         my $copy = shift;
 712
 713     if(defined $copy->price) {
 714             my $p = $copy->price || 0;
 715             $p =~ s/\$//og;
 716             $copy->price($p);
 717     }
 718
 719         my $d = $copy->deposit_amount || 0;
 720         $d =~ s/\$//og;
 721         $copy->deposit_amount($d);
 722 }
 723
 724
 725 sub update_copy {
 726         my( $editor, $override, $vol, $copy ) = @_;
 727
 728         my $evt;
 729         my $org = (ref $copy->circ_lib) ? $copy->circ_lib->id : $copy->circ_lib;
 730         return $evt if ( $evt = org_cannot_have_vols($editor, $org) );
 731
 732         $logger->info("vol-update: updating copy ".$copy->id);
 733         my $orig_copy = $editor->retrieve_asset_copy($copy->id);
 734         my $orig_vol  = $editor->retrieve_asset_call_number($copy->call_number);
 735
 736         $copy->editor($editor->requestor->id);
 737         $copy->edit_date('now');
 738
 739         $copy->age_protect( $copy->age_protect->id )
 740                 if ref $copy->age_protect;
 741
 742         fix_copy_price($copy);
 743
 744         return $editor->event unless $editor->update_asset_copy($copy);
 745         return remove_empty_objects($editor, $override, $orig_vol);
 746 }
 747
 748
 749 sub remove_empty_objects {
 750         my( $editor, $override, $vol ) = @_;
 751
 752     my $koe = $U->ou_ancestor_setting_value(
 753         $editor->requestor->ws_ou, 'cat.bib.keep_on_empty', $editor);
 754     my $aoe =  $U->ou_ancestor_setting_value(
 755         $editor->requestor->ws_ou, 'cat.bib.alert_on_empty', $editor);
 756
 757         if( title_is_empty($editor, $vol->record, $vol->id) ) {
 758
 759         # delete this volume if it's not already marked as deleted
 760         unless( $U->is_true($vol->deleted) || $vol->isdeleted ) {
 761             $vol->deleted('t');
 762             $vol->editor($editor->requestor->id);
 763             $vol->edit_date('now');
 764             $editor->update_asset_call_number($vol) or return $editor->event;
 765         }
 766
 767         unless($koe) {
 768             # delete the bib record if the keep-on-empty setting is not set
 769             my $evt = delete_rec($editor, $vol->record);
 770             return $evt if $evt;
 771         }
 772
 773         # return the empty alert if the alert-on-empty setting is set
 774         return OpenILS::Event->new('TITLE_LAST_COPY', payload => $vol->record ) if $aoe;
 775         }
 776
 777         return undef;
 778 }
 779
 780
 781 __PACKAGE__->register_method (
 782         method => 'delete_bib_record',
 783         api_name => 'open-ils.cat.biblio.record_entry.delete');
 784
 785 sub delete_bib_record {
 786     my($self, $conn, $auth, $rec_id) = @_;
 787     my $e = new_editor(xact=>1, authtoken=>$auth);
 788     return $e->die_event unless $e->checkauth;
 789     return $e->die_event unless $e->allowed('DELETE_RECORD', $e->requestor->ws_ou);
 790     my $vols = $e->search_asset_call_number({record=>$rec_id, deleted=>'f'});
 791     return OpenILS::Event->new('RECORD_NOT_EMPTY', payload=>$rec_id) if @$vols;
 792     my $evt = delete_rec($e, $rec_id);
 793     if($evt) { $e->rollback; return $evt; }
 794     $e->commit;
 795     return 1;
 796 }
 797
 798
 799 # marks a record as deleted
 800 sub delete_rec {
 801    my( $editor, $rec_id ) = @_;
 802
 803    my $rec = $editor->retrieve_biblio_record_entry($rec_id)
 804       or return $editor->event;
 805
 806    return undef if $U->is_true($rec->deleted);
 807
 808    $rec->deleted('t');
 809    $rec->active('f');
 810    $rec->editor( $editor->requestor->id );
 811    $rec->edit_date('now');
 812    $editor->update_biblio_record_entry($rec) or return $editor->event;
 813
 814    return undef;
 815 }
 816
 817
 818 sub delete_copy {
 819         my( $editor, $override, $vol, $copy ) = @_;
 820
 821    return $editor->event unless
 822       $editor->allowed('DELETE_COPY',copy_perm_org($vol, $copy));
 823
 824         my $stat = $U->copy_status($copy->status)->id;
 825
 826         unless($override) {
 827                 return OpenILS::Event->new('COPY_DELETE_WARNING', payload => $copy->id )
 828                         if $stat == OILS_COPY_STATUS_CHECKED_OUT or
 829                                 $stat == OILS_COPY_STATUS_IN_TRANSIT or
 830                                 $stat == OILS_COPY_STATUS_ON_HOLDS_SHELF or
 831                                 $stat == OILS_COPY_STATUS_ILL;
 832         }
 833
 834         $logger->info("vol-update: deleting copy ".$copy->id);
 835         $copy->deleted('t');
 836
 837         $copy->editor($editor->requestor->id);
 838         $copy->edit_date('now');
 839         $editor->update_asset_copy($copy) or return $editor->event;
 840
 841         # Delete any open transits for this copy
 842         my $transits = $editor->search_action_transit_copy(
 843                 { target_copy=>$copy->id, dest_recv_time => undef } );
 844
 845         for my $t (@$transits) {
 846                 $editor->delete_action_transit_copy($t)
 847                         or return $editor->event;
 848         }
 849
 850         return remove_empty_objects($editor, $override, $vol);
 851 }
 852
 853
 854 sub create_copy {
 855         my( $editor, $vol, $copy ) = @_;
 856
 857         my $existing = $editor->search_asset_copy(
 858                 { barcode => $copy->barcode, deleted => 'f' } );
 859
 860         return OpenILS::Event->new('ITEM_BARCODE_EXISTS') if @$existing;
 861
 862    # see if the volume this copy references is marked as deleted
 863    my $evol = $editor->retrieve_asset_call_number($copy->call_number)
 864       or return $editor->event;
 865    return OpenILS::Event->new('VOLUME_DELETED', vol => $evol->id)
 866       if $U->is_true($evol->deleted);
 867
 868         my $evt;
 869         my $org = (ref $copy->circ_lib) ? $copy->circ_lib->id : $copy->circ_lib;
 870         return $evt if ( $evt = org_cannot_have_vols($editor, $org) );
 871
 872         $copy->clear_id;
 873         $copy->creator($editor->requestor->id);
 874         $copy->create_date('now');
 875         fix_copy_price($copy);
 876
 877         $editor->create_asset_copy($copy) or return $editor->event;
 878         return undef;
 879 }
 880
 881 # if 'delete_stats' is true, the copy->stat_cat_entries data is
 882 # treated as the authoritative list for the copy. existing entries
 883 # that are not in said list will be deleted from the DB
 884 sub update_copy_stat_entries {
 885         my( $editor, $copy, $delete_stats ) = @_;
 886
 887         return undef if $copy->isdeleted;
 888         return undef unless $copy->ischanged or $copy->isnew;
 889
 890         my $evt;
 891         my $entries = $copy->stat_cat_entries;
 892
 893         if( $delete_stats ) {
 894                 $entries = ($entries and @$entries) ? $entries : [];
 895         } else {
 896                 return undef unless ($entries and @$entries);
 897         }
 898
 899         my $maps = $editor->search_asset_stat_cat_entry_copy_map({owning_copy=>$copy->id});
 900
 901         if(!$copy->isnew) {
 902                 # if there is no stat cat entry on the copy who's id matches the
 903                 # current map's id, remove the map from the database
 904                 for my $map (@$maps) {
 905                         if(! grep { $_->id == $map->stat_cat_entry } @$entries ) {
 906
 907                                 $logger->info("copy update found stale ".
 908                                         "stat cat entry map ".$map->id. " on copy ".$copy->id);
 909
 910                                 $editor->delete_asset_stat_cat_entry_copy_map($map)
 911                                         or return $editor->event;
 912                         }
 913                 }
 914         }
 915
 916         # go through the stat cat update/create process
 917         for my $entry (@$entries) {
 918                 next unless $entry;
 919
 920                 # if this link already exists in the DB, don't attempt to re-create it
 921                 next if( grep{$_->stat_cat_entry == $entry->id} @$maps );
 922
 923                 my $new_map = Fieldmapper::asset::stat_cat_entry_copy_map->new();
 924
 925                 my $sc = ref($entry->stat_cat) ? $entry->stat_cat->id : $entry->stat_cat;
 926
 927                 $new_map->stat_cat( $sc );
 928                 $new_map->stat_cat_entry( $entry->id );
 929                 $new_map->owning_copy( $copy->id );
 930
 931                 $editor->create_asset_stat_cat_entry_copy_map($new_map)
 932                         or return $editor->event;
 933
 934                 $logger->info("copy update created new stat cat entry map ".$editor->data);
 935         }
 936
 937         return undef;
 938 }
 939
 940
 941 sub create_volume {
 942         my( $override, $editor, $vol ) = @_;
 943         my $evt;
 944
 945         return $evt if ( $evt = org_cannot_have_vols($editor, $vol->owning_lib) );
 946
 947    # see if the record this volume references is marked as deleted
 948    my $rec = $editor->retrieve_biblio_record_entry($vol->record)
 949       or return $editor->event;
 950    return OpenILS::Event->new('BIB_RECORD_DELETED', rec => $rec->id)
 951       if $U->is_true($rec->deleted);
 952
 953         # first lets see if there are any collisions
 954         my $vols = $editor->search_asset_call_number( {
 955                         owning_lib      => $vol->owning_lib,
 956                         record          => $vol->record,
 957                         label                   => $vol->label,
 958                         deleted         => 'f'
 959                 }
 960         );
 961
 962         my $label = undef;
 963         if(@$vols) {
 964       # we've found an exising volume
 965                 if($override) {
 966                         $label = $vol->label;
 967                 } else {
 968                         return OpenILS::Event->new(
 969                                 'VOLUME_LABEL_EXISTS', payload => $vol->id);
 970                 }
 971         }
 972
 973         # create a temp label so we can create the new volume,
 974    # then de-dup it with the existing volume
 975         $vol->label( "__SYSTEM_TMP_$$".time) if $label;
 976
 977         $vol->creator($editor->requestor->id);
 978         $vol->create_date('now');
 979         $vol->editor($editor->requestor->id);
 980         $vol->edit_date('now');
 981         $vol->clear_id;
 982
 983         $editor->create_asset_call_number($vol) or return $editor->event;
 984
 985         if($label) {
 986                 # now restore the label and merge into the existing record
 987                 $vol->label($label);
 988                 (undef, $evt) =
 989                         OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $$vols[0]);
 990                 return $evt if $evt;
 991         }
 992
 993         return undef;
 994 }
 995
 996
 997 __PACKAGE__->register_method (
 998         method => 'batch_volume_transfer',
 999         api_name => 'open-ils.cat.asset.volume.batch.transfer',
1000 );
1001
1002 __PACKAGE__->register_method (
1003         method => 'batch_volume_transfer',
1004         api_name => 'open-ils.cat.asset.volume.batch.transfer.override',
1005 );
1006
1007
1008 sub batch_volume_transfer {
1009         my( $self, $conn, $auth, $args ) = @_;
1010
1011         my $evt;
1012         my $rec         = $$args{docid};
1013         my $o_lib       = $$args{lib};
1014         my $vol_ids = $$args{volumes};
1015
1016         my $override = 1 if $self->api_name =~ /override/;
1017
1018         $logger->info("merge: transferring volumes to lib=$o_lib and record=$rec");
1019
1020         my $e = new_editor(authtoken => $auth, xact =>1);
1021         return $e->event unless $e->checkauth;
1022         return $e->event unless $e->allowed('UPDATE_VOLUME', $o_lib);
1023
1024         my $dorg = $e->retrieve_actor_org_unit($o_lib)
1025                 or return $e->event;
1026
1027         my $ou_type = $e->retrieve_actor_org_unit_type($dorg->ou_type)
1028                 or return $e->event;
1029
1030         return $evt if ( $evt = org_cannot_have_vols($e, $o_lib) );
1031
1032         my $vols = $e->batch_retrieve_asset_call_number($vol_ids);
1033         my @seen;
1034
1035    my @rec_ids;
1036
1037         for my $vol (@$vols) {
1038
1039                 # if we've already looked at this volume, go to the next
1040                 next if !$vol or grep { $vol->id == $_ } @seen;
1041
1042                 # grab all of the volumes in the list that have
1043                 # the same label so they can be merged
1044                 my @all = grep { $_->label eq $vol->label } @$vols;
1045
1046                 # take note of the fact that we've looked at this set of volumes
1047                 push( @seen, $_->id ) for @all;
1048       push( @rec_ids, $_->record ) for @all;
1049
1050                 # for each volume, see if there are any copies that have a
1051                 # remote circ_lib (circ_lib != vol->owning_lib and != $o_lib ).
1052                 # if so, warn them
1053                 unless( $override ) {
1054                         for my $v (@all) {
1055
1056                                 $logger->debug("merge: searching for copies with remote circ_lib for volume ".$v->id);
1057                                 my $args = {
1058                                         call_number     => $v->id,
1059                                         circ_lib                => { "not in" => [ $o_lib, $v->owning_lib ] },
1060                                         deleted         => 'f'
1061                                 };
1062
1063                                 my $copies = $e->search_asset_copy($args, {idlist=>1});
1064
1065                                 # if the copy's circ_lib matches the destination lib,
1066                                 # that's ok too
1067                                 return OpenILS::Event->new('COPY_REMOTE_CIRC_LIB') if @$copies;
1068                         }
1069                 }
1070
1071                 # see if there is a volume at the destination lib that
1072                 # already has the requested label
1073                 my $existing_vol = $e->search_asset_call_number(
1074                         {
1075                                 label                   => $vol->label,
1076                                 record          =>$rec,
1077                                 owning_lib      =>$o_lib,
1078                                 deleted         => 'f'
1079                         }
1080                 )->[0];
1081
1082                 if( $existing_vol ) {
1083
1084                         if( grep { $_->id == $existing_vol->id } @all ) {
1085                                 # this volume is already accounted for in our list of volumes to merge
1086                                 $existing_vol = undef;
1087
1088                         } else {
1089                                 # this volume exists on the destination record/owning_lib and must
1090                                 # be used as the destination for merging
1091                                 $logger->debug("merge: volume already exists at destination record: ".
1092                                         $existing_vol->id.' : '.$existing_vol->label) if $existing_vol;
1093                         }
1094                 }
1095
1096                 if( @all > 1 || $existing_vol ) {
1097                         $logger->info("merge: found collisions in volume transfer");
1098                         my @args = ($e, \@all);
1099                         @args = ($e, \@all, $existing_vol) if $existing_vol;
1100                         ($vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes(@args);
1101                         return $evt if $evt;
1102                 }
1103
1104                 if( !$existing_vol ) {
1105
1106                         $vol->owning_lib($o_lib);
1107                         $vol->record($rec);
1108                         $vol->editor($e->requestor->id);
1109                         $vol->edit_date('now');
1110
1111                         $logger->info("merge: updating volume ".$vol->id);
1112                         $e->update_asset_call_number($vol) or return $e->event;
1113
1114                 } else {
1115                         $logger->info("merge: bypassing volume update because existing volume used as target");
1116                 }
1117
1118                 # regardless of what volume was used as the destination,
1119                 # update any copies that have moved over to the new lib
1120                 my $copies = $e->search_asset_copy({call_number=>$vol->id, deleted => 'f'});
1121
1122                 # update circ lib on the copies - make this a method flag?
1123                 for my $copy (@$copies) {
1124                         next if $copy->circ_lib == $o_lib;
1125                         $logger->info("merge: transfer moving circ lib on copy ".$copy->id);
1126                         $copy->circ_lib($o_lib);
1127                         $copy->editor($e->requestor->id);
1128                         $copy->edit_date('now');
1129                         $e->update_asset_copy($copy) or return $e->event;
1130                 }
1131
1132                 # Now see if any empty records need to be deleted after all of this
1133
1134       for(@rec_ids) {
1135          $logger->debug("merge: seeing if we should delete record $_...");
1136          $evt = delete_rec($e, $_) if title_is_empty($e, $_);
1137                         return $evt if $evt;
1138       }
1139
1140                 #for(@all) {
1141                 #       $evt = remove_empty_objects($e, $override, $_);
1142                 #}
1143         }
1144
1145         $logger->info("merge: transfer succeeded");
1146         $e->commit;
1147         return 1;
1148 }
1149
1150
1151
1152 sub org_cannot_have_vols {
1153         my $e = shift;
1154         my $org_id = shift;
1155
1156         my $org = $e->retrieve_actor_org_unit($org_id)
1157                 or return $e->event;
1158
1159         my $ou_type = $e->retrieve_actor_org_unit_type($org->ou_type)
1160                 or return $e->event;
1161
1162         return OpenILS::Event->new('ORG_CANNOT_HAVE_VOLS')
1163                 unless $U->is_true($ou_type->can_have_vols);
1164
1165         return 0;
1166 }
1167
1168
1169
1170
1171 __PACKAGE__->register_method(
1172         api_name => 'open-ils.cat.call_number.find_or_create',
1173         method => 'find_or_create_volume',
1174 );
1175
1176 sub find_or_create_volume {
1177         my( $self, $conn, $auth, $label, $record_id, $org_id ) = @_;
1178         my $e = new_editor(authtoken=>$auth, xact=>1);
1179         return $e->die_event unless $e->checkauth;
1180
1181     my $vol;
1182
1183     if($record_id == OILS_PRECAT_RECORD) {
1184
1185         $vol = $e->retrieve_asset_call_number(OILS_PRECAT_CALL_NUMBER)
1186             or return $e->die_event;
1187
1188     } else {
1189
1190             $vol = $e->search_asset_call_number(
1191                     {label => $label, record => $record_id, owning_lib => $org_id, deleted => 'f'},
1192                     {idlist=>1}
1193             )->[0];
1194     }
1195
1196         # If the volume exists, return the ID
1197         if( $vol ) { $e->rollback; return $vol; }
1198
1199         # -----------------------------------------------------------------
1200         # Otherwise, create a new volume with the given attributes
1201         # -----------------------------------------------------------------
1202
1203         return $e->die_event unless $e->allowed('UPDATE_VOLUME', $org_id);
1204
1205         $vol = Fieldmapper::asset::call_number->new;
1206         $vol->owning_lib($org_id);
1207         $vol->label($label);
1208         $vol->record($record_id);
1209
1210    my $evt = create_volume( 0, $e, $vol );
1211    return $evt if $evt;
1212
1213         $e->commit;
1214         return $vol->id;
1215 }
1216
1217
1218
1219 1;