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