[libcatmandu-marc-perl] 59/208: gh#46: bugfix for subfield code 0

[Jonas Smedegaard]

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 <jorol at cpan.org>
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, Curtis0(DE-601)7303424090(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