[libcatmandu-perl] 09/85: Adding the benchmark and loop monad

[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 b5b9a39e767a62280637e65b7f70b32e19eb791e
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date:   Thu May 8 16:26:18 2014 +0200

    Adding the benchmark and loop monad
---
 lib/Catmandu/Fix/Bind/benchmark.pm | 50 ++++++++++++++++++++++++++++++++++++++
 lib/Catmandu/Fix/Bind/eval.pm      |  7 ++++--
 lib/Catmandu/Fix/Bind/loop.pm      | 23 ++++++++++++++++++
 3 files changed, 78 insertions(+), 2 deletions(-)

diff --git a/lib/Catmandu/Fix/Bind/benchmark.pm b/lib/Catmandu/Fix/Bind/benchmark.pm
new file mode 100644
index 0000000..06eb964
--- /dev/null
+++ b/lib/Catmandu/Fix/Bind/benchmark.pm
@@ -0,0 +1,50 @@
+package Catmandu::Fix::Bind::benchmark;
+
+use Moo;
+use Data::Dumper;
+use Time::HiRes qw(gettimeofday tv_interval);
+
+with 'Catmandu::Fix::Bind';
+
+has stats => (is => 'lazy');
+
+sub _build_stats {
+	+{};
+}
+
+sub bind {
+   my ($self,$data,$code,$name) = @_;
+   
+   my $t0 = [gettimeofday];
+   $data = $code->($data);
+   my $elapsed = tv_interval ( $t0 );
+
+   $self->stats->{$name}->{count}   += 1;
+   $self->stats->{$name}->{elapsed} += $elapsed;
+
+   $data;
+}
+
+sub DESTROY {
+	my ($self) = @_;
+
+	printf STDERR "%-8.8s\t%-40.40s\t%-8.8s\t%-8.8s\n"
+					, 'elapsed'
+					, 'command'
+					, 'calls'
+					, 'sec/command';
+	printf STDERR "-" x 100 . "\n";
+
+	for my $key (sort { $self->stats->{$b}->{elapsed} cmp $self->stats->{$a}->{elapsed} } keys %{$self->stats} ) {
+		my $speed = $self->stats->{$key}->{elapsed} / $self->stats->{$key}->{count};
+		printf STDERR "%f\t%-40.40s\t%d times\t%f secs/command\n" 
+					, $self->stats->{$key}->{elapsed}
+					, $key 
+					, $self->stats->{$key}->{count}
+					, $speed;
+	}
+
+	printf STDERR "\n\n";
+}
+
+1;
\ No newline at end of file
diff --git a/lib/Catmandu/Fix/Bind/eval.pm b/lib/Catmandu/Fix/Bind/eval.pm
index 8d67141..35ee65d 100644
--- a/lib/Catmandu/Fix/Bind/eval.pm
+++ b/lib/Catmandu/Fix/Bind/eval.pm
@@ -2,6 +2,7 @@ package Catmandu::Fix::Bind::eval;
 
 use Moo;
 use Data::Dumper;
+use Perl::Tidy;
 
 with 'Catmandu::Fix::Bind';
 
@@ -12,8 +13,10 @@ sub bind {
 		$data = $code->($data);
 	};
 	if ($@) {
-		warn "$name $perl";
-		die "Fix: $name threw an error: $@";
+		warn "$name : failed : $@";
+	}
+	else {
+		warn "$name : ok";
 	}
 
 	$data
diff --git a/lib/Catmandu/Fix/Bind/loop.pm b/lib/Catmandu/Fix/Bind/loop.pm
new file mode 100644
index 0000000..8239de9
--- /dev/null
+++ b/lib/Catmandu/Fix/Bind/loop.pm
@@ -0,0 +1,23 @@
+package Catmandu::Fix::Bind::loop;
+
+use Moo;
+
+with 'Catmandu::Fix::Bind';
+
+has count => (is => 'ro' , default => sub { 1 } );
+has index => (is => 'ro');
+
+sub bind {
+   my ($self,$data,$code,$name) = @_;
+   
+   for (my $i = 0 ; $i < $self->count ; $i++) {
+   	  if (defined $self->index) {
+   	  	$data->{$self->index} = $i;
+   	  }
+	  $data = $code->($data);
+   }
+
+   $data;
+}
+
+1;

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