#!/usr/bin/perl use strict; use warnings; use Getopt::Long; use Equinox::Migration::MapDrivenMARCXMLProc; use Equinox::Migration::MARCXMLSampler; my $VERSION = '1.000'; my $c = initialize(); $| = 1; # run samples if we've been asked for them run_samples($c) if ($c->{sample} or $c->{samplemap} or $c->{samplestr}); extract_holdings($c) if ($c->{map}); #-------------------------- sub extract_holdings { my ($c) = @_; print "Parsing records for extraction... "; my $m = Equinox::Migration::MapDrivenMARCXMLProc->new( marcfile => $c->{marcfile}, mapfile => $c->{map} ); # open main holdings file open HOLDINGS, '>', ($c->{prefix} . "-HOLDINGS.pg"); # open the files for multi mappings # FIXME DO THIS select HOLDINGS; while (my $rec = $m->parse_record) { # for each holdings tag in the record... for my $holdidx ( @{$rec->{tmap}{ $c->{holdings} }} ) { print STDOUT "\r", $m->recno; my @out = (); # clear the output buffer push @out, $rec->{egid}; # slug in the egid first thing print "BEGIN;\n\negid\t" if ($m->recno == 1); # grab the unary mappings and slug 'em in for my $sub ( sort keys %{$rec->{tags}[$holdidx]{uni}} ) { push @out, $rec->{tags}[$holdidx]{uni}{$sub}; print "l_", $m->name($rec->{tags}[$holdidx]{tag}, $sub),"\t" if ($m->recno == 1); } # now get everything else in the mapping for my $othertag ( sort keys %{$rec->{tmap}} ) { next if $othertag eq $c->{holdings}; # ignoring the holdings, o'course my $idx = $rec->{tmap}{$othertag}[0]; # get index into tags struct for my $sub ( sort keys %{$rec->{tags}[$idx]{uni}} ) { push @out, $rec->{tags}[$idx]{uni}{$sub}; print "l_", $m->name($rec->{tags}[$idx]{tag}, $sub), "\t" if ($m->recno == 1); } } # and dump it print "\n" if ($m->recno == 1); print join("\t", @out); print "\n"; } } select STDOUT; print "\n"; } #-------------------------- sub run_samples { my ($c) = @_; my $s; if ($c->{samplemap}) { $s = Equinox::Migration::MARCXMLSampler->new( marcfile => $c->{marcfile}, mapfile => $c->{samplemap}); } elsif ($c->{samplestr}) { $s = Equinox::Migration::MARCXMLSampler->new( marcfile => $c->{marcfile}, mapstring => $c->{samplestr}); } else { $s = Equinox::Migration::MARCXMLSampler->new( marcfile => $c->{marcfile} ); } print "Parsing records for sampling... "; $s->parse_records; dump_sample_overview($c, $s) if $c->{sample}; dump_sample_detail($c, $s) if ($c->{samplemap} or $c->{samplestr}); } sub dump_sample_detail { my ($c, $s) = @_; my $tags = $s->{data}{samp}; my $count = $s->{data}{rcnt}; open DETAIL, '>', ($c->{prefix} . "-HOLDINGS-DETAIL.txt"); select DETAIL; for my $tag (sort keys %{$tags}) { print ">>>>> TAG $tag\n"; for my $subkey (sort keys %{$tags->{$tag}}) { my $sub = $tags->{$tag}{$subkey}; print " Subfield: $subkey\n"; print " Sample: '", $sub->{value}, "'\n"; print " Count: ", $sub->{count}, " in ", $sub->{tcnt}, " tags\n\n"; #print "(", int($sub->{count} / $sub->{rcnt}), "%)\n"; } } select STDOUT; print "\n"; close DETAIL; } sub dump_sample_overview { my ($c, $s) = @_; my $tags = $s->{data}{tags}; my $count = $s->{data}{rcnt}; my @tagsbyname = sort keys %{$tags}; my @tagsbycount = reverse sort { $tags->{$a} <=> $tags->{$b} } keys %{$tags}; open SAMPLE, '>', ($c->{prefix} . "-HOLDINGS-OVERVIEW.txt"); select SAMPLE; print "SAMPLE REPORT FOR ", $c->{prefix},": $count records\n\n"; print "FOUND TAGS (BY TAG) FOUND TAGS (BY COUNT)\n"; print "------------------------ --------------------------\n"; for my $i (0 .. @tagsbyname - 1) { print $tagsbyname[$i], (" " x (14 - length $tags->{ $tagsbyname[$i] })), $tags->{ $tagsbyname[$i] }; print " (", sprintf("%03d", int($tags->{ $tagsbyname[$i] } / $count * 100)), "%)"; print " "; print $tagsbycount[$i], (" " x (16 - length $tags->{ $tagsbycount[$i] })), $tags->{ $tagsbycount[$i] }; print " (", sprintf("%03d", int($tags->{ $tagsbycount[$i] } / $count * 100)), "%)\n"; } select STDOUT; print "\n"; close SAMPLE; } #-------------------------- sub initialize { my $c = {}; my @missing = (); # set mode on existing filehandles binmode(STDIN, ':utf8'); my $rc = GetOptions( $c, 'sample|s', 'samplemap|sm=s', 'samplestr|ss=s', 'marcfile|m=s', 'map=s', 'holdings|h=i', 'prefix|p=s', 'version|v', 'help', ); show_help() unless $rc; show_help() if ($c->{help}); show_help("map and holdings must be specified together!") if ($c->{map} and !$c->{holdings}); show_version() if $c->{version}; my @keys = keys %{$c}; for my $key ('prefix') { push @missing, $key unless $c->{$key} } if (@missing) { print "Required option: ", join(', ', @missing), " missing!\n"; show_help(); } return $c; } sub show_help { my ($msg) = @_; print "\nERROR - $msg\n" if $msg; print <