normalize path update arguments

LibreCat · Jun 6, 2018 · 2ec557d · 2ec557d
1 parent b065a8c
commit 2ec557d
Show file tree

Hide file tree

Showing 8 changed files with 56 additions and 45 deletions.
diff --git a/lib/Catmandu/Emit.pm b/lib/Catmandu/Emit.pm
@@ -136,8 +136,7 @@ sub _emit_assign {
             $l_var = "${up_var}->[${index}]";
         }
         else {
-            Catmandu::BadArg->throw(
-                'up_var without key or index');
+            Catmandu::BadArg->throw('up_var without key or index');
         }
     }
     "${l_var} = ${val};";
@@ -158,8 +157,7 @@ sub _emit_delete {
         "splice(\@{${up_var}}, ${idx}, 1)";
     }
     else {
-        Catmandu::BadArg->throw(
-            'up_var without key or index');
+        Catmandu::BadArg->throw('up_var without key or index');
     }
 }
 

diff --git a/lib/Catmandu/Fix/Condition/is_false.pm b/lib/Catmandu/Fix/Condition/is_false.pm
@@ -24,9 +24,9 @@ sub _build_value_tester {
     else {
         sub {
             my $val = $_[0];
-            (is_bool($val) && !$val) || (is_number($val) && $val == 0) || (
-                is_string($val) && $val eq 'false'
-                );
+            (is_bool($val) && !$val)
+                || (is_number($val) && $val == 0)
+                || (is_string($val) && $val eq 'false');
         };
     }
 }

diff --git a/lib/Catmandu/Fix/Condition/is_true.pm b/lib/Catmandu/Fix/Condition/is_true.pm
@@ -24,9 +24,9 @@ sub _build_value_tester {
     else {
         sub {
             my $val = $_[0];
-            (is_bool($val) && $val) || (is_number($val) && $val == 1) || (
-                is_string($val) && $val eq 'true'
-                );
+            (is_bool($val) && $val)
+                || (is_number($val) && $val == 1)
+                || (is_string($val) && $val eq 'true');
         };
     }
 }

diff --git a/lib/Catmandu/Fix/error.pm b/lib/Catmandu/Fix/error.pm
@@ -24,8 +24,7 @@ sub _build_fixer {
             my $vals = $getter->($data);
             @$vals || return $data;
             my $str = join "\n", grep {is_value($_)} @$vals;
-            Catmandu::Error->throw(
-                $str);
+            Catmandu::Error->throw($str);
         };
     }
     else {

diff --git a/lib/Catmandu/Path.pm b/lib/Catmandu/Path.pm
@@ -4,6 +4,7 @@ use Catmandu::Sane;
 
 our $VERSION = '1.0606';
 
+use Catmandu::Util qw(is_array_ref is_code_ref);
 use Moo::Role;
 
 has path => (is => 'ro', required => 1);
@@ -14,4 +15,28 @@ requires 'creator';
 requires 'updater';
 requires 'deleter';
 
+around updater => sub {
+    my $orig = shift;
+    my $self = shift;
+    my %opts = @_ == 1 ? (value => $_[0]) : @_;
+
+    for my $key (keys %opts) {
+        my $val = $opts{$key};
+        next unless $key =~ s/^if_//;
+        push @{$opts{if} ||= []}, $key, $val;
+    }
+
+    if (my $tests = $opts{if}) {
+        for (my $i = 0; $i < @$tests; $i += 2) {
+            my $test = $tests->[$i];
+            $test = [$test] unless is_array_ref($test);
+            $tests->[$i]
+                = [map {is_code_ref($_) ? $_ : Catmandu::Util->can("is_$_")}
+                    @$test];
+        }
+    }
+
+    $orig->($self, %opts);
+};
+
 1;
diff --git a/lib/Catmandu/Path/default.pm b/lib/Catmandu/Path/default.pm
@@ -4,8 +4,7 @@ use Catmandu::Sane;
 
 our $VERSION = '1.0606';
 
-use Catmandu::Util
-    qw(is_hash_ref is_array_ref is_value is_string is_code_ref trim);
+use Catmandu::Util qw(is_hash_ref is_array_ref is_value is_code_ref trim);
 use Moo;
 use namespace::clean;
 
@@ -86,37 +85,29 @@ sub setter {
 }
 
 sub updater {
-    my $self     = shift;
-    my %opts     = @_ == 1 ? (value => $_[0]) : @_;
+    my ($self, %opts) = @_;
     my $path     = $self->split_path;
     my $data_var = $self->_generate_var;
     my $captures = {};
     my $args     = [$data_var];
     my $cb;
 
-    my $predicates = $opts{if};
-    for my $key (keys %opts) {
-        my $val = $opts{$key};
-        next unless $key =~ s/^if_//;
-        push @{$predicates ||= []}, $key => $val;
-    }
-
-    if ($predicates) {
+    if (my $tests = $opts{if}) {
         $cb = sub {
             my ($var, %opts) = @_;
             my $perl = "";
-            for (my $i = 0; $i < @$predicates; $i += 2) {
-                my $pred    = $predicates->[$i];
-                my $val     = $predicates->[$i + 1];
-                my $val_var = $self->_generate_var;
-                $captures->{$val_var} = $val;
-                $pred = [$pred] if is_string($pred);
+            for (my $i = 0; $i < @$tests; $i += 2) {
+                my $test     = $tests->[$i];
+                my $val      = $tests->[$i + 1];
+                my $test_var = $self->_generate_var;
+                my $val_var  = $self->_generate_var;
+                $captures->{$test_var} = $test;
+                $captures->{$val_var}  = $val;
                 if ($i) {
                     $perl .= 'els';
                 }
                 $perl
-                    .= 'if ('
-                    . join(' || ', map {"is_${_}(${var})"} @$pred) . ') {'
+                    .= "if (List::Util::any {\$_->(${var})} \@{${test_var}}) {"
                     . $self->_emit_assign_cb($var, $val_var, %opts) . '}';
             }
             $perl;

diff --git a/lib/Catmandu/Path/mock.pm b/lib/Catmandu/Path/mock.pm
@@ -4,7 +4,7 @@ use Catmandu::Sane;
 
 our $VERSION = '1.0606';
 
-use Catmandu::Util qw(is_code_ref is_string);
+use Catmandu::Util qw(is_code_ref);
 use List::Util qw(any);
 use Moo;
 use namespace::clean;
@@ -63,24 +63,21 @@ sub creator {    # same as setter in this simple case
 }
 
 sub updater {
-    my $self = shift;
-    my %opts = @_ == 1 ? (value => $_[0]) : @_;
-    my $key  = $self->path;
+    my ($self, %opts) = @_;
+    my $key = $self->path;
 
-    if (my $predicates = $opts{if}) {
+    if (my $tests = $opts{if}) {
         return sub {
             my $data = $_[0];
 
             return unless exists $data->{$key};
 
             my $value = $data->{$key};
 
-            for (my $i = 0; $i < @$predicates; $i += 2) {
-                my $tests = $predicates->[$i];
-                my $cb    = $predicates->[$i + 1];
-                $tests = [$tests] if is_string($tests);
-                $tests = [map {Catmandu::Util->can("is_$_")} @$tests];
-                next unless any {$_->($value)} @$tests;
+            for (my $i = 0; $i < @$tests; $i += 2) {
+                my $test = $tests->[$i];
+                my $cb   = $tests->[$i + 1];
+                next unless any {$_->($value)} @$test;
                 $data->{$key} = $cb->($value);
                 last;
             }

diff --git a/lib/Catmandu/Util/Path.pm b/lib/Catmandu/Util/Path.pm
@@ -15,7 +15,7 @@ our @EXPORT_OK = qw(
 
 our %EXPORT_TAGS = (all => \@EXPORT_OK,);
 
-sub looks_like_path { # TODO only recognizes Catmandu::Path::default
+sub looks_like_path {    # TODO only recognizes Catmandu::Path::default
     my ($path) = @_;
     is_string($path) && $path =~ /^\$[\.\/]/ ? 1 : 0;
 }
@@ -25,7 +25,8 @@ sub as_path {
     if (is_value($path)) {
         $path_type //= 'default';
         state $class_cache = {};
-        my $class = $class_cache->{$path_type} ||= require_package($path_type, 'Catmandu::Path');
+        my $class = $class_cache->{$path_type}
+            ||= require_package($path_type, 'Catmandu::Path');
         $class->new(path => $path);
     }
     else {