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