X-Git-Url: http://git.equinoxoli.org/?p=migration-tools.git;a=blobdiff_plain;f=Equinox-Migration%2Flib%2FEquinox%2FMigration%2FMapDrivenMARCXMLProc.pm;h=ca82ca7e6328c6a17b48de26f1216a791a64cd30;hp=609468c35de21856ebbe418c78ce73a28c66e346;hb=d1d70c501f6592ae84fc351e4325e5a5f9a67376;hpb=11374de369499ed76b215362a419dff3365fd67c diff --git a/Equinox-Migration/lib/Equinox/Migration/MapDrivenMARCXMLProc.pm b/Equinox-Migration/lib/Equinox/Migration/MapDrivenMARCXMLProc.pm index 609468c..ca82ca7 100644 --- a/Equinox-Migration/lib/Equinox/Migration/MapDrivenMARCXMLProc.pm +++ b/Equinox-Migration/lib/Equinox/Migration/MapDrivenMARCXMLProc.pm @@ -1,33 +1,37 @@ -package Equinox::Migration::MapDrivenXMLProc; +package Equinox::Migration::MapDrivenMARCXMLProc; use warnings; use strict; use XML::Twig; -use Equinox::Migration::SubfieldMapper; +use Equinox::Migration::SubfieldMapper 1.004; + =head1 NAME -Equinox::Migration::MapDrivenXMLProc +Equinox::Migration::MapDrivenMARCXMLProc =head1 VERSION -Version 1.000 +Version 1.004 =cut -our $VERSION = '1.000'; +our $VERSION = '1.004'; + +my $dstore; +my $sfmap; +my @mods = qw( multi bib required ); +my $multis = {}; +my $reccount; +my $verbose = 0; =head1 SYNOPSIS Foo - use Equinox::Migration::MapDrivenXMLProc; - - -=cut - + use Equinox::Migration::MapDrivenMARCXMLProc; =head1 METHODS @@ -35,112 +39,285 @@ Foo =head2 new +Takes two required arguments: C (which will be passed along +to L as the basis for its map), +and C (the MARC data to be processed). + + my $m = Equinox::Migration::MapDrivenMARCXMLProc->new( mapfile => FILE, + marcfile => FILE ); + =cut sub new { my ($class, %args) = @_; - my $self = bless { conf => { count => 0, - total => 0, - quiet => 0, - }, - map => Equinox::Migration::SubfieldMapper->new(file => $args{mapfile}), - tags => {}, - twig => XML::Twig->new( twig_handlers => { record => \&record } ), + $verbose = 1 if $args{verbose}; + + my $self = bless { multis => \$multis, }, $class; - if ($args{marcfile}) { - if (-r $args{marcfile}) { - $self->{conf}{marc} = $args{marcfile}; - $self->generate; - } else { - die "Can't open marc file: $!\n"; - } + # initialize map and taglist + die "Argument 'mapfile' must be specified\n" unless ($args{mapfile}); + $sfmap = Equinox::Migration::SubfieldMapper->new( file => $args{mapfile}, + mods => \@mods ); + + # initialize datastore + $dstore = {}; + $reccount = 0; # next record ptr + $dstore->{tags} = $sfmap->tags; # list of all tags + $self->{data} = $dstore; + + # initialize twig + die "Argument 'marcfile' must be specified\n" unless ($args{marcfile}); + if (-r $args{marcfile}) { + my $xmltwig = XML::Twig->new( twig_handlers => { record => \&parse_record } ); + $xmltwig->parsefile( $args{marcfile} ); + } else { + die "Can't open marc file: $!\n"; } - $self->{twig}->parsefile($self->{conf}{marc}); - return $self; } -sub parse { - my ($self) = @_; -} +=head2 parse_record +Extracts data from the next record, per the mapping file. -sub emit_status { - my ($self) = @_; - my $c = $self->{conf}; - return if $c->{quiet}; - $c->{count}++; - my $percent = int(($c->{count} / $c->{total}) * 100); - print STDERR "\r$percent% done (", $c->{count}, ")"; +=cut + +sub parse_record { + my ($twig, $record) = @_; + my $crec = {}; # current record + + my @fields = $record->children; + for my $f (@fields) + { process_field($f, $crec) } + + # cleanup memory and increment pointer + $record->purge; + $reccount++; + + # check for required fields + check_required($crec); + push @{ $dstore->{recs} }, $crec; + + print STDERR "$reccount\n" + if ($verbose and !($reccount % 1000)); } +sub process_field { + my ($field, $crec) = @_; + my $tag = $field->{'att'}->{'tag'}; + + # leader + unless (defined $tag) { + #FIXME + return; + } + + # datafields + if ($tag == 903) { + my $sub = $field->first_child('subfield'); + $crec->{egid} = $sub->text; + return; + } + if ($sfmap->has($tag)) { + push @{$crec->{tags}}, { tag => $tag, uni => undef, multi => undef }; + push @{$crec->{tmap}{$tag}}, (@{$crec->{tags}} - 1); + my @subs = $field->children('subfield'); + for my $sub (@subs) + { process_subs($tag, $sub, $crec) } + + # check map to ensure all declared tags and subs have a value + for my $mappedsub ( @{ $sfmap->subfields($tag) } ) { + my $fieldname = $sfmap->field($tag, $mappedsub); + my $mods = $sfmap->mods($fieldname); + next if $mods->{multi}; + $crec->{tags}[-1]{uni}{$mappedsub} = '' + unless defined $crec->{tags}[-1]{uni}{$mappedsub}; + } + for my $mappedtag ( @{ $sfmap->tags }) { + $crec->{tmap}{$mappedtag} = undef + unless defined $crec->{tmap}{$mappedtag}; + } + } +} -=head2 XML::Twig CALLBACK ROUTINES +sub process_subs { + my ($tag, $sub, $crec) = @_; + my $code = $sub->{'att'}->{'code'}; -=head3 record + # handle unmapped tag/subs + return unless ($sfmap->has($tag, $code)); -=cut + # fetch our datafield struct and fiel + my $dataf = $crec->{tags}[-1]; + my $field = $sfmap->field($tag, $code); -sub record { - my($t, $r)= @_; - $self->{holdings} = {}; + # test filters + for my $filter ( @{$sfmap->filters($field)} ) { + return if ($sub->text =~ /$filter/i); + } - my @dfields = $r->children('datafield'); - for my $d (@dfields) { - process_datafields($d); + # handle multi modifier + if (my $mods = $sfmap->mods($field)) { + if ($mods->{multi}) { + push @{$dataf->{multi}{$code}}, $sub->text; + $multis->{$tag}{$code} = 1; + return; + } } - write_data_out(); - $r->purge; + + # if this were a multi field, it would be handled already. make sure its a singleton + die "Multiple occurances of a non-multi field: $tag$code at rec ", + ($reccount + 1),"\n" if (defined $dataf->{uni}{$code}); + + # everything seems okay + $dataf->{uni}{$code} = $sub->text; } -=head3 process_datafields -=cut +sub check_required { + my ($crec) = @_; + my $mods = $sfmap->mods; -sub process_datafields { - my ($d) = @_; - my $map = $self->{map}; - my $tag = $d->{'att'}->{'tag'}; + for my $tag_id (keys %{$mods->{required}}) { + for my $code (@{$mods->{required}{$tag_id}}) { + my $found = 0; - if ($tag == 903) { - my $s = $d->first_child('subfield'); - $self->{holdings}{id} = $s->text;; - } elsif ($map->has($tag)) { - push @{$self->{holdings}{copies}}, { tag => $tag }; - my @subs = $d->children('subfield'); - for my $sub (@subs) - { process_subs($tag, $sub) } + for my $tag (@{$crec->{tags}}) { + $found = 1 if ($tag->{multi}{($tag_id . $code)}); + $found = 1 if ($tag->{uni}{$code}); + } + + die "Required mapping $tag_id$code not found in rec ",$reccount,"\n" + unless ($found); + } } + } -=head3 process_subs +=head2 recno + +Returns current record number (starting from zero) =cut -sub process_subs { - my ($tag, $sub) = @_; - my $map = $self->{map}; - my $code = $sub->{'att'}->{'code'}; +sub recno { my ($self) = @_; return $self->{data}{rcnt} } - unless ($map->has($tag, $code)) { - # this is a subfield code we don't have mapped. report on it if this is a sample tag - push @{$c->{sample}{$tag}}, $code if defined $c->{sample}{tag}; - return; - } +=head2 name - my $copy = $self->{holdings}{copies}[-1]; - my $field = $map->field($tag, $code); - if ($map->mod($field) eq 'multi') { - my $name = $tag . $code; - push @{$copy->{multi}{$name}}, $sub->text; - } else { - $copy->{uni}{$code} = $sub->text; - } +Returns mapped fieldname when passed a tag, and code + + my $name = $m->name(999,'a'); + +=cut + +sub name { my ($self, $t, $c) = @_; return $sfmap->field($t, $c) } + +=head2 get_multis + +Returns hashref of C<{tag}{code}> for all mapped multi fields + +=cut + +sub get_multis { + my ($self) = @_; + return $multis; } +=head1 MODIFIERS + +MapDrivenMARCXMLProc implements the following modifiers, and passes +them to L, meaning that specifying +any other modifiers in a MDMP map file will cause a fatal error when +it is processed. + +=head2 multi + +If a mapping is declared to be C, then MDMP expects to see more +than one instance of that subfield per datafield, and the data is +handled accordingly (see L below). + +Occurring zero or one time is legal for a C mapping. + +A mapping which is not flagged as C, but which occurs more than +once per datafield will cause a fatal error. + +=head2 required + +By default, if a mapping does not occur in a datafield, processing +continues normally. if a mapping has the C modifier, +however, it must appear, or a fatal error will occur. + +=head1 PARSED RECORDS + +Given: + + my $m = Equinox::Migration::MapDrivenMARCXMLProc->new(ARGUMENTS); + $rec = $m->parse_record; + +Then C<$rec> will look like: + + { + egid => evergreen_record_id, + tags => [ + { + tag => tag_id, + multi => { code => [ val1, val2, ... ] }, + uni => { code => value, code2 => value2, ... }, + }, + ... + ], + tmap => { tag_id => [ INDEX_LIST ], tag_id2 => [ INDEX_LIST ], ... } + } + +That is, there is an C key which points to the Evergreen ID of +that record, a C key which points to an arrayref, and a C +key which points to a hashref. + +=head3 C + +A reference to a list of anonymous hashes, one for each instance of +each tag which occurs in the map. + +Each tag hash holds its own id (e.g. C<998>), and two references to +two more hashrefs, C and C. + +The C hash holds the extracted data for tag/sub mappings which +have the C modifier on them. The keys in C subfield +codes. The values are arrayrefs containing the content of all +instances of that subfield in that instance of that tag. If no tags +are defined as C, it will be C. + +The C hash holds data for tag/sub mappings which occur only once +per instance of a tag (but may occur multiple times in a record due to +there being multiple instances of that tag in a record). Keys are +subfield codes and values are subfield content. + +All C subfields occuring in the map are guaranteed to be +defined. Sufields which are mapped but do not occur in a particular +datafield will be given a value of '' (the null string) in the current +record struct. Oppose subfields which are not mapped, which will be +C. + +=head3 tmap + +A hashref, where each key (a tag id like "650") points to a listref +containing the index (or indices) of C where that tag has +extracted data. + +The intended use of this is to simplify the processing of data from +tags which can appear more than once in a MARC record, like +holdings. If your holdings data is in 852, C{852}> will be a +listref with the indices of C which hold the data from the 852 +datafields. + +Complimentarily, C prevents data from singular datafields from +having to be copied for every instance of a multiple datafield, as it +lets you get the data from that record's one instance of whichever +field you're looking for. + =head1 AUTHOR Shawn Boyette, C<< >> @@ -153,7 +330,7 @@ Please report any bugs or feature requests to the above email address. You can find documentation for this module with the perldoc command. - perldoc Equinox::Migration::MapDrivenXMLProc + perldoc Equinox::Migration::MapDrivenMARCXMLProc =head1 COPYRIGHT & LICENSE @@ -166,4 +343,4 @@ under the same terms as Perl itself. =cut -1; # End of Equinox::Migration::MapDrivenXMLProc +1; # End of Equinox::Migration::MapDrivenMARCXMLProc