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.hochstenb...@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 _______________________________________________ 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