#!/usr/bin/perl use strict; use Test::More 'no_plan'; use_ok( 'Brick::General' ); use_ok( 'Brick::Bucket' ); use lib qw( t/lib ); use_ok( 'Mock::Bucket' ); my $bucket = Mock::Bucket->new; isa_ok( $bucket, 'Mock::Bucket' ); isa_ok( $bucket, Mock::Bucket->bucket_class ); # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # Will it get past something that returns undef? { my $undef_sub = sub { return }; my $pass_sub = sub { 1 }; { my $sub = $bucket->__compose_pass_or_skip( $undef_sub, $pass_sub ); isa_ok( $sub, ref sub {}, "__compose_pass_or_skip returns a hash ref" ); my $result = eval { $sub->({}) }; ok( $result, "Satisfied one" ); } { my $sub = $bucket->__compose_pass_or_skip( $undef_sub, $undef_sub ); isa_ok( $sub, ref sub {}, "__compose_pass_or_skip returns a hash ref" ); my $result = eval { $sub->({}) }; my $at = $@; print STDERR Data::Dumper->Dump( [$at], [qw(at)] ) if $ENV{DEBUG}; TODO: { local $TODO = "Should this return undef?"; ok( ! defined $at, "\$@ is undef" ); } is( $result, 0, "Satisfied none" ); } } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # Will it get past something that returns die with a reference? # It shouldn't { my $undef_sub = sub { die { message => "Validation error!", handler => "undef_sub" } }; my $pass_sub = sub { 1 }; { my $sub = $bucket->__compose_pass_or_skip( $undef_sub, $pass_sub ); isa_ok( $sub, ref sub {}, "__compose_pass_or_skip returns a hash ref" ); my $result = eval { $sub->({}) }; my $at = $@; is( $result, undef, "Failed, as expected" ); isa_ok( $at, ref {}, "\$@ is a reference" ); ok( exists $at->{message}, "Key 'message' exists in die ref" ); ok( exists $at->{handler}, "Key 'handler' exists in die ref" ); } } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # Two selectors that will work with the right input data { my $cat_selector = sub { #print STDERR "\nRunning cat selector\n" if $ENV{DEBUG}; return unless $_[0]->{animal} eq 'cat'; return 1 }; my $dog_selector = sub { #print STDERR "\nRunning dog selector\n" if $ENV{DEBUG}; return unless $_[0]->{animal} eq 'dog'; return 1 }; my $sub = $bucket->__compose_pass_or_skip( $cat_selector, $dog_selector ); isa_ok( $sub, ref sub {}, "__compose_pass_or_skip returns a hash ref" ); foreach my $animal ( qw(dog cat dog) ) { my $result = eval { $sub->( { animal => $animal } ) }; #print STDERR Data::Dumper->Dump( [$result], [qw(result)] ); ok( $result, "Animal '$animal' returned true" ); } foreach my $animal ( qw(llama camel) ) { my $result = eval { $sub->( { animal => $animal } ) }; my $at = $@; print STDERR Data::Dumper->Dump( [$at], [qw(at)] ) if $ENV{DEBUG}; TODO: { local $TODO = "Error in return values"; eval { isa_ok( $at, ref {}, "\$@" ); ok( exists $at->{message}, "Key 'message' exists in die ref" ); ok( exists $at->{handler}, "Key 'handler' exists in die ref" ); }; } } } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # Two selectors with sub conditions { my $cat_selector = sub { print STDERR "Running cat selector with $_[0]->{animal}\n" if $ENV{DEBUG}; return unless $_[0]->{animal} eq 'cat'; print "Still here!\n"; return 1 }; my $cat_sound = sub { print STDERR "Running cat sound with $_[0]->{animal}\n" if $ENV{DEBUG}; die { message => "Cats don't go '$_[0]->{sound}'", handler => 'cat_sound', } unless $_[0]->{sound} eq 'meow'; # print STDERR "Still here!\n"; return 1 }; my $cat_composed = $bucket->__compose_pass_or_stop( $cat_selector, $cat_sound ); my $dog_selector = sub { print STDERR "Running dog selector with $_[0]->{animal}\n" if $ENV{DEBUG}; return unless $_[0]->{animal} eq 'dog'; return 1 }; my $dog_sound = sub { print STDERR "Running dog sound with $_[0]->{animal}\n" if $ENV{DEBUG}; die { message => "Dogs don't go '$_[0]->{sound}'", handler => 'dog_sound', } unless $_[0]->{sound} eq 'bark'; return 1 }; my $dog_composed = $bucket->__compose_pass_or_stop( $dog_selector, $dog_sound ); my $sub = $bucket->__compose_pass_or_skip( $cat_composed, $dog_composed ); isa_ok( $sub, ref sub {}, "__compose_pass_or_skip returns a hash ref" ); foreach my $animal ( qw(dog cat dog) ) { print STDERR "\n-----------------\nTrying animal ==> $animal, sound => meow\n" if $ENV{DEBUG}; my $result = eval { $sub->( { animal => $animal, sound => 'meow' } ) }; #print STDERR Data::Dumper->Dump( [$result], [qw(result)] ); is( !! $result, 'cat' eq $animal, "Animal '$animal' with 'meow' " . ('cat' eq $animal ? "passed" : "failed") ); } }