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 BEGIN {
   7     # find Koha's Perl modules
   8     # test carefully before changing this
   9     use FindBin;
  10     eval { require "$FindBin::Bin/../kohalib.pl" };
  11 }
  12
  13 # Koha modules used
  14 use MARC::File::USMARC;
  15 # Uncomment the line below and use MARC::File::XML again when it works better.
  16 # -- thd
  17 # use MARC::File::XML;
  18 use MARC::Record;
  19 use MARC::Batch;
  20 use MARC::Charset;
  21
  22 # According to kados, an undocumented feature of setting MARC::Charset to
  23 # ignore_errors(1) is that errors are not ignored.  Instead of deleting the
  24 # whole subfield when a character does not translate properly from MARC8 into
  25 # UTF-8, just the problem characters are deleted.  This should solve at least
  26 # some of the fixme problems for fMARC8ToUTF8().
  27 #
  28 # Problems remain if there are MARC 21 records where 000/09 is set incorrectly.
  29 # -- thd.
  30 # MARC::Charset->ignore_errors(1);
  31
  32 use C4::Context;
  33 use C4::Biblio;
  34 use Unicode::Normalize;
  35 use Time::HiRes qw(gettimeofday);
  36 use Getopt::Long;
  37 binmode(STDOUT, ":utf8");
  38
  39 use Getopt::Long;
  40
  41 my ( $input_marc_file, $number) = ('',0);
  42 my ($version, $delete, $test_parameter, $skip_marc8_conversion, $char_encoding, $verbose, $commit, $fk_off);
  43
  44 $|=1;
  45
  46 GetOptions(
  47     'commit:f'    => \$commit,
  48     'file:s'    => \$input_marc_file,
  49     'n:f' => \$number,
  50     'h' => \$version,
  51     'd' => \$delete,
  52     't' => \$test_parameter,
  53     's' => \$skip_marc8_conversion,
  54     'c:s' => \$char_encoding,
  55     'v:s' => \$verbose,
  56     'fk' => \$fk_off,
  57 );
  58
  59 # FIXME:  Management of error conditions needed for record parsing problems
  60 # and MARC8 character sets with mappings to Unicode not yet included in
  61 # MARC::Charset.  The real world rarity of these problems is not fully tested.
  62 # Unmapped character sets will throw a warning currently and processing will
  63 # continue with the error condition.  A fairly trivial correction should
  64 # address some record parsing and unmapped character set problems but I need
  65 # time to implement a test and correction for undef subfields and revert to
  66 # MARC8 if mappings are missing. -- thd
  67 sub fMARC8ToUTF8($$) {
  68     my ($record) = shift;
  69     my ($verbose) = shift;
  70
  71     foreach my $field ($record->fields()) {
  72         if ($field->is_control_field()) {
  73             ; # do nothing -- control fields should not contain non-ASCII characters
  74         } else {
  75             my @subfieldsArray;
  76             my $fieldName = $field->tag();
  77             my $indicator1Value = $field->indicator(1);
  78             my $indicator2Value = $field->indicator(2);
  79             foreach my $subfield ($field->subfields()) {
  80                 my $subfieldName = $subfield->[0];
  81                 my $subfieldValue = $subfield->[1];
  82                 my $utf8sf = MARC::Charset::marc8_to_utf8($subfieldValue);
  83                 unless (defined $utf8sf) {
  84                     # For now, we're being very strict about
  85                     # error during the MARC8 conversion, so return
  86                     # if there's a problem.
  87                     return;
  88                 }
  89                 $subfieldValue = NFC($utf8sf); # Normalization Form C to assist
  90                                                # some browswers (e.g., Firefox on OS X)
  91                                                # that have issues with decomposed characters
  92                                                # in certain fonts.
  93
  94                 # Alas, MARC::Field::update() does not work correctly.
  95                 ## push (@subfieldsArray, $subfieldName, $subfieldValue);
  96
  97                 push @subfieldsArray, [$subfieldName, $subfieldValue];
  98             }
  99
 100             # Alas, MARC::Field::update() does not work correctly.
 101             #
 102             # The first instance in the field of a of a repeated subfield
 103             # overwrites the content from later instances with the content
 104             # from the first instance.
 105             ## $field->update(@subfieldsArray);
 106
 107             foreach my $subfieldRow(@subfieldsArray) {
 108                 my $subfieldName = $subfieldRow->[0];
 109                 $field->delete_subfields($subfieldName);
 110             }
 111             foreach my $subfieldRow(@subfieldsArray) {
 112                 $field->add_subfields(@$subfieldRow);
 113             }
 114
 115             if ($verbose) {
 116                 if ($verbose >= 2) {
 117                     # Reading the indicator values again is not necessary.
 118                     # They were not converted.
 119                     # $indicator1Value = $field->indicator(1);
 120                     # $indicator2Value = $field->indicator(2);
 121                     # $indicator1Value =~ s/ /#/;
 122                     # $indicator2Value =~ s/ /#/;
 123                     print "\nCONVERTED TO UTF-8:\n" . $fieldName . ' ' .
 124                             $indicator1Value .
 125                     $indicator2Value;
 126                     foreach my $subfield ($field->subfields()) {
 127                         my $subfieldName = $subfield->[0];
 128                         my $subfieldValue = $subfield->[1];
 129                         print " \$" . $subfieldName . ' ' . $subfieldValue;
 130                     }
 131                 }
 132             }
 133             if ($verbose) {
 134                 if ($verbose >= 2) {
 135                     print "\n" if $verbose;
 136                 }
 137             }
 138         }
 139     }
 140
 141     # must set Leader/09 to 'a' to indicate that
 142     # record is now in UTF-8
 143     my $leader = $record->leader();
 144     substr($leader, 9, 1) = 'a';
 145     $record->leader($leader);
 146
 147     $record->encoding('UTF-8');
 148     return 1;
 149 }
 150
 151
 152 if ($version || ($input_marc_file eq '')) {
 153     print <<EOF
 154 small script to import an iso2709 file into Koha.
 155 parameters :
 156 \th : this version/help screen
 157 \tfile /path/to/file/to/dump : the file to import
 158 \tv : verbose mode. 1 means "some infos", 2 means "MARC dumping"
 159 \tfk : Turn off foreign key checks during import.
 160 \tn : the number of records to import. If missing, all the file is imported
 161 \tcommit : the number of records to wait before performing a 'commit' operation
 162 \tt : test mode : parses the file, saying what he would do, but doing nothing.
 163 \ts : skip automatic conversion of MARC-8 to UTF-8.  This option is
 164 \t    provided for debugging.
 165 \tc : the characteristic MARC flavour. At the moment, only MARC21 and UNIMARC
 166 \tsupported. MARC21 by default.
 167 \td : delete EVERYTHING related to biblio in koha-DB before import  :tables :
 168 \t\tbiblio, \tbiblioitems,\titems
 169 IMPORTANT : don't use this script before you've entered and checked your MARC parameters tables twice (or more!).
 170 Otherwise, the import won't work correctly and you will get invalid data.
 171
 172 SAMPLE :
 173 \t\$ export KOHA_CONF=/etc/koha.conf
 174 \t\$ perl misc/migration_tools/bulkmarcimport.pl -d -commit 1000 -file /home/jmf/koha.mrc -n 3000
 175 EOF
 176 ;#'
 177 exit;
 178 }
 179
 180 my $dbh = C4::Context->dbh;
 181
 182 # save the CataloguingLog property : we don't want to log a bulkmarcimport. It will slow the import &
 183 # will create problems in the action_logs table, that can't handle more than 1 entry per second per user.
 184 my $CataloguingLog = C4::Context->preference('CataloguingLog');
 185 $dbh->do("UPDATE systempreferences SET value=0 WHERE variable='CataloguingLog'");
 186
 187 if ($delete) {
 188     print "deleting biblios\n";
 189     $dbh->do("truncate biblio");
 190     $dbh->do("truncate biblioitems");
 191     $dbh->do("truncate items");
 192     $dbh->do("truncate zebraqueue");
 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 my $starttime = gettimeofday;
 205 my $batch = MARC::Batch->new( 'USMARC', $input_marc_file );
 206 $batch->warnings_off();
 207 $batch->strict_off();
 208 my $i=0;
 209 my $commitnum = 50;
 210
 211 if ($commit) {
 212
 213 $commitnum = $commit;
 214
 215 }
 216
 217 my $dbh = C4::Context->dbh();
 218 $dbh->{AutoCommit} = 0;
 219 RECORD: while ( my $record = $batch->next() ) {
 220     $i++;
 221     print ".";
 222     print "\r$i" unless $i % 100;
 223
 224     if ($record->encoding() eq 'MARC-8' and not $skip_marc8_conversion) {
 225         unless (fMARC8ToUTF8($record, $verbose)) {
 226             warn "ERROR: failed to perform character conversion for record $i\n";
 227             next RECORD;
 228         }
 229     }
 230
 231     unless ($test_parameter) {
 232         my ( $bibid, $oldbibitemnum, $itemnumbers_ref, $errors_ref );
 233         eval { ( $bibid, $oldbibitemnum, $itemnumbers_ref, $errors_ref ) = AddBiblioAndItems( $record, '' ); };
 234         if ( $@ ) {
 235             warn "ERROR: Adding biblio and or items $bibid failed: $@\n";
 236         }
 237         if ($#{ $errors_ref } > -1) {
 238             report_item_errors($bibid, $errors_ref);
 239         }
 240
 241         $dbh->commit() if (0 == $i % $commitnum);
 242     }
 243     last if $i == $number;
 244 }
 245 $dbh->commit();
 246
 247
 248 if ($fk_off) {
 249         $dbh->do("SET FOREIGN_KEY_CHECKS = 1");
 250 }
 251
 252 # restore CataloguingLog
 253 $dbh->do("UPDATE systempreferences SET value=$CataloguingLog WHERE variable='CataloguingLog'");
 254
 255 my $timeneeded = gettimeofday - $starttime;
 256 print "$i MARC records done in $timeneeded seconds\n";
 257
 258 exit 0;
 259
 260 sub report_item_errors {
 261     my $bibid = shift;
 262     my $errors_ref = shift;
 263
 264     foreach my $error (@{ $errors_ref }) {
 265         my $msg = "Item not added (bib $bibid, item tag #$error->{'item_sequence'}, barcode $error->{'item_barcode'}): ";
 266         my $error_code = $error->{'error_code'};
 267         $error_code =~ s/_/ /g;
 268         $msg .= "$error_code $error->{'error_information'}";
 269         print $msg, "\n";
 270     }
 271 }