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