[libcatmandu-perl] 08/85: Adding an eval monad to debug individual fixes

[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 374d979d1479e7f2afa7285f567eb498fe0e19ec
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date:   Thu May 8 14:59:34 2014 +0200

    Adding an eval monad to debug individual fixes
---
 lib/Catmandu/Fix.pm           |  3 ++-
 lib/Catmandu/Fix/Bind.pm      |  7 ++++---
 lib/Catmandu/Fix/Bind/eval.pm | 22 ++++++++++++++++++++++
 3 files changed, 28 insertions(+), 4 deletions(-)

diff --git a/lib/Catmandu/Fix.pm b/lib/Catmandu/Fix.pm
index fc3230b..411cd0f 100644
--- a/lib/Catmandu/Fix.pm
+++ b/lib/Catmandu/Fix.pm
@@ -218,11 +218,12 @@ sub emit_bind {
         for my $pair (@$code) { 
             my $name = $pair->[0];
             my $code = $pair->[1]; 
+            my $code_var = $self->capture($code);
             $perl .= "${var} = ${bind_var}->bind(${unit}, sub {";
             $perl .= "${var} = shift;";
             $perl .= $code;
             $perl .= "${var}";
-            $perl .= "},'$name');"
+            $perl .= "},'$name',${code_var});"
         }
     }
 
diff --git a/lib/Catmandu/Fix/Bind.pm b/lib/Catmandu/Fix/Bind.pm
index 692c1b2..3c3e1c4 100644
--- a/lib/Catmandu/Fix/Bind.pm
+++ b/lib/Catmandu/Fix/Bind.pm
@@ -90,17 +90,18 @@ Catmandu::Fix::Bind instance before all Fix methods are executed. A trivial impl
       return $data;
   }
 
-=head2 bind($data,$code,$name)
+=head2 bind($data,$code,$name,$perl)
 
 The bind method is executed for every Catmandu::Fix method in the fixer. It receives the $data
-, which as wrapped by unit, the fix method as anonymous subroutine and the name of the fix. It should
-return the fixed code. A trivial implementaion of 'bind' is:
+, which as wrapped by unit, the fix method as anonymous subroutine, the name of the fix and the actual perl
+code to run it. It should return the fixed code. A trivial implementaion of 'bind' is:
 
   sub bind {
 	  my ($self,$data,$code,$name) = @_;
 	  return $code->($data);
   } 
 
+
 =head1 SEE ALSO
 
 L<Catmandu::Fix>
diff --git a/lib/Catmandu/Fix/Bind/eval.pm b/lib/Catmandu/Fix/Bind/eval.pm
new file mode 100644
index 0000000..8d67141
--- /dev/null
+++ b/lib/Catmandu/Fix/Bind/eval.pm
@@ -0,0 +1,22 @@
+package Catmandu::Fix::Bind::eval;
+
+use Moo;
+use Data::Dumper;
+
+with 'Catmandu::Fix::Bind';
+
+sub bind {
+	my ($self,$data,$code,$name,$perl) = @_;
+	
+	eval {
+		$data = $code->($data);
+	};
+	if ($@) {
+		warn "$name $perl";
+		die "Fix: $name threw an error: $@";
+	}
+
+	$data
+}
+
+1;
\ No newline at end of file

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