line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Error::TypeTiny::Assertion; |
2
|
|
|
|
|
|
|
|
3
|
264
|
|
|
264
|
|
6121
|
use 5.008001; |
|
264
|
|
|
|
|
949
|
|
4
|
264
|
|
|
264
|
|
1538
|
use strict; |
|
264
|
|
|
|
|
595
|
|
|
264
|
|
|
|
|
6122
|
|
5
|
264
|
|
|
264
|
|
1448
|
use warnings; |
|
264
|
|
|
|
|
580
|
|
|
264
|
|
|
|
|
13172
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
BEGIN { |
8
|
264
|
|
|
264
|
|
1132
|
$Error::TypeTiny::Assertion::AUTHORITY = 'cpan:TOBYINK'; |
9
|
264
|
|
|
|
|
200993
|
$Error::TypeTiny::Assertion::VERSION = '2.004000'; |
10
|
|
|
|
|
|
|
} |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
$Error::TypeTiny::Assertion::VERSION =~ tr/_//d; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
require Error::TypeTiny; |
15
|
|
|
|
|
|
|
our @ISA = 'Error::TypeTiny'; |
16
|
|
|
|
|
|
|
|
17
|
373
|
|
|
373
|
1
|
1413
|
sub type { $_[0]{type} } |
18
|
369
|
|
|
369
|
1
|
1301
|
sub value { $_[0]{value} } |
19
|
1038
|
|
100
|
1038
|
1
|
5684
|
sub varname { $_[0]{varname} ||= '$_' } |
20
|
2
|
|
|
2
|
1
|
10
|
sub attribute_step { $_[0]{attribute_step} } |
21
|
2
|
|
|
2
|
1
|
12
|
sub attribute_name { $_[0]{attribute_name} } |
22
|
|
|
|
|
|
|
|
23
|
367
|
|
|
367
|
1
|
1123
|
sub has_type { defined $_[0]{type} }; # sic |
24
|
2
|
|
|
2
|
1
|
10
|
sub has_attribute_step { exists $_[0]{attribute_step} } |
25
|
2
|
|
|
2
|
1
|
1677
|
sub has_attribute_name { exists $_[0]{attribute_name} } |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub new { |
28
|
418
|
|
|
418
|
1
|
910
|
my $class = shift; |
29
|
418
|
|
|
|
|
1581
|
my $self = $class->SUPER::new( @_ ); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# Supported but undocumented parameter is `mgaca`. |
32
|
|
|
|
|
|
|
# This indicates whether Error::TypeTiny::Assertion |
33
|
|
|
|
|
|
|
# should attempt to figure out which attribute caused |
34
|
|
|
|
|
|
|
# the error from Method::Generate::Accessor's info. |
35
|
|
|
|
|
|
|
# Can be set to true/false or not set. If not set, |
36
|
|
|
|
|
|
|
# the current behaviour is true, but this may change |
37
|
|
|
|
|
|
|
# in the future. If set to false, will ignore the |
38
|
|
|
|
|
|
|
# $Method::Generate::Accessor::CurrentAttribute hashref. |
39
|
|
|
|
|
|
|
# |
40
|
|
|
|
|
|
|
|
41
|
418
|
50
|
33
|
|
|
1634
|
if ( ref $Method::Generate::Accessor::CurrentAttribute |
|
|
|
66
|
|
|
|
|
42
|
|
|
|
|
|
|
and $self->{mgaca} || !exists $self->{mgaca} ) |
43
|
|
|
|
|
|
|
{ |
44
|
26
|
|
|
|
|
138
|
require B; |
45
|
26
|
|
|
|
|
42
|
my %d = %{$Method::Generate::Accessor::CurrentAttribute}; |
|
26
|
|
|
|
|
114
|
|
46
|
26
|
50
|
|
|
|
104
|
$self->{attribute_name} = $d{name} if defined $d{name}; |
47
|
26
|
50
|
|
|
|
79
|
$self->{attribute_step} = $d{step} if defined $d{step}; |
48
|
|
|
|
|
|
|
|
49
|
26
|
100
|
|
|
|
68
|
if ( defined $d{init_arg} ) { |
|
|
50
|
|
|
|
|
|
50
|
21
|
|
|
|
|
173
|
$self->{varname} = sprintf( '$args->{%s}', B::perlstring( $d{init_arg} ) ); |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
elsif ( defined $d{name} ) { |
53
|
5
|
|
|
|
|
47
|
$self->{varname} = sprintf( '$self->{%s}', B::perlstring( $d{name} ) ); |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
} #/ if ( ref $Method::Generate::Accessor::CurrentAttribute...) |
56
|
|
|
|
|
|
|
|
57
|
418
|
|
|
|
|
1947
|
return $self; |
58
|
|
|
|
|
|
|
} #/ sub new |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub message { |
61
|
349
|
|
|
349
|
1
|
2096
|
my $e = shift; |
62
|
349
|
100
|
|
|
|
870
|
$e->varname eq '$_' |
63
|
|
|
|
|
|
|
? $e->SUPER::message |
64
|
|
|
|
|
|
|
: sprintf( '%s (in %s)', $e->SUPER::message, $e->varname ); |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub _build_message { |
68
|
1
|
|
|
1
|
|
5
|
my $e = shift; |
69
|
1
|
50
|
|
|
|
4
|
$e->has_type |
70
|
|
|
|
|
|
|
? sprintf( |
71
|
|
|
|
|
|
|
'%s did not pass type constraint "%s"', |
72
|
|
|
|
|
|
|
Type::Tiny::_dd( $e->value ), $e->type |
73
|
|
|
|
|
|
|
) |
74
|
|
|
|
|
|
|
: sprintf( |
75
|
|
|
|
|
|
|
'%s did not pass type constraint', |
76
|
|
|
|
|
|
|
Type::Tiny::_dd( $e->value ) |
77
|
|
|
|
|
|
|
); |
78
|
|
|
|
|
|
|
} #/ sub _build_message |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
*to_string = sub { |
81
|
343
|
|
|
343
|
|
794
|
my $e = shift; |
82
|
343
|
|
|
|
|
920
|
my $msg = $e->message; |
83
|
|
|
|
|
|
|
|
84
|
343
|
|
|
|
|
1174
|
my $c = $e->context; |
85
|
343
|
50
|
50
|
|
|
2509
|
$msg .= sprintf( " at %s line %s", $c->{file} || 'file?', $c->{line} || 'NaN' ) |
|
|
|
50
|
|
|
|
|
86
|
|
|
|
|
|
|
if $c; |
87
|
|
|
|
|
|
|
|
88
|
343
|
|
|
|
|
965
|
my $explain = $e->explain; |
89
|
343
|
100
|
|
|
|
725
|
return "$msg\n" unless @{ $explain || [] }; |
|
343
|
100
|
|
|
|
1291
|
|
90
|
|
|
|
|
|
|
|
91
|
342
|
|
|
|
|
898
|
$msg .= "\n"; |
92
|
342
|
|
|
|
|
922
|
for my $line ( @$explain ) { |
93
|
2105
|
|
|
|
|
4201
|
$msg .= " $line\n"; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
342
|
|
|
|
|
2166
|
return $msg; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
if $] >= 5.008; |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
sub explain { |
101
|
366
|
|
|
366
|
1
|
699
|
my $e = shift; |
102
|
366
|
100
|
|
|
|
905
|
return undef unless $e->has_type; |
103
|
365
|
|
|
|
|
1030
|
$e->type->validate_explain( $e->value, $e->varname ); |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
1; |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
__END__ |