Equinox-Migration/lib/Equinox/Migration/MARCXMLSampler.pm

   1 package Equinox::Migration::MARCXMLSampler;
   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 warnings;
  20 use strict;
  21
  22 use XML::Twig;
  23 use Equinox::Migration::SimpleTagList 1.001;
  24
  25
  26 =head1 NAME
  27
  28 Equinox::Migration::MARCXMLSampler
  29
  30 =head1 VERSION
  31
  32 Version 1.003
  33
  34 =cut
  35
  36 our $VERSION = '1.003';
  37
  38 my $taglist;
  39 my $dstore;
  40
  41
  42 =head1 SYNOPSIS
  43
  44 Produce a list of all fields in a MARCXML file which have a C<tag>
  45 attribute, and count how many times each occurs
  46
  47     my $s =  E::M::MARCXMLSampler->new( marcfile => "foo.marc.xml" );
  48     $s->parse_records;
  49
  50 Also deeply introspect certain tags, producing lists of all subfields,
  51 and counts of how many times each subfield occurs I<in toto> and how
  52 many records each subfield appears in
  53
  54     my $s = E::M::MARCXMLSampler->new( marcfile => "foo.marc.xml",
  55                                        mapfile  => "foo.map" );
  56              ~ or ~
  57
  58     my $s = E::M::MARCXMLSampler->new( marcfile  => "foo.marc.xml",
  59                                        mapstring => "852 999" );
  60     $s->parse_records;
  61
  62
  63 =head1 METHODS
  64
  65
  66 =head2 new
  67
  68 Takes one required argument, C<marcfile>, which points to the MARCXML
  69 file to be processed.
  70
  71 Has two mutually-exclusive optional arguments, C<mapfile> and
  72 C<mapstring>". The former should point to a file which will be used as
  73 a L<Equinox::Migration::SimpleTagList> map; the latter should have as
  74 its value a text string which will be used in the same way (handy for
  75 when you only want deep introspection on a handful of tags).
  76
  77 =cut
  78
  79 sub new {
  80     my ($class, %args) = @_;
  81
  82     $dstore = { rcnt => 0,     # record counter
  83                 tcnt => 0,     # tag counter
  84                 scnt => {},    # subfield/tag counters
  85                 samp => {},    # data samples
  86                 tags => {},    # all found tags
  87               };
  88
  89     my $self = bless { data => $dstore,
  90                      }, $class;
  91
  92     # if we have a sample arg, create the sample map
  93     die "Can't use a mapfile and mapstring\n"
  94       if ($args{mapfile} and $args{mapstring});
  95     $taglist = Equinox::Migration::SimpleTagList->new(file => $args{mapfile})
  96         if ($args{mapfile});
  97     $taglist = Equinox::Migration::SimpleTagList->new(str => $args{mapstring})
  98         if ($args{mapstring});
  99
 100     # initialize twig and process xml
 101     die "Argument 'marcfile' must be specified\n" unless ($args{marcfile});
 102     if (-r $args{marcfile}) {
 103         my $xmltwig = XML::Twig->new( twig_handlers => { record => \&parse_record } );
 104         $xmltwig->parsefile( $args{marcfile} );
 105     } else {
 106         die "Can't open marc file: $!\n";
 107     }
 108
 109     # hand ourselves back for datastore manipulation
 110     return $self;
 111 }
 112
 113
 114 =head2 parse_record
 115
 116 XML::Twig handler for record elements; drives data extraction process.
 117
 118 =cut
 119
 120 sub parse_record {
 121     my ($twig, $record) = @_;
 122
 123     my @fields = $record->children;
 124     for my $f (@fields)
 125       { process_field($f) }
 126
 127     # cleanup memory and increment pointer
 128     $record->purge;
 129     $dstore->{rcnt}++;
 130 }
 131
 132
 133 sub process_field {
 134     my ($field) = @_;
 135     my $tag = $field->{'att'}->{'tag'};
 136     return unless ($tag and ($tag =~ /[^0-9]/ or $tag > 9));
 137
 138     # increment raw tag count
 139     $dstore->{tcnt}++;
 140     $dstore->{tags}{$tag}++;
 141
 142
 143     if ($taglist and $taglist->has($tag)) {
 144         my @subs = $field->children('subfield');
 145         my $i= 0;
 146         for my $sub (@subs)
 147           { process_subs($tag, $sub); $i++ }
 148
 149         # increment sub length counter
 150         $dstore->{scnt}{$tag}{$i}++;
 151     }
 152 }
 153
 154 sub process_subs {
 155     my ($tag, $sub) = @_;
 156     my $code = $sub->{'att'}->{'code'};
 157
 158     # handle unmapped tag/subs
 159     my $samp = $dstore->{samp};
 160     # set a value, total-seen count and records-seen-in count
 161     $samp->{$tag}{$code}{value} = $sub->text unless ($samp->{$tag}{$code}{value} and
 162                                                      $samp->{$tag}{$code}{value} =~ /\w/);
 163     $samp->{$tag}{$code}{count}++;
 164     $samp->{$tag}{$code}{tcnt}++ unless ( defined $samp->{$tag}{$code}{last} and
 165                                           $samp->{$tag}{$code}{last} == $dstore->{tcnt} );
 166     $samp->{$tag}{$code}{last} = $dstore->{tcnt};
 167 }
 168
 169
 170 =head1 SAMPLED TAGS
 171
 172 If the C<mapfile> or C<mapstring> arguments are passed to L</new>, a
 173 structure will be constructed which holds data about tags in the map.
 174
 175     { tag_id => {
 176                   sub_code  => { value => VALUE,
 177                                  count => COUNT,
 178                                  tcnt  => TAGCOUNT
 179                                },
 180                   ...
 181                 },
 182       ...
 183     }
 184
 185 For each subfield in each mapped tag, there is a hash of data about
 186 that subfield containing
 187
 188     * value - A sample of the subfield text
 189     * count - Total number of times the subfield was seen
 190     * tcnt  - The number of tags the subfield was seen in
 191
 192 =head1 AUTHOR
 193
 194 Shawn Boyette, C<< <sboyette at esilibrary.com> >>
 195
 196 =head1 BUGS
 197
 198 Please report any bugs or feature requests to the above email address.
 199
 200 =head1 SUPPORT
 201
 202 You can find documentation for this module with the perldoc command.
 203
 204     perldoc Equinox::Migration::MARCXMLSampler
 205
 206
 207 =head1 COPYRIGHT & LICENSE
 208
 209 Copyright 2009 Equinox, all rights reserved.
 210
 211 This program is free software; you can redistribute it and/or modify it
 212 under the same terms as Perl itself.
 213
 214
 215 =cut
 216
 217 1; # End of Equinox::Migration::MARCXMLSampler