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