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