File Coverage

blib/lib/Error/TypeTiny/Assertion.pm

Criterion	Covered	Total	%
statement	48	48	100.0
branch	16	22	72.7
condition	7	12	58.3
subroutine	17	17	100.0
pod	11	11	100.0
total	99	110	90.0

package Error::TypeTiny::Assertion;

use 5.008001;
use strict;
use warnings;

BEGIN {
	$Error::TypeTiny::Assertion::AUTHORITY = 'cpan:TOBYINK';
	$Error::TypeTiny::Assertion::VERSION   = '2.010001';
}

$Error::TypeTiny::Assertion::VERSION =~ tr/_//d;

require Error::TypeTiny;
our @ISA = 'Error::TypeTiny';

sub type           { $_[0]{type} }
sub value          { $_[0]{value} }
sub varname        { $_[0]{varname} ||= '$_' }
sub attribute_step { $_[0]{attribute_step} }
sub attribute_name { $_[0]{attribute_name} }

sub has_type           { defined $_[0]{type} };           # sic
sub has_attribute_step { exists $_[0]{attribute_step} }
sub has_attribute_name { exists $_[0]{attribute_name} }

sub new {
	my $class = shift;
	my $self  = $class->SUPER::new( @_ );

	# Supported but undocumented parameter is `mgaca`.
	# This indicates whether Error::TypeTiny::Assertion
	# should attempt to figure out which attribute caused
	# the error from Method::Generate::Accessor's info.
	# Can be set to true/false or not set. If not set,
	# the current behaviour is true, but this may change
	# in the future. If set to false, will ignore the
	# $Method::Generate::Accessor::CurrentAttribute hashref.
	#

	if ( ref $Method::Generate::Accessor::CurrentAttribute
		and $self->{mgaca} || !exists $self->{mgaca} )
	{
		require B;
		my %d = %{$Method::Generate::Accessor::CurrentAttribute};
		$self->{attribute_name} = $d{name} if defined $d{name};
		$self->{attribute_step} = $d{step} if defined $d{step};

		if ( defined $d{init_arg} ) {
			$self->{varname} = sprintf( '$args->{%s}', B::perlstring( $d{init_arg} ) );
		}
		elsif ( defined $d{name} ) {
			$self->{varname} = sprintf( '$self->{%s}', B::perlstring( $d{name} ) );
		}
	} #/ if ( ref $Method::Generate::Accessor::CurrentAttribute...)

	return $self;
} #/ sub new

sub message {
	my $e = shift;
	$e->varname eq '$_'
		? $e->SUPER::message
		: sprintf( '%s (in %s)', $e->SUPER::message, $e->varname );
}

sub _build_message {
	my $e = shift;
	$e->has_type
		? sprintf(
		'%s did not pass type constraint "%s"',
		Type::Tiny::_dd( $e->value ), $e->type
		)
		: sprintf(
		'%s did not pass type constraint',
		Type::Tiny::_dd( $e->value )
		);
} #/ sub _build_message

*to_string = sub {
	my $e   = shift;
	my $msg = $e->message;

	my $c = $e->context;
	$msg .= sprintf( " at %s line %s", $c->{file} || 'file?', $c->{line} || 'NaN' )
		if $c;

	my $explain = $e->explain;
	return "$msg\n" unless @{ $explain || [] };

	$msg .= "\n";
	for my $line ( @$explain ) {
		$msg .= "    $line\n";
	}

	return $msg;
	}
	if $] >= 5.008;

sub explain {
	my $e = shift;
	return undef unless $e->has_type;
	$e->type->validate_explain( $e->value, $e->varname );
}

1;

__END__