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