[libcatmandu-perl] 14/16: remove more fix boilerplate
Jonas Smedegaard
dr at jones.dk
Thu Dec 4 14:43:17 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 dab79f79736bb7f4a42f3f9357097398b4bfc529
Author: Nicolas Steenlant <nicolas.steenlant at ugent.be>
Date: Thu Dec 4 11:42:50 2014 +0100
remove more fix boilerplate
---
lib/Catmandu/Fix/add_to_store.pm | 29 +++++------
lib/Catmandu/Fix/sort_field.pm | 101 ++++++++++++++++++---------------------
lib/Catmandu/Fix/split_field.pm | 18 ++-----
lib/Catmandu/Fix/substring.pm | 32 +++++--------
lib/Catmandu/Fix/sum.pm | 24 ++++------
lib/Catmandu/Fix/to_json.pm | 30 +++++-------
6 files changed, 95 insertions(+), 139 deletions(-)
diff --git a/lib/Catmandu/Fix/add_to_store.pm b/lib/Catmandu/Fix/add_to_store.pm
index 0cc44ab..c171ac5 100644
--- a/lib/Catmandu/Fix/add_to_store.pm
+++ b/lib/Catmandu/Fix/add_to_store.pm
@@ -5,14 +5,15 @@ use Catmandu;
use Moo;
use Catmandu::Fix::Has;
-with 'Catmandu::Fix::Base';
-
has path => (fix_arg => 1);
has store_name => (fix_arg => 1);
has bag_name => (fix_opt => 1, init_arg => 'bag');
has store_args => (fix_opt => 'collect');
has store => (is => 'lazy', init_arg => undef);
has bag => (is => 'lazy', init_arg => undef);
+has _bag_var => (is => 'rwp', writer => '_set_bag_var', init_arg => undef);
+
+with 'Catmandu::Fix::SimpleGetValue';
sub _build_store {
my ($self) = @_;
@@ -26,21 +27,15 @@ sub _build_bag {
: $self->store->bag;
}
-sub emit {
- my ($self, $fixer) = @_;
- my $path = $fixer->split_path($self->path);
- my $key = pop @$path;
- my $bag_var = $fixer->capture($self->bag);
-
- $fixer->emit_walk_path($fixer->var, $path, sub {
- my $var = shift;
- $fixer->emit_get_key($var, $key, sub {
- my $val_var = shift;
- "if (is_hash_ref(${val_var})) {" .
- "${bag_var}->add(${val_var});" .
- "}";
- });
- });
+sub emit_value {
+ my ($self, $var, $fixer) = @_;
+ # memoize in case called multiple times
+ my $bag_var = $self->_bag_var ||
+ $self->_set_bag_var($fixer->capture($self->bag));
+
+ "if (is_hash_ref(${var})) {" .
+ "${bag_var}->add(${var});" .
+ "}";
}
=head1 NAME
diff --git a/lib/Catmandu/Fix/sort_field.pm b/lib/Catmandu/Fix/sort_field.pm
index 6d9ac67..79b8c64 100644
--- a/lib/Catmandu/Fix/sort_field.pm
+++ b/lib/Catmandu/Fix/sort_field.pm
@@ -5,68 +5,59 @@ use List::MoreUtils ();
use Moo;
use Catmandu::Fix::Has;
-with 'Catmandu::Fix::Base';
-
has path => (fix_arg => 1);
has uniq => (fix_opt => 1);
has reverse => (fix_opt => 1);
has numeric => (fix_opt => 1);
-has undef_position => (fix_opt => 1, default => sub { "last"; });
+has undef_position => (fix_opt => 1, default => sub { 'last' });
-sub emit {
- my ($self, $fixer) = @_;
- my $path = $fixer->split_path($self->path);
- my $key = pop @$path;
- my $comparer = $self->numeric ? "<=>" : "cmp";
+with 'Catmandu::Fix::SimpleGetValue';
- $fixer->emit_walk_path($fixer->var, $path, sub {
- my $var = shift;
- $fixer->emit_get_key($var, $key, sub {
- my $var = shift;
- my $perl = "if (is_array_ref(${var})) {";
-
- #filter out undef
- my $undef_values = $fixer->generate_var();
- $perl .= "my ${undef_values} = [ grep { !defined(\$_) } \@{${var}} ];";
- $perl .= "${var} = [ grep { defined(\$_) } \@{${var}} ];";
-
- #uniq
- if ($self->uniq) {
- $perl .= "${var} = [List::MoreUtils::uniq(\@{${var}})];";
- }
-
- #sort
- if ($self->reverse) {
- $perl .= "${var} = [sort { \$b $comparer \$a } \@{${var}}];";
- } else {
- $perl .= "${var} = [sort { \$a $comparer \$b } \@{${var}}];";
- }
-
- #insert undef at the end
- if($self->undef_position eq "last"){
- if($self->uniq){
- $perl .= "push \@{${var}},undef if scalar(\@{${undef_values}});";
- }
- else{
- $perl .= "push \@{${var}},\@{${undef_values}};";
- }
- }
- #insert undef at the beginning
- elsif($self->undef_position eq "first"){
- if($self->uniq){
- $perl .= "unshift \@{${var}},undef if scalar(\@{${undef_values}});";
- }
- else{
- $perl .= "unshift \@{${var}},\@{${undef_values}};";
- }
- }
- #leave undef out of the list
-
- $perl .= "}";
- $perl;
- });
- });
+sub emit_value {
+ my ($self, $var, $fixer) = @_;
+ my $comparer = $self->numeric ? "<=>" : "cmp";
+ my $perl = "if (is_array_ref(${var})) {";
+
+ #filter out undef
+ my $undef_values = $fixer->generate_var;
+ $perl .= "my ${undef_values} = [ grep { !defined(\$_) } \@{${var}} ];";
+ $perl .= "${var} = [ grep { defined(\$_) } \@{${var}} ];";
+
+ #uniq
+ if ($self->uniq) {
+ $perl .= "${var} = [List::MoreUtils::uniq(\@{${var}})];";
+ }
+
+ #sort
+ if ($self->reverse) {
+ $perl .= "${var} = [sort { \$b $comparer \$a } \@{${var}}];";
+ } else {
+ $perl .= "${var} = [sort { \$a $comparer \$b } \@{${var}}];";
+ }
+
+ #insert undef at the end
+ if($self->undef_position eq "last"){
+ if($self->uniq){
+ $perl .= "push \@{${var}},undef if scalar(\@{${undef_values}});";
+ }
+ else{
+ $perl .= "push \@{${var}},\@{${undef_values}};";
+ }
+ }
+ #insert undef at the beginning
+ elsif($self->undef_position eq "first"){
+ if($self->uniq){
+ $perl .= "unshift \@{${var}},undef if scalar(\@{${undef_values}});";
+ }
+ else{
+ $perl .= "unshift \@{${var}},\@{${undef_values}};";
+ }
+ }
+ #leave undef out of the list
+
+ $perl .= "}";
+ $perl;
}
=head1 NAME
diff --git a/lib/Catmandu/Fix/split_field.pm b/lib/Catmandu/Fix/split_field.pm
index d87fed7..d7bcf18 100644
--- a/lib/Catmandu/Fix/split_field.pm
+++ b/lib/Catmandu/Fix/split_field.pm
@@ -4,24 +4,16 @@ use Catmandu::Sane;
use Moo;
use Catmandu::Fix::Has;
-with 'Catmandu::Fix::Base';
-
has path => (fix_arg => 1);
has split_char => (fix_arg => 1, default => sub { qr'\s+' });
-sub emit {
- my ($self, $fixer) = @_;
- my $path = $fixer->split_path($self->path);
- my $key = pop @$path;
+with 'Catmandu::Fix::SimpleGetValue';
+
+sub emit_value {
+ my ($self, $var, $fixer) = @_;
my $split_char = $fixer->emit_string($self->split_char);
- $fixer->emit_walk_path($fixer->var, $path, sub {
- my $var = shift;
- $fixer->emit_get_key($var, $key, sub {
- my $var = shift;
- "${var} = [split ${split_char}, ${var}] if is_value(${var});";
- });
- });
+ "${var} = [split ${split_char}, ${var}] if is_value(${var});";
}
=head1 NAME
diff --git a/lib/Catmandu/Fix/substring.pm b/lib/Catmandu/Fix/substring.pm
index 3739457..f87b013 100644
--- a/lib/Catmandu/Fix/substring.pm
+++ b/lib/Catmandu/Fix/substring.pm
@@ -4,32 +4,24 @@ use Catmandu::Sane;
use Moo;
use Catmandu::Fix::Has;
-with 'Catmandu::Fix::Base';
-
has path => (fix_arg => 1);
has args => (fix_arg => 'collect');
-sub emit {
- my ($self, $fixer) = @_;
- my $path = $fixer->split_path($self->path);
- my $key = pop @$path;
+with 'Catmandu::Fix::SimpleGetValue';
+
+sub emit_value {
+ my ($self, $var, $fixer) = @_;
my $args = $self->args;
my $str_args = @$args > 1 ? join(", ", @$args[0, 1]) : $args->[0];
- $fixer->emit_walk_path($fixer->var, $path, sub {
- my $var = shift;
- $fixer->emit_get_key($var, $key, sub {
- my $var = shift;
- if (@$args < 3) {
- return "eval { ${var} = substr(as_utf8(${var}), ${str_args}) } if is_value(${var});";
- }
- my $replace = $fixer->emit_string($args->[2]);
- "if (is_value(${var})) {"
- ."utf8::upgrade(${var});"
- ."eval { substr(${var}, ${str_args}) = ${replace} };"
- ."}";
- });
- });
+ if (@$args < 3) {
+ return "eval { ${var} = substr(as_utf8(${var}), ${str_args}) } if is_value(${var});";
+ }
+ my $replace = $fixer->emit_string($args->[2]);
+ "if (is_value(${var})) {"
+ ."utf8::upgrade(${var});"
+ ."eval { substr(${var}, ${str_args}) = ${replace} };"
+ ."}";
}
=head1 NAME
diff --git a/lib/Catmandu/Fix/sum.pm b/lib/Catmandu/Fix/sum.pm
index 7176c33..5a52459 100644
--- a/lib/Catmandu/Fix/sum.pm
+++ b/lib/Catmandu/Fix/sum.pm
@@ -5,24 +5,16 @@ use List::Util ();
use Moo;
use Catmandu::Fix::Has;
-with 'Catmandu::Fix::Base';
-
has path => (fix_arg => 1);
-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;
- "if (is_array_ref(${var})) {" .
- "${var} = List::Util::sum(\@{${var}}) // 0;" .
- "}";
- });
- });
+with 'Catmandu::Fix::SimpleGetValue';
+
+sub emit_value {
+ my ($self, $var) = @_;
+
+ "if (is_array_ref(${var})) {" .
+ "${var} = List::Util::sum(\@{${var}}) // 0;" .
+ "}";
}
=head1 NAME
diff --git a/lib/Catmandu/Fix/to_json.pm b/lib/Catmandu/Fix/to_json.pm
index b9db99b..efc97d0 100644
--- a/lib/Catmandu/Fix/to_json.pm
+++ b/lib/Catmandu/Fix/to_json.pm
@@ -5,26 +5,20 @@ use JSON::XS ();
use Moo;
use Catmandu::Fix::Has;
-with 'Catmandu::Fix::Base';
-
has path => (fix_arg => 1);
+has _json_var => (is => 'rwp', writer => '_set_json_var', init_arg => undef);
+
+with 'Catmandu::Fix::SimpleGetValue';
+
+sub emit_value {
+ my ($self, $var, $fixer) = @_;
+ # memoize in case called multiple times
+ my $json_var = $self->_json_var ||
+ $self->_set_json_var($fixer->capture(JSON::XS->new->utf8(0)->pretty(0)->allow_nonref(1)));
-sub emit {
- my ($self, $fixer) = @_;
- my $path = $fixer->split_path($self->path);
- my $key = pop @$path;
-
- my $json_var = $fixer->capture(JSON::XS->new->utf8(0)->pretty(0)->allow_nonref(1));
-
- $fixer->emit_walk_path($fixer->var, $path, sub {
- my $var = shift;
- $fixer->emit_get_key($var, $key, sub {
- my $var = shift;
- "if (is_maybe_value(${var}) || is_array_ref(${var}) || is_hash_ref(${var})) {" .
- "${var} = ${json_var}->encode(${var});" .
- "}";
- });
- });
+ "if (is_maybe_value(${var}) || is_array_ref(${var}) || is_hash_ref(${var})) {" .
+ "${var} = ${json_var}->encode(${var});" .
+ "}";
}
=head1 NAME
--
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