This is an automated email from the git hooks/post-receive script. js pushed a commit to branch master in repository libcatmandu-perl.
commit 255551e5621719742aa40da77fdc65da0889faae Author: Patrick Hochstenbach <patrick.hochstenb...@ugent.be> Date: Thu Dec 10 11:21:32 2015 +0100 Adding support for concatenating variable length string, path arguments --- lib/Catmandu/Fix/paste.pm | 102 ++++++++++++++++++++++++++++++++++++++++++++++ t/Catmandu-Fix-paste.t | 26 ++++++++++++ 2 files changed, 128 insertions(+) diff --git a/lib/Catmandu/Fix/paste.pm b/lib/Catmandu/Fix/paste.pm new file mode 100644 index 0000000..8c6cbba --- /dev/null +++ b/lib/Catmandu/Fix/paste.pm @@ -0,0 +1,102 @@ +package Catmandu::Fix::paste; + +use Catmandu::Sane; + +our $VERSION = '0.9505'; + +use Moo; +use namespace::clean; +use Catmandu::Fix::Has; + +with 'Catmandu::Fix::Base'; + +has path => (fix_arg => 1); +has values => (fix_arg => 'collect'); + +sub emit { + my ($self, $fixer) = @_; + my $values = $self->values; + + my @parsed_values = (); + my $join_char = ' '; + + while (@$values) { + my $val = shift @$values; + if ($val eq 'join_char') { + $join_char = shift @$values; + last; + } + else { + push @parsed_values , $val; + } + } + + $join_char = $fixer->emit_string($join_char); + + my $vals_var = $fixer->generate_var; + my $perl = $fixer->emit_declare_vars($vals_var, '[]'); + + for my $val (@parsed_values) { + my $vals_path = $fixer->split_path($val); + my $vals_key = pop @$vals_path; + + if ($val =~ /^~(.*)/) { + my $tmp = $fixer->emit_string($1); + $perl .= "push(\@{${vals_var}}, ${tmp});"; + } + else { + $perl .= $fixer->emit_walk_path($fixer->var, $vals_path, sub { + my $var = shift; + $fixer->emit_get_key($var, $vals_key, sub { + my $var = shift; + "push(\@{${vals_var}}, ${var}) if is_value(${var});"; + }); + }); + } + } + + my $path = $fixer->split_path($self->path); + + $perl .= $fixer->emit_create_path($fixer->var, $path, sub { + my $var = shift; + "${var} = join(${join_char}, \@{${vals_var}});"; + }); + + $perl; +} + +1; + +__END__ + +=pod + +=head1 NAME + +Catmandu::Fix::paste - concatenate path values + +=head1 SYNOPSIS + + # If you data record is: + # a: eeny + # b: meeny + # c: miny + # d: moe + paste(my.string,a,b,c,d) # my.string: eeny meeny miny moe + + # Use a join character + paste(my.string,a,b,c,d,join_char:", ") # my.string: eeny, meeny, miny, moe + + # Paste literal strings with a tilde sign + paste(my.string,~Hi,a,~,how are you?) # my.string: Hi eeny ,how are you? + +=head1 DESCRIPTION + +Paste places a concatenation of all paths starting from the second path into the first path. +Literal values can be pasted by prefixing them with a tilde (~) sign. + +=head1 SEE ALSO + +L<Catmandu::Fix> + +=cut diff --git a/t/Catmandu-Fix-paste.t b/t/Catmandu-Fix-paste.t new file mode 100644 index 0000000..699fd56 --- /dev/null +++ b/t/Catmandu-Fix-paste.t @@ -0,0 +1,26 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use Test::More; +use Test::Exception; + +my $pkg; +BEGIN { + $pkg = 'Catmandu::Fix::paste'; + use_ok $pkg; +} + +is_deeply + $pkg->new('my.field', 'a', 'b', 'c')->fix({a => 'A', b => 'B' , c => 'C'}), + {my => {field => 'A B C'}, a => 'A', b => 'B' , c => 'C'} , 'paste paths'; + +is_deeply + $pkg->new('my.field', 'a', 'b', 'c', join_char => '/')->fix({a => 'A', b => 'B' , c => 'C'}), + {my => {field => 'A/B/C'}, a => 'A', b => 'B' , c => 'C'} , 'join_char'; + +is_deeply + $pkg->new('my.field', 'a', '~b', 'c')->fix({a => 'A', b => 'B' , c => 'C'}), + {my => {field => 'A b C'}, a => 'A', b => 'B' , c => 'C'} , 'literal strings'; + +done_testing 4; -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list Pkg-perl-cvs-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits