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