This is an automated email from the git hooks/post-receive script.
js pushed a commit to tag 0.91
in repository libcatmandu-perl.
commit 892c3d8ff6fecc7c900dfb29c1ba7de04a432eff
Author: Patrick Hochstenbach <patrick.hochstenb...@ugent.be>
Date: Wed May 7 18:16:48 2014 +0200
Adding binds to the conditionals
---
lib/Catmandu/Fix.pm | 53 +++++++++++++++++------------
lib/Catmandu/Fix/Condition/SimpleAllTest.pm | 13 +++----
lib/Catmandu/Fix/Condition/SimpleAnyTest.pm | 10 +++---
lib/Catmandu/Fix/Condition/exists.pm | 11 +++---
4 files changed, 46 insertions(+), 41 deletions(-)
diff --git a/lib/Catmandu/Fix.pm b/lib/Catmandu/Fix.pm
index 90ec2b3..ad8b757 100644
--- a/lib/Catmandu/Fix.pm
+++ b/lib/Catmandu/Fix.pm
@@ -115,27 +115,9 @@ sub emit {
$perl .= "sub {";
$perl .= $self->emit_declare_vars($var, '$_[0]');
$perl .= "eval {";
- if ($self->binds) {
- # Loop over all 'Catmandu::Fix::Bind' an use the result
- # of a previous bind as input for a new bind. In this way
- # we are sure that every fix is executed once.
- my $code = [ map { [ref($_) , $self->emit_fix($_)] } @{$self->fixes} ];
- my $bind_perl = undef;
- for my $bind (@{$self->binds}) {
- if (defined $bind_perl) {
- $bind_perl = $self->emit_bind($bind,[[$bind , $bind_perl]]);
- }
- else {
- $bind_perl = $self->emit_bind($bind,$code);
- }
- }
- $perl .= $bind_perl;
- }
- else {
- for my $fix (@{$self->fixes}) {
- $perl .= $self->emit_fix($fix);
- }
- }
+
+ $perl .= $self->emit_fixes($self->fixes);
+
$perl .= "${var};";
$perl .= "} or do {";
$perl .= $self->emit_declare_vars($err, '$@');
@@ -177,6 +159,35 @@ sub emit {
$perl;
}
+sub emit_fixes {
+ my ($self,$fixes) = @_;
+ my $perl = '';
+
+ if ($self->binds) {
+ # Loop over all 'Catmandu::Fix::Bind' an use the result
+ # of a previous bind as input for a new bind. In this way
+ # we are sure that every fix is executed once.
+ my $code = [ map { [ref($_) , $self->emit_fix($_)] } @{$fixes} ];
+ my $bind_perl = undef;
+ for my $bind (@{$self->binds}) {
+ if (defined $bind_perl) {
+ $bind_perl = $self->emit_bind($bind,[[$bind , $bind_perl]]);
+ }
+ else {
+ $bind_perl = $self->emit_bind($bind,$code);
+ }
+ }
+ $perl .= $bind_perl;
+ }
+ else {
+ for my $fix (@{$fixes}) {
+ $perl .= $self->emit_fix($fix);
+ }
+ }
+
+ $perl;
+}
+
sub emit_reject {
my ($self) = @_;
my $reject_var = $self->_reject_var;
diff --git a/lib/Catmandu/Fix/Condition/SimpleAllTest.pm
b/lib/Catmandu/Fix/Condition/SimpleAllTest.pm
index 87af8e4..fe77144 100644
--- a/lib/Catmandu/Fix/Condition/SimpleAllTest.pm
+++ b/lib/Catmandu/Fix/Condition/SimpleAllTest.pm
@@ -19,11 +19,8 @@ sub emit {
my $fail_label;
my $fail_block = $fixer->emit_block(sub {
$fail_label = shift;
- my $perl = "";
- for my $fix (@$fail_fixes) {
- $perl .= $fixer->emit_fix($fix);
- }
- $perl;
+
+ $fixer->emit_fixes($fail_fixes);
});
my $has_match_var = $fixer->generate_var;
@@ -47,9 +44,9 @@ sub emit {
});
$perl .= "if (${has_match_var}) {";
- for my $fix (@$pass_fixes) {
- $perl .= $fixer->emit_fix($fix);
- }
+
+ $perl .= $fixer->emit_fixes($pass_fixes);
+
$perl .= "last ${label};";
$perl .= "}";
diff --git a/lib/Catmandu/Fix/Condition/SimpleAnyTest.pm
b/lib/Catmandu/Fix/Condition/SimpleAnyTest.pm
index b11dd87..1dc5788 100644
--- a/lib/Catmandu/Fix/Condition/SimpleAnyTest.pm
+++ b/lib/Catmandu/Fix/Condition/SimpleAnyTest.pm
@@ -18,18 +18,16 @@ sub emit {
$fixer->emit_get_key($var, $key, sub {
my $var = shift;
my $perl = "if (" . $self->emit_test($var) . ") {";
- for my $fix (@{$self->pass_fixes}) {
- $perl .= $fixer->emit_fix($fix);
- }
+
+ $perl .= $fixer->emit_fixes($self->pass_fixes);
+
$perl .= "last $label;";
$perl .= "}";
$perl;
});
});
- for my $fix (@{$self->fail_fixes}) {
- $perl .= $fixer->emit_fix($fix);
- }
+ $perl .= $fixer->emit_fixes($self->fail_fixes);
$perl;
}
diff --git a/lib/Catmandu/Fix/Condition/exists.pm
b/lib/Catmandu/Fix/Condition/exists.pm
index 8e1f1d0..f72d569 100644
--- a/lib/Catmandu/Fix/Condition/exists.pm
+++ b/lib/Catmandu/Fix/Condition/exists.pm
@@ -23,17 +23,16 @@ sub emit {
$perl .= "is_hash_ref(${var}) && exists(${var}->{${str_key}})";
}
$perl .= ") {";
- for my $fix (@{$self->pass_fixes}) {
- $perl .= $fixer->emit_fix($fix);
- }
+
+ $perl .= $fixer->emit_fixes($self->pass_fixes);
+
$perl .= "last $label;";
$perl .= "}";
$perl;
});
- for my $fix (@{$self->fail_fixes}) {
- $perl .= $fixer->emit_fix($fix);
- }
+ $perl .= $fixer->emit_fixes($self->fail_fixes);
+
$perl;
}
--
Alioth's /usr/local/bin/git-commit-notice on
/srv/git.debian.org/git/pkg-perl/packages/libcatmandu-perl.git
_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
