[libcatmandu-perl] 03/85: Adding code to get working Binds by passing them as instances and class names

[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 c391ea81d712cb2d5ad95e463170efeb30ad3499
Author: Patrick Hochstenbach <patrick.hochstenb...@ugent.be>
Date:   Wed May 7 18:39:07 2014 +0200

    Adding code to get working Binds by passing them as instances and class
    names
---
 lib/Catmandu/Fix.pm | 42 ++++++++++++++++++++++++------------------
 1 file changed, 24 insertions(+), 18 deletions(-)

diff --git a/lib/Catmandu/Fix.pm b/lib/Catmandu/Fix.pm
index ad8b757..1f7d05e 100644
--- a/lib/Catmandu/Fix.pm
+++ b/lib/Catmandu/Fix.pm
@@ -26,6 +26,7 @@ has _captures   => (is => 'ro', lazy => 1, init_arg => undef, 
default => sub { +
 has var         => (is => 'ro', lazy => 1, init_arg => undef, builder => 
'generate_var');
 has fixes       => (is => 'ro', required => 1, trigger => 1);
 has binds       => (is => 'ro');
+has binder      => (is => 'lazy');
 has _reject     => (is => 'ro', init_arg => undef, default => sub { +{} });
 has _reject_var => (is => 'ro', lazy => 1, init_arg => undef, builder => 
'_build_reject_var');
 
@@ -58,6 +59,26 @@ sub _build_reject_var {
     $self->capture($self->_reject);
 }
 
+sub _build_binder {
+    my ($self) = @_;
+
+    return undef unless $self->binds;
+
+    my @real_binds = ();
+
+    for my $bind (@{$self->binds}) {
+        if (is_instance($bind)) {
+            push @real_binds , $bind;
+        }
+        elsif (is_string($bind)) {
+            my $instance = require_package($bind,'Catmandu::Fix::Bind')->new;
+            push @real_binds , $instance;
+        }    
+    }
+
+    \@real_binds;
+}
+
 sub fix {
     my ($self, $data) = @_;
 
@@ -116,6 +137,7 @@ sub emit {
     $perl .= $self->emit_declare_vars($var, '$_[0]');
     $perl .= "eval {";
 
+    # Loop over all the fixes and emit their code, binded to Binds if required
     $perl .= $self->emit_fixes($self->fixes);
 
     $perl .= "${var};";
@@ -163,13 +185,13 @@ sub emit_fixes {
     my ($self,$fixes) = @_;
     my $perl = '';
 
-    if ($self->binds) {
+    if ($self->binder) {
         # 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}) {
+        for my $bind (@{$self->binder}) {
             if (defined $bind_perl) {
                 $bind_perl = $self->emit_bind($bind,[[$bind , $bind_perl]]);
             }
@@ -216,22 +238,6 @@ sub emit_bind {
             $perl .= "},'$name');"
         }
     }
-    elsif (is_string($bind)) {
-        my $instance = require_package($bind,'Catmandu::Fix::Bind')->new;
-        my $bind_var = $self->capture($instance);
-        my $unit     = $self->generate_var;
-        $perl .= "my ${unit} = ${bind_var}->unit(${var});";
-
-        for my $pair (@$code) {
-            my $name = $pair->[0];
-            my $code = $pair->[1]; 
-            $perl .= "${var} = ${bind_var}->bind(${unit}, sub {";
-            $perl .= "${var} = shift;";
-            $perl .= $code;
-            $perl .= "${var}";
-            $perl .= "},'$name');"
-        }
-    }
 
     $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