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,     # record counter
  65                                  tcnt => 0,     # tag counter
  66                                  samp => {},    # data samples
  67                                  tags => {},    # all found tags
  68                                },
  69                      }, $class;
  70
  71     # initialize twig
  72     die "Argument 'marcfile' must be specified\n" unless ($args{marcfile});
  73     if (-r $args{marcfile}) {
  74         $self->{twig} = XML::Twig->new;
  75         $self->{twig}->parsefile($args{marcfile});
  76         my @records = $self->{twig}->root->children;
  77         $self->{data}{recs} = \@records;
  78     } else {
  79         die "Can't open marc file: $!\n";
  80     }
  81
  82     # if we have a sample arg, create the sample map
  83     die "Can't use a mapfile and mapstring\n"
  84       if ($args{mapfile} and $args{mapstring});
  85     $self->{map} = Equinox::Migration::SimpleTagList->new(file => $args{mapfile})
  86         if ($args{mapfile});
  87     $self->{map} = Equinox::Migration::SimpleTagList->new(str => $args{mapstring})
  88         if ($args{mapstring});
  89
  90     return $self;
  91 }
  92
  93
  94 =head2 parse_records
  95
  96 Extracts data from MARC records, per the mapping file.
  97
  98 =cut
  99
 100 sub parse_records {
 101     my ($self) = @_;
 102
 103     for my $record ( @{$self->{data}{recs}} ) {
 104         my @fields = $record->children;
 105         for my $f (@fields)
 106           { $self->process_field($f) }
 107
 108         # cleanup memory and increment pointer
 109         $record->purge;
 110         $self->{data}{rcnt}++;
 111     }
 112 }
 113
 114 sub process_field {
 115     my ($self, $field) = @_;
 116     my $map = $self->{map};
 117     my $tag = $field->{'att'}->{'tag'};
 118     return unless ($tag and $tag > 9);
 119
 120     # increment raw tag count
 121     $self->{data}{tcnt}++;
 122     $self->{data}{tags}{$tag}++;
 123
 124     if ($map and $map->has($tag)) {
 125         my @subs = $field->children('subfield');
 126         for my $sub (@subs)
 127           { $self->process_subs($tag, $sub) }
 128     }
 129 }
 130
 131 sub process_subs {
 132     my ($self, $tag, $sub) = @_;
 133     my $map  = $self->{map};
 134     my $code = $sub->{'att'}->{'code'};
 135
 136     # handle unmapped tag/subs
 137     my $samp = $self->{data}{samp};
 138     # set a value, total-seen count and records-seen-in count
 139     $samp->{$tag}{$code}{value} = $sub->text unless defined $samp->{$tag}{$code};
 140     $samp->{$tag}{$code}{count}++;
 141     $samp->{$tag}{$code}{tcnt}++ unless ( defined $samp->{$tag}{$code}{last} and
 142                                           $samp->{$tag}{$code}{last} == $self->{data}{tcnt} );
 143     $samp->{$tag}{$code}{last} = $self->{data}{tcnt};
 144     #FIXME tcnt not rcnt
 145 }
 146
 147
 148 =head1 SAMPLED TAGS
 149
 150 If the C<mapfile> or C<mapstring> arguments are passed to L</new>, a
 151 structure will be constructed which holds data about tags in the map.
 152
 153     { tag_id => {
 154                   sub_code  => { value => VALUE,
 155                                  count => COUNT,
 156                                  tcnt  => TAGCOUNT
 157                                },
 158                   ...
 159                 },
 160       ...
 161     }
 162
 163 For each subfield in each mapped tag, there is a hash of data about
 164 that subfield containing
 165
 166     * value - A sample of the subfield text
 167     * count - Total number of times the subfield was seen
 168     * tcnt  - The number of tags the subfield was seen in
 169
 170 =head1 AUTHOR
 171
 172 Shawn Boyette, C<< <sboyette at esilibrary.com> >>
 173
 174 =head1 BUGS
 175
 176 Please report any bugs or feature requests to the above email address.
 177
 178 =head1 SUPPORT
 179
 180 You can find documentation for this module with the perldoc command.
 181
 182     perldoc Equinox::Migration::MARCXMLSampler
 183
 184
 185 =head1 COPYRIGHT & LICENSE
 186
 187 Copyright 2009 Equinox, all rights reserved.
 188
 189 This program is free software; you can redistribute it and/or modify it
 190 under the same terms as Perl itself.
 191
 192
 193 =cut
 194
 195 1; # End of Equinox::Migration::MARCXMLSampler