fix builder cancel and delete; lookup fix builder version

LibreCat · Oct 20, 2017 · 3575553 · 3575553
1 parent f29d031
commit 3575553
Show file tree

Hide file tree

Showing 5 changed files with 60 additions and 55 deletions.
diff --git a/lib/Catmandu/Emit.pm b/lib/Catmandu/Emit.pm
@@ -79,6 +79,22 @@ sub _emit_iterate_hash {
     $perl;
 }
 
+sub _emit_assign_cb {
+    my ($self, $var, $cb_var, %opts) = @_;
+    my $val_var    = $self->_generate_var;
+    my $cancel_var = $self->_generate_var;
+    my $delete_var = $self->_generate_var;
+    my $perl       = "";
+    $perl
+        .= "my (${val_var}, ${cancel_var}, ${delete_var}) = ${cb_var}->(${var});";
+    $perl .= "if (${delete_var}) {";
+    $perl .= $self->_emit_delete(%opts);
+    $perl .= "} elsif (!${cancel_var}) {";
+    $perl .= $self->_emit_assign($var, $val_var, %opts);
+    $perl .= "}";
+    $perl;
+}
+
 sub _emit_assign {
     my ($self, $var, $val, %opts) = @_;
     my $l_var  = $var;
@@ -92,6 +108,17 @@ sub _emit_assign {
     "${l_var} = ${val};";
 }
 
+sub _emit_delete {
+    my ($self, %opts) = @_;
+    my $up_var = $opts{up_var};
+    if (my $key = $opts{key}) {
+        return "delete ${up_var}->{${key}}";
+    }
+    elsif (my $index = $opts{index}) {
+        return "splice(\@{${up_var}}, ${index}, 1)";
+    }
+}
+
 sub _emit_value {
     my ($self, $val) = @_;
     return 'undef' unless defined $val;

diff --git a/lib/Catmandu/Fix/capitalize.pm b/lib/Catmandu/Fix/capitalize.pm
@@ -9,10 +9,10 @@ use Catmandu::Util qw(as_path as_utf8);
 use namespace::clean;
 use Catmandu::Fix::Has;
 
-has path => (fix_arg => 1);
-
 with 'Catmandu::Fix::Builder';
 
+has path => (fix_arg => 1);
+
 sub _build_fixer {
     my ($self) = @_;
     as_path($self->path)

diff --git a/lib/Catmandu/Fix/lookup.pm b/lib/Catmandu/Fix/lookup.pm
@@ -5,15 +5,16 @@ use Catmandu::Sane;
 our $VERSION = '1.0606';
 
 use Catmandu::Importer::CSV;
+use Catmandu::Util qw(is_value as_path);
 use Moo;
 use namespace::clean;
 use Catmandu::Fix::Has;
 
-with 'Catmandu::Fix::Base';
+with 'Catmandu::Fix::Builder';
 
 has path       => (fix_arg => 1);
 has file       => (fix_arg => 1);
-has default    => (fix_opt => 1);
+has default    => (fix_opt => 1, predicate => 1);
 has delete     => (fix_opt => 1);
 has csv_args   => (fix_opt => 'collect');
 has dictionary => (is      => 'lazy', init_arg => undef);
@@ -35,48 +36,26 @@ sub _build_dictionary {
         );
 }
 
-sub emit {
-    my ($self, $fixer) = @_;
-    my $path     = $fixer->split_path($self->path);
-    my $key      = pop @$path;
-    my $dict_var = $fixer->capture($self->dictionary);
-    my $delete   = $self->delete;
-    my $default  = $self->default;
-
-    $fixer->emit_walk_path(
-        $fixer->var,
-        $path,
+sub _build_fixer {
+    my ($self)      = @_;
+    my $path        = as_path($self->path);
+    my $dict        = $self->dictionary;
+    my $has_default = $self->has_default;
+    my $default     = $self->default;
+    my $delete      = $self->delete;
+    $path->updater(
         sub {
-            my $var = shift;
-            $fixer->emit_get_key(
-                $var, $key,
-                sub {
-                    my $val_var      = shift;
-                    my $val_index    = shift;
-                    my $dict_val_var = $fixer->generate_var;
-                    my $perl
-                        = "if (is_value(${val_var}) && defined(my ${dict_val_var} = ${dict_var}->{${val_var}})) {"
-                        . "${val_var} = ${dict_val_var};" . "}";
-                    if ($delete) {
-                        $perl .= "else {";
-                        if (defined $val_index)
-                        { # wildcard: only delete the value where the lookup failed
-                            $perl .= "splice(\@{${var}}, ${val_index}--, 1);";
-                        }
-                        else {
-                            $perl .= $fixer->emit_delete_key($var, $key);
-                        }
-                        $perl .= "}";
-                    }
-                    elsif (defined $default) {
-                        $perl
-                            .= "else {"
-                            . "${val_var} = "
-                            . $fixer->emit_value($default) . ";" . "}";
-                    }
-                    $perl;
-                }
-            );
+            my $val = $_[0];
+            if (is_value($val) && defined(my $new_val = $dict->{$val})) {
+                return $new_val;
+            }
+            elsif ($delete) {
+                return undef, 1, 1;
+            }
+            elsif ($has_default) {
+                return $default;
+            }
+            return undef, 1, 0;
         }
     );
 }

diff --git a/lib/Catmandu/Fix/rename.pm b/lib/Catmandu/Fix/rename.pm
@@ -16,7 +16,7 @@ has replace => (fix_arg => 1);
 with 'Catmandu::Fix::Builder';
 
 sub _build_fixer {
-    my ($self) = @_;
+    my ($self)  = @_;
     my $search  = $self->search;
     my $replace = $self->replace;
     my $renamer;

diff --git a/lib/Catmandu/Path/default.pm b/lib/Catmandu/Path/default.pm
@@ -48,8 +48,8 @@ sub getter {
 }
 
 sub setter {
-    my $self = shift;
-    my %opts = @_ == 1 ? (value => $_[0]) : @_;
+    my $self     = shift;
+    my %opts     = @_ == 1 ? (value => $_[0]) : @_;
     my $path     = $self->split_path;
     my $key      = pop @$path;
     my $data_var = $self->_generate_var;
@@ -83,8 +83,8 @@ sub setter {
 }
 
 sub updater {
-    my $self = shift;
-    my %opts = @_ == 1 ? (value => $_[0]) : @_;
+    my $self     = shift;
+    my %opts     = @_ == 1 ? (value => $_[0]) : @_;
     my $path     = $self->split_path;
     my $data_var = $self->_generate_var;
     my $captures = {};
@@ -107,8 +107,7 @@ sub updater {
                 $perl
                     .= 'if ('
                     . join(' || ', map {"is_${_}(${var})"} @$pred) . ') {'
-                    . $self->_emit_assign($var, "${val_var}->(${var})", %opts)
-                    . '}';
+                    . $self->_emit_assign_cb($var, $val_var, %opts) . '}';
             }
             $perl;
         };
@@ -123,7 +122,7 @@ sub updater {
         }
         $cb = sub {
             my ($var, %opts) = @_;
-            $self->_emit_assign($var, "${val_var}->(${var})", %opts);
+            $self->_emit_assign_cb($var, $val_var, %opts);
         };
     }
 
@@ -133,8 +132,8 @@ sub updater {
 }
 
 sub creator {
-    my $self = shift;
-    my %opts = @_ == 1 ? (value => $_[0]) : @_;
+    my $self     = shift;
+    my %opts     = @_ == 1 ? (value => $_[0]) : @_;
     my $path     = $self->split_path;
     my $data_var = $self->_generate_var;
     my $val_var  = $self->_generate_var;