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

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