extract_holdings

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 use Getopt::Long;
   6 use Equinox::Migration::MapDrivenMARCXMLProc;
   7 use Equinox::Migration::MARCXMLSampler;
   8
   9
  10 my $c = initialize();
  11 $| = 1;
  12
  13 # run samples if we've been asked for them
  14 run_samples($c) if ($c->{sample} or $c->{samplemap} or $c->{samplestr});
  15 extract_holdings($c) if ($c->{map});
  16
  17 #--------------------------
  18
  19 sub extract_holdings {
  20     my ($c) = @_;
  21     print "Parsing records for extraction... ";
  22     my $m = Equinox::Migration::MapDrivenMARCXMLProc->new( marcfile => $c->{marcfile},
  23                                                            mapfile  => $c->{map} );
  24     # open main holdings file
  25     open HOLDINGS, '>', ($c->{prefix} . "-HOLDINGS.pg");
  26     # open the files for multi mappings
  27     # FIXME DO THIS
  28     select HOLDINGS;
  29
  30     while (my $rec = $m->parse_record) {
  31         # for each holdings tag in the record...
  32         for my $holdidx ( @{$rec->{tmap}{ $c->{holdings} }} ) {
  33             print STDOUT "\r", $m->recno;
  34             my @out = ();            # clear the output buffer
  35             push @out, $rec->{egid}; # slug in the egid first thing
  36             print "BEGIN;\n\negid\t" if ($m->recno == 1);
  37
  38             # grab the unary mappings and slug 'em in
  39             for my $sub ( sort keys %{$rec->{tags}[$holdidx]{uni}} ) {
  40                 push @out, $rec->{tags}[$holdidx]{uni}{$sub};
  41                 print "l_", $m->name($rec->{tags}[$holdidx]{tag}, $sub),"\t"
  42                   if ($m->recno == 1);
  43             }
  44
  45             # now get everything else in the mapping
  46             for my $othertag ( sort keys %{$rec->{tmap}} ) {
  47                 next if $othertag eq $c->{holdings};  # ignoring the holdings, o'course
  48                 my $idx = $rec->{tmap}{$othertag}[0]; # get index into tags struct
  49                 for my $sub ( sort keys %{$rec->{tags}[$idx]{uni}} ) {
  50                     push @out, $rec->{tags}[$idx]{uni}{$sub};
  51                     print "l_", $m->name($rec->{tags}[$idx]{tag}, $sub), "\t"
  52                       if ($m->recno == 1);
  53                 }
  54             }
  55
  56             # and dump it
  57             print "\n" if ($m->recno == 1);
  58             print join("\t", @out);
  59             print "\n";
  60         }
  61
  62     }
  63     select STDOUT;
  64     print "\n";
  65 }
  66
  67 #--------------------------
  68
  69 sub run_samples {
  70     my ($c) = @_;
  71     my $s;
  72     if ($c->{samplemap}) {
  73         $s = Equinox::Migration::MARCXMLSampler->new( marcfile => $c->{marcfile},
  74                                                       mapfile  => $c->{samplemap});
  75     } elsif ($c->{samplestr}) {
  76         $s = Equinox::Migration::MARCXMLSampler->new( marcfile  => $c->{marcfile},
  77                                                       mapstring => $c->{samplestr});
  78     } else {
  79         $s = Equinox::Migration::MARCXMLSampler->new( marcfile => $c->{marcfile} );
  80     }
  81     print "Parsing records for sampling... ";
  82     $s->parse_records;
  83
  84     dump_sample_overview($c, $s) if $c->{sample};
  85     dump_sample_detail($c, $s) if ($c->{samplemap} or $c->{samplestr});
  86 }
  87
  88 sub dump_sample_detail {
  89     my ($c, $s) = @_;
  90     my $tags = $s->{data}{samp};
  91     my $count = $s->{data}{rcnt};
  92
  93     open DETAIL, '>', ($c->{prefix} . "-HOLDINGS-DETAIL.txt");
  94     select DETAIL;
  95     for my $tag (sort keys %{$tags}) {
  96         print ">>>>> TAG $tag\n";
  97         for my $subkey (sort keys %{$tags->{$tag}}) {
  98             my $sub = $tags->{$tag}{$subkey};
  99             print "  Subfield: $subkey\n";
 100             print "  Sample:   '", $sub->{value}, "'\n";
 101             print "  Count:    ", $sub->{count}, " in ", $sub->{tcnt}, " tags\n\n";
 102             #print "(", int($sub->{count} / $sub->{rcnt}), "%)\n";
 103         }
 104     }
 105     select STDOUT;
 106     print "\n";
 107     close DETAIL;
 108 }
 109
 110 sub dump_sample_overview {
 111     my ($c, $s) = @_;
 112     my $tags = $s->{data}{tags};
 113     my $count = $s->{data}{rcnt};
 114
 115     my @tagsbyname  = sort keys %{$tags};
 116     my @tagsbycount = reverse sort { $tags->{$a} <=> $tags->{$b} } keys %{$tags};
 117
 118     open SAMPLE, '>', ($c->{prefix} . "-HOLDINGS-OVERVIEW.txt");
 119     select SAMPLE;
 120     print "SAMPLE REPORT FOR ", $c->{prefix},": $count records\n\n";
 121     print "FOUND TAGS (BY TAG)           FOUND TAGS (BY COUNT)\n";
 122     print "------------------------      --------------------------\n";
 123     for my $i (0 .. @tagsbyname - 1) {
 124         print $tagsbyname[$i], (" " x (14 - length $tags->{ $tagsbyname[$i] })),
 125           $tags->{ $tagsbyname[$i] };
 126         print " (", sprintf("%03d", int($tags->{ $tagsbyname[$i] } / $count * 100)), "%)";
 127         print "      ";
 128         print $tagsbycount[$i], (" " x (16 - length $tags->{ $tagsbycount[$i] })),
 129           $tags->{ $tagsbycount[$i] };
 130         print " (", sprintf("%03d", int($tags->{ $tagsbycount[$i] } / $count * 100)), "%)\n";
 131     }
 132     select STDOUT;
 133     print "\n";
 134     close SAMPLE;
 135 }
 136
 137 #--------------------------
 138
 139 sub initialize {
 140     my $c = {};
 141     my @missing = ();
 142
 143     # set mode on existing filehandles
 144     binmode(STDIN, ':utf8');
 145
 146     my $rc = GetOptions( $c,
 147                          'sample|s',
 148                          'samplemap|sm=s',
 149                          'samplestr|ss=s',
 150                          'marcfile|m=s',
 151                          'map=s',
 152                          'holdings|h=i',
 153                          'prefix|p=s',
 154                          'help',
 155                        );
 156     show_help() unless $rc;
 157     show_help() if ($c->{help});
 158     show_help("map and holdings must be specified together!")
 159       if ($c->{map} and !$c->{holdings});
 160
 161     my @keys = keys %{$c};
 162     for my $key ('prefix')
 163       { push @missing, $key unless $c->{$key} }
 164     if (@missing) {
 165         print "Required option: ", join(', ', @missing), " missing!\n";
 166         show_help();
 167     }
 168
 169     return $c;
 170 }
 171
 172 sub show_help {
 173     my ($msg) = @_;
 174     print "\nERROR - $msg\n" if $msg;
 175     print <<HELP;
 176
 177 Usage is: extract_holdings -p PREFIX -m MARCFILE [ARGUMENTS]
 178
 179 REQUIRED ARGUMENTS
 180   --prefix   -p  Prefix string for output filenames
 181   --marcfile -m  MARCXML to use as source data
 182
 183 SAMPLING ARGUMENTS
 184   --sample    -s   Generate a report of all tags in the MARC data
 185   --samplemap -sm  Specify a E::M::STL map file which will be used to generate
 186                    subfield breakdown reports about specific tags in the MARC
 187                    data
 188   --samplestr -ss  As above, but with a one-liner map specified on the command
 189                    line as a string (e.g. '-ss "852 999"')
 190
 191   If --samplemap and --samplestr are both specified, --samplemap wins.
 192
 193 HOLDINGS EXTRACTION ARGUMENTS
 194   --map          E::M::SM map file which will be used to extract holdings data
 195                  from the input MARC file
 196   --holdings -h  Specifies actual holdings tag
 197
 198   Both these must be given together.
 199 HELP
 200     exit;
 201 }