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