Equinox-Migration/lib/Equinox/Migration/MapDrivenMARCXMLProc.pm

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