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 <[email protected]> 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 _______________________________________________ Pkg-perl-cvs-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
