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 # FIXME
  10 #
  11 # sample functionality should be extracted into a new module which
  12 # uses E::M::SM to drive sampling of individual datafields, and
  13 # reports ALL datafields which occur
  14 #
  15 # --sample should give the list of all datafields
  16 # --samplefile should take a SM map as teh argument and introspect the mapped datafields
  17
  18
  19 =head1 NAME
  20
  21 Equinox::Migration::MARCXMLSampler
  22
  23 =head1 VERSION
  24
  25 Version 1.000
  26
  27 =cut
  28
  29 our $VERSION = '1.000';
  30
  31
  32 =head1 SYNOPSIS
  33
  34 Foo
  35
  36     use Equinox::Migration::MARCXMLSampler;
  37
  38
  39 =head1 METHODS
  40
  41
  42 =head2 new
  43
  44 =cut
  45
  46 sub new {
  47     my ($class, %args) = @_;
  48
  49     my $self = bless { data => { recs => undef, # X::T record objects
  50                                  rcnt => 0,     # next record counter
  51                                  samp => {},    # data samples
  52                                  tags => {},    # all found tags
  53                                },
  54                      }, $class;
  55
  56     # initialize twig
  57     die "Argument 'marcfile' must be specified\n" unless ($args{marcfile});
  58     if (-r $args{marcfile}) {
  59         $self->{twig} = XML::Twig->new;
  60         $self->{twig}->parsefile($args{marcfile});
  61         my @records = $self->{twig}->root->children;
  62         $self->{data}{recs} = \@records;
  63     } else {
  64         die "Can't open marc file: $!\n";
  65     }
  66
  67     # if we have a sample arg, create the sample map
  68     $self->{map} = Equinox::Migration::SimpleTagList->new(file => $args{mapfile})
  69         if ($args{mapfile});
  70     $self->{map} = Equinox::Migration::SimpleTagList->new(str => $args{mapstring})
  71         if ($args{mapstring});
  72
  73     return $self;
  74 }
  75
  76
  77 =head2 parse_records
  78
  79 Extracts data from MARC records, per the mapping file.
  80
  81 =cut
  82
  83 sub parse_records {
  84     my ($self) = @_;
  85
  86     for my $record ( @{$self->{data}{recs}} ) {
  87         my @fields = $record->children;
  88         for my $f (@fields)
  89           { $self->process_field($f) }
  90
  91         # cleanup memory and increment pointer
  92         $record->purge;
  93         $self->{data}{rcnt}++;
  94     }
  95 }
  96
  97 sub process_field {
  98     my ($self, $field) = @_;
  99     my $map = $self->{map};
 100     my $tag = $field->{'att'}->{'tag'};
 101     return unless ($tag and $tag > 9);
 102
 103     # increment raw tag count
 104     $self->{data}{tags}{$tag}++;
 105
 106     if ($map and $map->has($tag)) {
 107         my @subs = $field->children('subfield');
 108         for my $sub (@subs)
 109           { $self->process_subs($tag, $sub) }
 110     }
 111 }
 112
 113 sub process_subs {
 114     my ($self, $tag, $sub) = @_;
 115     my $map  = $self->{map};
 116     my $code = $sub->{'att'}->{'code'};
 117
 118     # handle unmapped tag/subs
 119     my $samp = $self->{data}{samp};
 120     # set a value, total-seen count and records-seen-in count
 121     $samp->{$tag}{$code}{value} = $sub->text unless defined $samp->{$tag}{$code};
 122     $samp->{$tag}{$code}{count}++;
 123     $samp->{$tag}{$code}{rcnt}++ unless ( defined $samp->{$tag}{$code}{last} and
 124                                           $samp->{$tag}{$code}{last} == $self->{data}{rcnt} );
 125     $samp->{$tag}{$code}{last} = $self->{data}{rcnt};
 126 }
 127
 128
 129 =head1 SAMPLED TAGS
 130
 131 If the C<sample> argument is passed to L</new>, there will also be a
 132 structure which holds data about unmapped subfields encountered in
 133 mapped tags which are also in the declared sample set. This
 134 information is collected over the life of the object and is not reset
 135 for every record processed (as the current record data neccessarily
 136 is).
 137
 138     { tag_id => {
 139                   sub_code  => { value => VALUE,
 140                                  count => COUNT,
 141                                  rcnt => RCOUNT
 142                                },
 143                   ...
 144                 },
 145       ...
 146     }
 147
 148 For each mapped tag, for each unmapped subfield, there is a hash of
 149 data about that subfield containing
 150
 151     * value - A sample of the subfield text
 152     * count - Total number of times the subfield was seen
 153     * rcnt  - The number of records the subfield was seen in
 154
 155 =head1 AUTHOR
 156
 157 Shawn Boyette, C<< <sboyette at esilibrary.com> >>
 158
 159 =head1 BUGS
 160
 161 Please report any bugs or feature requests to the above email address.
 162
 163 =head1 SUPPORT
 164
 165 You can find documentation for this module with the perldoc command.
 166
 167     perldoc Equinox::Migration::MARCXMLSampler
 168
 169
 170 =head1 COPYRIGHT & LICENSE
 171
 172 Copyright 2009 Equinox, all rights reserved.
 173
 174 This program is free software; you can redistribute it and/or modify it
 175 under the same terms as Perl itself.
 176
 177
 178 =cut
 179
 180 1; # End of Equinox::Migration::MARCXMLSampler