misc/migration_tools/bulkmarcimport.pl

   1 #!/usr/bin/perl
   2 # Import an iso2709 file into Koha 3
   3
   4 use strict;
   5 use warnings;
   6 #use diagnostics;
   7 BEGIN {
   8     # find Koha's Perl modules
   9     # test carefully before changing this
  10     use FindBin;
  11     eval { require "$FindBin::Bin/../kohalib.pl" };
  12 }
  13
  14 # Koha modules used
  15 use MARC::File::USMARC;
  16 use MARC::File::XML;
  17 use MARC::Record;
  18 use MARC::Batch;
  19 use MARC::Charset;
  20
  21 use C4::Context;
  22 use C4::Biblio;
  23 use C4::Koha;
  24 use C4::Debug;
  25 use C4::Charset;
  26 use C4::Items;
  27 use Unicode::Normalize;
  28 use Time::HiRes qw(gettimeofday);
  29 use Getopt::Long;
  30 use IO::File;
  31 use Pod::Usage;
  32
  33 binmode STDOUT, ':encoding(UTF-8)';
  34 my ( $input_marc_file, $number, $offset) = ('',0,0);
  35 my ($version, $delete, $test_parameter, $skip_marc8_conversion, $char_encoding, $verbose, $commit, $fk_off,$format,$biblios,$authorities,$keepids,$match, $isbn_check, $logfile);
  36 my $cleanisbn = 1;
  37 my ($sourcetag,$sourcesubfield,$idmapfl, $dedup_barcode);
  38
  39 $|=1;
  40
  41 GetOptions(
  42     'commit:f'    => \$commit,
  43     'file:s'    => \$input_marc_file,
  44     'n:f' => \$number,
  45     'o|offset:f' => \$offset,
  46     'h' => \$version,
  47     'd' => \$delete,
  48     't' => \$test_parameter,
  49     's' => \$skip_marc8_conversion,
  50     'c:s' => \$char_encoding,
  51     'v:s' => \$verbose,
  52     'fk' => \$fk_off,
  53     'm:s' => \$format,
  54     'l:s' => \$logfile,
  55     'k|keepids:s' => \$keepids,
  56     'b|biblios' => \$biblios,
  57     'a|authorities' => \$authorities,
  58     'match=s@'    => \$match,
  59     'i|isbn' => \$isbn_check,
  60     'x:s' => \$sourcetag,
  61     'y:s' => \$sourcesubfield,
  62     'idmap:s' => \$idmapfl,
  63     'cleanisbn!'     => \$cleanisbn,
  64     'dedupbarcode' => \$dedup_barcode,
  65 );
  66 $biblios=!$authorities||$biblios;
  67
  68 if ($version || ($input_marc_file eq '')) {
  69     pod2usage( -verbose => 2 );
  70     exit;
  71 }
  72
  73 if (defined $idmapfl) {
  74   open(IDMAP,">$idmapfl") or die "cannot open $idmapfl \n";
  75 }
  76
  77 if ((not defined $sourcesubfield) && (not defined $sourcetag)){
  78   $sourcetag="910";
  79   $sourcesubfield="a";
  80 }
  81
  82 my $dbh = C4::Context->dbh;
  83
  84 # save the CataloguingLog property : we don't want to log a bulkmarcimport. It will slow the import &
  85 # will create problems in the action_logs table, that can't handle more than 1 entry per second per user.
  86 my $CataloguingLog = C4::Context->preference('CataloguingLog');
  87 $dbh->do("UPDATE systempreferences SET value=0 WHERE variable='CataloguingLog'");
  88
  89 if ($fk_off) {
  90         $dbh->do("SET FOREIGN_KEY_CHECKS = 0");
  91 }
  92
  93
  94 if ($delete) {
  95         if ($biblios){
  96         print "deleting biblios\n";
  97         $dbh->do("truncate biblio");
  98         $dbh->do("truncate biblioitems");
  99         $dbh->do("truncate items");
 100         }
 101         else {
 102         print "deleting authorities\n";
 103         $dbh->do("truncate auth_header");
 104         }
 105     $dbh->do("truncate zebraqueue");
 106 }
 107
 108
 109
 110 if ($test_parameter) {
 111     print "TESTING MODE ONLY\n    DOING NOTHING\n===============\n";
 112 }
 113
 114 my $marcFlavour = C4::Context->preference('marcflavour') || 'MARC21';
 115
 116 print "Characteristic MARC flavour: $marcFlavour\n" if $verbose;
 117 my $starttime = gettimeofday;
 118 my $batch;
 119 my $fh = IO::File->new($input_marc_file); # don't let MARC::Batch open the file, as it applies the ':utf8' IO layer
 120 if (defined $format && $format =~ /XML/i) {
 121     # ugly hack follows -- MARC::File::XML, when used by MARC::Batch,
 122     # appears to try to convert incoming XML records from MARC-8
 123     # to UTF-8.  Setting the BinaryEncoding key turns that off
 124     # TODO: see what happens to ISO-8859-1 XML files.
 125     # TODO: determine if MARC::Batch can be fixed to handle
 126     #       XML records properly -- it probably should be
 127     #       be using a proper push or pull XML parser to
 128     #       extract the records, not using regexes to look
 129     #       for <record>.*</record>.
 130     $MARC::File::XML::_load_args{BinaryEncoding} = 'utf-8';
 131     my $recordformat= ($marcFlavour eq "MARC21"?"USMARC":uc($marcFlavour));
 132 #UNIMARC Authorities have a different way to manage encoding than UNIMARC biblios.
 133     $recordformat=$recordformat."AUTH" if ($authorities and $marcFlavour ne "MARC21");
 134     $MARC::File::XML::_load_args{RecordFormat} = $recordformat;
 135     $batch = MARC::Batch->new( 'XML', $fh );
 136 } else {
 137     $batch = MARC::Batch->new( 'USMARC', $fh );
 138 }
 139 $batch->warnings_off();
 140 $batch->strict_off();
 141 my $i=0;
 142 my $commitnum = $commit ? $commit : 50;
 143
 144
 145 # Skip file offset
 146 if ( $offset ) {
 147     print "Skipping file offset: $offset records\n";
 148     $batch->next() while ($offset--);
 149 }
 150
 151 my ($tagid,$subfieldid);
 152 if ($authorities){
 153           $tagid='001';
 154 }
 155 else {
 156    ( $tagid, $subfieldid ) =
 157             GetMarcFromKohaField( "biblio.biblionumber", '' );
 158         $tagid||="001";
 159 }
 160
 161 # the SQL query to search on isbn
 162 my $sth_isbn = $dbh->prepare("SELECT biblionumber,biblioitemnumber FROM biblioitems WHERE isbn=?");
 163
 164 $dbh->{AutoCommit} = 0;
 165 my $loghandle;
 166 if ($logfile){
 167    $loghandle= IO::File->new($logfile,"w") ;
 168    print $loghandle "id;operation;status\n";
 169 }
 170 RECORD: while (  ) {
 171     my $record;
 172     # get records
 173     eval { $record = $batch->next() };
 174     if ( $@ ) {
 175         print "Bad MARC record $i: $@ skipped\n";
 176         # FIXME - because MARC::Batch->next() combines grabbing the next
 177         # blob and parsing it into one operation, a correctable condition
 178         # such as a MARC-8 record claiming that it's UTF-8 can't be recovered
 179         # from because we don't have access to the original blob.  Note
 180         # that the staging import can deal with this condition (via
 181         # C4::Charset::MarcToUTF8Record) because it doesn't use MARC::Batch.
 182         next;
 183     }
 184     # skip if we get an empty record (that is MARC valid, but will result in AddBiblio failure
 185     last unless ( $record );
 186     $i++;
 187     print ".";
 188     print "\r$i" unless $i % 100;
 189
 190     # transcode the record to UTF8 if needed & applicable.
 191     if ($record->encoding() eq 'MARC-8' and not $skip_marc8_conversion) {
 192         # FIXME update condition
 193         my ($guessed_charset, $charset_errors);
 194          ($record, $guessed_charset, $charset_errors) = MarcToUTF8Record($record, $marcFlavour.(($authorities and $marcFlavour ne "MARC21")?'AUTH':''));
 195         if ($guessed_charset eq 'failed') {
 196             warn "ERROR: failed to perform character conversion for record $i\n";
 197             next RECORD;
 198         }
 199     }
 200     my $isbn;
 201     # remove trailing - in isbn (only for biblios, of course)
 202     if ($biblios && $cleanisbn) {
 203         my $tag = $marcFlavour eq 'UNIMARC' ? '010' : '020';
 204         my $field = $record->field($tag);
 205         my $isbn = $field && $field->subfield('a');
 206         if ( $isbn ) {
 207             $isbn =~ s/-//g;
 208             $field->update('a' => $isbn);
 209         }
 210     }
 211     my $id;
 212     # search for duplicates (based on Local-number)
 213     if ($match){
 214        require C4::Search;
 215        my $query=build_query($match,$record);
 216        my $server=($authorities?'authorityserver':'biblioserver');
 217        my ($error, $results,$totalhits)=C4::Search::SimpleSearch( $query, 0, 3, [$server] );
 218        die "unable to search the database for duplicates : $error" if (defined $error);
 219        #warn "$query $server : $totalhits";
 220        if ( @{$results} == 1 ){
 221            my $marcrecord = MARC::File::USMARC::decode($results->[0]);
 222                    $id=GetRecordId($marcrecord,$tagid,$subfieldid);
 223        }
 224        elsif  ( @{$results} > 1){
 225            $debug && warn "more than one match for $query";
 226        }
 227        else {
 228            $debug && warn "nomatch for $query";
 229        }
 230     }
 231         my $originalid;
 232     if ($keepids){
 233           $originalid=GetRecordId($record,$tagid,$subfieldid);
 234       if ($originalid){
 235                  my $storeidfield;
 236                  if (length($keepids)==3){
 237                         $storeidfield=MARC::Field->new($keepids,$originalid);
 238                  }
 239                  else  {
 240                         $storeidfield=MARC::Field->new(substr($keepids,0,3),"","",substr($keepids,3,1),$originalid);
 241                  }
 242          $record->insert_fields_ordered($storeidfield);
 243              $record->delete_field($record->field($tagid));
 244       }
 245     }
 246     unless ($test_parameter) {
 247         if ($authorities){
 248             use C4::AuthoritiesMarc;
 249             my $authtypecode=GuessAuthTypeCode($record);
 250             my $authid= ($id?$id:GuessAuthId($record));
 251             if ($authid && GetAuthority($authid)){
 252             ## Authority has an id and is in database : Replace
 253                 eval { ( $authid ) = ModAuthority($authid,$record, $authtypecode) };
 254                 if ($@){
 255                     warn "Problem with authority $authid Cannot Modify";
 256                                         printlog({id=>$originalid||$id||$authid, op=>"edit",status=>"ERROR"}) if ($logfile);
 257                 }
 258                                 else{
 259                                         printlog({id=>$originalid||$id||$authid, op=>"edit",status=>"ok"}) if ($logfile);
 260                                 }
 261             }
 262             elsif (defined $authid) {
 263             ## An authid is defined but no authority in database : add
 264                 eval { ( $authid ) = AddAuthority($record,$authid, $authtypecode) };
 265                 if ($@){
 266                     warn "Problem with authority $authid Cannot Add ".$@;
 267                                         printlog({id=>$originalid||$id||$authid, op=>"insert",status=>"ERROR"}) if ($logfile);
 268                 }
 269                                 else{
 270                                         printlog({id=>$originalid||$id||$authid, op=>"insert",status=>"ok"}) if ($logfile);
 271                                 }
 272             }
 273                 else {
 274             ## True insert in database
 275                 eval { ( $authid ) = AddAuthority($record,"", $authtypecode) };
 276                 if ($@){
 277                     warn "Problem with authority $authid Cannot Add".$@;
 278                                         printlog({id=>$originalid||$id||$authid, op=>"insert",status=>"ERROR"}) if ($logfile);
 279                 }
 280                                 else{
 281                                         printlog({id=>$originalid||$id||$authid, op=>"insert",status=>"ok"}) if ($logfile);
 282                                 }
 283                 }
 284         }
 285         else {
 286             my ( $biblionumber, $biblioitemnumber, $itemnumbers_ref, $errors_ref );
 287             $biblionumber = $id;
 288             # check for duplicate, based on ISBN (skip it if we already have found a duplicate with match parameter
 289             if (!$biblionumber && $isbn_check && $isbn) {
 290     #         warn "search ISBN : $isbn";
 291                 $sth_isbn->execute($isbn);
 292                 ($biblionumber,$biblioitemnumber) = $sth_isbn->fetchrow;
 293             }
 294                 if (defined $idmapfl) {
 295                                 if ($sourcetag < "010"){
 296                                         if ($record->field($sourcetag)){
 297                                           my $source = $record->field($sourcetag)->data();
 298                                           printf(IDMAP "%s|%s\n",$source,$biblionumber);
 299                                         }
 300                             } else {
 301                                         my $source=$record->subfield($sourcetag,$sourcesubfield);
 302                                         printf(IDMAP "%s|%s\n",$source,$biblionumber);
 303                           }
 304                         }
 305                                         # create biblio, unless we already have it ( either match or isbn )
 306             if ($biblionumber) {
 307                                 eval{$biblioitemnumber=GetBiblioData($biblionumber)->{biblioitemnumber};}
 308                         }
 309                         else
 310                         {
 311                 eval { ( $biblionumber, $biblioitemnumber ) = AddBiblio($record, '', { defer_marc_save => 1 }) };
 312             }
 313             if ( $@ ) {
 314                 warn "ERROR: Adding biblio $biblionumber failed: $@\n";
 315                                 printlog({id=>$id||$originalid||$biblionumber, op=>"insert",status=>"ERROR"}) if ($logfile);
 316                 next RECORD;
 317             }
 318                         else{
 319                                 printlog({id=>$id||$originalid||$biblionumber, op=>"insert",status=>"ok"}) if ($logfile);
 320                         }
 321             eval { ( $itemnumbers_ref, $errors_ref ) = AddItemBatchFromMarc( $record, $biblionumber, $biblioitemnumber, '' ); };
 322             my $error_adding = $@;
 323             # Work on a clone so that if there are real errors, we can maybe
 324             # fix them up later.
 325                         my $clone_record = $record->clone();
 326             C4::Biblio::_strip_item_fields($clone_record, '');
 327             # This sets the marc fields if there was an error, and also calls
 328             # defer_marc_save.
 329             ModBiblioMarc( $clone_record, $biblionumber, '' );
 330             if ( $error_adding ) {
 331                 warn "ERROR: Adding items to bib $biblionumber failed: $error_adding";
 332                                 printlog({id=>$id||$originalid||$biblionumber, op=>"insertitem",status=>"ERROR"}) if ($logfile);
 333                 # if we failed because of an exception, assume that
 334                 # the MARC columns in biblioitems were not set.
 335                 next RECORD;
 336             }
 337                         else{
 338                                 printlog({id=>$id||$originalid||$biblionumber, op=>"insert",status=>"ok"}) if ($logfile);
 339                         }
 340             if ($dedup_barcode && grep { exists $_->{error_code} && $_->{error_code} eq 'duplicate_barcode' } @$errors_ref) {
 341                 # Find the record called 'barcode'
 342                 my ($tag, $sub) = C4::Biblio::GetMarcFromKohaField('items.barcode', '');
 343                 # Now remove any items that didn't have a duplicate_barcode error,
 344                 # erase the barcodes on items that did, and re-add those items.
 345                 my %dupes;
 346                 foreach my $i (0 .. $#{$errors_ref}) {
 347                     my $ref = $errors_ref->[$i];
 348                     if ($ref && ($ref->{error_code} eq 'duplicate_barcode')) {
 349                         $dupes{$ref->{item_sequence}} = 1;
 350                         # Delete the error message because we're going to
 351                         # retry this one.
 352                         delete $errors_ref->[$i];
 353                     }
 354                 }
 355                 my $seq = 0;
 356                 foreach my $field ($record->field($tag)) {
 357                     $seq++;
 358                     if ($dupes{$seq}) {
 359                         # Here we remove the barcode
 360                         $field->delete_subfield(code => $sub);
 361                     } else {
 362                         # otherwise we delete the field because we don't want
 363                         # two of them
 364                         $record->delete_fields($field);
 365                     }
 366                 }
 367                 # Now re-add the record as before, adding errors to the prev list
 368                 my $more_errors;
 369                 eval { ( $itemnumbers_ref, $more_errors ) = AddItemBatchFromMarc( $record, $biblionumber, $biblioitemnumber, '' ); };
 370                 if ( $@ ) {
 371                     warn "ERROR: Adding items to bib $biblionumber failed: $@\n";
 372                     printlog({id=>$id||$originalid||$biblionumber, op=>"insertitem",status=>"ERROR"}) if ($logfile);
 373                     # if we failed because of an exception, assume that
 374                     # the MARC columns in biblioitems were not set.
 375                     ModBiblioMarc( $record, $biblionumber, '' );
 376                     next RECORD;
 377                 } else {
 378                     printlog({id=>$id||$originalid||$biblionumber, op=>"insert",status=>"ok"}) if ($logfile);
 379                 }
 380                 push @$errors_ref, @{ $more_errors };
 381             }
 382             if ($#{ $errors_ref } > -1) {
 383                 report_item_errors($biblionumber, $errors_ref);
 384             }
 385         }
 386         $dbh->commit() if (0 == $i % $commitnum);
 387     }
 388     last if $i == $number;
 389 }
 390 $dbh->commit();
 391
 392
 393
 394 if ($fk_off) {
 395         $dbh->do("SET FOREIGN_KEY_CHECKS = 1");
 396 }
 397
 398 # restore CataloguingLog
 399 $dbh->do("UPDATE systempreferences SET value=$CataloguingLog WHERE variable='CataloguingLog'");
 400
 401 my $timeneeded = gettimeofday - $starttime;
 402 print "\n$i MARC records done in $timeneeded seconds\n";
 403 if ($logfile){
 404   print $loghandle "file : $input_marc_file\n";
 405   print $loghandle "$i MARC records done in $timeneeded seconds\n";
 406   $loghandle->close;
 407 }
 408 exit 0;
 409
 410 sub GetRecordId{
 411         my $marcrecord=shift;
 412         my $tag=shift;
 413         my $subfield=shift;
 414         my $id;
 415         if ($tag lt "010"){
 416                 return $marcrecord->field($tag)->data() if $marcrecord->field($tag);
 417         }
 418         elsif ($subfield){
 419                 if ($marcrecord->field($tag)){
 420                         return $marcrecord->subfield($tag,$subfield);
 421                 }
 422         }
 423         return $id;
 424 }
 425 sub build_query {
 426         my $match = shift;
 427         my $record=shift;
 428         my @searchstrings;
 429         foreach my $matchingpoint (@$match){
 430           my $string = build_simplequery($matchingpoint,$record);
 431           push @searchstrings,$string if (length($string)>0);
 432         }
 433         return join(" and ",@searchstrings);
 434 }
 435 sub build_simplequery {
 436         my $element=shift;
 437         my $record=shift;
 438         my ($index,$recorddata)=split /,/,$element;
 439         my ($tag,$subfields) =($1,$2) if ($recorddata=~/(\d{3})(.*)/);
 440         my @searchstrings;
 441         foreach my $field ($record->field($tag)){
 442                   if (length($field->as_string("$subfields"))>0){
 443                 push @searchstrings,"$index,wrdl=\"".$field->as_string("$subfields")."\"";
 444                   }
 445         }
 446         return join(" and ",@searchstrings);
 447 }
 448 sub report_item_errors {
 449     my $biblionumber = shift;
 450     my $errors_ref = shift;
 451
 452     foreach my $error (@{ $errors_ref }) {
 453         next if !$error;
 454         my $msg = "Item not added (bib $biblionumber, item tag #$error->{'item_sequence'}, barcode $error->{'item_barcode'}): ";
 455         my $error_code = $error->{'error_code'};
 456         $error_code =~ s/_/ /g;
 457         $msg .= "$error_code $error->{'error_information'}";
 458         print $msg, "\n";
 459     }
 460 }
 461 sub printlog{
 462         my $logelements=shift;
 463         print $loghandle join (";",@$logelements{qw<id op status>}),"\n";
 464 }
 465
 466
 467 =head1 NAME
 468
 469 bulkmarcimport.pl - Import bibliographic/authority records into Koha
 470
 471 =head1 USAGE
 472
 473  $ export KOHA_CONF=/etc/koha.conf
 474  $ perl misc/migration_tools/bulkmarcimport.pl -d -commit 1000 \\
 475     -file /home/jmf/koha.mrc -n 3000
 476
 477 =head1 WARNING
 478
 479 Don't use this script before you've entered and checked your MARC parameters
 480 tables twice (or more!). Otherwise, the import won't work correctly and you
 481 will get invalid data.
 482
 483 =head1 DESCRIPTION
 484
 485 =over
 486
 487 =item  B<-h>
 488
 489 This version/help screen
 490
 491 =item B<-b, -biblios>
 492
 493 Type of import: bibliographic records
 494
 495 =item B<-a, -authorities>
 496
 497 Type of import: authority records
 498
 499 =item B<-file>=I<FILE>
 500
 501 The I<FILE> to import
 502
 503 =item  B<-v>
 504
 505 Verbose mode. 1 means "some infos", 2 means "MARC dumping"
 506
 507 =item B<-fk>
 508
 509 Turn off foreign key checks during import.
 510
 511 =item B<-n>=I<NUMBER>
 512
 513 The I<NUMBER> of records to import. If missing, all the file is imported
 514
 515 =item B<-o, -offset>=I<NUMBER>
 516
 517 File offset before importing, ie I<NUMBER> of records to skip.
 518
 519 =item B<-commit>=I<NUMBER>
 520
 521 The I<NUMBER> of records to wait before performing a 'commit' operation
 522
 523 =item B<-l>
 524
 525 File logs actions done for each record and their status into file
 526
 527 =item B<-t>
 528
 529 Test mode: parses the file, saying what he would do, but doing nothing.
 530
 531 =item B<-s>
 532
 533 Skip automatic conversion of MARC-8 to UTF-8.  This option is provided for
 534 debugging.
 535
 536 =item B<-c>=I<CHARACTERISTIC>
 537
 538 The I<CHARACTERISTIC> MARC flavour. At the moment, only I<MARC21> and
 539 I<UNIMARC> are supported. MARC21 by default.
 540
 541 =item B<-d>
 542
 543 Delete EVERYTHING related to biblio in koha-DB before import. Tables: biblio,
 544 biblioitems, items
 545
 546 =item B<-m>=I<FORMAT>
 547
 548 Input file I<FORMAT>: I<MARCXML> or I<ISO2709> (defaults to ISO2709)
 549
 550 =item B<-k, -keepids>=<FIELD>
 551
 552 Field store ids in I<FIELD> (usefull for authorities, where 001 contains the
 553 authid for Koha, that can contain a very valuable info for authorities coming
 554 from LOC or BNF. useless for biblios probably)
 555
 556 =item B<-match>=<FIELD>
 557
 558 I<FIELD> matchindex,fieldtomatch matchpoint to use to deduplicate fieldtomatch
 559 can be either 001 to 999 or field and list of subfields as such 100abcde
 560
 561 =item B<-i,-isbn>
 562
 563 If set, a search will be done on isbn, and, if the same isbn is found, the
 564 biblio is not added. It's another method to deduplicate.  B<-match> & B<-isbn>
 565 can be both set.
 566
 567 =item B<-cleanisbn>
 568
 569 Clean ISBN fields from entering biblio records, ie removes hyphens. By default,
 570 ISBN are cleaned. --nocleanisbn will keep ISBN unchanged.
 571
 572 =item B<-x>=I<TAG>
 573
 574 Source bib I<TAG> for reporting the source bib number
 575
 576 =item B<-y>=I<SUBFIELD>
 577
 578 Source I<SUBFIELD> for reporting the source bib number
 579
 580 =item B<-idmap>=I<FILE>
 581
 582 I<FILE> for the koha bib and source id
 583
 584 =item B<-keepids>
 585
 586 Store ids in 009 (usefull for authorities, where 001 contains the authid for
 587 Koha, that can contain a very valuable info for authorities coming from LOC or
 588 BNF. useless for biblios probably)
 589
 590 =item B<-dedupbarcode>
 591
 592 If set, whenever a duplicate barcode is detected, it is removed and the attempt
 593 to add the record is retried, thereby giving the record a blank barcode. This
 594 is useful when something has set barcodes to be a biblio ID, or similar
 595 (usually other software.)
 596
 597 =back
 598
 599 =cut
 600