[libcatmandu-marc-perl] 22/208: Fixing the negated subfield bug

[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 b093351f9e7ab68ab05e73c2656658190334403f
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date:   Wed Jul 6 09:39:24 2016 +0200

    Fixing the negated subfield bug
---
 lib/Catmandu/MARC.pm | 13 +++++++++----
 t/03-marc_map.t      |  4 ++++
 t/test.fix           |  5 ++++-
 3 files changed, 17 insertions(+), 5 deletions(-)

diff --git a/lib/Catmandu/MARC.pm b/lib/Catmandu/MARC.pm
index 130dd20..dc0f333 100644
--- a/lib/Catmandu/MARC.pm
+++ b/lib/Catmandu/MARC.pm
@@ -36,13 +36,15 @@ sub marc_map {
             for (my $i = $context{start}; $i < $context{end}; $i += 2) {
                 push @{ $_h->{ $field->[$i] } } , $field->[$i + 1];
             }
-            for my $c (split('',$context{subfield})) {
+            my $subfield = $context{subfield};
+            $subfield =~ s{^[a-zA-Z0-9]}{}g;
+            for my $c (split('',$subfield)) {
                 push @v , @{ $_h->{$c} } if exists $_h->{$c};
             }
         }
         else {
             for (my $i = $context{start}; $i < $context{end}; $i += 2) {
-                if ($field->[$i] =~ /$context{subfield}/) {
+                if ($field->[$i] =~ /^$context{subfield}$/) {
                     push(@v, $field->[$i + 1]);
                 }
             }
@@ -401,8 +403,11 @@ sub marc_at_field {
         $field          = $1;
         $ind1           = $3;
         $ind2           = $4;
-        if (defined $5) {
-            $subfield_regex = "$5";
+        $subfield_regex = $5;
+        if (defined($subfield_regex)) {
+            unless ($subfield_regex =~ /^[a-zA-Z0-9]$/) {
+                $subfield_regex = "[$subfield_regex]";
+            }
         }
         elsif ($opts{subfield_default}) {
             $subfield_regex = $field =~ /^0|LDR/ ? '_' : 'a';
diff --git a/t/03-marc_map.t b/t/03-marc_map.t
index 448028c..7ee9c1b 100644
--- a/t/03-marc_map.t
+++ b/t/03-marc_map.t
@@ -47,4 +47,8 @@ is $records->[0]->{has_260c}, 'OK' , 'value subfield';
 
 ok ! $records->[0]->{has_260h}, 'value subfield';
 
+is $records->[0]->{has_500_not_c}, 'OK' , '^c value subfield';
+
+ok ! $records->[0]->{has_500_not_a}, '^a value subfield';
+
 done_testing;
diff --git a/t/test.fix b/t/test.fix
index d12ffce..adb320c 100644
--- a/t/test.fix
+++ b/t/test.fix
@@ -29,4 +29,7 @@ marc_map('245','my.has_title', value:'Y')
 marc_map('260c','has_260c', value:'OK')
 marc_map('260h','has_260h', value:'BAD')
 
-marc_xml('record')
\ No newline at end of file
+marc_map('500^c','has_500_not_c', value: 'OK')
+marc_map('500^a','has_500_not_a', value: 'BAD')
+
+marc_xml('record')

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-marc-perl.git