[libcatmandu-marc-perl] 167/208: Updating POD

[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 3096e92551184bfcc2a6ab6aed151fadff4ebbae
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date:   Thu Jun 29 16:01:29 2017 +0200

    Updating POD
---
 lib/Catmandu/Fix/marc_remove.pm      |  2 +-
 lib/Catmandu/Fix/marc_replace_all.pm | 30 +++++++------------
 lib/Catmandu/Fix/marc_set.pm         |  4 +--
 lib/Catmandu/MARC.pm                 | 58 ++++++++++++++++++++++++++++++++++++
 4 files changed, 72 insertions(+), 22 deletions(-)

diff --git a/lib/Catmandu/Fix/marc_remove.pm b/lib/Catmandu/Fix/marc_remove.pm
index f653a08..62087e6 100644
--- a/lib/Catmandu/Fix/marc_remove.pm
+++ b/lib/Catmandu/Fix/marc_remove.pm
@@ -36,7 +36,7 @@ Remove (sub)fields in a MARC record
 
 =head1 METHODS
 
-=head2 marc_remove( MARC_PATH , [OPT1:VAL, OPT2: VAL])
+=head2 marc_remove(MARC_PATH)
 
 Delete the (sub)fields from the MARC record as indicated by the MARC_PATH.
 
diff --git a/lib/Catmandu/Fix/marc_replace_all.pm b/lib/Catmandu/Fix/marc_replace_all.pm
index 3363fb5..1f0e2de 100644
--- a/lib/Catmandu/Fix/marc_replace_all.pm
+++ b/lib/Catmandu/Fix/marc_replace_all.pm
@@ -23,44 +23,36 @@ sub fix {
 
 =head1 NAME
 
-Catmandu::Fix::marc_set - set a marc value of one (sub)field to a new value
+Catmandu::Fix::marc_replace_all - regex replace (sub)field values in a MARC file
 
 =head1 SYNOPSIS
 
-    # Set a field in the leader
-    if marc_match('LDR/6','c')
-        marc_set('LDR/6','p')
-    end
+    # Append to all the 650-p values the string "xyz"
+    marc_replace_all('650p','$','xyz')
 
-    # Set all the 650-p fields to 'test'
-    marc_set('650p','test')
-
-    # Set the 100-a subfield where indicator-1 is 3
-    marc_set('100[3]a','Farquhar family.')
-
-    # Copy data from another field in a subfield
-    marc_set('100a','$.my.deep.field')
+    # Replace all 'Joe'-s in 100a to 'Joey'
+    marc_replace_all('100a','\bJoe\b','Joey')
 
 =head1 DESCRIPTION
 
-Set the value of a MARC subfield to a new value.
+Use regex search and replace on MARC field values.
 
 =head1 METHODS
 
-=head2 marc_set( MARC_PATH , VALUE , [OPT1:VAL, OPT2: VAL])
+=head2 marc_replace_all(MARC_PATH , REGEX, VALUE)
 
-Set a MARC subfield to a particular new value. This valeu can be a literal or
-reference an existing field in the record using the dollar JSON_PATH syntax.
+For each (sub)field matching the MARC_PATH replace the pattern found by REGEX to
+a new VALUE
 
 =head1 INLINE
 
 This Fix can be used inline in a Perl script:
 
-    use Catmandu::Fix::marc_set as => 'marc_xmarc_setml';
+    use Catmandu::Fix::marc_replace_all as => 'marc_replace_all';
 
     my $data = { record => [...] };
 
-    $data = marc_set($data, '245a', 'test');
+    $data = marc_replace_all($data, '245a', 'test' , 'rest');
 
 =head1 SEE ALSO
 
diff --git a/lib/Catmandu/Fix/marc_set.pm b/lib/Catmandu/Fix/marc_set.pm
index b6d02e9..e8098ab 100644
--- a/lib/Catmandu/Fix/marc_set.pm
+++ b/lib/Catmandu/Fix/marc_set.pm
@@ -45,7 +45,7 @@ Set the value of a MARC subfield to a new value.
 
 =head1 METHODS
 
-=head2 marc_set( MARC_PATH , VALUE , [OPT1:VAL, OPT2: VAL])
+=head2 marc_set(MARC_PATH , VALUE)
 
 Set a MARC subfield to a particular new value. This valeu can be a literal or
 reference an existing field in the record using the dollar JSON_PATH syntax.
@@ -54,7 +54,7 @@ reference an existing field in the record using the dollar JSON_PATH syntax.
 
 This Fix can be used inline in a Perl script:
 
-    use Catmandu::Fix::marc_set as => 'marc_xmarc_setml';
+    use Catmandu::Fix::marc_set as => 'marc_set';
 
     my $data = { record => [...] };
 
diff --git a/lib/Catmandu/MARC.pm b/lib/Catmandu/MARC.pm
index b18863c..f8b4531 100644
--- a/lib/Catmandu/MARC.pm
+++ b/lib/Catmandu/MARC.pm
@@ -264,6 +264,64 @@ sub marc_replace_all {
     $data;
 }
 
+sub marc_replace_all {
+    my ($self,$data,$marc_path,$regex,$value) = @_;
+    my $record = $data->{'record'};
+
+    return $data unless defined $record;
+
+    if ($value =~ /^\$\.(\S+)/) {
+        my $path = $1;
+        $value = Catmandu::Util::data_at($path,$data);
+    }
+
+    if (Catmandu::Util::is_array_ref $value) {
+        $value = $value->[-1];
+    }
+    elsif (Catmandu::Util::is_hash_ref $value) {
+        my $last;
+        for (keys %$value) {
+            $last = $value->{$_};
+        }
+        $value = $last;
+    }
+
+    my $context = $self->compile_marc_path($marc_path, subfield_wildcard => 1);
+
+    confess "invalid marc path" unless $context;
+
+    for my $field (@$record) {
+        my ($tag, $ind1, $ind2, @subfields) = @$field;
+
+        if ($context->{is_regex_field}) {
+            next unless $tag =~ $context->{field_regex};
+        }
+        else {
+            next unless $tag eq $context->{field};
+        }
+
+        if (defined $context->{ind1}) {
+            if (!defined $ind1 || $ind1 ne $context->{ind1}) {
+                next;
+            }
+        }
+        if (defined $context->{ind2}) {
+            if (!defined $ind2 || $ind2 ne $context->{ind2}) {
+                next;
+            }
+        }
+
+        for (my $i = 0; $i < @subfields; $i += 2) {
+            if ($subfields[$i] =~ $context->{subfield}) {
+                $field->[$i + 4] =~ s{$regex}{$value}g;
+            }
+        }
+    }
+
+    $data;
+}
+
+
 sub marc_set {
     my ($self,$data,$marc_path,$value,%opts) = @_;
     my $record = $data->{'record'};

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