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);
  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 );
  49
  50 # FIXME:  Management of error conditions needed for record parsing problems
  51 # and MARC8 character sets with mappings to Unicode not yet included in
  52 # MARC::Charset.  The real world rarity of these problems is not fully tested.
  53 # Unmapped character sets will throw a warning currently and processing will
  54 # continue with the error condition.  A fairly trivial correction should
  55 # address some record parsing and unmapped character set problems but I need
  56 # time to implement a test and correction for undef subfields and revert to
  57 # MARC8 if mappings are missing. -- thd
  58 sub fMARC8ToUTF8($$) {
  59     my ($record) = shift;
  60     my ($verbose) = shift;
  61     if ($verbose) {
  62         if ($verbose >= 2) {
  63             my $leader = $record->leader();
  64             $leader =~ s/ /#/g;
  65             print "\n000 " . $leader;
  66         }
  67     }
  68     foreach my $field ($record->fields()) {
  69         if ($field->is_control_field()) {
  70             if ($verbose) {
  71                 if ($verbose >= 2) {
  72                     my $fieldName = $field->tag();
  73                     my $fieldValue = $field->data();
  74                     $fieldValue =~ s/ /#/g;
  75                     print "\n" . $fieldName;
  76                     print ' ' . $fieldValue;
  77                 }
  78             }
  79         } else {
  80             my @subfieldsArray;
  81             my $fieldName = $field->tag();
  82             my $indicator1Value = $field->indicator(1);
  83             my $indicator2Value = $field->indicator(2);
  84             if ($verbose) {
  85                 if ($verbose >= 2) {
  86                     $indicator1Value =~ s/ /#/;
  87                     $indicator2Value =~ s/ /#/;
  88                     print "\n" . $fieldName . ' ' .
  89                             $indicator1Value .
  90                     $indicator2Value;
  91                 }
  92             }
  93             foreach my $subfield ($field->subfields()) {
  94                 my $subfieldName = $subfield->[0];
  95                 my $subfieldValue = $subfield->[1];
  96                 $subfieldValue = MARC::Charset::marc8_to_utf8($subfieldValue);
  97
  98                 # Alas, MARC::Field::update() does not work correctly.
  99                 ## push (@subfieldsArray, $subfieldName, $subfieldValue);
 100
 101                 push @subfieldsArray, [$subfieldName, $subfieldValue];
 102                 if ($verbose) {
 103                     if ($verbose >= 2) {
 104                         print " \$" . $subfieldName . ' ' . $subfieldValue;
 105                     }
 106                 }
 107             }
 108
 109             # Alas, MARC::Field::update() does not work correctly.
 110             #
 111             # The first instance in the field of a of a repeated subfield
 112             # overwrites the content from later instances with the content
 113             # from the first instance.
 114             ## $field->update(@subfieldsArray);
 115
 116             foreach my $subfieldRow(@subfieldsArray) {
 117                 my $subfieldName = $subfieldRow->[0];
 118                 $field->delete_subfields($subfieldName);
 119             }
 120             foreach my $subfieldRow(@subfieldsArray) {
 121                 $field->add_subfields(@$subfieldRow);
 122             }
 123
 124             if ($verbose) {
 125                 if ($verbose >= 2) {
 126                     # Reading the indicator values again is not necessary.
 127                     # They were not converted.
 128                     # $indicator1Value = $field->indicator(1);
 129                     # $indicator2Value = $field->indicator(2);
 130                     # $indicator1Value =~ s/ /#/;
 131                     # $indicator2Value =~ s/ /#/;
 132                     print "\nCONVERTED TO UTF-8:\n" . $fieldName . ' ' .
 133                             $indicator1Value .
 134                     $indicator2Value;
 135                     foreach my $subfield ($field->subfields()) {
 136                         my $subfieldName = $subfield->[0];
 137                         my $subfieldValue = $subfield->[1];
 138                         print " \$" . $subfieldName . ' ' . $subfieldValue;
 139                     }
 140                 }
 141             }
 142             if ($verbose) {
 143                 if ($verbose >= 2) {
 144                     print "\n" if $verbose;
 145                 }
 146             }
 147         }
 148     }
 149     $record->encoding('UTF-8');
 150     return $record;
 151 }
 152
 153
 154 if ($version || ($input_marc_file eq '')) {
 155     print <<EOF
 156 small script to import an iso2709 file into Koha.
 157 parameters :
 158 \th : this version/help screen
 159 \tfile /path/to/file/to/dump : the file to dump
 160 \tv : verbose mode. 1 means "some infos", 2 means "MARC dumping"
 161 \tn : the number of records to import. If missing, all the file is imported
 162 \tcommit : the number of records to wait before performing a 'commit' operation
 163 \tt : test mode : parses the file, saying what he would do, but doing nothing.
 164 \tc : the characteristic MARC flavour. At the moment, only MARC21 and UNIMARC
 165 \tsupported. MARC21 by default.
 166 \td : delete EVERYTHING related to biblio in koha-DB before import  :tables :
 167 \t\tbiblio, \t\tbiblioitems, \t\tsubjects,\titems
 168 \tmarc_biblio,
 169 \t\tmarc_subfield_table, \tmarc_word, \t\tmarc_blob_subfield
 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 die;
 179 }
 180
 181 my $dbh = C4::Context->dbh;
 182
 183 if ($delete) {
 184     print "deleting biblios\n";
 185     $dbh->do("delete from biblio");
 186     $dbh->do("delete from biblioitems");
 187     $dbh->do("delete from items");
 188 }
 189 if ($test_parameter) {
 190     print "TESTING MODE ONLY\n    DOING NOTHING\n===============\n";
 191 }
 192
 193 my $marcFlavour = C4::Context->preference('marcflavour') || 'MARC21';
 194
 195 print "Characteristic MARC flavour: $marcFlavour\n" if $verbose;
 196 # die;
 197 my $starttime = gettimeofday;
 198 my $batch = MARC::Batch->new( 'USMARC', $input_marc_file );
 199 $batch->warnings_off();
 200 $batch->strict_off();
 201 my $i=0;
 202 my $commitnum = 50;
 203
 204 if ($commit) {
 205
 206 $commitnum = $commit;
 207
 208 }
 209
 210 #1st of all, find item MARC tag.
 211 my ($tagfield,$tagsubfield) = &GetMarcFromKohaField($dbh,"items.itemnumber",'');
 212 # $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");
 213 while ( my $record = $batch->next() ) {
 214 # warn "=>".$record->as_formatted;
 215 # warn "I:".$i;
 216 # warn "NUM:".$number;
 217     $i++;
 218     print ".";
 219     print "\r$i" unless $i % 100;
 220 #     if ($i==$number) {
 221 #         z3950_extended_services('commit',set_service_options('commit'));
 222 #         print "COMMIT OPERATION SUCCESSFUL\n";
 223 #
 224 #         my $timeneeded = gettimeofday - $starttime;
 225 #         die "$i MARC records imported in $timeneeded seconds\n";
 226 #     }
 227 #     # perform the commit operation ever so often
 228 #     if ($i==$commit) {
 229 #         z3950_extended_services('commit',set_service_options('commit'));
 230 #         $commit+=$commitnum;
 231 #         print "COMMIT OPERATION SUCCESSFUL\n";
 232 #     }
 233     #now, parse the record, extract the item fields, and store them in somewhere else.
 234
 235     ## create an empty record object to populate
 236     my $newRecord = MARC::Record->new();
 237     $newRecord->leader($record->leader());
 238
 239     # go through each field in the existing record
 240     foreach my $oldField ( $record->fields() ) {
 241
 242     # just reproduce tags < 010 in our new record
 243     #
 244     # Fields are not necessarily only numeric in the actual world of records
 245     # nor in what I would recommend for additonal safe non-interfering local
 246     # use fields.  The following regular expression match is much safer than
 247     # a numeric evaluation. -- thd
 248     if ( $oldField->tag() =~ m/^00/ ) {
 249         $newRecord->append_fields( $oldField );
 250         next();
 251     }
 252
 253     # store our new subfield data in this list
 254     my @newSubfields = ();
 255
 256     # go through each subfield code/data pair
 257     foreach my $pair ( $oldField->subfields() ) {
 258         #$pair->[1] =~ s/\<//g;
 259         #$pair->[1] =~ s/\>//g;
 260         push( @newSubfields, $pair->[0], $pair->[1] ); #char_decode($pair->[1],$char_encoding) );
 261     }
 262
 263     # add the new field to our new record
 264     my $newField = MARC::Field->new(
 265         $oldField->tag(),
 266         $oldField->indicator(1),
 267         $oldField->indicator(2),
 268         @newSubfields
 269     );
 270
 271     $newRecord->append_fields( $newField );
 272
 273     }
 274
 275     warn "$i ==>".$newRecord->as_formatted() if $verbose eq 2;
 276     my @fields = $newRecord->field($tagfield);
 277     my @items;
 278     my $nbitems=0;
 279
 280     foreach my $field (@fields) {
 281         my $item = MARC::Record->new();
 282         $item->append_fields($field);
 283         push @items,$item;
 284         $newRecord->delete_field($field);
 285         $nbitems++;
 286     }
 287     print "$i : $nbitems items found\n" if $verbose;
 288     # now, create biblio and items with Addbiblio call.
 289     unless ($test_parameter) {
 290     warn "NEWREC : ".$newRecord->as_formatted;
 291         my ($bibid,$oldbibitemnum) = AddBiblio($newRecord,'');
 292         warn "ADDED biblio NB $bibid in DB\n" if $verbose;
 293         for (my $i=0;$i<=$#items;$i++) {
 294 #             warn "here is the biblioitemnumber $oldbibitemnum";
 295             AddItem($items[$i],$bibid,$oldbibitemnum);
 296         }
 297     }
 298 }
 299 # final commit of the changes
 300 z3950_extended_services('commit',set_service_options('commit'));
 301 print "COMMIT OPERATION SUCCESSFUL\n";
 302
 303 my $timeneeded = gettimeofday - $starttime;
 304 print "$i MARC records done in $timeneeded seconds\n";