This is an automated email from the git hooks/post-receive script. js pushed a commit to annotated tag upstream/1.19 in repository libcatmandu-marc-perl.
commit d1b76f2987979d0ca7db1186a52f9b3f931b67bc Author: Johann Rolschewski <[email protected]> Date: Fri Oct 14 19:09:04 2016 +0200 gh#46: bugfix for subfield code 0 --- lib/Catmandu/MARC.pm | 6 +++--- t/03-marc_map.t | 25 +++++++++++++++++++++++++ 2 files changed, 28 insertions(+), 3 deletions(-) diff --git a/lib/Catmandu/MARC.pm b/lib/Catmandu/MARC.pm index 0f3bdcd..bf41eec 100644 --- a/lib/Catmandu/MARC.pm +++ b/lib/Catmandu/MARC.pm @@ -50,7 +50,7 @@ sub marc_map { my $v; if ($value_set) { - for (my $i = 3; $field->[$i]; $i += 2) { + for (my $i = 3; $i < @{$field}; $i += 2) { my $subfield_regex = $context->{subfield_regex}; if ($field->[$i] =~ $subfield_regex) { $v = $value_set; @@ -64,7 +64,7 @@ sub marc_map { if ($pluck) { # Treat the subfield as a hash index my $_h = {}; - for (my $i = $context->{start}; $field->[$i]; $i += 2) { + for (my $i = $context->{start}; $i < @{$field}; $i += 2) { push @{ $_h->{ $field->[$i] } } , $field->[$i + 1]; } my $subfield = $context->{subfield}; @@ -74,7 +74,7 @@ sub marc_map { } } else { - for (my $i = $context->{start}; $field->[$i]; $i += 2) { + for (my $i = $context->{start}; $i < @{$field}; $i += 2) { my $subfield_regex = $context->{subfield_regex}; if ($field->[$i] =~ $subfield_regex) { push(@$v, $field->[$i + 1]); diff --git a/t/03-marc_map.t b/t/03-marc_map.t index fe2a4e2..190f355 100644 --- a/t/03-marc_map.t +++ b/t/03-marc_map.t @@ -51,4 +51,29 @@ is $records->[0]->{has_500_not_c}, 'OK' , '^c value subfield'; ok ! $records->[0]->{has_500_not_a}, '^a value subfield'; +# gh#46: Test for subfield codes 0 +{ + my $mrc + = '00093nam a2200037 c 4500100005500000 1 aPoe, Curtis 0(DE-601)730342409 0(DE-588)1028093195 '; + +my $fixer = Catmandu::Fix->new( + fixes => [ + 'marc_map(100,subf_all,join => "~")', + 'marc_map(1000,subf_zero,join => "~")', + 'marc_map(1000a,subf_zero_pluck,join => "~",pluck => 1)', + ] +); +my $importer = Catmandu::Importer::MARC->new( file => \$mrc, type => 'ISO' ); +my $record = $fixer->fix($importer)->first; + +is( $record->{subf_all}, + 'Poe, Curtis~(DE-601)730342409~(DE-588)1028093195', + 'all subfields' +); +is( $record->{subf_zero}, '(DE-601)730342409~(DE-588)1028093195', + 'subfields 0' ); +is( $record->{subf_zero_pluck}, '(DE-601)730342409~(DE-588)1028093195~Poe, Curtis', + 'subfields 0 pluck' ); +} + done_testing; -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-marc-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
