[libcatmandu-perl] 10/16: SimpleSetValue

Jonas Smedegaard dr at jones.dk
Thu Dec 4 14:43:16 UTC 2014


This is an automated email from the git hooks/post-receive script.

js pushed a commit to tag 0.9209
in repository libcatmandu-perl.

commit b84c6b3bd317837854e32fc1dac1b2ecdddd176b
Author: Nicolas Steenlant <nicolas.steenlant at ugent.be>
Date:   Tue Dec 2 13:14:12 2014 +0100

    SimpleSetValue
---
 lib/Catmandu/Fix/Condition/SimpleAllTest.pm |  6 +++---
 lib/Catmandu/Fix/Condition/SimpleAnyTest.pm |  2 +-
 lib/Catmandu/Fix/SimpleSetValue.pm          | 25 +++++++++++++++++++++++++
 lib/Catmandu/Fix/append.pm                  | 17 ++++-------------
 t/Catmandu-Fix-retain.t                     |  2 +-
 5 files changed, 34 insertions(+), 18 deletions(-)

diff --git a/lib/Catmandu/Fix/Condition/SimpleAllTest.pm b/lib/Catmandu/Fix/Condition/SimpleAllTest.pm
index d8f238a..1cdc8b2 100644
--- a/lib/Catmandu/Fix/Condition/SimpleAllTest.pm
+++ b/lib/Catmandu/Fix/Condition/SimpleAllTest.pm
@@ -12,10 +12,10 @@ Catmandu::Fix::Condition::SimpleAllTest - Base class to ease the construction of
    use Moo;
    use Catmandu::Fix::Has;
 
-   has path    => (fix_arg => 1);
+   has path => (fix_arg => 1);
 
    with 'Catmandu::Fix::Condition::SimpleAllTest';
- 
+
    sub emit_test {
        my ($self, $var) = @_;
        my $value = $self->value;
@@ -77,7 +77,7 @@ sub emit {
         $fixer->emit_get_key($var, $key, sub {
             my $var = shift;
             my $perl = "${has_match_var} ||= 1;";
-            $perl .= "unless (" . $self->emit_test($var) . ") {";
+            $perl .= "unless (" . $self->emit_test($var, $fixer) . ") {";
             if (@$fail_fixes) {
                 $perl .= "goto ${fail_label};";
             } else {
diff --git a/lib/Catmandu/Fix/Condition/SimpleAnyTest.pm b/lib/Catmandu/Fix/Condition/SimpleAnyTest.pm
index 3deaf65..8c89723 100644
--- a/lib/Catmandu/Fix/Condition/SimpleAnyTest.pm
+++ b/lib/Catmandu/Fix/Condition/SimpleAnyTest.pm
@@ -60,7 +60,7 @@ sub emit {
         my $var = shift;
         $fixer->emit_get_key($var, $key, sub {
             my $var = shift;
-            my $perl = "if (" . $self->emit_test($var) . ") {";
+            my $perl = "if (" . $self->emit_test($var, $fixer) . ") {";
 
             $perl .= $fixer->emit_fixes($self->pass_fixes);
 
diff --git a/lib/Catmandu/Fix/SimpleSetValue.pm b/lib/Catmandu/Fix/SimpleSetValue.pm
new file mode 100644
index 0000000..6155227
--- /dev/null
+++ b/lib/Catmandu/Fix/SimpleSetValue.pm
@@ -0,0 +1,25 @@
+package Catmandu::Fix::SimpleSetValue;
+
+use Catmandu::Sane;
+use Moo::Role;
+
+with 'Catmandu::Fix::Base';
+
+requires 'path';
+requires 'emit_value';
+
+sub emit {
+    my ($self, $fixer) = @_;
+    my $path = $fixer->split_path($self->path);
+    my $key = pop @$path;
+
+    $fixer->emit_walk_path($fixer->var, $path, sub {
+        my $var = shift;
+        $fixer->emit_get_key($var, $key, sub {
+            my $var = shift;
+            "${var} = " . $self->emit_value($var, $fixer);
+        });
+    });
+}
+
+1;
diff --git a/lib/Catmandu/Fix/append.pm b/lib/Catmandu/Fix/append.pm
index c415811..f1de9f6 100644
--- a/lib/Catmandu/Fix/append.pm
+++ b/lib/Catmandu/Fix/append.pm
@@ -4,24 +4,15 @@ use Catmandu::Sane;
 use Moo;
 use Catmandu::Fix::Has;
 
-with 'Catmandu::Fix::Base';
+with 'Catmandu::Fix::SimpleSetValue';
 
 has path  => (fix_arg => 1);
 has value => (fix_arg => 1);
 
-sub emit {
-    my ($self, $fixer) = @_;
-    my $path = $fixer->split_path($self->path);
-    my $key = pop @$path;
+sub emit_value {
+    my ($self, $var, $fixer) = @_;
     my $value = $fixer->emit_string($self->value);
-
-    $fixer->emit_walk_path($fixer->var, $path, sub {
-        my $var = shift;
-        $fixer->emit_get_key($var, $key, sub {
-            my $var = shift;
-            "${var} = join('', ${var}, $value) if is_value(${var});";
-        });
-    });
+    "join('', ${var}, $value) if is_value(${var});";
 }
 
 =head1 NAME
diff --git a/t/Catmandu-Fix-retain.t b/t/Catmandu-Fix-retain.t
index 6161a9b..031073e 100644
--- a/t/Catmandu-Fix-retain.t
+++ b/t/Catmandu-Fix-retain.t
@@ -7,7 +7,7 @@ use Test::Exception;
 
 my $pkg;
 BEGIN {
-    $pkg = 'Catmandu::Fix::retain_field';
+    $pkg = 'Catmandu::Fix::retain';
     use_ok $pkg;
 }
 

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-perl.git



More information about the Pkg-perl-cvs-commits mailing list