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