[libcatmandu-marc-perl] 99/208: Starting fixing broken append
Jonas Smedegaard
dr at jones.dk
Sat Oct 28 03:42:40 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 6c340b556535131ce01e5687160a77e5aacc1d5e
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date: Wed Mar 1 16:54:37 2017 +0100
Starting fixing broken append
---
lib/Catmandu/Fix/Inline/marc_map.pm | 1 +
lib/Catmandu/Fix/marc_map.pm | 25 ++++++----
lib/Catmandu/MARC.pm | 21 +++++---
t/22-append-path.t | 95 +++++++++++++++++++++++++++++++++++++
4 files changed, 128 insertions(+), 14 deletions(-)
diff --git a/lib/Catmandu/Fix/Inline/marc_map.pm b/lib/Catmandu/Fix/Inline/marc_map.pm
index 156a0bc..095a1e0 100644
--- a/lib/Catmandu/Fix/Inline/marc_map.pm
+++ b/lib/Catmandu/Fix/Inline/marc_map.pm
@@ -74,6 +74,7 @@ sub marc_map {
$opts{'-split'} = 0 unless exists $opts{'-split'};
$opts{'-pluck'} = 0 unless exists $opts{'-pluck'};
$opts{'-nested_arrays'} = 1 unless exists $opts{'-nested_arrays'};
+
my $vals = Catmandu::MARC->instance->marc_map(
$data,
$marc_path,
diff --git a/lib/Catmandu/Fix/marc_map.pm b/lib/Catmandu/Fix/marc_map.pm
index 44b71a6..1b2730c 100644
--- a/lib/Catmandu/Fix/marc_map.pm
+++ b/lib/Catmandu/Fix/marc_map.pm
@@ -20,6 +20,7 @@ has nested_arrays => (fix_opt => 1);
sub emit {
my ($self,$fixer) = @_;
my $path = $fixer->split_path($self->path);
+ my $key = $path->[-1];
my $marc_obj = Catmandu::MARC->instance;
# Precompile the marc_path to gain some speed
@@ -27,31 +28,39 @@ sub emit {
my $marc = $fixer->capture($marc_obj);
my $marc_path = $fixer->capture($marc_context);
my $marc_opt = $fixer->capture({
- '-join' => $self->join // '' ,
- '-split' => $self->split // 0 ,
- '-pluck' => $self->pluck // 0 ,
+ '-join' => $self->join // '' ,
+ '-split' => $self->split // 0 ,
+ '-pluck' => $self->pluck // 0 ,
'-nested_arrays' => $self->nested_arrays // 0 ,
- '-value' => $self->value
+ '-value' => $self->value ,
+ '-append' => $key eq '$append'
});
- my $var = $fixer->var;
- my $result = $fixer->generate_var;
- my $perl =<<EOF;
+ my $var = $fixer->var;
+ my $result = $fixer->generate_var;
+ my $current_value = $fixer->generate_var;
+
+ my $perl = "";
+ $perl .= $fixer->emit_declare_vars($current_value, "[]");
+ $perl .=<<EOF;
if (my ${result} = ${marc}->marc_map(
${var},
${marc_path},
${marc_opt}) ) {
+ ${result} = ref(${result}) ? ${result} : [${result}];
+ for ${current_value} (\@{${result}}) {
EOF
$perl .= $fixer->emit_create_path(
$var,
$path,
sub {
my $var2 = shift;
- "${var2} = ${result}"
+ "${var2} = ${current_value}"
}
);
$perl .=<<EOF;
+ }
}
EOF
$perl;
diff --git a/lib/Catmandu/MARC.pm b/lib/Catmandu/MARC.pm
index f44162d..368c9bd 100644
--- a/lib/Catmandu/MARC.pm
+++ b/lib/Catmandu/MARC.pm
@@ -36,6 +36,7 @@ sub marc_map {
my $pluck = $_[3]->{'-pluck'} // 0;
my $value_set = $_[3]->{'-value'} // undef;
my $nested_arrays = $_[3]->{'-nested_arrays'} // 0;
+ my $append = $_[3]->{'-append'} // undef;
my $vals;
@@ -134,16 +135,24 @@ sub marc_map {
}
}
else {
- if (defined($vals) && ref($vals) eq '') {
- $vals = join $join_char , $vals , $v;
- }
- else {
- $vals = $v;
- }
+ push @$vals , $v;
}
}
}
+ if ($split) {
+ $vals = [ $vals ];
+ }
+ elsif ($append) {
+ # we got a $append
+ }
+ elsif (defined $vals) {
+ $vals = join $join_char , @$vals;
+ }
+ else {
+ # no result
+ }
+
$vals;
}
diff --git a/t/22-append-path.t b/t/22-append-path.t
new file mode 100644
index 0000000..31f111a
--- /dev/null
+++ b/t/22-append-path.t
@@ -0,0 +1,95 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use warnings qw(FATAL utf8);
+use utf8;
+
+use Test::More;
+
+use Catmandu::Importer::MARC;
+use Catmandu::Fix;
+
+note("t");
+{
+ my $importer = Catmandu::Importer::MARC->new( file => 't/rug01.aleph', type => "ALEPHSEQ" );
+ my $fixer = Catmandu::Fix->new(fixes => ['marc_map(650a,t)']);
+
+ my $result = $fixer->fix($importer);
+
+ my $field = $result->first->{t};
+
+ ok $field , 'got an 650';
+
+ my $joined = join "" , (
+ 'Semantics.',
+ 'Proposition (Logic)',
+ 'Speech acts (Linguistics)',
+ 'Generative grammar.',
+ 'Competence and performance (Linguistics)'
+ );
+
+ is $field , $joined , '650 is a joined string';
+}
+
+note("t.\$append");
+{
+ my $importer = Catmandu::Importer::MARC->new( file => 't/rug01.aleph', type => "ALEPHSEQ" );
+ my $fixer = Catmandu::Fix->new(fixes => ['marc_map(650a,t.$append)']);
+
+ my $result = $fixer->fix($importer);
+
+ my $field = $result->first->{t};
+
+ ok $field , 'got an 650';
+
+ is_deeply $field , [
+ 'Semantics.',
+ 'Proposition (Logic)',
+ 'Speech acts (Linguistics)',
+ 'Generative grammar.',
+ 'Competence and performance (Linguistics)'
+ ] , '650 is an array of values';
+}
+
+note("t, split:1");
+{
+ my $importer = Catmandu::Importer::MARC->new( file => 't/rug01.aleph', type => "ALEPHSEQ" );
+ my $fixer = Catmandu::Fix->new(fixes => ['marc_map(650a,t,split:1)']);
+
+ my $result = $fixer->fix($importer);
+
+ my $field = $result->first->{t};
+
+ ok $field , 'got an 650';
+
+ is_deeply $field , [
+ 'Semantics.',
+ 'Proposition (Logic)',
+ 'Speech acts (Linguistics)',
+ 'Generative grammar.',
+ 'Competence and performance (Linguistics)'
+ ] , '650 is an array of values';
+}
+
+note("t.\$append, split:1");
+{
+ my $importer = Catmandu::Importer::MARC->new( file => 't/rug01.aleph', type => "ALEPHSEQ" );
+ my $fixer = Catmandu::Fix->new(fixes => ['marc_map(650a,t.$append,split:1)']);
+
+ my $result = $fixer->fix($importer);
+
+ my $field = $result->first->{t};
+
+ ok $field , 'got an 650';
+
+ is_deeply $field , [[
+ 'Semantics.',
+ 'Proposition (Logic)',
+ 'Speech acts (Linguistics)',
+ 'Generative grammar.',
+ 'Competence and performance (Linguistics)'
+ ]] , '650 is an array of array of values';
+}
+
+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