making the user delete information a bit more robust
[migration-tools.git] / extract_holdings
1 #!/usr/bin/perl
2
3 # Copyright 2009-2012, Equinox Software, Inc.
4 #
5 # This program is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU General Public License
7 # as published by the Free Software Foundation; either version 2
8 # of the License, or (at your option) any later version.
9 #
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 # GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
18
19 use strict;
20 use warnings;
21
22 use Getopt::Long;
23 use Equinox::Migration::MapDrivenMARCXMLProc 1.005;
24 use Equinox::Migration::MARCXMLSampler;
25
26 my $VERSION = '1.001';
27
28 =pod
29
30 TODO
31
32   * Have detail mode report on number of subfields per datafield
33
34 =cut
35
36 my $c = initialize();
37 $| = 1;
38
39 # run samples if we've been asked for them
40 run_samples($c) if ($c->{sample} or $c->{samplemap} or $c->{samplestr});
41 extract_holdings($c) if ($c->{map});
42 print "\n";
43
44 #--------------------------
45
46 sub extract_holdings {
47     my ($c) = @_;
48     print "Parsing records for extraction:\n";
49     my $m = Equinox::Migration::MapDrivenMARCXMLProc->new( marcfile => $c->{marcfile},
50                                                            mapfile  => $c->{map},
51                                                            verbose  => 1,
52                                                          );
53
54     print "Writing holdings to output file(s)...\n";
55     # open main holdings file
56     open HOLDINGS, '>', ($c->{prefix} . "-" . $c->{suffix} . ".pg");
57     # create multi files
58     my $multis = $m->get_multis;
59     my %MULTIFILE = ();
60     for my $t ( keys %{$multis} ) {
61         for my $s ( keys %{$multis->{$t}}) 
62           { open my $fh, ">", ($c->{prefix} . "-" . $c->{suffix} . "-MULT-$t$s.pg"); $MULTIFILE{"$t$s"} = $fh }
63     }
64
65     my $parallel_fields = $m->get_parallel_fields;
66
67     my $i = 0; # record counter
68     my $j = 0; # holdings counter
69
70     while (  $m->{data}{recs}[$i] ) {
71         print HOLDINGS "BEGIN;\n\negid, hseq, " unless $j;
72         my $rec = $m->{data}{recs}[$i];
73         my $k = 0; # holding-within-record pointer
74
75         for my $holdidx ( @{ $rec->{tmap}{ $c->{holdings} } } ) {
76             # for each holdings tag in the record...
77             my $tagid = $rec->{tags}[$holdidx]{tag};
78             $k++;
79
80             my @out = ();            # clear the output buffer
81             push @out, $rec->{egid}; # slug in the egid first thing
82             push @out, $j;           # holding seq goes next
83
84             # grab the unary mappings and slug 'em in
85             for my $sub ( sort keys %{$rec->{tags}[$holdidx]{uni}} ) {
86                 push @out, $rec->{tags}[$holdidx]{uni}{$sub};
87                 print HOLDINGS "l_", $m->name($tagid, $sub),", " unless $j;
88             }
89
90             # handle holdings multis
91             for my $sub ( sort keys %{$multis->{$tagid}} ) {
92                 for my $value ( @{$rec->{tags}[$holdidx]{multi}{$sub}} ) {
93                   my $fh = $MULTIFILE{"$tagid$sub"};
94                   my $clean_value = $value;
95                   $clean_value =~ s/[\r\n\t]//g;
96                   print $fh join("\t", $rec->{egid}, $j, $clean_value), "\n";
97               }
98             }
99
100
101             # now get everything else in the mapping
102             for my $othertag ( sort keys %{$rec->{tmap}} ) {
103                 next if $othertag eq $c->{holdings};  # ignoring the holdings, o'course
104                 my $test_idx = $rec->{tmap}{$othertag}[0]; # get index into tags struct
105                 unless (defined $test_idx) {
106                     push @out, '';
107                     next;
108                 }
109
110                 # handle parallel fields
111                 if (exists($parallel_fields->{$othertag})) {
112                     my $num_fields = $#{ $rec->{tmap}{$othertag} };
113                     my $tag_idx;
114                     if ($holdidx > $num_fields) {
115                         $tag_idx = -1;
116                     } else {
117                         $tag_idx = $rec->{tmap}{$othertag}[$holdidx];
118                     }
119                     for my $sub ( sort keys %{ $parallel_fields->{$othertag } } ) {
120                         push @out, $tag_idx > -1 ? $rec->{tags}[$tag_idx]{parallel}{$sub}->[0] : '';
121                         print HOLDINGS "l_", $m->name($rec->{tags}[$tag_idx]{tag}, $sub), ", " unless $j;
122                     }
123                 }
124
125                 # handle only first other tag unless it is known to be multi
126                 my $limit = 0;
127                 if (exists($multis->{$othertag})) {
128                     $limit = $#{ $rec->{tmap}{$othertag} };
129                 }
130                 foreach my $idx (0..$limit) {
131                     my $tag_idx = $rec->{tmap}{$othertag}[$idx];
132                     for my $sub ( sort keys %{$rec->{tags}[$tag_idx]{uni}} ) {
133                         if ($m->first_only($rec->{tags}[$tag_idx]{tag}, $sub)) {
134                             push @out, ($k == 1) ? $rec->{tags}[$tag_idx]{uni}{$sub} : '';
135                         } else {
136                             push @out, $rec->{tags}[$tag_idx]{uni}{$sub};
137                         }
138                         print HOLDINGS "l_", $m->name($rec->{tags}[$tag_idx]{tag}, $sub), ", " unless $j;
139                     }
140                     next unless exists($multis->{$othertag});
141                     for my $sub ( sort keys %{$multis->{$othertag}} ) {
142                         next if $m->first_only($rec->{tags}[$tag_idx]{tag}, $sub) and ($k > 1);
143                         for my $value ( @{$rec->{tags}[$tag_idx]{multi}{$sub}} ) {
144                             my $fh = $MULTIFILE{"$othertag$sub"};
145                             my $clean_value = $value;
146                             $clean_value =~ s/[\r\n\t]//g;
147                             print $fh normalize_output(join("\t", $rec->{egid}, $j, $clean_value)), "\n";
148                         }
149                     }
150                 }
151             }
152
153             # and dump it
154             print HOLDINGS "\n" unless $j;
155             print HOLDINGS normalize_output(join("\t", @out));
156             print HOLDINGS "\n";
157             $j++;
158         }
159         $i++;
160         print "\r$i $j";
161     }
162     print "\n";
163 }
164
165 #--------------------------
166
167 sub run_samples {
168     my ($c) = @_;
169     my $s;
170     print "Parsing records for sampling... ";
171     if ($c->{samplemap}) {
172         $s = Equinox::Migration::MARCXMLSampler->new( marcfile => $c->{marcfile},
173                                                       mapfile  => $c->{samplemap});
174     } elsif ($c->{samplestr}) {
175         $s = Equinox::Migration::MARCXMLSampler->new( marcfile  => $c->{marcfile},
176                                                       mapstring => $c->{samplestr});
177     } else {
178         $s = Equinox::Migration::MARCXMLSampler->new( marcfile => $c->{marcfile} );
179     }
180
181     dump_sample_overview($c, $s) if $c->{sample};
182     dump_sample_detail($c, $s) if ($c->{samplemap} or $c->{samplestr});
183 }
184
185 sub dump_sample_detail {
186     my ($c, $s) = @_;
187     my $tags = $s->{data}{samp};
188     my $count = $s->{data}{rcnt};
189     my $scnt  = $s->{data}{scnt};
190
191     open DETAIL, '>', ($c->{prefix} . "-" . $c->{suffix} . "-DETAIL.txt");
192     select DETAIL;
193     for my $tag (sort keys %{ $tags }) {
194         print ">>>>> TAG $tag\n\n";
195         for my $subkey (sort keys %{ $tags->{$tag} }) {
196             my $sub = $tags->{$tag}{$subkey};
197             print "|| $subkey | ", $sub->{value}, " | ", 
198               $sub->{count}, "/", $sub->{tcnt}, " | ", ($sub->{count} > $sub->{tcnt}) ? "MULTI" : "", " ||\n";
199         }
200         print "\n";
201     }
202     close DETAIL;
203     open SCOUNT, '>', ($c->{prefix} . "-" . $c->{suffix} . "-SUBCOUNTS.txt");
204     select SCOUNT;
205     for my $tag (sort keys %{ $scnt }) {
206         print ">>>>> TAG $tag\n\n";
207         for my $len (sort keys %{ $scnt->{$tag} }) 
208           { print "|| $len | ", $scnt->{$tag}{$len}, " ||\n" }
209         print "\n";
210     }
211     select STDOUT;
212     print "Saved results as ", ($c->{prefix} . "-" . $c->{suffix} . "-DETAIL.txt"), " and ",
213         ($c->{prefix} . "-" . $c->{suffix} . "-SUBCOUNTS.txt"), "\n";
214 }
215
216 sub dump_sample_overview {
217     my ($c, $s) = @_;
218     my $tags = $s->{data}{tags};
219     my $count = $s->{data}{rcnt};
220
221     my @tagsbyname  = sort keys %{$tags};
222     my @tagsbycount = reverse sort { $tags->{$a} <=> $tags->{$b} } keys %{$tags};
223
224     open SAMPLE, '>', ($c->{prefix} . "-" . $c->{suffix} . "-OVERVIEW.txt");
225     select SAMPLE;
226     print "SAMPLE REPORT FOR ", $c->{prefix},": $count records\n\n";
227     print "FOUND TAGS (BY TAG)           FOUND TAGS (BY COUNT)\n";
228     print "------------------------      --------------------------\n";
229     for my $i (0 .. @tagsbyname - 1) {
230         print $tagsbyname[$i], (" " x (14 - length $tags->{ $tagsbyname[$i] })),
231           $tags->{ $tagsbyname[$i] };
232         print " (", sprintf("%03d", int($tags->{ $tagsbyname[$i] } / $count * 100)), "%)";
233         print "      ";
234         print $tagsbycount[$i], (" " x (16 - length $tags->{ $tagsbycount[$i] })),
235           $tags->{ $tagsbycount[$i] };
236         print " (", sprintf("%03d", int($tags->{ $tagsbycount[$i] } / $count * 100)), "%)\n";
237     }
238     select STDOUT;
239     print "Saved results as ", ($c->{prefix} . "-" . $c->{suffix} . "-OVERVIEW.txt"), "\n";
240     close SAMPLE;
241 }
242
243 #--------------------------
244
245 sub initialize {
246     my $c = {};
247     my @missing = ();
248
249     # set mode on existing filehandles
250     binmode(STDIN, ':utf8');
251
252     my $rc = GetOptions( $c,
253                          'sample|s',
254                          'samplemap|sm=s',
255                          'samplestr|ss=s',
256                          'marcfile=s',
257                          'map|m=s',
258                          'holdings|h=i',
259                          'copyid|c=s',
260                          'prefix|p=s',
261                          'suffix|o=s',
262                          'disable-pg-normalization',
263                          'version|v',
264                          'help',
265                        );
266     show_help() unless $rc;
267     show_help() if ($c->{help});
268     show_help("Nothing to do!")
269       unless ($c->{map} or $c->{sample} or $c->{samplemap} or $c->{samplestr});
270     show_help("map, holdings, and copyid must be specified together!")
271       if ($c->{map} and !($c->{holdings} and $c->{copyid}));
272     show_version() if $c->{version};
273
274     if (! $c->{suffix}) {
275         $c->{suffix} = 'HOLDINGS';
276     }
277     if ($c->{prefix} and !$c->{marcfile}) {
278         $c->{marcfile} = $c->{prefix} . ".clean.marc.xml";
279     }
280
281     my @keys = keys %{$c};
282     for my $key ('prefix', 'marcfile')
283       { push @missing, $key unless $c->{$key} }
284     if (@missing) {
285         print "Required option: ", join(', ', @missing), " missing!\n";
286         show_help();
287     }
288
289     return $c;
290 }
291
292 sub normalize_output {
293     my $str = shift;
294     $str =~ s!\\!\\\\!g unless $c->{'disable-pg-normalization'};
295     return $str;
296 }
297
298 sub show_help {
299     my ($msg) = @_;
300     print "\nERROR - $msg\n" if $msg;
301     print <<HELP;
302
303 Usage is: extract_holdings --prefix PREFIX --marcfile MARCFILE [ARGUMENTS]
304
305 REQUIRED ARGUMENTS
306   --prefix   -p  Prefix string for output filenames
307   --suffix   -o  Suffix string for output filenames (defaults to HOLDINGS)
308   --marcfile     MARCXML to use as source data
309                  Defaults to 'PREFIX.clean.marc.xml'
310
311 SAMPLING ARGUMENTS
312   --sample    -s   Generate a report of all tags in the MARC data
313   --samplemap -sm  Specify a Equinox::Migration::SimpleTagList map file which
314                    will be used to generate subfield breakdown reports about
315                    specific tags in the MARC data
316   --samplestr -ss  As above, but with a one-liner map specified on the command
317                    line as a string (e.g. '-ss "852 999"')
318
319   If --samplemap and --samplestr are both specified, --samplemap wins.
320
321 HOLDINGS EXTRACTION ARGUMENTS
322   --map      -m  Equinox::Migration::SubfieldMapper map file which will be
323                  used to extract holdings data from the input MARC file
324   --holdings -h  Specifies actual holdings tag
325   --copyid   -c  Specifies subfield of holdings with unique copy identifier
326   --disable-pg-normalization  By default, output is normalized so that a Postgres
327                               copy or \\copy can import the data without choking on
328                               backslashes; use this command-line option if
329                               output is not meant to be consumed by psql.
330
331   All three of these must be given together.
332 HELP
333     exit;
334 }
335
336 sub show_version { print "extract_holdings v$VERSION\n"; exit }