[libcatmandu-marc-perl] 05/208: Adding inline support for value

[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 52bfbbb70265e6c7a885229de33fa29dd30cdde1
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date:   Mon Jun 13 14:31:29 2016 +0200

    Adding inline support for value
---
 Changes                             |  1 +
 lib/Catmandu/Fix/Inline/marc_map.pm | 52 ++++++++++++++++++++++---------------
 t/03-marc_map.t                     |  4 +++
 t/07-inline-fix.t                   | 12 ++++++++-
 t/test.fix                          |  7 +++--
 5 files changed, 52 insertions(+), 24 deletions(-)

diff --git a/Changes b/Changes
index abcb674..86d7915 100644
--- a/Changes
+++ b/Changes
@@ -2,6 +2,7 @@ Revision history for Catmandu-MARC
 
 {{$NEXT}}
   - Fixed indicator-2 selection bug
+  - Fixed marc_map value bug
   
 0.215  2016-02-22 09:57:07 CET
   - Supporting ISO alias for USMARC importer and exporter
diff --git a/lib/Catmandu/Fix/Inline/marc_map.pm b/lib/Catmandu/Fix/Inline/marc_map.pm
index fbbfe95..cfb1245 100644
--- a/lib/Catmandu/Fix/Inline/marc_map.pm
+++ b/lib/Catmandu/Fix/Inline/marc_map.pm
@@ -75,6 +75,7 @@ sub marc_map {
     my $split     = $opts{'-split'};
     my $join_char = $opts{'-join'} // '';
     my $pluck     = $opts{'-pluck'};
+    my $value_set = $opts{'-value'};
     my $attrs     = {};
 
     if ($marc_path =~ /(\S{3})(\[(.)?,?(.)?\])?([_a-z0-9^]+)?(\/(\d+)(-(\d+))?)?/) {
@@ -127,27 +128,36 @@ sub marc_map {
 
     	my $v;
 
-    	if ($var->[0] =~ /LDR|00./) {
-    		$v = $add_subfields->($var,3);
-    	}
-    	elsif (defined $var->[5] && $var->[5] eq '_') {
-    		$v = $add_subfields->($var,5);
-    	}
-    	else {
-    		$v = $add_subfields->($var,3);
-    	}
-
-    	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 ($value_set) {
+            for (my $i = 3; $i < @$var; $i += 2) {
+                if ($var->[$i] =~ /$attrs->{subfield_regex}/) {
+                    $v = $value_set;
+                    last;
+                }
+            }
+        }
+        else {
+        	if ($var->[0] =~ /LDR|00./) {
+        		$v = $add_subfields->($var,3);
+        	}
+        	elsif (defined $var->[5] && $var->[5] eq '_') {
+        		$v = $add_subfields->($var,5);
+        	}
+        	else {
+        		$v = $add_subfields->($var,3);
+        	}
+
+        	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);
+        			}
+        		}
+        	}
+        }
     	push (@vals,$v) if ( (ref $v eq 'ARRAY' && @$v) || (ref $v eq '' && length $v ));
     }
 
diff --git a/t/03-marc_map.t b/t/03-marc_map.t
index 5984827..ded46b3 100644
--- a/t/03-marc_map.t
+++ b/t/03-marc_map.t
@@ -41,4 +41,8 @@ is $records->[0]->{my}->{pluck} , "M33 2000QA76.73.P22" , 'pluck feature';
 
 is $records->[0]->{my}->{has_title}, 'Y' , 'value feature';
 
+is $records->[0]->{has_260c}, 'OK' , 'value subfield';
+
+ok ! $records->[0]->{has_260h}, 'value subfield';
+
 done_testing;
diff --git a/t/07-inline-fix.t b/t/07-inline-fix.t
index d4f1106..f812bdc 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 => 13;
+use Test::More tests => 15;
 
 use Catmandu::Fix::Inline::marc_map qw(marc_map);
 use Catmandu::Fix::Inline::marc_add qw(marc_add);
@@ -68,4 +68,14 @@ ok(@$records == 2 , "Found 2 records");
 {
 	my $f050 = marc_map($records->[0],'050ba',-pluck=>1);
 	is $f050 , "M33 2000QA76.73.P22" , q|pluck test|;
+}
+
+{
+	my $f260c = marc_map($records->[0],'260c',-value=>'OK');
+	is $f260c , "OK" , q|value test|;
+}
+
+{
+	my $f260h = marc_map($records->[0],'260h',-value=>'BAD');
+	ok ! $f260h , q|value test|;
 }
\ No newline at end of file
diff --git a/t/test.fix b/t/test.fix
index 6a16f5c..2fbae92 100644
--- a/t/test.fix
+++ b/t/test.fix
@@ -23,6 +23,9 @@ marc_map('050ba','my.pluck', pluck:1)
 
 marc_map('245','my.has_title', value:'Y')
 
-marc_xml('record');
+marc_map('245','my.has_title', value:'Y')
+
+marc_map('260c','has_260c', value:'OK')
+marc_map('260h','has_260h', value:'BAD')
 
-#remove_field('record')
+marc_xml('record')
\ No newline at end of file

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