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.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                                },
  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             my $name = $tag . $code;
 173             push @{$dataf->{multi}{$name}}, $sub->text;
 174             return;
 175         }
 176     }
 177
 178     # if this were a multi field, it would be handled already. make sure its a singleton
 179     die "Multiple occurances of a non-multi field: $tag$code at rec ",
 180       ($self->{data}{rptr} + 1),"\n" if (defined $dataf->{uni}{$code});
 181
 182     # everything seems okay
 183     $dataf->{uni}{$code} = $sub->text;
 184 }
 185
 186
 187 sub check_required {
 188     my ($self) = @_;
 189     my $mods = $self->{map}->mods;
 190     my $crec = $self->{data}{crec};
 191
 192     for my $tag_id (keys %{$mods->{required}}) {
 193         for my $code (@{$mods->{required}{$tag_id}}) {
 194             my $found = 0;
 195
 196             for my $tag (@{$crec->{tags}}) {
 197                 $found = 1 if ($tag->{multi}{($tag_id . $code)});
 198                 $found = 1 if ($tag->{uni}{$code});
 199             }
 200
 201             die "Required mapping $tag_id$code not found in rec ",$self->{data}{rptr},"\n"
 202               unless ($found);
 203         }
 204     }
 205
 206 }
 207
 208 =head2 recno
 209
 210 Returns current record number (starting from zero)
 211
 212 =cut
 213
 214 sub recno { my ($self) = @_; return $self->{data}{rptr} }
 215
 216 =head2 name
 217
 218 Returns mapped fieldname when pass a tag and code
 219
 220     my $name = $m->name(999,'a');
 221
 222 =cut
 223
 224 sub name { my ($self, $t, $c) = @_; return $self->{data}{crec}{names}{$t}{$c} };
 225
 226 =head1 MODIFIERS
 227
 228 MapDrivenMARCXMLProc implements the following modifiers, and passes
 229 them to L<Equinox::Migration::SubfieldMapper>, meaning that specifying
 230 any other modifiers in a MDMP map file will cause a fatal error when
 231 it is processed.
 232
 233 =head2 multi
 234
 235 If a mapping is declared to be C<multi>, then MDMP expects to see more
 236 than one instance of that subfield per datafield, and the data is
 237 handled accordingly (see L</PARSED RECORDS> below).
 238
 239 Occurring zero or one time is legal for a C<multi> mapping.
 240
 241 A mapping which is not flagged as C<multi>, but which occurs more than
 242 once per datafield will cause a fatal error.
 243
 244 =head2 required
 245
 246 By default, if a mapping does not occur in a datafield, processing
 247 continues normally. if a mapping has the C<required> modifier,
 248 however, it must appear, or a fatal error will occur.
 249
 250 =head1 PARSED RECORDS
 251
 252 Given:
 253
 254     my $m = Equinox::Migration::MapDrivenMARCXMLProc->new(ARGUMENTS);
 255     $rec = $m->parse_record;
 256
 257 Then C<$rec> will look like:
 258
 259     {
 260       egid => evergreen_record_id,
 261       tags => [
 262                 {
 263                   tag   => tag_id,
 264                   multi => { (tag_id . sub_code) => [ val1, val2, ... ] },
 265                   uni   => { code => value, code2 => value2, ... },
 266                 },
 267                 ...
 268               ],
 269       tmap => { tag_id => [ INDEX_LIST ], tag_id2 => [ INDEX_LIST ], ... }
 270     }
 271
 272 That is, there is an C<egid> key which points to the Evergreen ID of
 273 that record, a C<tags> key which points to an arrayref, and a C<tmap>
 274 key which points to a hashref.
 275
 276 =head3 C<tags>
 277
 278 A reference to a list of anonymous hashes, one for each instance of
 279 each tag which occurs in the map.
 280
 281 Each tag hash holds its own id (e.g. C<998>), and two references to
 282 two more hashrefs, C<multi> and C<uni>.
 283
 284 The C<multi> hash holds the extracted data for tag/sub mappings which
 285 have the C<multiple> modifier on them. The keys in C<multi> are
 286 composed of the tag id and subfield code, catenated
 287 (e.g. C<901c>). The values are arrayrefs containing the content of all
 288 instances of that subfield in that instance of that tag. If no tags
 289 are defined as C<multi>, it will be C<undef>.
 290
 291 The C<uni> hash holds data for tag/sub mappings which occur only once
 292 per instance of a tag (but may occur multiple times in a record due to
 293 there being multiple instances of that tag in a record). Keys are
 294 subfield codes and values are subfield content.
 295
 296 All C<uni> subfields occuring in the map are guaranteed to be
 297 defined. Sufields which are mapped but do not occur in a particular
 298 datafield will be given a value of '' (the null string) in the current
 299 record struct. Oppose subfields which are not mapped, which will be
 300 C<undef>.
 301
 302 =head3 tmap
 303
 304 A hashref, where each key (a tag id like "650") points to a listref
 305 containing the index (or indices) of C<tags> where that tag has
 306 extracted data.
 307
 308 The intended use of this is to simplify the processing of data from
 309 tags which can appear more than once in a MARC record, like
 310 holdings. If your holdings data is in 852, C<tmap->{852}> will be a
 311 listref with the indices of C<tags> which hold the data from the 852
 312 datafields.
 313
 314 Complimentarily, C<tmap> prevents data from singular datafields from
 315 having to be copied for every instance of a multiple datafield, as it
 316 lets you get the data from that record's one instance of whichever
 317 field you're looking for.
 318
 319 =head1 AUTHOR
 320
 321 Shawn Boyette, C<< <sboyette at esilibrary.com> >>
 322
 323 =head1 BUGS
 324
 325 Please report any bugs or feature requests to the above email address.
 326
 327 =head1 SUPPORT
 328
 329 You can find documentation for this module with the perldoc command.
 330
 331     perldoc Equinox::Migration::MapDrivenMARCXMLProc
 332
 333
 334 =head1 COPYRIGHT & LICENSE
 335
 336 Copyright 2009 Equinox, all rights reserved.
 337
 338 This program is free software; you can redistribute it and/or modify it
 339 under the same terms as Perl itself.
 340
 341
 342 =cut
 343
 344 1; # End of Equinox::Migration::MapDrivenMARCXMLProc