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