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