new flag --tcnfile, allows specification of a dumpfile for all dontuse and found...
[Evergreen.git] / Open-ILS / src / extras / import / marc2bre.pl
1 #!/usr/bin/perl
2 use strict;
3 use warnings;
4
5 use lib '/openils/lib/perl5/';
6
7 use Error qw/:try/;
8 use OpenILS::Utils::Fieldmapper;
9 use Digest::MD5 qw/md5_hex/;
10 use OpenSRF::Utils::JSON;
11 use Data::Dumper;
12 use Unicode::Normalize;
13 use Encode;
14
15 use FileHandle;
16 use Time::HiRes qw/time/;
17 use Getopt::Long;
18 use MARC::Batch;
19 use MARC::File::XML ( BinaryEncoding => 'utf-8' );
20 use MARC::Charset;
21 use DBI;
22
23 #MARC::Charset->ignore_errors(1);
24
25 my ($id_field, $id_subfield, $recid, $user, $config, $idlfile, $marctype, $keyfile, $tcnfile, $dontuse_file, $enc, $force_enc, @files, @trash_fields, @req_fields, $use901, $quiet) =
26         ('', 'a', 0, 1, '/openils/conf/opensrf_core.xml', '/openils/conf/fm_IDL.xml', 'USMARC');
27
28 my ($db_driver,$db_host,$db_name,$db_user,$db_pw) =
29         ('Pg','localhost','evergreen','postgres','postgres');
30
31 GetOptions( 'marctype=s'       => \$marctype,
32             'startid=i'        => \$recid,
33             'idfield=s'        => \$id_field,
34             'idsubfield=s'     => \$id_subfield,
35             'user=s'           => \$user,
36             'encoding=s'       => \$enc,
37             'hard_encoding'    => \$force_enc,
38             'keyfile=s'        => \$keyfile,
39             'tcnfile=s'        => \$tcnfile,
40             'config=s'         => \$config,
41             'file=s'           => \@files,
42             'required_field=s' => \@req_fields,
43             'trash=s'          => \@trash_fields,
44             'xml_idl=s'        => \$idlfile,
45             'dontuse=s'        => \$dontuse_file,
46             "db_driver=s"      => \$db_driver,
47             "db_host=s"        => \$db_host,
48             "db_name=s"        => \$db_name,
49             "db_user=s"        => \$db_user,
50             "db_pw=s"          => \$db_pw,
51             "use901"           => \$use901,
52             'quiet'            => \$quiet,
53           );
54
55 @trash_fields = split(/,/,join(',',@trash_fields));
56
57 if ($enc) {
58         MARC::Charset->ignore_errors(1);
59         MARC::Charset->assume_encoding($enc);
60 }
61
62 if (uc($marctype) eq 'XML') {
63         'open'->use(':utf8');
64 } else {
65         bytes->use();
66 }
67
68 @files = @ARGV if (!@files);
69
70 my @ses;
71 my @req;
72 my %processing_cache;
73
74 my $dsn = "dbi:$db_driver:host=$db_host;dbname=$db_name";
75
76 if (!$recid) {
77     my $table = 'biblio_record_entry';
78     $table = 'biblio.record_entry' if ($db_driver eq 'Pg');
79
80         my $dbh = DBI->connect($dsn,$db_user,$db_pw);
81         my $sth = $dbh->prepare("SELECT MAX(id) + 1 FROM $table");
82
83         $sth->execute;
84         $sth->bind_col(1, \$recid);
85         $sth->fetch;
86         $sth->finish;
87         $recid++;
88         $dbh->disconnect;
89 }
90
91 my %source_map = (
92         o  => 'OCLC',
93         i  => 'ISxN',
94         l  => 'LCCN',
95         s  => 'System',
96         g  => 'Gutenberg',
97 );
98
99 Fieldmapper->import(IDL => $idlfile);
100
101 my %keymap;
102 if ($keyfile) {
103         open F, $keyfile or die "Couldn't open key file $keyfile";
104         while (<F>) {
105                 if ( /^(\d+)\|(\S+)/o ) {
106                         $keymap{$1} = $2;
107                 }
108         }
109         close(F);
110 }
111
112 my %dontuse_id;
113 if ($dontuse_file) {
114         open F, $dontuse_file or die "Couldn't open used-id file $dontuse_file";
115         while (<F>) {
116                 chomp;
117                 s/^\s*//;
118                 s/\s*$//;
119                 $dontuse_id{$_} = 1;
120         }
121         close(F);
122 }
123
124 select STDERR; $| = 1;
125 select STDOUT; $| = 1;
126
127 my $batch = new MARC::Batch ( $marctype, @files );
128 $batch->strict_off();
129 $batch->warnings_off();
130
131 my %used_ids;
132 my $starttime = time;
133 my $rec;
134 my $count = 0;
135 PROCESS: while ( try { $rec = $batch->next } otherwise { $rec = -1 } ) {
136         next if ($rec == -1);
137
138         # Skip records that don't contain a required field (like '245', for example)
139         foreach my $req_field(@req_fields) {
140                 next PROCESS if !$rec->field("$req_field");
141         }
142         my $id;
143
144         $recid++;
145         while (exists $used_ids{$recid}) {
146                 $recid++;
147         }
148         $used_ids{$recid} = 1;
149
150         if ($id_field) {
151                 my $field = $rec->field($id_field);
152                 if ($field) {
153                         if ($field->is_control_field) {
154                                 $id = $field->data;
155                         } else {
156                                 $id = $field->subfield($id_subfield);
157                         }
158
159                         $id =~ s/\D+//gso;
160                 }
161                 $id = '' if (exists $dontuse_id{$id});
162         }
163
164         if (!$id) {
165                 $id = $recid;
166         }
167
168         if ($keyfile) {
169                 if (my $tcn = $keymap{$id}) {
170                         $rec->delete_field( $_ ) for ($rec->field($id_field));
171                         $rec->append_fields( MARC::Field->new( $id_field, '', '', $id_subfield, $tcn ) );
172                 } else {
173                         $count++;
174                         next;
175                 }
176         }
177
178         my $tcn;
179         if ($use901) {
180             $id = $rec->subfield('901' => 'c')
181         } else {
182             ($rec, $tcn) = preprocess($rec, $id);
183             $tcn->add_subfields(c => $id);
184
185             $rec->delete_field( $_ ) for ($rec->field($id_field));
186             $rec->append_fields( $tcn );
187
188             next unless $rec;
189         }
190
191         my $tcn_value = $rec->subfield('901' => 'a') || "SYS$id";
192         my $tcn_source = $rec->subfield('901' => 'b') || 'System';
193
194         (my $xml = $rec->as_xml_record()) =~ s/\n//sog;
195         $xml =~ s/^<\?xml.+\?\s*>//go;
196         $xml =~ s/>\s+</></go;
197         $xml =~ s/\p{Cc}//go;
198         $xml = entityize($xml,'D');
199         $xml =~ s/[\x00-\x1f]//go;
200
201         my $bib = new Fieldmapper::biblio::record_entry;
202         $bib->id($id);
203         $bib->active('t');
204         $bib->deleted('f');
205         $bib->marc($xml);
206         $bib->creator($user);
207         $bib->create_date('now');
208         $bib->editor($user);
209         $bib->edit_date('now');
210         $bib->tcn_source($tcn_source);
211         $bib->tcn_value($tcn_value);
212         $bib->last_xact_id('IMPORT-'.$starttime);
213
214         print OpenSRF::Utils::JSON->perl2JSON($bib)."\n";
215         $dontuse_id{$tcn_value} = 1;
216
217         $count++;
218
219         if (!$quiet && !($count % 50)) {
220                 print STDERR "\r$count\t". $count / (time - $starttime);
221         }
222 }
223
224 if ($tcnfile) {
225     open TCNFILE, '>', $tcnfile;
226     print "$_\n" for (keys %dontuse_id);
227 }
228
229
230
231 sub preprocess {
232         my $rec = shift;
233         my $id = shift;
234
235         my ($source, $value) = ('','');
236
237         $id = '' if (exists $dontuse_id{$id});
238
239         if (!$id) {
240                 my $f = $rec->field('001');
241                 $id = $f->data if ($f);
242                 $id = '' if (exists $dontuse_id{$id});
243         }
244
245         if (!$id || exists $dontuse_id{$source.$id}) {
246                 my $f = $rec->field('000');
247                 $id = $f->data if ($f);
248                 $source = 'g' if ($f); # only PG seems to use this
249         }
250
251         if (!$id || exists $dontuse_id{$source.$id}) {
252                 my $f = $rec->field('020');
253                 $id = $f->subfield('a') if ($f);
254                 $source = 'i' if ($f);
255         }
256
257         if (!$id || exists $dontuse_id{$source.$id}) {
258                 my $f = $rec->field('022');
259                 $id = $f->subfield('a') if ($f);
260                 $source = 'i' if ($f);
261         }
262
263         if (!$id || exists $dontuse_id{$source.$id}) {
264                 my $f = $rec->field('010');
265                 $id = $f->subfield('a') if ($f);
266                 $source = 'l' if ($f);
267         }
268
269         $rec->delete_field($_) for ($rec->field('901', $id_field, @trash_fields));
270
271         if ($id) {
272                 $id =~ s/\s*$//o;
273                 $id =~ s/^\s*//o;
274                 $id =~ s/^(\S+).*$/$1/o;
275
276                 $id = $source.$id if ($source);
277
278                 ($source, $value) = $id =~ /^(.)(.+)$/o;
279                 if ($id =~ /^o(\d+)$/o) {
280                         $id = "ocm$1";
281                         $source = 'o';
282                 }
283         }
284
285         if ($id && exists $dontuse_id{$id}) {
286                 warn "\n!!! TCN $id is already in use.  Using the record ID ($recid) as a system-generated TCN.\n";
287                 $id = '';
288         }
289
290         if (!$id) {
291                 $source = 's';
292                 $id = 's'.$recid;
293         }
294
295         my $tcn = MARC::Field->new(
296                 '901' => ('', ''),
297                 a => $id,
298                 b => do { $source_map{$source} || 'System' },
299         );
300
301         return ($rec,$tcn);
302 }
303
304 sub entityize {
305         my $stuff = shift;
306         my $form = shift;
307
308         if ($form and $form eq 'D') {
309                 $stuff = NFD($stuff);
310         } else {
311                 $stuff = NFC($stuff);
312         }
313
314         $stuff =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
315         return $stuff;
316 }
317