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 fa45feeda7080ff7b92f22cb2c0440a0a9b36e4e Author: Patrick Hochstenbach <patrick.hochstenb...@ugent.be> Date: Fri May 9 18:01:42 2014 +0200 Adding tests and documentation for Binds --- lib/Catmandu/Fix/Bind.pm | 62 ++++++++++--------- lib/Catmandu/Fix/Bind/benchmark.pm | 14 +++-- lib/Catmandu/Fix/Bind/each.pm | 32 ++++++++++ lib/Catmandu/Fix/Bind/eval.pm | 3 - t/Catmandu-Fix-Bind-benchmark.t | 96 +++++++++++++++++++++++++++++ t/Catmandu-Fix-Bind-each.t | 110 ++++++++++++++++++++++++++++++++++ t/Catmandu-Fix-Bind-eval.t | 116 +++++++++++++++++++++++++++++++++++ t/Catmandu-Fix-Bind-identity.t | 96 +++++++++++++++++++++++++++++ t/Catmandu-Fix-Bind-loop.t | 120 +++++++++++++++++++++++++++++++++++++ t/Catmandu-Fix-Bind.t | 15 +++++ 10 files changed, 627 insertions(+), 37 deletions(-) diff --git a/lib/Catmandu/Fix/Bind.pm b/lib/Catmandu/Fix/Bind.pm index b8215e9..01e2052 100644 --- a/lib/Catmandu/Fix/Bind.pm +++ b/lib/Catmandu/Fix/Bind.pm @@ -8,18 +8,14 @@ requires 'bind'; has fixes => (is => 'rw', default => sub { [] }); -sub BUILD { - warn "creating " . $_[0]; -} - sub unit { my ($self,$data) = @_; return $data; } sub bind { - my ($self,$data,$code,$name) = @_; - return $code->($data); + my ($self,$data,$code,$name,$perl) = @_; + return $code->($data); } sub finally { @@ -66,42 +62,49 @@ sub emit_bind { =head1 NAME -Catmandu::Fix::Bind - a Binder for fixes +Catmandu::Fix::Bind - a wrapper for Catmandu::Fix-es =head1 SYNOPSIS - package Catmandu::Fix::Bind::Demo; + package Catmandu::Fix::Bind::demo; use Moo; with 'Catmandu::Fix::Bind'; sub bind { - my $(self,$data,$code,$name) = @_; + my ($self,$data,$code,$name) = @_; warn "executing $name"; $code->($data); } - package main; - use Catmandu::Importer::JSON; - use Catmandu::Fix; - - my $importer = Catmandu::Importer::JSON->new(file => 'test.data'); - my $fixer = Catmandu::Fix->new( - fixes => ['add_field("foo","bar"); set_field("foo","test")'], - binds => ['Demo'] - ); + # in your fix script you can now write + do + demo() - # This will print: - # executing add_field - # executing set_field - # executing add_field - # executing set_field - $fixer->fix($importer)->each(sub {}); + fix1() + fix2() + fix3() + end + # this will execute all the fixes as expected plus print to STDERR + executing fix1 + executing fix2 + executing fix3 + =head1 DESCRIPTION Bind is a package that wraps Catmandu::Fix-es and other Catmandu::Bind-s together. This gives the programmer further control on the excution of fixes. With Catmandu::Fix::Bind you can simulate -the 'before', 'after' and 'around' modifiers as found in Moo. +the 'before', 'after' and 'around' modifiers as found in Moo or Dancer. + +To wrap Fix functions, the Fix language has provided a 'do' statment: + + do BIND + FIX1 + FIX2 + FIX3 + end + +In the example above the BIND will wrap FIX1, FIX2 and FIX3. A Catmandu::Fix::Bind needs to implement two methods: 'unit' and 'bind'. @@ -124,17 +127,18 @@ The bind method is executed for every Catmandu::Fix method in the fixer. It rece 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); + my ($self,$data,$code,$name) = @_; + return $code->($data); } =head2 finally($data) -Optionally finally is executed on the data when all the fixes have run. +Optionally finally is executed on the data when all the fixes in a do block have run. =head1 SEE ALSO -L<Catmandu::Fix> +L<Catmandu::Fix::Bind::identity>, L<Catmandu::Fix::Bind::each> , L<Catmandu::Fix::Bind::loop> , +L<Catmandu::Fix::Bind::eval>, L<Catmandu::Fix::Bind::benchmark> =cut diff --git a/lib/Catmandu/Fix/Bind/benchmark.pm b/lib/Catmandu/Fix/Bind/benchmark.pm index 06eb964..807b309 100644 --- a/lib/Catmandu/Fix/Bind/benchmark.pm +++ b/lib/Catmandu/Fix/Bind/benchmark.pm @@ -6,7 +6,8 @@ use Time::HiRes qw(gettimeofday tv_interval); with 'Catmandu::Fix::Bind'; -has stats => (is => 'lazy'); +has output => (is => 'ro' , required => 1); +has stats => (is => 'lazy'); sub _build_stats { +{}; @@ -27,24 +28,27 @@ sub bind { sub DESTROY { my ($self) = @_; + local(*OUT); + open (OUT, '>' , $self->output) || return undef; - printf STDERR "%-8.8s\t%-40.40s\t%-8.8s\t%-8.8s\n" + printf OUT "%-8.8s\t%-40.40s\t%-8.8s\t%-8.8s\n" , 'elapsed' , 'command' , 'calls' , 'sec/command'; - printf STDERR "-" x 100 . "\n"; + printf OUT "-" 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" + printf OUT "%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"; + printf OUT "\n\n"; + close (OUT); } 1; \ No newline at end of file diff --git a/lib/Catmandu/Fix/Bind/each.pm b/lib/Catmandu/Fix/Bind/each.pm index 2d30e27..f3958d3 100644 --- a/lib/Catmandu/Fix/Bind/each.pm +++ b/lib/Catmandu/Fix/Bind/each.pm @@ -46,4 +46,36 @@ sub finally { $data; } +=head1 NAME + +Catmandu::Fix::Bind::each - loop over all the values in a path + +=head1 SYNOPSIS + + add_field(demo.$append,foo) + add_field(demo.$append,bar) + + do each(path => demo, index => val) + copy_field(val,demo2.$append) + end + + # demo = ['foo' , 'bar']; + # demo2 = ['foo' , 'bar']; + +=head1 PARAMETERS + +=head2 path (required) + +A path to an array ref over which the 'each' needs to loop + +=head2 index (optional) + +The name of an index field that gets populated for every value on the path + +=head1 SEE ALSO + +L<Catmandu::Fix::Bind> + +=cut + 1; diff --git a/lib/Catmandu/Fix/Bind/eval.pm b/lib/Catmandu/Fix/Bind/eval.pm index 35ee65d..a47a74b 100644 --- a/lib/Catmandu/Fix/Bind/eval.pm +++ b/lib/Catmandu/Fix/Bind/eval.pm @@ -15,9 +15,6 @@ sub bind { if ($@) { warn "$name : failed : $@"; } - else { - warn "$name : ok"; - } $data } diff --git a/t/Catmandu-Fix-Bind-benchmark.t b/t/Catmandu-Fix-Bind-benchmark.t new file mode 100644 index 0000000..d6c3ffc --- /dev/null +++ b/t/Catmandu-Fix-Bind-benchmark.t @@ -0,0 +1,96 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Exception; +use Catmandu::Fix; +use Catmandu::Importer::Mock; +use Catmandu::Util qw(:is); + +my $pkg; +BEGIN { + $pkg = 'Catmandu::Fix::Bind::benchmark'; + use_ok $pkg; +} +require_ok $pkg; + +my $fixes =<<EOF; +do benchmark(output => /dev/null) + add_field(foo,bar) +end +EOF + +my $fixer = Catmandu::Fix->new(fixes => [$fixes]); + +ok $fixer , 'create fixer'; + +is_deeply $fixer->fix({}), {foo => 'bar'} , 'testing add_field'; + +$fixes =<<EOF; +do benchmark(output => /dev/null) +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing zero fix functions'; + +$fixes =<<EOF; +do benchmark(output => /dev/null) + unless exists(foo) + add_field(foo,bar) + end +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({}), {foo => 'bar'} , 'testing unless'; + +$fixes =<<EOF; +do benchmark(output => /dev/null) + if exists(foo) + add_field(foo2,bar) + end +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar', foo2 => 'bar'} , 'testing if'; + +$fixes =<<EOF; +do benchmark(output => /dev/null) + reject exists(foo) +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), undef , 'testing reject'; + +$fixes =<<EOF; +do benchmark(output => /dev/null) + select exists(foo) +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing select'; + +$fixes =<<EOF; +do benchmark(output => /dev/null) + do benchmark(output => /dev/null) + do benchmark(output => /dev/null) + add_field(foo,bar) + end + end +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing nesting'; + +done_testing 10; \ No newline at end of file diff --git a/t/Catmandu-Fix-Bind-each.t b/t/Catmandu-Fix-Bind-each.t new file mode 100644 index 0000000..4021ac6 --- /dev/null +++ b/t/Catmandu-Fix-Bind-each.t @@ -0,0 +1,110 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Exception; +use Catmandu::Fix; +use Catmandu::Importer::Mock; +use Catmandu::Util qw(:is); + +my $pkg; +BEGIN { + $pkg = 'Catmandu::Fix::Bind::loop'; + use_ok $pkg; +} +require_ok $pkg; + +my $fixes =<<EOF; +do loop(count => 1) + add_field(foo,bar) +end +EOF + +my $fixer = Catmandu::Fix->new(fixes => [$fixes]); + +ok $fixer , 'create fixer'; + +is_deeply $fixer->fix({}), {foo => 'bar'} , 'testing add_field'; + +$fixes =<<EOF; +do loop(count => 1) +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing zero fix functions'; + +$fixes =<<EOF; +do loop(count => 1) + unless exists(foo) + add_field(foo,bar) + end +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({}), {foo => 'bar'} , 'testing unless'; + +$fixes =<<EOF; +do loop(count => 1) + if exists(foo) + add_field(foo2,bar) + end +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar', foo2 => 'bar'} , 'testing if'; + +$fixes =<<EOF; +do loop(count => 1) + reject exists(foo) +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), undef , 'testing reject'; + +$fixes =<<EOF; +do loop(count => 1) + select exists(foo) +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing select'; + +$fixes =<<EOF; +do loop(count => 1) + do loop(count => 1) + do loop(count => 1) + add_field(foo,bar) + end + end +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing nesting'; + +$fixes =<<EOF; +add_field(demo.\$append,foo) +add_field(demo.\$append,bar) +do each(path => demo, index => i) + do each(path => demo) + copy_field(i,demo2.\$append) + end +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({}), { demo => [qw(foo bar)] , demo2 => [qw(foo foo bar bar)] } , 'testing each specifics'; + +done_testing 11; diff --git a/t/Catmandu-Fix-Bind-eval.t b/t/Catmandu-Fix-Bind-eval.t new file mode 100644 index 0000000..b30af20 --- /dev/null +++ b/t/Catmandu-Fix-Bind-eval.t @@ -0,0 +1,116 @@ +#!/usr/bin/env perl +package Catmandu::Fix::bad_fix; + +use Moo; + +sub fix { + die "this should show that something failed"; +} + +package main; + +use strict; +use warnings; +use Test::More; +use Test::Exception; +use Catmandu::Fix; +use Catmandu::Importer::Mock; +use Catmandu::Util qw(:is); + +my $pkg; +BEGIN { + $pkg = 'Catmandu::Fix::Bind::benchmark'; + use_ok $pkg; +} +require_ok $pkg; + +my $fixes =<<EOF; +do eval() + add_field(foo,bar) +end +EOF + +my $fixer = Catmandu::Fix->new(fixes => [$fixes]); + +ok $fixer , 'create fixer'; + +is_deeply $fixer->fix({}), {foo => 'bar'} , 'testing add_field'; + +$fixes =<<EOF; +do eval() +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing zero fix functions'; + +$fixes =<<EOF; +do eval() + unless exists(foo) + add_field(foo,bar) + end +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({}), {foo => 'bar'} , 'testing unless'; + +$fixes =<<EOF; +do eval() + if exists(foo) + add_field(foo2,bar) + end +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar', foo2 => 'bar'} , 'testing if'; + +$fixes =<<EOF; +do eval() + reject exists(foo) +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), undef , 'testing reject'; + +$fixes =<<EOF; +do eval() + select exists(foo) +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing select'; + +$fixes =<<EOF; +do eval() + do eval() + do eval() + add_field(foo,bar) + end + end +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing nesting'; + +$fixes =<<EOF; +do eval() + bad_fix() +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing bad_fix'; + +done_testing 11; \ No newline at end of file diff --git a/t/Catmandu-Fix-Bind-identity.t b/t/Catmandu-Fix-Bind-identity.t new file mode 100644 index 0000000..8caa8ad --- /dev/null +++ b/t/Catmandu-Fix-Bind-identity.t @@ -0,0 +1,96 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Exception; +use Catmandu::Fix; +use Catmandu::Importer::Mock; +use Catmandu::Util qw(:is); + +my $pkg; +BEGIN { + $pkg = 'Catmandu::Fix::Bind::identity'; + use_ok $pkg; +} +require_ok $pkg; + +my $fixes =<<EOF; +do identity() + add_field(foo,bar) +end +EOF + +my $fixer = Catmandu::Fix->new(fixes => [$fixes]); + +ok $fixer , 'create fixer'; + +is_deeply $fixer->fix({}), {foo => 'bar'} , 'testing add_field'; + +$fixes =<<EOF; +do identity() +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing zero fix functions'; + +$fixes =<<EOF; +do identity() + unless exists(foo) + add_field(foo,bar) + end +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({}), {foo => 'bar'} , 'testing unless'; + +$fixes =<<EOF; +do identity() + if exists(foo) + add_field(foo2,bar) + end +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar', foo2 => 'bar'} , 'testing if'; + +$fixes =<<EOF; +do identity() + reject exists(foo) +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), undef , 'testing reject'; + +$fixes =<<EOF; +do identity() + select exists(foo) +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing select'; + +$fixes =<<EOF; +do identity() + do identity() + do identity() + add_field(foo,bar) + end + end +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing nesting'; + +done_testing 10; \ No newline at end of file diff --git a/t/Catmandu-Fix-Bind-loop.t b/t/Catmandu-Fix-Bind-loop.t new file mode 100644 index 0000000..19eda6b --- /dev/null +++ b/t/Catmandu-Fix-Bind-loop.t @@ -0,0 +1,120 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Exception; +use Catmandu::Fix; +use Catmandu::Importer::Mock; +use Catmandu::Util qw(:is); + +my $pkg; +BEGIN { + $pkg = 'Catmandu::Fix::Bind::loop'; + use_ok $pkg; +} +require_ok $pkg; + +my $fixes =<<EOF; +do loop(count => 1) + add_field(foo,bar) +end +EOF + +my $fixer = Catmandu::Fix->new(fixes => [$fixes]); + +ok $fixer , 'create fixer'; + +is_deeply $fixer->fix({}), {foo => 'bar'} , 'testing add_field'; + +$fixes =<<EOF; +do loop(count => 1) +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing zero fix functions'; + +$fixes =<<EOF; +do loop(count => 1) + unless exists(foo) + add_field(foo,bar) + end +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({}), {foo => 'bar'} , 'testing unless'; + +$fixes =<<EOF; +do loop(count => 1) + if exists(foo) + add_field(foo2,bar) + end +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar', foo2 => 'bar'} , 'testing if'; + +$fixes =<<EOF; +do loop(count => 1) + reject exists(foo) +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), undef , 'testing reject'; + +$fixes =<<EOF; +do loop(count => 1) + select exists(foo) +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing select'; + +$fixes =<<EOF; +do loop(count => 1) + do loop(count => 1) + do loop(count => 1) + add_field(foo,bar) + end + end +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing nesting'; + +$fixes =<<EOF; +do loop(count => 3 , index => i) + copy_field(i,demo.\$append) + copy_field(i,demo2.\$append) +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({}), {demo => [(qw(0 1 2))] , demo2 => [qw(0 1 2 )]} , 'testing specific loop'; + +$fixes =<<EOF; +do loop(count => 3 , index => i) + copy_field(i,demo.\$append) + do loop(count => 3) + copy_field(i,demo2.\$append) + end +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({}), {demo => [(qw(0 1 2))] , demo2 => [qw(0 0 0 1 1 1 2 2 2)]} , 'testing specific loop'; + +done_testing 12; diff --git a/t/Catmandu-Fix-Bind.t b/t/Catmandu-Fix-Bind.t new file mode 100644 index 0000000..c43f94c --- /dev/null +++ b/t/Catmandu-Fix-Bind.t @@ -0,0 +1,15 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Exception; +use Catmandu::Util qw(:is); + +my $pkg; +BEGIN { + $pkg = 'Catmandu::Fix::Bind'; + use_ok $pkg; +} +require_ok $pkg; + +done_testing 2; \ 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 _______________________________________________ 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