fix Experimental unshift on scalar is now forbidden with newer Perl
[migration-tools.git] / mig-bin / mig-loadbibs
1 #!/usr/bin/perl
2
3 ###############################################################################
4 =pod
5
6 =item B<loadbibs> --stage_file foo.mrc 
7
8 Takes a load of bibs from a binary marc file and loads them into mig staging table 
9 of bibio_record_entry.
10
11 Takes these optional arguments:
12
13 --append 
14
15 When used it does not drop the staging table and instead adds onto it.  
16
17 --source
18
19 Sets an x_source value on the staging table to the one supplied instead of the 
20 default of none.
21
22 --xml 
23
24 By default the program assumes a USMARC file.  This flag will identify it as 
25 a MARCXML file instead.
26
27 =back
28
29 =cut
30
31 ###############################################################################
32
33 use strict;
34 use warnings;
35
36 use DBI;
37 use Data::Dumper;
38 use MARC::Record;
39 use MARC::Batch;
40 use MARC::File;
41 use MARC::File::XML;
42 use MARC::Charset 'marc8_to_utf8';
43 #binmode STDIN, ':bytes';
44 use Env qw(
45     HOME PGHOST PGPORT PGUSER PGDATABASE MIGSCHEMA
46     MIGBASEWORKDIR MIGBASEGITDIR MIGGITDIR MIGWORKDIR
47 );
48 use Pod::Usage;
49 use Switch;
50 use Cwd 'abs_path';
51 use FindBin;
52 use UNIVERSAL;
53 use Unicode::Normalize;
54 my $mig_bin = "$FindBin::Bin/";
55 use lib "$FindBin::Bin/";
56 use Mig;
57
58 pod2usage(-verbose => 2) if defined $ARGV[0] && $ARGV[0] eq '--help';
59 pod2usage(-verbose => 1) if ! $ARGV[1];
60
61 my $next_arg_is_file = 0;
62 my $append = 0;
63 my $next_arg_is_source = 0;
64 my $next_arg_is_stage = 0;
65 my $stage_table = 'biblio_record_entry_legacy';
66 my $source = 'default';
67 my $file_is_xml = 0;
68 my $dbh = Mig::db_connect();
69 my $infile;
70 my $i = 0;
71 my $batch;
72 binmode STDIN, ':utf8';
73
74 #MARC::Charset->assume_unicode(1); 
75 MARC::Charset->ignore_errors(1);
76
77 foreach my $arg (@ARGV) {
78     if ($arg eq '--stage_file') {
79         $next_arg_is_file = 1;
80         next;
81     }
82     if ($next_arg_is_file) {
83         $infile = $arg;
84         $next_arg_is_file = 0;
85         next;
86     }
87     if ($arg eq '--source') {
88         $next_arg_is_source = 1;
89         next;
90     }
91     if ($next_arg_is_source) {
92         $source = $arg;
93         $next_arg_is_source = 0;
94         next;
95     }
96     if ($arg eq '--stage_table') {
97         $next_arg_is_stage = 1;
98         next;
99     }
100     if ($next_arg_is_stage) {
101         $stage_table = $arg;
102         $next_arg_is_stage = 0;
103         next;
104     }
105         if ($arg eq '--append') {
106                 $append = 1;
107                 next;
108         }
109     if ($arg eq '--xml') {
110         $file_is_xml = 1;
111         next;
112     }
113 }
114
115 create_child_table($dbh); #and test to see if it exists 
116
117 # normal stage table creation
118 if ($append == 0) { 
119     drop_stage_table($dbh,$stage_table); 
120     create_stage_table($dbh,$stage_table);
121     }
122 if ($file_is_xml) {
123         $batch = MARC::Batch->new('XML',$infile);
124 } else {
125         $batch = MARC::Batch->new('USMARC',$infile);
126
127 $batch->strict_off();
128
129 my $record;
130 #while ( my $record = $batch->next() ) {
131 while ( eval {$record = $batch->next()} or do { if (!$record and !$@) { last; } else { next; }} ) {
132         my $xml = $record->as_xml_record();
133     $xml = marc8_to_utf8($xml);
134         $i++;
135         $xml = clean_marc($xml);
136         $xml = '$_$' . $xml . '$_$';
137         my @warnings = $batch->warnings();
138         my $warning_string;
139         if (@warnings) { $warning_string = "'" . join(':',@warnings) . "'"; } else { $warning_string = "'none'"; }
140         my $sql = "INSERT INTO $MIGSCHEMA.$stage_table (marc,x_source,x_warnings) VALUES ($xml,'$source',$warning_string);";
141     my $sth = $dbh->prepare($sql);
142     eval { $sth->execute() };
143         report_progress("Records staged", $i) if 0 != $i % 100;
144 }
145
146 $dbh->do(qq/
147     CREATE INDEX ${MIGSCHEMA}_biblio_record_entry_legacy_idx ON
148         $MIGSCHEMA.biblio_record_entry_legacy (id);
149 /);
150
151 print "Finis.\n";
152
153
154 sub drop_stage_table {
155     my $dbh = shift;
156     my $stage_table = shift;
157     my $tablecheck = check_for_mig_table($dbh,$stage_table);
158     my $answer = 'null';
159     if ($tablecheck == 1) { $answer = prompt('Do you want to drop $MIGSCHEMA.$stage_table? This will not remove any bibs loaded to production. y/n'); }
160     if ($tablecheck == 1 and $answer eq 'y') { $dbh->do("DROP TABLE IF EXISTS $MIGSCHEMA.$stage_table;"); } 
161     if ($tablecheck == 1 and $answer ne 'y') { abort('Table not dropped, bib load aborted.'); }
162     return();
163 }
164
165 sub create_stage_table {
166         my $dbh = shift;
167     my $stage_table = shift;
168
169     $dbh->do("CREATE UNLOGGED TABLE $MIGSCHEMA.$stage_table (
170             l_bib_id    TEXT,
171             x_source    TEXT,
172             x_warnings  TEXT,
173             x_migrate   BOOLEAN DEFAULT TRUE
174         ) INHERITS ($MIGSCHEMA.biblio_record_entry);");
175
176     return();
177 }
178
179 sub create_child_table {
180     my $dbh = shift;
181
182     $dbh->do("DO \$\$ 
183         DECLARE
184             t   BOOLEAN;
185         BEGIN
186         SELECT EXISTS(SELECT 1 FROM information_schema.tables WHERE table_schema = '$MIGSCHEMA' AND table_name = 'biblio_record_entry') INTO t;
187         IF t = FALSE THEN
188             PERFORM migration_tools.build_specific_base_staging_table ('$MIGSCHEMA','biblio.record_entry');
189         END IF;
190         END \$\$;");
191
192     return ();
193 }
194
195 sub clean_marc {
196     my $xml = shift;
197     $xml = marc8_to_utf8($xml);
198     $xml =~ s/\n//sog;
199     $xml =~ s/^<\?xml.+\?\s*>//go;
200     $xml =~ s/>\s+</></go;
201     $xml =~ s/\p{Cc}//go;
202     $xml = NFC($xml);
203     $xml =~ s/&(?!\S+;)/&amp;/gso;
204     $xml =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
205     $xml =~ s/[\x00-\x1f]//go;
206     return $xml;
207 }
208
209
210 sub abort {
211     my $msg = shift;
212     print STDERR "$0: $msg", "\n";
213     exit 1;
214 }
215
216 sub report_progress {
217     my ($msg, $counter) = @_;
218     if (defined $counter) {
219         print STDERR "$msg: $counter\n";
220     } else {
221         print STDERR "$msg\n";
222     }
223 }
224
225 sub check_for_mig_table {
226     my $dbh = shift;
227     my $table = shift;
228     my $sql = "SELECT 1 FROM information_schema.tables WHERE table_schema = '$MIGSCHEMA' AND table_name = '$table';";
229     my $sth = $dbh->prepare($sql);
230     $sth->execute();
231     my @sqlresult = $sth->fetchrow_array;
232     my $r = pop @sqlresult;
233     if ($r) { return $r; } else { return 0; }
234 }
235
236 sub prompt {
237   my ($query) = @_; 
238   local $| = 1; 
239   print $query;
240   chomp(my $answer = <STDIN>);
241   return $answer;
242 }
243
244