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