misc/migration_tools/bulkmarcimport.pl

   1 #!/usr/bin/perl
   2 # small script that import an iso2709 file into koha 2.0
   3
   4 use strict;
   5 # use warnings;
   6
   7 # Koha modules used
   8 use MARC::File::USMARC;
   9 # Uncomment the line below and use MARC::File::XML again when it works better.
  10 # -- thd
  11 # use MARC::File::XML;
  12 use MARC::Record;
  13 use MARC::Batch;
  14 use MARC::Charset;
  15
  16 # According to kados, an undocumented feature of setting MARC::Charset to
  17 # ignore_errors(1) is that errors are not ignored.  Instead of deleting the
  18 # whole subfield when a character does not translate properly from MARC8 into
  19 # UTF-8, just the problem characters are deleted.  This should solve at least
  20 # some of the fixme problems for fMARC8ToUTF8().
  21 #
  22 # Problems remain if there are MARC 21 records where 000/09 is set incorrectly.
  23 # -- thd.
  24 # MARC::Charset->ignore_errors(1);
  25
  26 use C4::Context;
  27 use C4::Biblio;
  28 use Time::HiRes qw(gettimeofday);
  29 use Getopt::Long;
  30 binmode(STDOUT, ":utf8");
  31
  32 use Getopt::Long;
  33
  34 my ( $input_marc_file, $number) = ('',0);
  35 my ($version, $delete, $test_parameter,$char_encoding, $verbose, $commit,$fk_off);
  36
  37 $|=1;
  38
  39 GetOptions(
  40     'commit:f'    => \$commit,
  41     'file:s'    => \$input_marc_file,
  42     'n:f' => \$number,
  43     'h' => \$version,
  44     'd' => \$delete,
  45     't' => \$test_parameter,
  46     'c:s' => \$char_encoding,
  47     'v:s' => \$verbose,
  48     'fk' => \$fk_off,
  49 );
  50
  51 # FIXME:  Management of error conditions needed for record parsing problems
  52 # and MARC8 character sets with mappings to Unicode not yet included in
  53 # MARC::Charset.  The real world rarity of these problems is not fully tested.
  54 # Unmapped character sets will throw a warning currently and processing will
  55 # continue with the error condition.  A fairly trivial correction should
  56 # address some record parsing and unmapped character set problems but I need
  57 # time to implement a test and correction for undef subfields and revert to
  58 # MARC8 if mappings are missing. -- thd
  59 sub fMARC8ToUTF8($$) {
  60     my ($record) = shift;
  61     my ($verbose) = shift;
  62     if ($verbose) {
  63         if ($verbose >= 2) {
  64             my $leader = $record->leader();
  65             $leader =~ s/ /#/g;
  66             print "\n000 " . $leader;
  67         }
  68     }
  69     foreach my $field ($record->fields()) {
  70         if ($field->is_control_field()) {
  71             if ($verbose) {
  72                 if ($verbose >= 2) {
  73                     my $fieldName = $field->tag();
  74                     my $fieldValue = $field->data();
  75                     $fieldValue =~ s/ /#/g;
  76                     print "\n" . $fieldName;
  77                     print ' ' . $fieldValue;
  78                 }
  79             }
  80         } else {
  81             my @subfieldsArray;
  82             my $fieldName = $field->tag();
  83             my $indicator1Value = $field->indicator(1);
  84             my $indicator2Value = $field->indicator(2);
  85             if ($verbose) {
  86                 if ($verbose >= 2) {
  87                     $indicator1Value =~ s/ /#/;
  88                     $indicator2Value =~ s/ /#/;
  89                     print "\n" . $fieldName . ' ' .
  90                             $indicator1Value .
  91                     $indicator2Value;
  92                 }
  93             }
  94             foreach my $subfield ($field->subfields()) {
  95                 my $subfieldName = $subfield->[0];
  96                 my $subfieldValue = $subfield->[1];
  97                 $subfieldValue = MARC::Charset::marc8_to_utf8($subfieldValue);
  98
  99                 # Alas, MARC::Field::update() does not work correctly.
 100                 ## push (@subfieldsArray, $subfieldName, $subfieldValue);
 101
 102                 push @subfieldsArray, [$subfieldName, $subfieldValue];
 103                 if ($verbose) {
 104                     if ($verbose >= 2) {
 105                         print " \$" . $subfieldName . ' ' . $subfieldValue;
 106                     }
 107                 }
 108             }
 109
 110             # Alas, MARC::Field::update() does not work correctly.
 111             #
 112             # The first instance in the field of a of a repeated subfield
 113             # overwrites the content from later instances with the content
 114             # from the first instance.
 115             ## $field->update(@subfieldsArray);
 116
 117             foreach my $subfieldRow(@subfieldsArray) {
 118                 my $subfieldName = $subfieldRow->[0];
 119                 $field->delete_subfields($subfieldName);
 120             }
 121             foreach my $subfieldRow(@subfieldsArray) {
 122                 $field->add_subfields(@$subfieldRow);
 123             }
 124
 125             if ($verbose) {
 126                 if ($verbose >= 2) {
 127                     # Reading the indicator values again is not necessary.
 128                     # They were not converted.
 129                     # $indicator1Value = $field->indicator(1);
 130                     # $indicator2Value = $field->indicator(2);
 131                     # $indicator1Value =~ s/ /#/;
 132                     # $indicator2Value =~ s/ /#/;
 133                     print "\nCONVERTED TO UTF-8:\n" . $fieldName . ' ' .
 134                             $indicator1Value .
 135                     $indicator2Value;
 136                     foreach my $subfield ($field->subfields()) {
 137                         my $subfieldName = $subfield->[0];
 138                         my $subfieldValue = $subfield->[1];
 139                         print " \$" . $subfieldName . ' ' . $subfieldValue;
 140                     }
 141                 }
 142             }
 143             if ($verbose) {
 144                 if ($verbose >= 2) {
 145                     print "\n" if $verbose;
 146                 }
 147             }
 148         }
 149     }
 150     $record->encoding('UTF-8');
 151     return $record;
 152 }
 153
 154
 155 if ($version || ($input_marc_file eq '')) {
 156     print <<EOF
 157 small script to import an iso2709 file into Koha.
 158 parameters :
 159 \th : this version/help screen
 160 \tfile /path/to/file/to/dump : the file to import
 161 \tv : verbose mode. 1 means "some infos", 2 means "MARC dumping"
 162 \tfk : Turn off foreign key checks during import.
 163 \tn : the number of records to import. If missing, all the file is imported
 164 \tcommit : the number of records to wait before performing a 'commit' operation
 165 \tt : test mode : parses the file, saying what he would do, but doing nothing.
 166 \tc : the characteristic MARC flavour. At the moment, only MARC21 and UNIMARC
 167 \tsupported. MARC21 by default.
 168 \td : delete EVERYTHING related to biblio in koha-DB before import  :tables :
 169 \t\tbiblio, \tbiblioitems,\titems
 170 IMPORTANT : don't use this script before you've entered and checked your MARC parameters tables twice (or more!).
 171 Otherwise, the import won't work correctly and you will get invalid data.
 172
 173 SAMPLE :
 174 \t\$ export KOHA_CONF=/etc/koha.conf
 175 \t\$ perl misc/migration_tools/bulkmarcimport.pl -d -commit 1000 -file /home/jmf/koha.mrc -n 3000
 176 EOF
 177 ;#'
 178 exit;
 179 }
 180
 181 my $dbh = C4::Context->dbh;
 182
 183 # save the CataloguingLog property : we don't want to log a bulkmarcimport. It will slow the import &
 184 # will create problems in the action_logs table, that can't handle more than 1 entry per second per user.
 185 my $CataloguingLog = C4::Context->preference('CataloguingLog');
 186 $dbh->do("UPDATE systempreferences SET value=0 WHERE variable='CataloguingLog'");
 187
 188 if ($delete) {
 189     print "deleting biblios\n";
 190     $dbh->do("truncate biblio");
 191     $dbh->do("truncate biblioitems");
 192     $dbh->do("truncate items");
 193 }
 194 if ($fk_off) {
 195         $dbh->do("SET FOREIGN_KEY_CHECKS = 0");
 196 }
 197 if ($test_parameter) {
 198     print "TESTING MODE ONLY\n    DOING NOTHING\n===============\n";
 199 }
 200
 201 my $marcFlavour = C4::Context->preference('marcflavour') || 'MARC21';
 202
 203 print "Characteristic MARC flavour: $marcFlavour\n" if $verbose;
 204 # die;
 205 my $starttime = gettimeofday;
 206 my $batch = MARC::Batch->new( 'USMARC', $input_marc_file );
 207 $batch->warnings_off();
 208 $batch->strict_off();
 209 my $i=0;
 210 my $commitnum = 50;
 211
 212 if ($commit) {
 213
 214 $commitnum = $commit;
 215
 216 }
 217
 218 #1st of all, find item MARC tag.
 219 my ($tagfield,$tagsubfield) = &GetMarcFromKohaField("items.itemnumber",'');
 220 # $dbh->do("lock tables biblio write, biblioitems write, items write, marc_biblio write, marc_subfield_table write, marc_blob_subfield write, marc_word write, marc_subfield_structure write, stopwords write");
 221 while ( my $record = $batch->next() ) {
 222 # warn "=>".$record->as_formatted;
 223 # warn "I:".$i;
 224 # warn "NUM:".$number;
 225     $i++;
 226     print ".";
 227     print "\r$i" unless $i % 100;
 228 #     if ($i==$number) {
 229 #         z3950_extended_services('commit',set_service_options('commit'));
 230 #         print "COMMIT OPERATION SUCCESSFUL\n";
 231 #
 232 #         my $timeneeded = gettimeofday - $starttime;
 233 #         die "$i MARC records imported in $timeneeded seconds\n";
 234 #     }
 235 #     # perform the commit operation ever so often
 236 #     if ($i==$commit) {
 237 #         z3950_extended_services('commit',set_service_options('commit'));
 238 #         $commit+=$commitnum;
 239 #         print "COMMIT OPERATION SUCCESSFUL\n";
 240 #     }
 241     #now, parse the record, extract the item fields, and store them in somewhere else.
 242
 243     ## create an empty record object to populate
 244     my $newRecord = MARC::Record->new();
 245     $newRecord->leader($record->leader());
 246
 247     # go through each field in the existing record
 248     foreach my $oldField ( $record->fields() ) {
 249
 250     # just reproduce tags < 010 in our new record
 251     #
 252     # Fields are not necessarily only numeric in the actual world of records
 253     # nor in what I would recommend for additonal safe non-interfering local
 254     # use fields.  The following regular expression match is much safer than
 255     # a numeric evaluation. -- thd
 256     if ( $oldField->tag() =~ m/^00/ ) {
 257         $newRecord->append_fields( $oldField );
 258         next();
 259     }
 260
 261     # store our new subfield data in this list
 262     my @newSubfields = ();
 263
 264     # go through each subfield code/data pair
 265     foreach my $pair ( $oldField->subfields() ) {
 266         #$pair->[1] =~ s/\<//g;
 267         #$pair->[1] =~ s/\>//g;
 268         push( @newSubfields, $pair->[0], $pair->[1] ); #char_decode($pair->[1],$char_encoding) );
 269     }
 270
 271     # add the new field to our new record
 272     my $newField = MARC::Field->new(
 273         $oldField->tag(),
 274         $oldField->indicator(1),
 275         $oldField->indicator(2),
 276         @newSubfields
 277     );
 278
 279     $newRecord->append_fields( $newField );
 280
 281     }
 282
 283     warn "$i ==>".$newRecord->as_formatted() if $verbose eq 2;
 284     my @fields = $newRecord->field($tagfield);
 285     my @items;
 286     my $nbitems=0;
 287
 288     foreach my $field (@fields) {
 289         my $item = MARC::Record->new();
 290         $item->append_fields($field);
 291         push @items,$item;
 292         $newRecord->delete_field($field);
 293         $nbitems++;
 294     }
 295     print "$i : $nbitems items found\n" if $verbose;
 296     # now, create biblio and items with Addbiblio call.
 297
 298     unless ($test_parameter) {
 299         my ( $bibid, $oldbibitemnum );
 300         eval { ( $bibid, $oldbibitemnum ) = AddBiblio( $newRecord, '' ); };
 301         warn $@ if $@;
 302         if ( $@ ) {
 303             warn "ERROR: Adding biblio $bibid failed\n" if $verbose
 304         } else {
 305             warn "ADDED biblio NB $bibid in DB\n" if $verbose;
 306             for ( my $it = 0 ; $it <= $#items ; $it++ ) {
 307                 # FIXME - duplicate barcode check needs to become part of AddItem()
 308                 my $itemhash = TransformMarcToKoha($dbh, $items[$it]);
 309                 my $duplicate_barcode = exists($itemhash->{'barcode'}) && GetItemnumberFromBarcode($itemhash->{'barcode'});
 310                 if ($duplicate_barcode) {
 311                     warn "ERROR: cannot add item $itemhash->{'barcode'} for biblio $bibid: duplicate barcode\n" if $verbose;
 312                 } else {
 313                     eval { AddItem( $items[$it], $bibid, $oldbibitemnum ); };
 314                     warn "ERROR: Adding item $it, rec $i failed\n" if ($@);
 315                 }
 316             }
 317         }
 318     }
 319     last if $i == $number;
 320 }
 321
 322
 323 if ($fk_off) {
 324         $dbh->do("SET FOREIGN_KEY_CHECKS = 1");
 325 }
 326 # final commit of the changes
 327 #z3950_extended_services('commit',set_service_options('commit'));
 328 #print "COMMIT OPERATION SUCCESSFUL\n";
 329
 330 # restore CataloguingLog
 331 $dbh->do("UPDATE systempreferences SET value=$CataloguingLog WHERE variable='CataloguingLog'");
 332
 333 my $timeneeded = gettimeofday - $starttime;
 334 print "$i MARC records done in $timeneeded seconds\n";