[libcatmandu-perl] 04/85: Fixing nested bind bug

[Jonas Smedegaard]

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 7fee62a275d6c35f12e9cbb716d54de819598e2c
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date:   Thu May 8 06:22:31 2014 +0200

    Fixing nested bind bug
---
 lib/Catmandu/Fix.pm | 30 ++++++++++++++++++++++--------
 1 file changed, 22 insertions(+), 8 deletions(-)

diff --git a/lib/Catmandu/Fix.pm b/lib/Catmandu/Fix.pm
index 1f7d05e..adc9205 100644
--- a/lib/Catmandu/Fix.pm
+++ b/lib/Catmandu/Fix.pm
@@ -181,6 +181,7 @@ sub emit {
     $perl;
 }
 
+# Emit an array of fixes
 sub emit_fixes {
     my ($self,$fixes) = @_;
     my $perl = '';
@@ -189,16 +190,21 @@ sub emit_fixes {
         # 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;
+        my $prev_bind = undef;
         for my $bind (@{$self->binder}) {
             if (defined $bind_perl) {
-                $bind_perl = $self->emit_bind($bind,[[$bind , $bind_perl]]);
+                $bind_perl = $self->emit_bind($bind,[[$prev_bind , $bind_perl]]);
             }
             else {
                 $bind_perl = $self->emit_bind($bind,$code);
             }
+            $prev_bind = ref $bind;
         }
+        
         $perl .= $bind_perl;
     }
     else {
@@ -210,12 +216,14 @@ sub emit_fixes {
     $perl;
 }
 
-sub emit_reject {
-    my ($self) = @_;
-    my $reject_var = $self->_reject_var;
-    "return $reject_var;";
-}
-
+# Wrap an array of fix names and code in bind a bind
+# 
+# $bind : a Catmandu::Fix::Bind
+# $code : array of [ $name , $perl] 
+# 
+# where
+#       $name : name of a fix
+#       $perl : perl code of a fix
 sub emit_bind {
     my ($self,$bind,$code) = @_;
 
@@ -223,7 +231,7 @@ sub emit_bind {
 
     my $perl = "";
 
-    if (is_instance($bind)) {
+    if (is_instance($bind) && $bind->can('unit') && $bind->can('bind')) {
         my $bind_var = $self->capture($bind);
         my $unit     = $self->generate_var;
         $perl .= "my ${unit} = ${bind_var}->unit(${var});";
@@ -242,6 +250,12 @@ sub emit_bind {
     $perl;
 }
 
+sub emit_reject {
+    my ($self) = @_;
+    my $reject_var = $self->_reject_var;
+    "return $reject_var;";
+}
+
 sub emit_fix {
     my ($self, $fix) = @_;
     my $perl;

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