misc/migration_tools/bulkauthimport.pl

   1 #!/usr/bin/perl
   2 # small script that import an iso2709 file into koha 2.0
   3
   4 use strict;
   5 BEGIN {
   6     # find Koha's Perl modules
   7     # test carefully before changing this
   8     use FindBin;
   9     eval { require "$FindBin::Bin/kohalib.pl" };
  10 }
  11
  12 # Koha modules used
  13 use Unicode::Normalize;
  14 use MARC::File::USMARC;
  15 use MARC::File::XML;
  16 use MARC::Record;
  17 use MARC::Batch;
  18 use C4::Context;
  19 use C4::AuthoritiesMarc;
  20 use Time::HiRes qw(gettimeofday);
  21
  22 use Getopt::Long;
  23 my ( $input_marc_file, $number) = ('',0);
  24 my ($version, $delete, $test_parameter,$char_encoding, $verbose, $format);
  25 GetOptions(
  26     'file:s'    => \$input_marc_file,
  27     'n' => \$number,
  28     'h' => \$version,
  29     'd' => \$delete,
  30     't' => \$test_parameter,
  31     'c:s' => \$char_encoding,
  32     'v:s' => \$verbose,
  33     'm:s' => \$format,
  34 );
  35
  36 if ($version || ($input_marc_file eq '')) {
  37     print <<EOF
  38 small script to import an iso2709 file into Koha.
  39 parameters :
  40 \th : this version/help screen
  41 \tfile /path/to/file/to/dump : the file to dump
  42 \tv : verbose mode. Valid modes are 1 and 2
  43 \tn : the number of the record to import. If missing, the whole file is imported
  44 \tt : test mode : parses the file, saying what it would do, but doing nothing.
  45 \tc : the MARC flavour. At the moment, MARC21 and UNIMARC supported. MARC21 by default.
  46 \td : delete EVERYTHING related to authorities in koha-DB before import
  47 \tm : format, MARCXML or ISO2709
  48 IMPORTANT : don't use this script before you've entered and checked twice (or more) your MARC parameters tables.
  49 If you fail the test, the import won't work correctly and you will get invalid datas.
  50
  51 SAMPLE : ./bulkmarcimport.pl -file /home/paul/koha.dev/local/npl -n 1
  52 EOF
  53 ;#'
  54 die;
  55 }
  56
  57 my $dbh = C4::Context->dbh;
  58
  59 if ($delete) {
  60     print "deleting authorities\n";
  61     $dbh->do("truncate auth_header");
  62 }
  63 if ($test_parameter) {
  64     print "TESTING MODE ONLY\n    DOING NOTHING\n===============\n";
  65 }
  66
  67 $char_encoding = 'MARC21' unless ($char_encoding);
  68 print "CHAR : $char_encoding\n" if $verbose;
  69 my $starttime = gettimeofday;
  70 my $batch;
  71 if ($format =~ /XML/i) {
  72     $batch = MARC::Batch->new( 'XML', $input_marc_file );
  73 } else {
  74     $batch = MARC::Batch->new( 'USMARC', $input_marc_file );
  75 }
  76 $batch->warnings_off();
  77 $batch->strict_off();
  78 my $i=0;
  79 while ( my $record = $batch->next() ) {
  80     $i++;
  81     #now, parse the record, extract the item fields, and store them in somewhere else.
  82
  83     ## create an empty record object to populate
  84     my $newRecord = MARC::Record->new();
  85     $newRecord->leader($record->leader);
  86     # go through each field in the existing record
  87     foreach my $oldField ( $record->fields() ) {
  88         # just reproduce tags < 010 in our new record
  89         if ( $oldField->tag() < 10 ) {
  90             $newRecord->append_fields( $oldField );
  91             next();
  92         }
  93         # store our new subfield data in this list
  94         my @newSubfields = ();
  95
  96         # go through each subfield code/data pair
  97         foreach my $pair ( $oldField->subfields() ) {
  98             $pair->[1] =~ s/\<//g;
  99             $pair->[1] =~ s/\>//g;
 100             push( @newSubfields, $pair->[0], $pair->[1]);
 101         }
 102
 103         # add the new field to our new record
 104         my $newField = MARC::Field->new(
 105             $oldField->tag(),
 106             $oldField->indicator(1),
 107             $oldField->indicator(2),
 108             @newSubfields
 109         );
 110         $newRecord->append_fields( $newField );
 111     }
 112     warn "$i ==>".$newRecord->as_formatted() if $verbose eq 2;
 113     my $authtypecode;
 114     if (C4::Context->preference('marcflavour') eq 'MARC21') {
 115         $authtypecode="PERSO_NAME" if ($newRecord->field('100'));
 116         $authtypecode="CORPO_NAME" if ($newRecord->field('110'));
 117         $authtypecode="MEETI_NAME" if ($newRecord->field('111'));
 118         $authtypecode="UNIF_TITLE" if ($newRecord->field('130'));
 119         $authtypecode="CHRON_TERM" if ($newRecord->field('148'));
 120         $authtypecode="TOPIC_TERM" if ($newRecord->field('150'));
 121         $authtypecode="GEOGR_NAME" if ($newRecord->field('151'));
 122         $authtypecode="GENRE/FORM" if ($newRecord->field('155'));
 123         next unless $authtypecode; # skip invalid records FIXME: far too simplistic
 124     }
 125     else {
 126         $authtypecode=substr($newRecord->leader(),9,1);
 127         $authtypecode="NP" if ($authtypecode eq 'a'); # personnes
 128         $authtypecode="CO" if ($authtypecode eq 'b'); # collectivit�
 129         $authtypecode="NG" if ($authtypecode eq 'c'); # g�graphique
 130         $authtypecode="NM" if ($authtypecode eq 'd'); # marque
 131         $authtypecode="NF" if ($authtypecode eq 'e'); # famille
 132         $authtypecode="TI" if ($authtypecode eq 'f'); # Titre uniforme
 133         $authtypecode="TI" if ($authtypecode eq 'h'); # auteur/titre
 134         $authtypecode="MM" if ($authtypecode eq 'j'); # mot mati�e
 135     }
 136     # now, create biblio and items with NEWnewXX call.
 137     unless ($test_parameter) {
 138         my ($authid) = AddAuthority($newRecord,0,$authtypecode);
 139         warn "ADDED authority NB $authid in DB\n" if $verbose;
 140     }
 141 }
 142 # $dbh->do("unlock tables");
 143 my $timeneeded = gettimeofday - $starttime;
 144 print "$i MARC record done in $timeneeded seconds";