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