]> git.evergreen-ils.org Git - Evergreen.git/blob - Open-ILS/src/extras/import/marc2bre.pl
Fix up the import script.
[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
22 #MARC::Charset->ignore_errors(1);
23
24 my ($id_field, $recid, $user, $config, $idlfile, $marctype, $keyfile, $dontuse_file, $enc, $force_enc, @files, @trash_fields, $quiet) =
25         ('', 1, 1, '/openils/conf/opensrf_core.xml', '/openils/conf/fm_IDL.xml', 'USMARC');
26
27 GetOptions(
28         'marctype=s'    => \$marctype,
29         'startid=i'     => \$recid,
30         'idfield=s'     => \$id_field,
31         'user=s'        => \$user,
32         'encoding=s'    => \$enc,
33         'hard_encoding' => \$force_enc,
34         'keyfile=s'     => \$keyfile,
35         'config=s'      => \$config,
36         'file=s'        => \@files,
37         'trash=s'       => \@trash_fields,
38         'xml_idl=s'     => \$idlfile,
39         'dontuse=s'     => \$dontuse_file,
40         'quiet'         => \$quiet
41 );
42
43 if ($enc) {
44         MARC::Charset->ignore_errors(1);
45         MARC::Charset->assume_encoding($enc);
46 }
47
48 if (uc($marctype) eq 'XML') {
49         'open'->use(':utf8');
50 } else {
51         bytes->use();
52 }
53
54 @files = @ARGV if (!@files);
55
56 my @ses;
57 my @req;
58 my %processing_cache;
59
60 my $startid = $recid;
61
62 my %source_map = (      
63         o  => 'OCLC',
64         i  => 'ISxN',    
65         l  => 'LCCN',
66         s  => 'System',  
67         g  => 'Gutenberg',  
68 );                              
69
70
71
72 Fieldmapper->import(IDL => $idlfile);
73
74 my %keymap;
75 if ($keyfile) {
76         open F, $keyfile or die "Couldn't open key file $keyfile";
77         while (<F>) {
78                 if ( /^(\d+)\|(\S+)/o ) {
79                         $keymap{$1} = $2;
80                 }
81         }
82         close(F);
83 }
84
85 my %dontuse_id;
86 if ($dontuse_file) {
87         open F, $dontuse_file or die "Couldn't open used-id file $dontuse_file";
88         while (<F>) {
89                 chomp;
90                 s/^\s*//;
91                 s/\s*$//;
92                 $dontuse_id{$_} = 1;
93         }
94         close(F);
95 }
96
97 select STDERR; $| = 1;
98 select STDOUT; $| = 1;
99
100 my $batch = new MARC::Batch ( $marctype, @files );
101 $batch->strict_off();
102 $batch->warnings_off();
103
104 my %used_ids;
105 my $starttime = time;
106 my $rec;
107 my $count = 0;
108 while ( try { $rec = $batch->next } otherwise { $rec = -1 } ) {
109         next if ($rec == -1);
110         my $id;
111
112         $recid++;
113         while ($used_ids{$recid}) {
114                 $recid++;
115         }
116         $used_ids{$recid} = 1;
117
118         if ($id_field) {
119                 my $field = $rec->field($id_field);
120                 if ($field) {
121                         if ($field->is_control_field) {
122                                 $id = $field->data;
123                         } else {
124                                 $id = $field->subfield('a');
125                         }
126
127                         $id =~ s/\D+//gso;
128                 }
129         }
130
131         if (!$id) {
132                 $id = $recid;
133         }
134
135         if ($keyfile) {
136                 if (my $tcn = $keymap{$id}) {
137                         $rec->delete_field( $_ ) for ($rec->field($id_field));
138                         $rec->append_fields( MARC::Field->new( $id_field, '', '', 'a', $tcn ) );
139                 } else {
140                         $count++;
141                         next;
142                 }
143         }
144
145         my $tcn;
146         ($rec, $tcn) = preprocess($rec);
147         $rec->delete_field( $_ ) for ($rec->field($id_field));
148         $rec->append_fields( $tcn );
149
150         if (!$rec) {
151                 next;
152         }
153
154         my $tcn_value = $rec->subfield('901' => 'a') || "SYS$id";
155         my $tcn_source = $rec->subfield('901' => 'b') || 'System';
156
157         (my $xml = $rec->as_xml_record()) =~ s/\n//sog;
158         $xml =~ s/^<\?xml.+\?\s*>//go;
159         $xml =~ s/>\s+</></go;
160         $xml =~ s/\p{Cc}//go;
161         $xml = entityize($xml);
162         $xml =~ s/[\x00-\x1f]//go;
163
164         my $bib = new Fieldmapper::biblio::record_entry;
165         $bib->id($id);
166         $bib->active('t');
167         $bib->deleted('f');
168         $bib->marc($xml);
169         $bib->creator($user);
170         $bib->create_date('now');
171         $bib->editor($user);
172         $bib->edit_date('now');
173         $bib->tcn_source($tcn_source);
174         $bib->tcn_value($tcn_value);
175         $bib->last_xact_id('IMPORT-'.$starttime);
176
177         print OpenSRF::Utils::JSON->perl2JSON($bib)."\n";
178         $dontuse_id{$tcn_value} = 1;
179
180         $count++;
181
182         if (!$quiet && !($count % 50)) {
183                 print STDERR "\r$count\t". $count / (time - $starttime);
184         }
185 }
186
187 sub preprocess {
188         my $rec = shift;
189
190         my ($id, $source, $value) = ('','','');
191
192         if (!$id) {
193                 my $f = $rec->field('001');
194                 $id = $f->data if ($f);
195         }
196
197         if (!$id || $dontuse_id{$source.$id}) {
198                 my $f = $rec->field('000');
199                 $id = $f->data if ($f);
200                 $source = 'g' if ($f); # only PG seems to use this
201         }
202
203         if (!$id || $dontuse_id{$source.$id}) {
204                 my $f = $rec->field('020');
205                 $id = $f->subfield('a') if ($f);
206                 $source = 'i' if ($f);
207         }
208
209         if (!$id || $dontuse_id{$source.$id}) {
210                 my $f = $rec->field('022');
211                 $id = $f->subfield('a') if ($f);
212                 $source = 'i' if ($f);
213         }
214
215         if (!$id || $dontuse_id{$source.$id}) {
216                 my $f = $rec->field('010');
217                 $id = $f->subfield('a') if ($f);
218                 $source = 'l' if ($f);
219         }
220
221 #        if (!$id) {
222 #                my $f = $rec->field($id_field);
223 #                $id = $f->subfield('a') if ($f);
224 #        }
225
226         $rec->delete_field($_) for ($rec->field($id_field, @trash_fields));
227
228         if ($id) {
229                 $id =~ s/\s*$//o;
230                 $id =~ s/^\s*//o;
231                 $id =~ s/^(\S+).*$/$1/o;
232
233                 $id = $source.$id if ($source);
234
235                 ($source, $value) = $id =~ /^(.)(.+)$/o;
236                 if ($id =~ /^o(\d+)$/o) {
237                         $id = "ocm$1";
238                         $source = 'o';
239                 }
240         }
241
242         if ($id && $dontuse_id{$id}) {
243                 warn "\n!!! ID $id is already in use\n";
244                 $id = '';
245         }
246
247         if (!$id) {
248                 $source = 's';
249                 $id = 's'.$recid;
250         }
251
252         my $tcn = MARC::Field->new(
253                 '901' => ('', ''),
254                 a => $id,
255                 b => do { $source_map{$source} || 'System' },
256         );
257
258         return ($rec,$tcn);
259 }
260
261 sub entityize {
262         my $stuff = shift;
263         my $form = shift;
264
265         if ($form and $form eq 'D') {
266                 $stuff = NFD($stuff);
267         } else {
268                 $stuff = NFC($stuff);
269         }
270
271         $stuff =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
272         return $stuff;
273 }
274