[libcatmandu-marc-perl] 180/208: Fixing marc_replace_all allowing marc_replace_all(field, (search), $1)
Jonas Smedegaard
dr at jones.dk
Sat Oct 28 03:42:48 UTC 2017
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 7d05569c9eee2221d57c673d6d6814e545b8984f
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date: Thu Jul 6 14:35:28 2017 +0200
Fixing marc_replace_all allowing marc_replace_all(field,(search),$1)
---
Changes | 1 +
lib/Catmandu/Fix/marc_replace_all.pm | 3 +++
lib/Catmandu/MARC.pm | 3 ++-
t/26_marc_replace_all.t | 14 ++++++++++++++
4 files changed, 20 insertions(+), 1 deletion(-)
diff --git a/Changes b/Changes
index 49d9674..3d149d7 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
Revision history for Catmandu-MARC
{{$NEXT}}
+ - Fixing marc_replace_all evaluating search groups
1.16 2017-07-04 15:27:51 CEST
- Adding marc_copy (Carsten Klee) and marc_paste fix
diff --git a/lib/Catmandu/Fix/marc_replace_all.pm b/lib/Catmandu/Fix/marc_replace_all.pm
index cd776e7..15126ff 100644
--- a/lib/Catmandu/Fix/marc_replace_all.pm
+++ b/lib/Catmandu/Fix/marc_replace_all.pm
@@ -36,6 +36,9 @@ Catmandu::Fix::marc_replace_all - regex replace (sub)field values in a MARC file
# Replace all 'Joe'-s in 100a to the value in field x.y.z
marc_replace_all('100a','\bJoe\b',$.x.y.z)
+ # Replace all the content of 100a with everything in curly brackets
+ marc_replace_all('100a','^(.*)$','{$1}')
+
=head1 DESCRIPTION
Use regex search and replace on MARC field values.
diff --git a/lib/Catmandu/MARC.pm b/lib/Catmandu/MARC.pm
index ea0b044..f6bba94 100644
--- a/lib/Catmandu/MARC.pm
+++ b/lib/Catmandu/MARC.pm
@@ -318,7 +318,8 @@ sub marc_replace_all {
for (my $i = 0; $i < @subfields; $i += 2) {
if ($subfields[$i] =~ $context->{subfield}) {
- $field->[$i + 4] =~ s{$regex}{$value}g;
+ # Trick to double eval the right hand side
+ $field->[$i + 4] =~ s{$regex}{"\"$value\""}eeg;
}
}
}
diff --git a/t/26_marc_replace_all.t b/t/26_marc_replace_all.t
index 8e2483d..b12d076 100644
--- a/t/26_marc_replace_all.t
+++ b/t/26_marc_replace_all.t
@@ -32,4 +32,18 @@ use Catmandu::Fix;
], q|fix: marc_replace_all('630a','Active','Silly')|;
}
+
+#---
+{
+ my $fixer = Catmandu::Fix->new(fixes => [q|marc_replace_all('630','(Active)','{$1}')|,q|marc_map('630a','test.$append')|]);
+ my $importer = Catmandu::Importer::MARC->new( file => 't/camel.mrc', type => "ISO" );
+ my $record = $fixer->fix($importer->first);
+
+ is_deeply $record->{test}, [
+ '{Active} server pages.' ,
+ '{Active}X.'
+ ], q|fix: marc_replace_all('630a','Active','{Active}')|;
+}
+
+
done_testing;
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-marc-perl.git
More information about the Pkg-perl-cvs-commits
mailing list