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