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


line stmt bran cond sub pod time code
1             package Error::TypeTiny::Assertion;
2              
3 295     295   6998 use 5.008001;
  295         1096  
4 295     295   1718 use strict;
  295         630  
  295         6823  
5 295     295   1690 use warnings;
  295         831  
  295         14098  
6              
7             BEGIN {
8 295     295   1206 $Error::TypeTiny::Assertion::AUTHORITY = 'cpan:TOBYINK';
9 295         226227 $Error::TypeTiny::Assertion::VERSION = '2.003_000';
10             }
11              
12             $Error::TypeTiny::Assertion::VERSION =~ tr/_//d;
13              
14             require Error::TypeTiny;
15             our @ISA = 'Error::TypeTiny';
16              
17 377     377 1 1442 sub type { $_[0]{type} }
18 373     373 1 1232 sub value { $_[0]{value} }
19 1046   100 1046 1 5548 sub varname { $_[0]{varname} ||= '$_' }
20 2     2 1 14 sub attribute_step { $_[0]{attribute_step} }
21 2     2 1 9 sub attribute_name { $_[0]{attribute_name} }
22              
23 371     371 1 1145 sub has_type { defined $_[0]{type} }; # sic
24 2     2 1 14 sub has_attribute_step { exists $_[0]{attribute_step} }
25 2     2 1 1074 sub has_attribute_name { exists $_[0]{attribute_name} }
26              
27             sub new {
28 422     422 1 1555 my $class = shift;
29 422         1588 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 422 50 33     1678 if ( ref $Method::Generate::Accessor::CurrentAttribute
      66        
42             and $self->{mgaca} || !exists $self->{mgaca} )
43             {
44 26         146 require B;
45 26         45 my %d = %{$Method::Generate::Accessor::CurrentAttribute};
  26         123  
46 26 50       108 $self->{attribute_name} = $d{name} if defined $d{name};
47 26 50       82 $self->{attribute_step} = $d{step} if defined $d{step};
48            
49 26 100       98 if ( defined $d{init_arg} ) {
    50          
50 21         207 $self->{varname} = sprintf( '$args->{%s}', B::perlstring( $d{init_arg} ) );
51             }
52             elsif ( defined $d{name} ) {
53 5         41 $self->{varname} = sprintf( '$self->{%s}', B::perlstring( $d{name} ) );
54             }
55             } #/ if ( ref $Method::Generate::Accessor::CurrentAttribute...)
56            
57 422         1966 return $self;
58             } #/ sub new
59              
60             sub message {
61 353     353 1 1661 my $e = shift;
62 353 100       835 $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   4 my $e = shift;
69 1 50       3 $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 347     347   816 my $e = shift;
82 347         960 my $msg = $e->message;
83            
84 347         1136 my $c = $e->context;
85 347 50 50     2581 $msg .= sprintf( " at %s line %s", $c->{file} || 'file?', $c->{line} || 'NaN' )
      50        
86             if $c;
87            
88 347         943 my $explain = $e->explain;
89 347 100       944 return "$msg\n" unless @{ $explain || [] };
  347 100       1484  
90            
91 346         685 $msg .= "\n";
92 346         825 for my $line ( @$explain ) {
93 2113         4200 $msg .= " $line\n";
94             }
95            
96 346         2225 return $msg;
97             }
98             if $] >= 5.008;
99            
100             sub explain {
101 370     370 1 731 my $e = shift;
102 370 100       810 return undef unless $e->has_type;
103 369         1044 $e->type->validate_explain( $e->value, $e->varname );
104             }
105              
106             1;
107              
108             __END__
109              
110             =pod
111              
112             =encoding utf-8
113              
114             =head1 NAME
115              
116             Error::TypeTiny::Assertion - exception when a value fails a type constraint
117              
118             =head1 STATUS
119              
120             This module is covered by the
121             L<Type-Tiny stability policy|Type::Tiny::Manual::Policies/"STABILITY">.
122              
123             =head1 DESCRIPTION
124              
125             This exception is thrown when a value fails a type constraint assertion.
126              
127             This package inherits from L<Error::TypeTiny>; see that for most
128             documentation. Major differences are listed below:
129              
130             =head2 Attributes
131              
132             =over
133              
134             =item C<type>
135              
136             The type constraint that was checked against. Weakened links are involved,
137             so this may end up being C<undef>.
138              
139             =item C<value>
140              
141             The value that was tested.
142              
143             =item C<varname>
144              
145             The name of the variable that was checked, if known. Defaults to C<< '$_' >>.
146              
147             =item C<attribute_name>
148              
149             If this exception was thrown as the result of an isa check or a failed
150             coercion for a Moo attribute, then this will tell you which attribute (if
151             your Moo is new enough).
152              
153             (Hopefully one day this will support other OO frameworks.)
154              
155             =item C<attribute_step>
156              
157             If this exception was thrown as the result of an isa check or a failed
158             coercion for a Moo attribute, then this will contain either C<< "isa check" >>
159             or C<< "coercion" >> to indicate which went wrong (if your Moo is new enough).
160              
161             (Hopefully one day this will support other OO frameworks.)
162              
163             =back
164              
165             =head2 Methods
166              
167             =over
168              
169             =item C<has_type>, C<has_attribute_name>, C<has_attribute_step>
170              
171             Predicate methods.
172              
173             =item C<message>
174              
175             Overridden to add C<varname> to the message if defined.
176              
177             =item C<explain>
178              
179             Attempts to explain why the value did not pass the type constraint. Returns
180             an arrayref of strings providing step-by-step reasoning; or returns undef if
181             no explanation is possible.
182              
183             =back
184              
185             =head1 BUGS
186              
187             Please report any bugs to
188             L<https://github.com/tobyink/p5-type-tiny/issues>.
189              
190             =head1 SEE ALSO
191              
192             L<Error::TypeTiny>.
193              
194             =head1 AUTHOR
195              
196             Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
197              
198             =head1 COPYRIGHT AND LICENCE
199              
200             This software is copyright (c) 2013-2014, 2017-2023 by Toby Inkster.
201              
202             This is free software; you can redistribute it and/or modify it under
203             the same terms as the Perl 5 programming language system itself.
204              
205             =head1 DISCLAIMER OF WARRANTIES
206              
207             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
208             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
209             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.