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