extract_holdings

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 use Getopt::Long;
   6 use Equinox::Migration::MapDrivenMARCXMLProc 1.005;
   7 use Equinox::Migration::MARCXMLSampler;
   8
   9 my $VERSION = '1.001';
  10
  11 =pod
  12
  13 TODO
  14
  15   * Have detail mode report on number of subfields per datafield
  16
  17 =cut
  18
  19 my $c = initialize();
  20 $| = 1;
  21
  22 # run samples if we've been asked for them
  23 run_samples($c) if ($c->{sample} or $c->{samplemap} or $c->{samplestr});
  24 extract_holdings($c) if ($c->{map});
  25 print "\n";
  26
  27 #--------------------------
  28
  29 sub extract_holdings {
  30     my ($c) = @_;
  31     print "Parsing records for extraction:\n";
  32     my $m = Equinox::Migration::MapDrivenMARCXMLProc->new( marcfile => $c->{marcfile},
  33                                                            mapfile  => $c->{map},
  34                                                            verbose  => 1,
  35                                                          );
  36
  37     print "Writing holdings to output file(s)...\n";
  38     # open main holdings file
  39     open HOLDINGS, '>', ($c->{prefix} . "-HOLDINGS.pg");
  40     # create multi files
  41     my $multis = $m->get_multis;
  42     my %MULTIFILE = ();
  43     for my $t ( keys %{$multis} ) {
  44         for my $s ( keys %{$multis->{$t}})
  45           { open my $fh, ">", ($c->{prefix} . "-HOLDINGS-MULT-$t$s.pg"); $MULTIFILE{"$t$s"} = $fh }
  46     }
  47
  48     my $i = 0; # record counter
  49     my $j = 0; # holdings counter
  50
  51     while (  $m->{data}{recs}[$i] ) {
  52         print HOLDINGS "BEGIN;\n\negid, hseq, " unless $j;
  53         my $rec = $m->{data}{recs}[$i];
  54         my $k = 0; # holding-within-record pointer
  55
  56         for my $holdidx ( @{ $rec->{tmap}{ $c->{holdings} } } ) {
  57             # for each holdings tag in the record...
  58             my $tagid = $rec->{tags}[$holdidx]{tag};
  59             $k++;
  60
  61             my @out = ();            # clear the output buffer
  62             push @out, $rec->{egid}; # slug in the egid first thing
  63             push @out, $j;           # holding seq goes next
  64
  65             # grab the unary mappings and slug 'em in
  66             for my $sub ( sort keys %{$rec->{tags}[$holdidx]{uni}} ) {
  67                 push @out, $rec->{tags}[$holdidx]{uni}{$sub};
  68                 print HOLDINGS "l_", $m->name($tagid, $sub),", " unless $j;
  69             }
  70
  71             # handle holdings multis
  72             for my $sub ( sort keys %{$multis->{$tagid}} ) {
  73                 for my $value ( @{$rec->{tags}[$holdidx]{multi}{$sub}} ) {
  74                   my $fh = $MULTIFILE{"$tagid$sub"};
  75                   print $fh join("\t", $rec->{egid}, $j, $value), "\n";
  76               }
  77             }
  78
  79
  80             # now get everything else in the mapping
  81             for my $othertag ( sort keys %{$rec->{tmap}} ) {
  82                 next if $othertag eq $c->{holdings};  # ignoring the holdings, o'course
  83                 my $test_idx = $rec->{tmap}{$othertag}[0]; # get index into tags struct
  84                 unless (defined $test_idx) {
  85                     push @out, '';
  86                     next;
  87                 }
  88                 # handle only first other tag unless it is known to be multi
  89                 my $limit = 0;
  90                 if (exists($multis->{$othertag})) {
  91                     $limit = $#{ $rec->{tmap}{$othertag} };
  92                 }
  93                 foreach my $idx (0..$limit) {
  94                     my $tag_idx = $rec->{tmap}{$othertag}[$idx];
  95                     for my $sub ( sort keys %{$rec->{tags}[$tag_idx]{uni}} ) {
  96                         if ($m->first_only($rec->{tags}[$tag_idx]{tag}, $sub)) {
  97                             push @out, ($k == 1) ? $rec->{tags}[$tag_idx]{uni}{$sub} : '';
  98                         } else {
  99                             push @out, $rec->{tags}[$tag_idx]{uni}{$sub};
 100                         }
 101                         print HOLDINGS "l_", $m->name($rec->{tags}[$tag_idx]{tag}, $sub), ", " unless $j;
 102                     }
 103                     next unless exists($multis->{$othertag});
 104                     for my $sub ( sort keys %{$multis->{$othertag}} ) {
 105                         next if $m->first_only($rec->{tags}[$tag_idx]{tag}, $sub) and ($k > 1);
 106                         for my $value ( @{$rec->{tags}[$tag_idx]{multi}{$sub}} ) {
 107                             my $fh = $MULTIFILE{"$othertag$sub"};
 108                             print $fh join("\t", $rec->{egid}, $j, $value), "\n";
 109                         }
 110                     }
 111                 }
 112             }
 113
 114             # and dump it
 115             print HOLDINGS "\n" unless $j;
 116             print HOLDINGS join("\t", @out);
 117             print HOLDINGS "\n";
 118             $j++;
 119         }
 120         $i++;
 121         print "\r$i $j";
 122     }
 123     print "\n";
 124 }
 125
 126 #--------------------------
 127
 128 sub run_samples {
 129     my ($c) = @_;
 130     my $s;
 131     print "Parsing records for sampling... ";
 132     if ($c->{samplemap}) {
 133         $s = Equinox::Migration::MARCXMLSampler->new( marcfile => $c->{marcfile},
 134                                                       mapfile  => $c->{samplemap});
 135     } elsif ($c->{samplestr}) {
 136         $s = Equinox::Migration::MARCXMLSampler->new( marcfile  => $c->{marcfile},
 137                                                       mapstring => $c->{samplestr});
 138     } else {
 139         $s = Equinox::Migration::MARCXMLSampler->new( marcfile => $c->{marcfile} );
 140     }
 141
 142     dump_sample_overview($c, $s) if $c->{sample};
 143     dump_sample_detail($c, $s) if ($c->{samplemap} or $c->{samplestr});
 144 }
 145
 146 sub dump_sample_detail {
 147     my ($c, $s) = @_;
 148     my $tags = $s->{data}{samp};
 149     my $count = $s->{data}{rcnt};
 150     my $scnt  = $s->{data}{scnt};
 151
 152     open DETAIL, '>', ($c->{prefix} . "-HOLDINGS-DETAIL.txt");
 153     select DETAIL;
 154     for my $tag (sort keys %{ $tags }) {
 155         print ">>>>> TAG $tag\n\n";
 156         for my $subkey (sort keys %{ $tags->{$tag} }) {
 157             my $sub = $tags->{$tag}{$subkey};
 158             print "|| $subkey | ", $sub->{value}, " | ",
 159               $sub->{count}, "/", $sub->{tcnt}, " |  ||\n";
 160         }
 161         print "\n";
 162     }
 163     close DETAIL;
 164     open SCOUNT, '>', ($c->{prefix} . "-HOLDINGS-SUBCOUNTS.txt");
 165     select SCOUNT;
 166     for my $tag (sort keys %{ $scnt }) {
 167         print ">>>>> TAG $tag\n\n";
 168         for my $len (sort keys %{ $scnt->{$tag} })
 169           { print "|| $len | ", $scnt->{$tag}{$len}, " ||\n" }
 170         print "\n";
 171     }
 172     select STDOUT;
 173 }
 174
 175 sub dump_sample_overview {
 176     my ($c, $s) = @_;
 177     my $tags = $s->{data}{tags};
 178     my $count = $s->{data}{rcnt};
 179
 180     my @tagsbyname  = sort keys %{$tags};
 181     my @tagsbycount = reverse sort { $tags->{$a} <=> $tags->{$b} } keys %{$tags};
 182
 183     open SAMPLE, '>', ($c->{prefix} . "-HOLDINGS-OVERVIEW.txt");
 184     select SAMPLE;
 185     print "SAMPLE REPORT FOR ", $c->{prefix},": $count records\n\n";
 186     print "FOUND TAGS (BY TAG)           FOUND TAGS (BY COUNT)\n";
 187     print "------------------------      --------------------------\n";
 188     for my $i (0 .. @tagsbyname - 1) {
 189         print $tagsbyname[$i], (" " x (14 - length $tags->{ $tagsbyname[$i] })),
 190           $tags->{ $tagsbyname[$i] };
 191         print " (", sprintf("%03d", int($tags->{ $tagsbyname[$i] } / $count * 100)), "%)";
 192         print "      ";
 193         print $tagsbycount[$i], (" " x (16 - length $tags->{ $tagsbycount[$i] })),
 194           $tags->{ $tagsbycount[$i] };
 195         print " (", sprintf("%03d", int($tags->{ $tagsbycount[$i] } / $count * 100)), "%)\n";
 196     }
 197     select STDOUT;
 198     print "\n";
 199     close SAMPLE;
 200 }
 201
 202 #--------------------------
 203
 204 sub initialize {
 205     my $c = {};
 206     my @missing = ();
 207
 208     # set mode on existing filehandles
 209     binmode(STDIN, ':utf8');
 210
 211     my $rc = GetOptions( $c,
 212                          'sample|s',
 213                          'samplemap|sm=s',
 214                          'samplestr|ss=s',
 215                          'marcfile=s',
 216                          'map|m=s',
 217                          'holdings|h=i',
 218                          'copyid|c=s',
 219                          'prefix|p=s',
 220                          'version|v',
 221                          'help',
 222                        );
 223     show_help() unless $rc;
 224     show_help() if ($c->{help});
 225     show_help("Nothing to do!")
 226       unless ($c->{map} or $c->{sample} or $c->{samplemap} or $c->{samplestr});
 227     show_help("map, holdings, and copyid must be specified together!")
 228       if ($c->{map} and !($c->{holdings} and $c->{copyid}));
 229     show_version() if $c->{version};
 230
 231     if ($c->{prefix} and !$c->{marcfile}) {
 232         $c->{marcfile} = $c->{prefix} . ".clean.marc.xml";
 233     }
 234
 235     my @keys = keys %{$c};
 236     for my $key ('prefix', 'marcfile')
 237       { push @missing, $key unless $c->{$key} }
 238     if (@missing) {
 239         print "Required option: ", join(', ', @missing), " missing!\n";
 240         show_help();
 241     }
 242
 243     return $c;
 244 }
 245
 246 sub show_help {
 247     my ($msg) = @_;
 248     print "\nERROR - $msg\n" if $msg;
 249     print <<HELP;
 250
 251 Usage is: extract_holdings -p PREFIX -m MARCFILE [ARGUMENTS]
 252
 253 REQUIRED ARGUMENTS
 254   --prefix   -p  Prefix string for output filenames
 255   --marcfile     MARCXML to use as source data
 256                  Defaults to 'PREFIX.clean.marc.xml'
 257
 258 SAMPLING ARGUMENTS
 259   --sample    -s   Generate a report of all tags in the MARC data
 260   --samplemap -sm  Specify a Equinox::Migration::SimpleTagList map file which
 261                    will be used to generate subfield breakdown reports about
 262                    specific tags in the MARC data
 263   --samplestr -ss  As above, but with a one-liner map specified on the command
 264                    line as a string (e.g. '-ss "852 999"')
 265
 266   If --samplemap and --samplestr are both specified, --samplemap wins.
 267
 268 HOLDINGS EXTRACTION ARGUMENTS
 269   --map      -m  Equinox::Migration::SubfieldMapper map file which will be
 270                  used to extract holdings data from the input MARC file
 271   --holdings -h  Specifies actual holdings tag
 272   --copyid   -c  Specifies subfield of holdings with unique copy identifier
 273
 274   All three of these must be given together.
 275 HELP
 276     exit;
 277 }
 278
 279 sub show_version { print "extract_holdings v$VERSION\n"; exit }