view release on metacpan or  search on metacpan

lib/Brick/Bucket.pm  view on Meta::CPAN

sub set_field_label {
	$_[0]->{_field_labels}{ $_[1] } = $_[2];
	}

sub __caller_chain_as_list {
	my $level = 0;
	my @Callers = ();

	while( 1 ) {
		my @caller = caller( ++$level );
		last unless @caller;

		push @Callers, {
			level   => $level,
			package => $caller[0],
			'sub'   => $caller[3] =~ m/(?:.*::)?(.*)/,
			};
		}

	#print STDERR Data::Dumper->Dump( [\@Callers], [qw(callers)] ), "-" x 73, "\n";

t/use_cases/programming-error-in-brick.t  view on Meta::CPAN

=head2 Create the constraint

Let's make two constraints that I expect to work, and one that fails from
a programming error.

=cut

sub Brick::Bucket::code_error {
	my( $bucket, $setup ) = @_;

	$setup->{name} ||= ( caller(0) )[3];

	$bucket->__make_constraint(
		$bucket->add_to_bucket( {
			name        => 'code_error',
			description => 'Length is 5',
			code        => sub {
				my $regex = "abcd(";
				length $_[0]->{string} == m/$regex/
					or die { message => 'Matches bad regex' };
				}
			} ),

		$setup );
	}

sub Brick::Bucket::just_fine {
	my( $bucket, $setup ) = @_;

	$setup->{name} ||= ( caller(0) )[3];

	$bucket->__make_constraint(
		$bucket->add_to_bucket( {
			name        => 'just_fine',
			description => 'Length is 5',
			code        => sub {
				length $_[0]->{string} == 5
					or die { message => 'Length is not five' };
				}
			} ),

		$setup );
	}

sub Brick::Bucket::never_passes {
	my( $bucket, $setup ) = @_;

	$setup->{name} ||= ( caller(0) )[3];

	$bucket->__make_constraint(
		$bucket->add_to_bucket( {
			name        => 'never_passes',
			description => 'Has a vowel',
			code        => sub {
				die {
					handler => 'never_passes',
					message => 'Length is not five'
					};