Open-ILS/src/perlmods/lib/OpenILS/Application/Cat/BibCommon.pm

   1 package OpenILS::Application::Cat::BibCommon;
   2 use strict; use warnings;
   3 use OpenILS::Utils::CStoreEditor q/:funcs/;
   4 use OpenSRF::Utils::Logger qw($logger);
   5 use OpenILS::Application::AppUtils;
   6 use OpenILS::Utils::Fieldmapper;
   7 use OpenILS::Const qw/:const/;
   8 use OpenSRF::AppSession;
   9 use OpenILS::Event;
  10 my $U = 'OpenILS::Application::AppUtils';
  11
  12
  13 # ---------------------------------------------------------------------------
  14 # Shared bib mangling code.  Do not publish methods from here.
  15 # ---------------------------------------------------------------------------
  16
  17 my $__bib_sources;
  18 sub bib_source_from_name {
  19     my $name = shift;
  20     $logger->debug("searching for bib source: $name");
  21
  22     fetch_bib_sources();
  23
  24     my ($s) = grep { lc($_->source) eq lc($name) } @$__bib_sources;
  25
  26     return $s->id if $s;
  27     return undef;
  28 }
  29
  30 sub fetch_bib_sources {
  31     $__bib_sources = new_editor()->retrieve_all_config_bib_source()
  32         unless $__bib_sources;
  33     return $__bib_sources;
  34 }
  35
  36
  37 sub biblio_record_replace_marc  {
  38     my($class, $e, $recid, $newxml, $source, $fixtcn, $override, $strip_grps) = @_;
  39
  40     $override = { all => 1 } if($override && !ref $override);
  41     $override = { all => 0 } if(!ref $override);
  42
  43     my $rec = $e->retrieve_biblio_record_entry($recid)
  44         or return $e->die_event;
  45
  46     # See if there is a different record in the database that has our TCN value
  47     # If we're not updating the TCN, all we care about it the marcdoc
  48     # XXX should .update even bother with the tcn_info if it's not going to replace it?
  49     # there is the potential for returning a TCN_EXISTS event, even though no replacement happens
  50
  51     my( $tcn, $tsource, $marcdoc, $evt);
  52
  53     if($fixtcn or $override->{all} or $override->{events}) {
  54
  55         ($tcn, $tsource, $marcdoc, $evt) =
  56             _find_tcn_info($e, $newxml, $override, $recid);
  57
  58         return $evt if $evt;
  59
  60         $rec->tcn_value($tcn) if ($tcn);
  61         $rec->tcn_source($tsource);
  62
  63     } else {
  64
  65         $marcdoc = __make_marc_doc($newxml);
  66     }
  67
  68     my $marc = $U->strip_marc_fields($e, $marcdoc, $strip_grps);
  69
  70     $rec->source(bib_source_from_name($source)) if $source;
  71     $rec->editor($e->requestor->id);
  72     $rec->edit_date('now');
  73     $rec->marc($marc);
  74
  75     my $inline_ingest = $e->retrieve_config_global_flag('ingest.queued.biblio.update.marc_edit_inline');
  76     $inline_ingest = ($inline_ingest and $U->is_true($inline_ingest->enabled));
  77
  78     $e->json_query(
  79         {from => [ 'action.set_queued_ingest_force', 'ingest.queued.biblio.update.disabled' ]}
  80     ) if ($inline_ingest);
  81
  82     $e->update_biblio_record_entry($rec) or return $e->die_event;
  83
  84     $e->json_query(
  85         {from => ['action.clear_queued_ingest_force']}
  86     ) if ($inline_ingest);
  87
  88     return $rec;
  89 }
  90
  91 sub biblio_record_xml_import {
  92     my($class, $e, $xml, $source, $auto_tcn, $override, $strip_grps) = @_;
  93
  94     $override = { all => 1 } if($override && !ref $override);
  95     $override = { all => 0 } if(!ref $override);
  96
  97     my( $evt, $tcn, $tcn_source, $marcdoc );
  98
  99     my $use_id = $e->retrieve_config_global_flag('cat.bib.use_id_for_tcn');
 100     $use_id = ($use_id and $U->is_true($use_id->enabled));
 101
 102     if( $auto_tcn or $use_id ) {
 103         # auto_tcn forces a blank TCN value so the DB will have to generate one for us
 104         $marcdoc = __make_marc_doc($xml);
 105     } else {
 106         ( $tcn, $tcn_source, $marcdoc, $evt ) = _find_tcn_info($e, $xml, $override);
 107         return $evt if $evt;
 108     }
 109
 110     # Silence warnings when _find_tcn_info() fails
 111     $tcn ||= '';
 112     $tcn_source ||= '';
 113     $logger->info("user ".$e->requestor->id.
 114         " creating new biblio entry with tcn=$tcn and tcn_source $tcn_source");
 115
 116     my $marc = $U->strip_marc_fields($e, $marcdoc, $strip_grps);
 117
 118     my $record = Fieldmapper::biblio::record_entry->new;
 119
 120     $record->source(bib_source_from_name($source)) if $source;
 121     $record->tcn_source($tcn_source) if $tcn_source;
 122     $record->tcn_value($tcn) if ($tcn);
 123     $record->creator($e->requestor->id);
 124     $record->editor($e->requestor->id);
 125     $record->create_date('now');
 126     $record->edit_date('now');
 127     $record->marc($marc);
 128
 129     my $inline_ingest = $e->retrieve_config_global_flag('ingest.queued.biblio.insert.marc_edit_inline');
 130     $inline_ingest = ($inline_ingest and $U->is_true($inline_ingest->enabled));
 131
 132     $e->json_query(
 133         {from => [ 'action.set_queued_ingest_force', 'ingest.queued.biblio.insert.disabled' ]}
 134     ) if ($inline_ingest);
 135
 136     $record = $e->create_biblio_record_entry($record) or return $e->die_event;
 137
 138     $e->json_query(
 139         {from => ['action.clear_queued_ingest_force']}
 140     ) if ($inline_ingest);
 141
 142     if($use_id) {
 143         my $existing = $e->search_biblio_record_entry(
 144             {
 145                 tcn_value => $record->id,
 146                 deleted => 'f'
 147             }, {
 148                 idlist => 1
 149             }
 150         );
 151
 152         if(@$existing) {
 153             # leave the auto-generated tcn_value in place
 154             $logger->warn("Collision using internal ID as tcn_value for record " . $record->id);
 155         } else {
 156             $record->tcn_value($record->id);
 157             $e->update_biblio_record_entry($record) or return $e->die_event;
 158         }
 159     }
 160
 161     $logger->info("marc create/import created new record ".$record->id);
 162     return $record;
 163 }
 164
 165 sub __make_marc_doc {
 166     my $xml = shift;
 167     my $marcxml = XML::LibXML->new->parse_string($xml);
 168     $marcxml->documentElement->setNamespace(MARC_NAMESPACE, "marc", 1 );
 169     $marcxml->documentElement->setNamespace(MARC_NAMESPACE);
 170     __remove_empty_marc_nodes($marcxml);
 171     return $marcxml;
 172 }
 173
 174 # remove empty control fields, subfields, and variable data fields, which
 175 # can creep in via less-than-correct imported MARC records or issues
 176 # with templates
 177 sub __remove_empty_marc_nodes {
 178     my $marcxml = shift;
 179
 180     __remove_if_childless($_) foreach $marcxml->documentElement->getElementsByTagNameNS(MARC_NAMESPACE, 'controlfield');
 181     __remove_if_childless($_) foreach $marcxml->documentElement->getElementsByTagNameNS(MARC_NAMESPACE, 'subfield');
 182     __remove_if_childless($_) foreach $marcxml->documentElement->getElementsByTagNameNS(MARC_NAMESPACE, 'datafield');
 183 }
 184
 185 sub __remove_if_childless {
 186     my $node = shift;
 187     my @children = $node->childNodes();
 188     my $has_nonblank_children = 0;
 189     # can do this more concisely by requiring XML::LibXML >= 1.70 and using nonBlankChildNodes()
 190     foreach my $node ($node->childNodes()) {
 191         if ($node->nodeType != XML::LibXML::XML_TEXT_NODE || $node->nodeValue !~ /^\s*$/) {
 192             $has_nonblank_children = 1;
 193             last;
 194         }
 195     }
 196     $node->parentNode->removeChild($node) unless $has_nonblank_children;
 197 }
 198
 199 sub _find_tcn_info {
 200     my $editor      = shift;
 201     my $xml         = shift;
 202     my $override    = shift;
 203     my $existing_rec    = shift || 0;
 204
 205     $override = { all => 1 } if($override && !ref $override);
 206     $override = { all => 0 } if(!ref $override);
 207
 208     # parse the XML
 209     my $marcxml = __make_marc_doc($xml);
 210
 211     my $xpath = '//marc:controlfield[@tag="001"]';
 212     my $tcn = $marcxml->documentElement->findvalue($xpath);
 213     $logger->info("biblio import located 001 (tcn) value of $tcn");
 214
 215     $xpath = '//marc:controlfield[@tag="003"]';
 216     my $tcn_source = $marcxml->documentElement->findvalue($xpath) || "System Local";
 217
 218     if(my $rec = _tcn_exists($editor, $tcn, $tcn_source, $existing_rec) ) {
 219
 220         my $origtcn = $tcn;
 221         $tcn = find_free_tcn( $marcxml, $editor, $existing_rec );
 222
 223         # if we're overriding, try to find a different TCN to use
 224         if( $override->{all} || grep { $_ eq 'TCN_EXISTS' } @{$override->{events}} ) {
 225
 226          # XXX Create ALLOW_ALT_TCN permission check support
 227
 228             $logger->info("tcn value $tcn already exists, attempting to override");
 229
 230             if(!$tcn) {
 231                 return (
 232                     undef,
 233                     undef,
 234                     undef,
 235                     OpenILS::Event->new(
 236                         'OPEN_TCN_NOT_FOUND',
 237                             payload => $marcxml->toString())
 238                     );
 239             }
 240
 241         } else {
 242
 243             $logger->warn("tcn value $origtcn already exists in import/create");
 244
 245             # otherwise, return event
 246             return (
 247                 undef,
 248                 undef,
 249                 undef,
 250                 OpenILS::Event->new(
 251                     'TCN_EXISTS', payload => {
 252                         dup_record  => $rec,
 253                         tcn         => $origtcn,
 254                         new_tcn     => $tcn
 255                         }
 256                     )
 257                 );
 258         }
 259     }
 260
 261     return ($tcn, $tcn_source, $marcxml);
 262 }
 263
 264 sub find_free_tcn {
 265
 266     my $marcxml = shift;
 267     my $editor = shift;
 268     my $existing_rec = shift;
 269
 270     my $xpath = '//marc:datafield[@tag="901"]/marc:subfield[@code="a"]';
 271     my ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
 272
 273     if (!$tcn) {
 274         $xpath = '//marc:datafield[@tag="039"]/marc:subfield[@code="a"]';
 275         ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
 276     }
 277
 278     $xpath = '//marc:datafield[@tag="901"]/marc:subfield[@code="b"]';
 279     my ($tcn_source) = $marcxml->documentElement->findvalue($xpath);
 280     if (!$tcn_source) {
 281         $xpath = '//marc:datafield[@tag="039"]/marc:subfield[@code="b"]';
 282         $tcn_source = $marcxml->documentElement->findvalue($xpath) || "System Local";
 283     }
 284
 285     if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {
 286         $tcn = undef;
 287     }
 288
 289
 290     if(!$tcn) {
 291         $xpath = '//marc:datafield[@tag="020"]/marc:subfield[@code="a"]';
 292         ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
 293         $tcn_source = "ISBN";
 294         if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
 295     }
 296
 297     if(!$tcn) {
 298         $xpath = '//marc:datafield[@tag="022"]/marc:subfield[@code="a"]';
 299         ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
 300         $tcn_source = "ISSN";
 301         if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
 302     }
 303
 304     if(!$tcn) {
 305         $xpath = '//marc:datafield[@tag="010"]';
 306         ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
 307         $tcn_source = "LCCN";
 308         if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
 309     }
 310
 311     if(!$tcn) {
 312         $xpath = '//marc:datafield[@tag="035"]/marc:subfield[@code="a"]';
 313         ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
 314         $tcn_source = "System Legacy";
 315         if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
 316
 317         if($tcn) {
 318             $marcxml->documentElement->removeChild(
 319                 $marcxml->documentElement->findnodes( '//marc:datafield[@tag="035"]' )
 320             );
 321         }
 322     }
 323
 324     return undef unless $tcn;
 325     return $tcn;
 326 }
 327
 328
 329
 330 sub _tcn_exists {
 331     my $editor = shift;
 332     my $tcn = shift;
 333     my $source = shift;
 334     my $existing_rec = shift || 0;
 335
 336     if(!$tcn) {return 0;}
 337
 338     $logger->debug("tcn_exists search for tcn $tcn and source $source and id $existing_rec");
 339
 340     # XXX why does the source matter?
 341 #   my $req = $session->request(
 342 #       { tcn_value => $tcn, tcn_source => $source, deleted => 'f' } );
 343
 344     my $recs = $editor->search_biblio_record_entry(
 345         {tcn_value => $tcn, deleted => 'f', id => {'!=' => $existing_rec}}, {idlist =>1});
 346
 347     if(@$recs) {
 348         $logger->debug("_tcn_exists is true for tcn : $tcn ($source)");
 349         return $recs->[0];
 350     }
 351
 352     $logger->debug("_tcn_exists is false for tcn : $tcn ($source)");
 353     return 0;
 354 }
 355
 356
 357 sub delete_rec {
 358    my($class, $editor, $rec_id ) = @_;
 359
 360    my $rec = $editor->retrieve_biblio_record_entry($rec_id)
 361       or return $editor->event;
 362
 363    return undef if $U->is_true($rec->deleted);
 364
 365    $rec->deleted('t');
 366    $rec->active('f');
 367    $rec->editor( $editor->requestor->id );
 368    $rec->edit_date('now');
 369
 370    # Set the leader/05 to indicate that the record has been deleted
 371    my $marc = $rec->marc();
 372    $marc =~ s{(<leader>.{5}).}{$1d};
 373    $rec->marc($marc);
 374
 375    $editor->update_biblio_record_entry($rec) or return $editor->event;
 376
 377     my $holds = $editor->search_action_hold_request({
 378         target => $rec->id,
 379         hold_type => 'T',
 380         cancel_time => undef,
 381         fulfillment_time => undef
 382     });
 383
 384     for my $hold (@$holds) {
 385
 386         $hold->cancel_time('now');
 387         $hold->cancel_cause(1); # un-targeted expiration.
 388         $editor->update_action_hold_request($hold) or return $editor->die_event;
 389
 390         # Update our copy of the hold to pick up the cancel_time
 391         # before we pass it off to A/T.
 392         $hold = $editor->retrieve_action_hold_request($hold->id);
 393
 394         my $at_ses = OpenSRF::AppSession->create('open-ils.trigger');
 395         $at_ses->request(
 396             'open-ils.trigger.event.autocreate',
 397             'hold_request.cancel.expire_no_target',
 398             $hold, $hold->pickup_lib);
 399     }
 400
 401    return undef;
 402 }
 403
 404
 405 # ---------------------------------------------------------------------------
 406 # returns true if the given title (id) has no un-deleted volumes or
 407 # copies attached.  If a context volume is defined, a record
 408 # is considered empty only if the context volume is the only
 409 # remaining volume on the record.
 410 # ---------------------------------------------------------------------------
 411 sub title_is_empty {
 412     my($class, $editor, $rid, $vol_id) = @_;
 413
 414     # check if $rid is an object, because may be passing the volume
 415     # with a fleshed record in one of our callers.
 416     $rid = $rid->id() if (ref($rid));
 417
 418     return 0 if $rid == OILS_PRECAT_RECORD;
 419
 420     my $cnlist = $editor->search_asset_call_number(
 421         { record => $rid, deleted => 'f' }, { idlist => 1 } );
 422
 423     return 1 unless @$cnlist; # no attached volumes
 424     return 0 if @$cnlist > 1; # multiple attached volumes
 425     return 0 unless $$cnlist[0] == $vol_id; # attached volume is not the context vol.
 426
 427     # see if the sole remaining context volume has any attached copies
 428     for my $cn (@$cnlist) {
 429         my $copylist = $editor->search_asset_copy(
 430             [
 431                 { call_number => $cn, deleted => 'f' },
 432                 { limit => 1 },
 433             ], { idlist => 1 });
 434         return 0 if @$copylist; # false if we find any copies
 435     }
 436
 437     return 1;
 438 }
 439
 440 # --------------------------------------------------------------------------
 441 # returns true if the given title (id) has active hold requests on it
 442 # --------------------------------------------------------------------------
 443 sub title_has_holds {
 444     my($class, $editor, $rid) = @_;
 445
 446     # check if $rid is an object, because may be passing the volume
 447     # with a fleshed record in one of our callers.
 448     $rid = $rid->id() if (ref($rid));
 449
 450     my $holds = $editor->search_action_hold_request(
 451         [
 452            { fulfillment_time  => undef,
 453             cancel_time         => undef,
 454             hold_type           => 'T',
 455             target              => $rid },
 456            { limit => 1 },
 457         ], { idlist => 1 });
 458     return 0 unless @$holds;
 459
 460     return 1; # we found a hold
 461 }
 462 1;