X-Git-Url: http://git.equinoxoli.org/?p=migration-tools.git;a=blobdiff_plain;f=Equinox-Migration%2Flib%2FEquinox%2FMigration%2FMapDrivenMARCXMLProc.pm;h=190125d1ee3260b68e88ebc20f9d156b8b8c72ab;hp=b55fdc45f608667c911a218fe8bf2c1f068d0fe0;hb=5cb143f1fc584a55e4732dbc747c875367baa241;hpb=967912046d1cdd6ffc0fc9ec76127d24e1a7b98d diff --git a/Equinox-Migration/lib/Equinox/Migration/MapDrivenMARCXMLProc.pm b/Equinox-Migration/lib/Equinox/Migration/MapDrivenMARCXMLProc.pm index b55fdc4..190125d 100644 --- a/Equinox-Migration/lib/Equinox/Migration/MapDrivenMARCXMLProc.pm +++ b/Equinox-Migration/lib/Equinox/Migration/MapDrivenMARCXMLProc.pm @@ -98,7 +98,7 @@ sub parse_record { my @fields = $record->children; for my $f (@fields) - { $self->process_field($f) } + { $self->process_field($f); $f->purge; } # cleanup memory and increment pointer $record->purge; @@ -133,14 +133,19 @@ sub process_field { push @{$crec->{tmap}{$tag}}, (@{$crec->{tags}} - 1); my @subs = $field->children('subfield'); for my $sub (@subs) - { $self->process_subs($tag, $sub) } - # check map to ensure all declared subs have a value + { $self->process_subs($tag, $sub); $sub->purge; } + + # check map to ensure all declared tags and subs have a value my $mods = $map->mods($field); for my $mappedsub ( @{ $map->subfields($tag) } ) { next if $mods->{multi}; $crec->{tags}[-1]{uni}{$mappedsub} = '' unless defined $crec->{tags}[-1]{uni}{$mappedsub}; } + for my $mappedtag ( @{ $map->tags }) { + $crec->{tmap}{$mappedtag} = undef + unless defined $crec->{tmap}{$mappedtag}; + } } } @@ -155,6 +160,7 @@ sub process_subs { # fetch our datafield struct and fieldname my $dataf = $self->{data}{crec}{tags}[-1]; my $field = $map->field($tag, $code); + $self->{data}{crec}{names}{$tag}{$code} = $field; # test filters for my $filter ( @{$map->filters($field)} ) { @@ -199,6 +205,24 @@ sub check_required { } +=head2 recno + +Returns current record number (starting from zero) + +=cut + +sub recno { my ($self) = @_; return $self->{data}{rptr} } + +=head2 name + +Returns mapped fieldname when pass a tag and code + + my $name = $m->name(999,'a'); + +=cut + +sub name { my ($self, $t, $c) = @_; return $self->{data}{crec}{names}{$t}{$c} }; + =head1 MODIFIERS MapDrivenMARCXMLProc implements the following modifiers, and passes