[libcatmandu-marc-perl] 101/208: Fixinf marc_spec 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 57d379fc023c6a978aa6271d27735daf8451bb0b
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date: Thu Mar 2 08:46:19 2017 +0100
Fixinf marc_spec append
---
lib/Catmandu/Fix/marc_map.pm | 1 +
lib/Catmandu/Fix/marc_spec.pm | 15 ++++++--
lib/Catmandu/MARC.pm | 32 +++++++++++++---
t/22-append-path.t | 86 +++++++++++++++++++++++++++++++++++++++++++
4 files changed, 125 insertions(+), 9 deletions(-)
diff --git a/lib/Catmandu/Fix/marc_map.pm b/lib/Catmandu/Fix/marc_map.pm
index 1b2730c..165ba1b 100644
--- a/lib/Catmandu/Fix/marc_map.pm
+++ b/lib/Catmandu/Fix/marc_map.pm
@@ -50,6 +50,7 @@ if (my ${result} = ${marc}->marc_map(
${result} = ref(${result}) ? ${result} : [${result}];
for ${current_value} (\@{${result}}) {
EOF
+
$perl .= $fixer->emit_create_path(
$var,
$path,
diff --git a/lib/Catmandu/Fix/marc_spec.pm b/lib/Catmandu/Fix/marc_spec.pm
index 31c4bde..50a1d4c 100644
--- a/lib/Catmandu/Fix/marc_spec.pm
+++ b/lib/Catmandu/Fix/marc_spec.pm
@@ -20,6 +20,7 @@ has invert => ( 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
@@ -31,27 +32,35 @@ sub emit {
'-split' => $self->split // 0 ,
'-pluck' => $self->pluck // 0 ,
'-invert' => $self->invert // 0 ,
- '-value' => $self->value
+ '-value' => $self->value ,
+ '-append' => $key eq '$append'
});
my $var = $fixer->var;
my $result = $fixer->generate_var;
+ my $current_value = $fixer->generate_var;
- my $perl =<<EOF;
+ my $perl = "";
+ $perl .= $fixer->emit_declare_vars($current_value, "[]");
+ $perl .=<<EOF;
if (my ${result} = ${marc}->marc_spec(
${var},
${marc_spec},
${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 368c9bd..cdbfe8d 100644
--- a/lib/Catmandu/MARC.pm
+++ b/lib/Catmandu/MARC.pm
@@ -350,6 +350,7 @@ sub marc_spec {
my $pluck = $_[3]->{'-pluck'} // 0;
my $value_set = $_[3]->{'-value'} // undef;
my $invert = $_[3]->{'-invert'} // 0;
+ my $append = $_[3]->{'-append'} // undef;
my $vals;
@@ -521,9 +522,18 @@ sub marc_spec {
unless (@subfields) { return $vals }
- $vals = ($split)
- ? [@subfields]
- : join( $join_char, @subfields );
+ if ($split) {
+ $vals = [[@subfields]];
+ }
+ elsif ($append) {
+ $vals = [@subfields];
+ }
+ elsif (@subfields) {
+ $vals = join( $join_char, @subfields );
+ }
+ else {
+ $vals = undef;
+ }
}
else { # no particular subfields requested
my $char_start = $field_spec->char_start;
@@ -553,10 +563,20 @@ sub marc_spec {
}
unless (@mapped) { return $vals }
- $vals = ($split)
- ? [@mapped]
- : join $join_char, @mapped;
+ if ($split) {
+ $vals = [[@mapped]]
+ }
+ elsif ($append) {
+ $vals = [@mapped]
+ }
+ elsif (@mapped) {
+ $vals = join $join_char, @mapped;
+ }
+ else {
+ $vals = undef;
+ }
}
+
return $vals;
}
diff --git a/t/22-append-path.t b/t/22-append-path.t
index 31f111a..3a7cd76 100644
--- a/t/22-append-path.t
+++ b/t/22-append-path.t
@@ -10,6 +10,8 @@ use Test::More;
use Catmandu::Importer::MARC;
use Catmandu::Fix;
+note("marc_map-----------------");
+
note("t");
{
my $importer = Catmandu::Importer::MARC->new( file => 't/rug01.aleph', type => "ALEPHSEQ" );
@@ -92,4 +94,88 @@ note("t.\$append, split:1");
]] , '650 is an array of array of values';
}
+note("marc_spec-----------------");
+
+note("t");
+{
+ my $importer = Catmandu::Importer::MARC->new( file => 't/rug01.aleph', type => "ALEPHSEQ" );
+ my $fixer = Catmandu::Fix->new(fixes => ['marc_spec(650$a,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_spec(650$a,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_spec(650$a,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_spec(650$a,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