Code cleaning :
[koha.git] / 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";