view release on metacpan or  search on metacpan

t/use_cases/foursquare.t  view on Meta::CPAN

This isn't a necessary step, but it's nice to know that the profile
makes sense before you actually try to use it. Even if you don't do it
for production code, you might want this step in there so you can turn
it on for debugging.

=cut

{
my $string = $profile->explain;
#stderr_like { $string = $profile->explain } qr/Cannot/,
#	"Error message for input lacking format brick";
ok( $string, "explain() returns something" );

print STDERR "\nExplaining $0 profile:\n",
	$string if $ENV{DEBUG};
}

=head2 Validate the data with apply()

This isn't a necessary step, but it's nice to know that the profile
makes sense before you actually try to use it. Even if you don't do it
for production code, you might want this step in there so you can turn
it on for debugging.

=cut

my $result = $brick->apply( $profile, $Input );
#stderr_like { $result = $brick->apply( $profile, $Input ) } qr/Cannot/,
#	"Error message for input lacking format brick";

isa_ok( $result, ref [], "Results come back as array reference" );
isa_ok( $result, Brick->result_class, "Results come back as array reference" );
is( scalar @$result, scalar @$Profile, "Results has one element per Profile element" );

print STDERR Data::Dumper->Dump( [$result], [qw(result)] ) if $ENV{DEBUG};

=head2 Check the results

This isn't a necessary step, but it's nice to know that the profile
makes sense before you actually try to use it. Even if you don't do it
for production code, you might want this step in there so you can turn
it on for debugging.

=cut

#print STDERR Data::Dumper->Dump( [$result], [qw(result)] ) ; #if $ENV{DEBUG};
use Data::Dumper;

print STDERR "\n" if $ENV{DEBUG};

foreach my $index ( 0 .. $#$result )
	{
	my $entry = $result->[$index];

	print STDERR "----- $entry->[0] ----------------------------\n" if $ENV{DEBUG};

	do { print STDERR "\tpassed\n\n" if $ENV{DEBUG}; next } if $entry->[2];

	my @data = ( $entry->[3] );
	my @errors = ();
	my $iterations = 0;
	while( my $error = shift @data )
		{
		last if $iterations++ > 20; # debugging guard against infinity
#		print STDERR "Iteration $iterations\n";
		if( $error->{handler} =~ m/^__/ )
			{
			push @data, @{ $error->{errors} };
			next;
			}

		push @errors, $error;
		}

	#print STDERR Data::Dumper->Dump( [\@errors], [qw(errors)] ) ; #if $ENV{DEBUG};

	#print STDERR "$entry->[0] checked by $entry->[1] which returned:\n\t$message\n";

	next unless ref $entry->[3] and @{ $entry->[3]{errors} } > 0;

	foreach my $error ( @errors )
		{
		print STDERR "$error->{handler}: $error->{message}\n" if $ENV{DEBUG};
		}

	print STDERR "\n" if $ENV{DEBUG};
	}

exit;

{
my $row = shift @$result;
is( $row->[2], 1, "zip_code passes" );
}

foreach my $row ( @$result )
	{
	is( $row->[2], 0, "$row->[0] fails (as expected)" );
	}