Equinox-Migration/lib/Equinox/Migration/MapDrivenMARCXMLProc.pm

   1 package Equinox::Migration::MapDrivenMARCXMLProc;
   2
   3 use warnings;
   4 use strict;
   5
   6 use XML::Twig;
   7 use Equinox::Migration::SubfieldMapper 1.003;
   8
   9
  10 =head1 NAME
  11
  12 Equinox::Migration::MapDrivenMARCXMLProc
  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::MapDrivenMARCXMLProc;
  28
  29
  30 =head1 METHODS
  31
  32
  33 =head2 new
  34
  35 Takes two required arguments: C<mapfile> (which will be passed along
  36 to L<Equinox::Migration::SubfieldMapper> as the basis for its map),
  37 and C<marcfile> (the MARC data to be processed).
  38
  39     my $m = Equinox::Migration::MapDrivenMARCXMLProc->new( mapfile  => FILE,
  40                                                            marcfile => FILE );
  41
  42 =cut
  43
  44 sub new {
  45     my ($class, %args) = @_;
  46
  47     my $self = bless { mods => { multi    => {},
  48                                  bib      => {},
  49                                  required => {},
  50                                },
  51                        data => { recs => undef, # X::T record objects
  52                                  rptr => 0,     # next record pointer
  53                                  crec => undef, # parsed record storage
  54                                  tmap => undef, # tag_id-to-tag array map
  55                                },
  56                      }, $class;
  57
  58     # initialize map and taglist
  59     die "Argument 'mapfile' must be specified\n" unless (defined $args{mapfile});
  60     my @mods = keys %{$self->{mods}};
  61     $self->{map} = Equinox::Migration::SubfieldMapper->new( file => $args{mapfile},
  62                                                             mods => \@mods );
  63     $self->{data}{tags} = $self->{map}->tags;
  64
  65     # initialize twig
  66     die "Argument 'marcfile' must be specified\n" unless (defined $args{marcfile});
  67     if (-r $args{marcfile}) {
  68         $self->{twig} = XML::Twig->new;
  69         $self->{twig}->parsefile($args{marcfile});
  70         my @records = $self->{twig}->root->children;
  71         $self->{data}{recs} = \@records;
  72     } else {
  73         die "Can't open marc file: $!\n";
  74     }
  75
  76     return $self;
  77 }
  78
  79
  80 =head2 parse_record
  81
  82 Extracts data from the next record, per the mapping file. Returns a
  83 normalized datastructure (see L</format_record> for details) on
  84 success; returns 0 otherwise.
  85
  86     while (my $rec = $m->parse_record) {
  87       # handle extracted record data
  88     }
  89
  90 =cut
  91
  92 sub parse_record {
  93     my ($self) = @_;
  94
  95     # get the next record and wipe current parsed record
  96     return 0 unless defined $self->{data}{recs}[ $self->{data}{rptr} ];
  97     my $record = $self->{data}{recs}[ $self->{data}{rptr} ];
  98     $self->{data}{crec} = { egid => undef, tags => undef };
  99     $self->{data}{tmap} = {};
 100
 101     my @fields = $record->children;
 102     for my $f (@fields)
 103       { $self->process_field($f) }
 104
 105     # cleanup memory and increment pointer
 106     $record->purge;
 107     $self->{data}{rptr}++;
 108
 109     # check for required fields
 110     $self->check_required;
 111
 112     return $self->{data}{crec};
 113 }
 114
 115 sub process_field {
 116     my ($self, $field) = @_;
 117     my $map = $self->{map};
 118     my $tag = $field->{'att'}->{'tag'};
 119     my $crec = $self->{data}{crec};
 120     my $tmap = $self->{data}{tmap};
 121
 122     # leader
 123     unless (defined $tag) {
 124         #FIXME
 125         return;
 126     }
 127
 128     # datafields
 129     if ($tag == 903) {
 130         my $sub = $field->first_child('subfield');
 131         $crec->{egid} = $sub->text;
 132         return;
 133     }
 134     if ($map->has($tag)) {
 135         push @{$crec->{tags}}, { tag => $tag, uni => undef, multi => undef };
 136         push @{$tmap->{$tag}}, (@{$crec->{tags}} - 1);
 137         my @subs = $field->children('subfield');
 138         for my $sub (@subs)
 139           { $self->process_subs($tag, $sub) }
 140         # check map to ensure all declared subs have a value
 141         my $mods = $map->mods($field);
 142         for my $mappedsub ( @{ $map->subfields($tag) } ) {
 143             next if $mods->{multi};
 144             $crec->{tags}[-1]{uni}{$mappedsub} = ''
 145               unless defined $crec->{tags}[-1]{uni}{$mappedsub};
 146         }
 147     }
 148 }
 149
 150 sub process_subs {
 151     my ($self, $tag, $sub) = @_;
 152     my $map  = $self->{map};
 153     my $code = $sub->{'att'}->{'code'};
 154
 155     # handle unmapped tag/subs
 156     return unless ($map->has($tag, $code));
 157
 158     # fetch our datafield struct and fieldname
 159     my $dataf = $self->{data}{crec}{tags}[-1];
 160     my $field = $map->field($tag, $code);
 161
 162     # test filters
 163     for my $filter ( @{$map->filters($field)} ) {
 164         return if ($sub->text =~ /$filter/i);
 165     }
 166     # handle multi modifier
 167     if (my $mods = $map->mods($field)) {
 168         if ($mods->{multi}) {
 169             my $name = $tag . $code;
 170             push @{$dataf->{multi}{$name}}, $sub->text;
 171             return;
 172         }
 173     }
 174
 175     # if this were a multi field, it would be handled already. make sure its a singleton
 176     die "Multiple occurances of a non-multi field: $tag$code at rec ",
 177       ($self->{data}{rptr} + 1),"\n" if (defined $dataf->{uni}{$code});
 178
 179     # everything seems okay
 180     $dataf->{uni}{$code} = $sub->text;
 181 }
 182
 183
 184 sub check_required {
 185     my ($self) = @_;
 186     my $mods = $self->{map}->mods;
 187     my $crec = $self->{data}{crec};
 188
 189     for my $tag_id (keys %{$mods->{required}}) {
 190         for my $code (@{$mods->{required}{$tag_id}}) {
 191             my $found = 0;
 192
 193             for my $tag (@{$crec->{tags}}) {
 194                 $found = 1 if ($tag->{multi}{($tag_id . $code)});
 195                 $found = 1 if ($tag->{uni}{$code});
 196             }
 197
 198             die "Required mapping $tag_id$code not found in rec ",$self->{data}{rptr},"\n"
 199               unless ($found);
 200         }
 201     }
 202
 203 }
 204
 205 =head1 MODIFIERS
 206
 207 MapDrivenMARCXMLProc implements the following modifiers, and passes
 208 them to L<Equinox::Migration::SubfieldMapper>, meaning that specifying
 209 any other modifiers in a MDMP map file will cause a fatal error when
 210 it is processed.
 211
 212 =head2 multi
 213
 214 If a mapping is declared to be C<multi>, then MDMP expects to see more
 215 than one instance of that subfield per datafield, and the data is
 216 handled accordingly (see L</PARSED RECORDS> below).
 217
 218 Occurring zero or one time is legal for a C<multi> mapping.
 219
 220 A mapping which is not flagged as C<multi>, but which occurs more than
 221 once per datafield will cause a fatal error.
 222
 223 =head2 required
 224
 225 By default, if a mapping does not occur in a datafield, processing
 226 continues normally. if a mapping has the C<required> modifier,
 227 however, it must appear, or a fatal error will occur.
 228
 229 =head1 PARSED RECORDS
 230
 231 Given:
 232
 233     my $m = Equinox::Migration::MapDrivenMARCXMLProc->new(ARGUMENTS);
 234     $rec = $m->parse_record;
 235
 236 Then C<$rec> will look like:
 237
 238     {
 239       egid => evergreen_record_id,
 240       tags => [
 241                 {
 242                   tag   => tag_id,
 243                   multi => { (tag_id . sub_code) => [ val1, val2, ... ] },
 244                   uni   => { code => value, code2 => value2, ... },
 245                 },
 246                 ...
 247               ]
 248     }
 249
 250 That is, there is an C<egid> key which points to the Evergreen ID of
 251 that record, and a C<tags> key which points to an arrayref.
 252
 253 =head3 C<tags>
 254
 255 A reference to a list of anonymous hashes, one for each instance of
 256 each tag which occurs in the map.
 257
 258 Each tag hash holds its own id (e.g. C<998>), and two references to
 259 two more hashrefs, C<multi> and C<uni>.
 260
 261 The C<multi> hash holds the extracted data for tag/sub mappings which
 262 have the C<multiple> modifier on them. The keys in C<multi> are
 263 composed of the tag id and subfield code, catenated
 264 (e.g. C<901c>). The values are arrayrefs containing the content of all
 265 instances of that subfield in that instance of that tag. If no tags
 266 are defined as C<multi>, it will be C<undef>.
 267
 268 The C<uni> hash holds data for tag/sub mappings which occur only once
 269 per instance of a tag (but may occur multiple times in a record due to
 270 there being multiple instances of that tag in a record). Keys are
 271 subfield codes and values are subfield content.
 272
 273 All C<uni> subfields occuring in the map are guaranteed to be
 274 defined. Sufields which are mapped but do not occur in a particular
 275 datafield will be given a value of '' (the null string) in the current
 276 record struct. Oppose subfields which are not mapped, which will be
 277 C<undef>.
 278
 279
 280 =head1 AUTHOR
 281
 282 Shawn Boyette, C<< <sboyette at esilibrary.com> >>
 283
 284 =head1 BUGS
 285
 286 Please report any bugs or feature requests to the above email address.
 287
 288 =head1 SUPPORT
 289
 290 You can find documentation for this module with the perldoc command.
 291
 292     perldoc Equinox::Migration::MapDrivenMARCXMLProc
 293
 294
 295 =head1 COPYRIGHT & LICENSE
 296
 297 Copyright 2009 Equinox, all rights reserved.
 298
 299 This program is free software; you can redistribute it and/or modify it
 300 under the same terms as Perl itself.
 301
 302
 303 =cut
 304
 305 1; # End of Equinox::Migration::MapDrivenMARCXMLProc