Open-ILS/src/perlmods/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 my $MARC_NAMESPACE = 'http://www.loc.gov/MARC21/slim';
  12
  13
  14 # ---------------------------------------------------------------------------
  15 # Shared bib mangling code.  Do not publish methods from here.
  16 # ---------------------------------------------------------------------------
  17
  18 my $__bib_sources;
  19 sub bib_source_from_name {
  20         my $name = shift;
  21         $logger->debug("searching for bib source: $name");
  22
  23         fetch_bib_sources();
  24
  25         my ($s) = grep { lc($_->source) eq lc($name) } @$__bib_sources;
  26
  27         return $s->id if $s;
  28         return undef;
  29 }
  30
  31 sub fetch_bib_sources {
  32         $__bib_sources = new_editor()->retrieve_all_config_bib_source()
  33                 unless $__bib_sources;
  34         return $__bib_sources;
  35 }
  36
  37
  38 sub biblio_record_replace_marc  {
  39         my($class, $e, $recid, $newxml, $source, $fixtcn, $override) = @_;
  40
  41         my $rec = $e->retrieve_biblio_record_entry($recid)
  42                 or return $e->die_event;
  43
  44     # See if there is a different record in the database that has our TCN value
  45     # If we're not updating the TCN, all we care about it the marcdoc
  46     # XXX should .update even bother with the tcn_info if it's not going to replace it?
  47     # there is the potential for returning a TCN_EXISTS event, even though no replacement happens
  48
  49         my( $tcn, $tsource, $marcdoc, $evt);
  50
  51     if($fixtcn or $override) {
  52
  53             ($tcn, $tsource, $marcdoc, $evt) =
  54                     _find_tcn_info($e, $newxml, $override, $recid);
  55
  56             return $evt if $evt;
  57
  58                 $rec->tcn_value($tcn) if ($tcn);
  59                 $rec->tcn_source($tsource);
  60
  61     } else {
  62
  63         $marcdoc = __make_marc_doc($newxml);
  64     }
  65
  66
  67         $rec->source(bib_source_from_name($source)) if $source;
  68         $rec->editor($e->requestor->id);
  69         $rec->edit_date('now');
  70         $rec->marc( $U->entityize( $marcdoc->documentElement->toString ) );
  71         $e->update_biblio_record_entry($rec) or return $e->die_event;
  72
  73         return $rec;
  74 }
  75
  76 sub biblio_record_xml_import {
  77         my($class, $e, $xml, $source, $auto_tcn, $override) = @_;
  78
  79         my( $evt, $tcn, $tcn_source, $marcdoc );
  80
  81         if( $auto_tcn ) {
  82                 # auto_tcn forces a blank TCN value so the DB will have to generate one for us
  83                 $marcdoc = __make_marc_doc($xml);
  84         } else {
  85                 ( $tcn, $tcn_source, $marcdoc, $evt ) = _find_tcn_info($e, $xml, $override);
  86                 return $evt if $evt;
  87         }
  88
  89         $logger->info("user ".$e->requestor->id.
  90                 " creating new biblio entry with tcn=$tcn and tcn_source $tcn_source");
  91
  92         my $record = Fieldmapper::biblio::record_entry->new;
  93
  94         $record->source(bib_source_from_name($source)) if $source;
  95         $record->tcn_source($tcn_source);
  96         $record->tcn_value($tcn) if ($tcn);
  97         $record->creator($e->requestor->id);
  98         $record->editor($e->requestor->id);
  99         $record->create_date('now');
 100         $record->edit_date('now');
 101         $record->marc($U->entityize($marcdoc->documentElement->toString));
 102
 103     $record = $e->create_biblio_record_entry($record) or return $e->die_event;
 104         $logger->info("marc create/import created new record ".$record->id);
 105
 106         return $record;
 107 }
 108
 109 sub __make_marc_doc {
 110         my $xml = shift;
 111         my $marcxml = XML::LibXML->new->parse_string($xml);
 112         $marcxml->documentElement->setNamespace($MARC_NAMESPACE, "marc", 1 );
 113         $marcxml->documentElement->setNamespace($MARC_NAMESPACE);
 114         return $marcxml;
 115 }
 116
 117
 118 sub _find_tcn_info {
 119         my $editor              = shift;
 120         my $xml                 = shift;
 121         my $override    = shift;
 122         my $existing_rec        = shift || 0;
 123
 124         # parse the XML
 125         my $marcxml = __make_marc_doc($xml);
 126
 127         my $xpath = '//marc:controlfield[@tag="001"]';
 128         my $tcn = $marcxml->documentElement->findvalue($xpath);
 129         $logger->info("biblio import located 001 (tcn) value of $tcn");
 130
 131         $xpath = '//marc:controlfield[@tag="003"]';
 132         my $tcn_source = $marcxml->documentElement->findvalue($xpath) || "System Local";
 133
 134         if(my $rec = _tcn_exists($editor, $tcn, $tcn_source, $existing_rec) ) {
 135
 136                 my $origtcn = $tcn;
 137                 $tcn = find_free_tcn( $marcxml, $editor, $existing_rec );
 138
 139                 # if we're overriding, try to find a different TCN to use
 140                 if( $override ) {
 141
 142          # XXX Create ALLOW_ALT_TCN permission check support
 143
 144                         $logger->info("tcn value $tcn already exists, attempting to override");
 145
 146                         if(!$tcn) {
 147                                 return (
 148                                         undef,
 149                                         undef,
 150                                         undef,
 151                                         OpenILS::Event->new(
 152                                                 'OPEN_TCN_NOT_FOUND',
 153                                                         payload => $marcxml->toString())
 154                                         );
 155                         }
 156
 157                 } else {
 158
 159                         $logger->warn("tcn value $origtcn already exists in import/create");
 160
 161                         # otherwise, return event
 162                         return (
 163                                 undef,
 164                                 undef,
 165                                 undef,
 166                                 OpenILS::Event->new(
 167                                         'TCN_EXISTS', payload => {
 168                                                 dup_record      => $rec,
 169                                                 tcn                     => $origtcn,
 170                                                 new_tcn         => $tcn
 171                                                 }
 172                                         )
 173                                 );
 174                 }
 175         }
 176
 177         return ($tcn, $tcn_source, $marcxml);
 178 }
 179
 180 sub find_free_tcn {
 181
 182         my $marcxml = shift;
 183         my $editor = shift;
 184         my $existing_rec = shift;
 185
 186         my $add_901 = 0;
 187
 188         my $xpath = '//marc:datafield[@tag="901"]/marc:subfield[@code="a"]';
 189         my ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
 190
 191     if (!$tcn) {
 192             $xpath = '//marc:datafield[@tag="039"]/marc:subfield[@code="a"]';
 193             ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
 194     }
 195
 196         $xpath = '//marc:datafield[@tag="901"]/marc:subfield[@code="b"]';
 197         my ($tcn_source) = $marcxml->documentElement->findvalue($xpath);
 198     if (!$tcn_source) {
 199             $xpath = '//marc:datafield[@tag="039"]/marc:subfield[@code="b"]';
 200         $tcn_source = $marcxml->documentElement->findvalue($xpath) || "System Local";
 201     }
 202
 203         if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {
 204                 $tcn = undef;
 205         } else {
 206                 $add_901++;
 207         }
 208
 209
 210         if(!$tcn) {
 211                 $xpath = '//marc:datafield[@tag="020"]/marc:subfield[@code="a"]';
 212                 ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
 213                 $tcn_source = "ISBN";
 214                 if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
 215         }
 216
 217         if(!$tcn) {
 218                 $xpath = '//marc:datafield[@tag="022"]/marc:subfield[@code="a"]';
 219                 ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
 220                 $tcn_source = "ISSN";
 221                 if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
 222         }
 223
 224         if(!$tcn) {
 225                 $xpath = '//marc:datafield[@tag="010"]';
 226                 ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
 227                 $tcn_source = "LCCN";
 228                 if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
 229         }
 230
 231         if(!$tcn) {
 232                 $xpath = '//marc:datafield[@tag="035"]/marc:subfield[@code="a"]';
 233                 ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
 234                 $tcn_source = "System Legacy";
 235                 if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
 236
 237                 if($tcn) {
 238                         $marcxml->documentElement->removeChild(
 239                                 $marcxml->documentElement->findnodes( '//marc:datafield[@tag="035"]' )
 240                         );
 241                 }
 242         }
 243
 244         return undef unless $tcn;
 245
 246         if ($add_901) {
 247                 my $df = $marcxml->createElementNS( 'http://www.loc.gov/MARC21/slim', 'datafield');
 248                 $df->setAttribute( tag => '901' );
 249                 $df->setAttribute( ind1 => ' ' );
 250                 $df->setAttribute( ind2 => ' ' );
 251                 $marcxml->documentElement->appendChild( $df );
 252
 253                 my $sfa = $marcxml->createElementNS( 'http://www.loc.gov/MARC21/slim', 'subfield');
 254                 $sfa->setAttribute( code => 'a' );
 255                 $sfa->appendChild( $marcxml->createTextNode( $tcn ) );
 256                 $df->appendChild( $sfa );
 257
 258                 my $sfb = $marcxml->createElementNS( 'http://www.loc.gov/MARC21/slim', 'subfield');
 259                 $sfb->setAttribute( code => 'b' );
 260                 $sfb->appendChild( $marcxml->createTextNode( $tcn_source ) );
 261                 $df->appendChild( $sfb );
 262
 263         if ($existing_rec) {
 264                 my $sfc = $marcxml->createElementNS( 'http://www.loc.gov/MARC21/slim', 'subfield');
 265                 $sfc->setAttribute( code => 'c' );
 266                 $sfc->appendChild( $marcxml->createTextNode( $existing_rec ) );
 267                     $df->appendChild( $sfb );
 268         }
 269         }
 270
 271         return $tcn;
 272 }
 273
 274
 275
 276 sub _tcn_exists {
 277         my $editor = shift;
 278         my $tcn = shift;
 279         my $source = shift;
 280         my $existing_rec = shift || 0;
 281
 282         if(!$tcn) {return 0;}
 283
 284         $logger->debug("tcn_exists search for tcn $tcn and source $source and id $existing_rec");
 285
 286         # XXX why does the source matter?
 287 #       my $req = $session->request(
 288 #               { tcn_value => $tcn, tcn_source => $source, deleted => 'f' } );
 289
 290     my $recs = $editor->search_biblio_record_entry(
 291         {tcn_value => $tcn, deleted => 'f', id => {'!=' => $existing_rec}}, {idlist =>1});
 292
 293         if(@$recs) {
 294                 $logger->debug("_tcn_exists is true for tcn : $tcn ($source)");
 295                 return $recs->[0];
 296         }
 297
 298         $logger->debug("_tcn_exists is false for tcn : $tcn ($source)");
 299         return 0;
 300 }
 301
 302
 303 sub delete_rec {
 304    my($class, $editor, $rec_id ) = @_;
 305
 306    my $rec = $editor->retrieve_biblio_record_entry($rec_id)
 307       or return $editor->event;
 308
 309    return undef if $U->is_true($rec->deleted);
 310
 311    $rec->deleted('t');
 312    $rec->active('f');
 313    $rec->editor( $editor->requestor->id );
 314    $rec->edit_date('now');
 315
 316    # Set the leader/05 to indicate that the record has been deleted
 317    my $marc = $rec->marc();
 318    $marc =~ s{(<leader>.{5}).}{$1d};
 319    $rec->marc($marc);
 320
 321    $editor->update_biblio_record_entry($rec) or return $editor->event;
 322
 323    return undef;
 324 }
 325
 326
 327 # ---------------------------------------------------------------------------
 328 # returns true if the given title (id) has no un-deleted volumes or
 329 # copies attached.  If a context volume is defined, a record
 330 # is considered empty only if the context volume is the only
 331 # remaining volume on the record.
 332 # ---------------------------------------------------------------------------
 333 sub title_is_empty {
 334         my($class, $editor, $rid, $vol_id) = @_;
 335
 336         return 0 if $rid == OILS_PRECAT_RECORD;
 337
 338         my $cnlist = $editor->search_asset_call_number(
 339                 { record => $rid, deleted => 'f' }, { idlist => 1 } );
 340
 341         return 1 unless @$cnlist; # no attached volumes
 342     return 0 if @$cnlist > 1; # multiple attached volumes
 343     return 0 unless $$cnlist[0] == $vol_id; # attached volume is not the context vol.
 344
 345     # see if the sole remaining context volume has any attached copies
 346         for my $cn (@$cnlist) {
 347                 my $copylist = $editor->search_asset_copy(
 348                         [
 349                                 { call_number => $cn, deleted => 'f' },
 350                                 { limit => 1 },
 351                         ], { idlist => 1 });
 352                 return 0 if @$copylist; # false if we find any copies
 353         }
 354
 355         return 1;
 356 }
 357 1;