[libcatmandu-perl] 03/101: Adding support for concatenating variable length string, path arguments

[Jonas Smedegaard]

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.hochstenbach at 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