[libcatmandu-perl] 12/85: Simplyfying monads

Jonas Smedegaard dr at jones.dk
Tue May 20 09:56:15 UTC 2014


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 8ab600587abe1649df600f86422285b6e6525028
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date:   Fri May 9 12:06:19 2014 +0200

    Simplyfying monads
---
 lib/Catmandu/Fix/Bind.pm      |  3 +--
 lib/Catmandu/Fix/Bind/each.pm | 36 +++++++++++++++++++++++++++++-------
 2 files changed, 30 insertions(+), 9 deletions(-)

diff --git a/lib/Catmandu/Fix/Bind.pm b/lib/Catmandu/Fix/Bind.pm
index d089818..b8215e9 100644
--- a/lib/Catmandu/Fix/Bind.pm
+++ b/lib/Catmandu/Fix/Bind.pm
@@ -2,7 +2,6 @@ package Catmandu::Fix::Bind;
 
 use Moo::Role;
 use namespace::clean;
-use Data::Dumper;
 
 requires 'unit';
 requires 'bind';
@@ -46,7 +45,7 @@ sub emit_bind {
 
     my $bind_var = $fixer->capture($self);
     my $unit     = $fixer->generate_var;
-    
+
     $perl .= "my ${unit} = ${bind_var}->unit(${var});";
 
     for my $pair (@$code) { 
diff --git a/lib/Catmandu/Fix/Bind/each.pm b/lib/Catmandu/Fix/Bind/each.pm
index da37293..2d30e27 100644
--- a/lib/Catmandu/Fix/Bind/each.pm
+++ b/lib/Catmandu/Fix/Bind/each.pm
@@ -2,12 +2,13 @@ package Catmandu::Fix::Bind::each;
 
 use Moo;
 use Catmandu::Util qw(:data :is);
-use Data::Dumper;
 
 with 'Catmandu::Fix::Bind';
 
-has path  => (is => 'ro' , required => 1);
-has index => (is => 'ro');
+has path     => (is => 'ro' , required => 1);
+has index    => (is => 'ro');
+has values   => (is => 'rw', default => sub { [] });
+has promises => (is => 'rw', default => sub { [] });
 
 sub bind {
 	my ($self,$data,$code,$name) = @_;
@@ -15,13 +16,34 @@ sub bind {
 	my $value = data_at($self->path,$data);
 
 	if (defined $value && is_array_ref($value)) {
-		for my $i (@$value) {
-			$data->{$self->index} = $i if defined $self->index;
-			$data = $code->($data);
-		}
+		$self->values($value);
+		push @{$self->promises} , [$code,$name];
 	}
 
 	$data;
 }
 
+sub finally {
+	my ($self,$data) = @_;
+
+    for my $i (@{$self->values}) {
+    	for my $promise (@{$self->promises}) {
+    		my ($code,$name) = @$promise;
+    		if (defined $self->index) {
+   	  			$data->{$self->index} = $i;
+   	  		}
+	  		$data = $code->($data);
+    	}
+    }
+
+    if (defined $self->index) {
+    	delete $data->{$self->index};
+    }
+
+    $self->promises([]);
+    $self->values([]);
+
+    $data;
+}
+
 1;

-- 
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