[libcatmandu-marc-perl] 07/208: Fixing combinations of substring with splita #33

[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 5c6d58849f067c3827a07a7ca706227e8165dfdf
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date:   Mon Jun 13 15:23:09 2016 +0200

    Fixing combinations of substring with splita #33
---
 lib/Catmandu/Fix/Inline/marc_map.pm | 11 ++++++-----
 lib/Catmandu/Fix/marc_map.pm        | 26 +++++++++++++++++++-------
 t/03-marc_map.t                     |  6 ++++--
 t/07-inline-fix.t                   |  7 ++++++-
 t/test.fix                          |  1 +
 5 files changed, 36 insertions(+), 15 deletions(-)

diff --git a/lib/Catmandu/Fix/Inline/marc_map.pm b/lib/Catmandu/Fix/Inline/marc_map.pm
index 808b372..09bc303 100644
--- a/lib/Catmandu/Fix/Inline/marc_map.pm
+++ b/lib/Catmandu/Fix/Inline/marc_map.pm
@@ -153,12 +153,13 @@ sub marc_map {
         	if (@$v) {
         		if (!$split) {
         			$v = join $join_char, @$v;
+                }
 
-        			if (defined(my $off = $attrs->{from})) {
-        				my $len = defined $attrs->{to} ? $attrs->{to} - $off + 1 : 1;
-        				$v = substr($v,$off,$len);
-        			}
-        		}
+    			if (defined(my $off = $attrs->{from})) {
+                    $v = join $join_char, @$v if (ref $v eq 'ARRAY');
+    				my $len = defined $attrs->{to} ? $attrs->{to} - $off + 1 : 1;
+    				$v = substr($v,$off,$len);
+    			}
         	}
         }
     	push (@vals,$v) if ( (ref $v eq 'ARRAY' && @$v) || (ref $v eq '' && length $v ));
diff --git a/lib/Catmandu/Fix/marc_map.pm b/lib/Catmandu/Fix/marc_map.pm
index 515118b..4032632 100644
--- a/lib/Catmandu/Fix/marc_map.pm
+++ b/lib/Catmandu/Fix/marc_map.pm
@@ -108,32 +108,44 @@ sub emit {
             $perl .= $add_subfields->(3);
             $perl .= "}";
             $perl .= "if (\@{${v}}) {";
+
             if (!$self->split) {
                 $perl .= "${v} = join(${join_char}, \@{${v}});";
-                if (defined(my $off = $from)) {
-                    my $len = defined $to ? $to - $off + 1 : 1;
-                    $perl .= "if (eval { ${v} = substr(${v}, ${off}, ${len}); 1 }) {";
-                }
             }
+
+            if (defined(my $off = $from)) {
+                my $len = defined $to ? $to - $off + 1 : 1;
+                $perl .= "${v} = join(${join_char}, \@{${v}}) if (is_array_ref(${v}));";
+                $perl .= "if (length(${v}) > ${off}) {" .
+                         "  ${v} = substr(${v}, ${off}, ${len});" .
+                         "} else {" .
+                         "  ${v} = undef;".
+                         "}";
+            }
+        
             $perl .= $fixer->emit_create_path($fixer->var, $path, sub {
                 my $var = shift;
+                my $perl = "";
+                $perl .= "if (defined ${v}) {";
                 if ($self->split) {
+                    $perl .= 
                     "if (is_array_ref(${var})) {".
                         "push \@{${var}}, ${v};".
                     "} else {".
                         "${var} = [${v}];".
                     "}";
                 } else {
+                    $perl .= 
                     "if (is_string(${var})) {".
                         "${var} = join(${join_char}, ${var}, ${v});".
                     "} else {".
                         "${var} = ${v};".
                     "}";
                 }
-            });
-            if (defined($from)) {
                 $perl .= "}";
-            }
+                $perl;
+            });
+        
             $perl .= "}";
         }
         $perl;
diff --git a/t/03-marc_map.t b/t/03-marc_map.t
index ded46b3..a1f6214 100644
--- a/t/03-marc_map.t
+++ b/t/03-marc_map.t
@@ -27,9 +27,11 @@ is_deeply
 # the '$append' fix creates $my->{'references'} hash key with empty array ref as value
 ok !$records->[0]->{'my'}{'references'}, q|fix: marc_map('666', 'my.references.$append');|;
 
-is $records->[0]->{my}{substr_id}, "057";
+is $records->[0]->{my}{substr_id}, "057" , 'substring';
 
-ok !exists $records->[0]->{my}{failed_substr_id};
+is $records->[0]->{my}{substr_id2}->[0], "057", 'substring + split';
+
+ok !exists $records->[0]->{my}{failed_substr_id} , 'failed substring';
 
 ok $records->[0]->{record} =~ /marc:datafield/ , "marcxml";
 
diff --git a/t/07-inline-fix.t b/t/07-inline-fix.t
index f812bdc..de370f2 100644
--- a/t/07-inline-fix.t
+++ b/t/07-inline-fix.t
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 15;
+use Test::More tests => 16;
 
 use Catmandu::Fix::Inline::marc_map qw(marc_map);
 use Catmandu::Fix::Inline::marc_add qw(marc_add);
@@ -78,4 +78,9 @@ ok(@$records == 2 , "Found 2 records");
 {
 	my $f260h = marc_map($records->[0],'260h',-value=>'BAD');
 	ok ! $f260h , q|value test|;
+}
+
+{
+	my @arr = marc_map($records->[0],'245a/0-3',-split=>1);
+	is $arr[0] , q|Acti|;
 }
\ No newline at end of file
diff --git a/t/test.fix b/t/test.fix
index 2fbae92..d12ffce 100644
--- a/t/test.fix
+++ b/t/test.fix
@@ -3,6 +3,7 @@ marc_map('245a', 'my.title')
 marc_map('666', 'my.references.$append')
 
 marc_map('001/3-5', 'my.substr_id')
+marc_map('001/3-5', 'my.substr_id2',split:1)
 marc_map('001/1003-1005', 'my.failed_substr_id')
 
 marc_map('245', 'my.split_title', split:1)

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