[libcatmandu-marc-perl] 168/208: Adding marc_append fix
Jonas Smedegaard
dr at jones.dk
Sat Oct 28 03:42:47 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 ab56cdd5ea9bdf80e11d321157f25b33d3fc5395
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date: Thu Jun 29 16:15:52 2017 +0200
Adding marc_append fix
---
Changes | 1 +
.../Fix/{marc_replace_all.pm => marc_append.pm} | 24 ++++----
lib/Catmandu/Fix/marc_replace_all.pm | 6 +-
lib/Catmandu/Fix/marc_set.pm | 2 +-
lib/Catmandu/MARC.pm | 66 +++++++++++++++++++++-
t/27_marc_append.t | 23 ++++++++
6 files changed, 104 insertions(+), 18 deletions(-)
diff --git a/Changes b/Changes
index 01ea645..7044e93 100644
--- a/Changes
+++ b/Changes
@@ -3,6 +3,7 @@ Revision history for Catmandu-MARC
{{$NEXT}}
- Adding the marc_spec_has Fix Condition (Carsten Klee)
- Adding marc_replace_all fix
+ - Adding marc_append fix
1.14 2017-06-23 07:48:49 CEST
- Upgrading to Catmandu 1.06X
diff --git a/lib/Catmandu/Fix/marc_replace_all.pm b/lib/Catmandu/Fix/marc_append.pm
similarity index 50%
copy from lib/Catmandu/Fix/marc_replace_all.pm
copy to lib/Catmandu/Fix/marc_append.pm
index 1f0e2de..f89ba2c 100644
--- a/lib/Catmandu/Fix/marc_replace_all.pm
+++ b/lib/Catmandu/Fix/marc_append.pm
@@ -1,4 +1,4 @@
-package Catmandu::Fix::marc_replace_all;
+package Catmandu::Fix::marc_append;
use Catmandu::Sane;
use Moo;
@@ -10,39 +10,35 @@ with 'Catmandu::Fix::Inlineable';
our $VERSION = '1.14';
has marc_path => (fix_arg => 1);
-has regex => (fix_arg => 1);
has value => (fix_arg => 1);
sub fix {
my ($self,$data) = @_;
my $marc_path = $self->marc_path;
- my $regex = $self->regex;
my $value = $self->value;
- return Catmandu::MARC->instance->marc_replace_all($data,$marc_path,$regex,$value);
+ return Catmandu::MARC->instance->marc_append($data,$marc_path,$value);
}
=head1 NAME
-Catmandu::Fix::marc_replace_all - regex replace (sub)field values in a MARC file
+Catmandu::Fix::marc_append - add a value at the end of a MARC field
=head1 SYNOPSIS
- # Append to all the 650-p values the string "xyz"
- marc_replace_all('650p','$','xyz')
-
- # Replace all 'Joe'-s in 100a to 'Joey'
- marc_replace_all('100a','\bJoe\b','Joey')
+ # Append a period at the end of the 100 field
+ marc_append(100,".")
=head1 DESCRIPTION
-Use regex search and replace on MARC field values.
+Append a value at the end of a MARC (sub)field
=head1 METHODS
-=head2 marc_replace_all(MARC_PATH , REGEX, VALUE)
+=head2 marc_append(MARC_PATH , VALUE)
-For each (sub)field matching the MARC_PATH replace the pattern found by REGEX to
-a new VALUE
+For each (sub)field matching the MARC_PATH append the VALUE to the last subfield.
+This value can be a literal or reference an existing field in the record using the
+dollar JSON_PATH syntax.
=head1 INLINE
diff --git a/lib/Catmandu/Fix/marc_replace_all.pm b/lib/Catmandu/Fix/marc_replace_all.pm
index 1f0e2de..c86c359 100644
--- a/lib/Catmandu/Fix/marc_replace_all.pm
+++ b/lib/Catmandu/Fix/marc_replace_all.pm
@@ -33,6 +33,9 @@ Catmandu::Fix::marc_replace_all - regex replace (sub)field values in a MARC file
# Replace all 'Joe'-s in 100a to 'Joey'
marc_replace_all('100a','\bJoe\b','Joey')
+ # Replace all 'Joe'-s in 100a to the value in field x.y.z
+ marc_replace_all('100a','\bJoe\b',$.x.y.z)
+
=head1 DESCRIPTION
Use regex search and replace on MARC field values.
@@ -42,7 +45,8 @@ Use regex search and replace on MARC field values.
=head2 marc_replace_all(MARC_PATH , REGEX, VALUE)
For each (sub)field matching the MARC_PATH replace the pattern found by REGEX to
-a new VALUE
+a new VALUE. This value can be a literal or
+reference an existing field in the record using the dollar JSON_PATH syntax.
=head1 INLINE
diff --git a/lib/Catmandu/Fix/marc_set.pm b/lib/Catmandu/Fix/marc_set.pm
index e8098ab..4c88bcc 100644
--- a/lib/Catmandu/Fix/marc_set.pm
+++ b/lib/Catmandu/Fix/marc_set.pm
@@ -47,7 +47,7 @@ Set the value of a MARC subfield to a new value.
=head2 marc_set(MARC_PATH , VALUE)
-Set a MARC subfield to a particular new value. This valeu can be a literal or
+Set a MARC subfield to a particular new value. This value can be a literal or
reference an existing field in the record using the dollar JSON_PATH syntax.
=head1 INLINE
diff --git a/lib/Catmandu/MARC.pm b/lib/Catmandu/MARC.pm
index f8b4531..0306df2 100644
--- a/lib/Catmandu/MARC.pm
+++ b/lib/Catmandu/MARC.pm
@@ -264,6 +264,68 @@ sub marc_replace_all {
$data;
}
+sub marc_append {
+ my ($self,$data,$marc_path,$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);
+
+ 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;
+ }
+ }
+
+ if ($context->{subfield}) {
+ for (my $i = 0; $i < @subfields; $i += 2) {
+ if ($subfields[$i] =~ $context->{subfield}) {
+ $field->[$i + 4] .= $value;
+ }
+ }
+ }
+ else {
+ $field->[-1] .= $value;
+ }
+ }
+
+ $data;
+}
+
sub marc_replace_all {
my ($self,$data,$marc_path,$regex,$value) = @_;
my $record = $data->{'record'};
@@ -321,7 +383,6 @@ sub marc_replace_all {
$data;
}
-
sub marc_set {
my ($self,$data,$marc_path,$value,%opts) = @_;
my $record = $data->{'record'};
@@ -451,7 +512,6 @@ sub marc_remove {
return $data;
}
-
sub marc_spec {
my $self = $_[0];
@@ -1100,6 +1160,8 @@ Catmandu::MARC - Catmandu modules for working with MARC data
=item * L<Catmandu::Fix::marc_add>
+=item * L<Catmandu::Fix::marc_append>
+
=item * L<Catmandu::Fix::marc_replace_all>
=item * L<Catmandu::Fix::marc_remove>
diff --git a/t/27_marc_append.t b/t/27_marc_append.t
new file mode 100644
index 0000000..3991751
--- /dev/null
+++ b/t/27_marc_append.t
@@ -0,0 +1,23 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use warnings qw(FATAL utf8);
+use utf8;
+
+use Test::More;
+
+use Catmandu::Importer::MARC;
+use Catmandu::Fix;
+
+
+#---
+{
+ my $fixer = Catmandu::Fix->new(fixes => [q|marc_append('100','.')|,q|marc_map('100','test')|]);
+ my $importer = Catmandu::Importer::MARC->new( file => 't/camel.mrc', type => "ISO" );
+ my $record = $fixer->fix($importer->first);
+
+ like $record->{test}, qr/^Martinsson, Tobias,1976-\.$/, q|fix: marc_append('100','.')|;
+}
+
+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