line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Type::Tiny; |
2
|
|
|
|
|
|
|
|
3
|
316
|
|
|
316
|
|
321326
|
use 5.008001; |
|
316
|
|
|
|
|
1269
|
|
4
|
316
|
|
|
316
|
|
1848
|
use strict; |
|
316
|
|
|
|
|
696
|
|
|
316
|
|
|
|
|
8341
|
|
5
|
316
|
|
|
316
|
|
1675
|
use warnings; |
|
316
|
|
|
|
|
808
|
|
|
316
|
|
|
|
|
16588
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
BEGIN { |
8
|
316
|
50
|
|
316
|
|
14345
|
if ( $] < 5.010 ) { require Devel::TypeTiny::Perl58Compat } |
|
0
|
|
|
|
|
0
|
|
9
|
|
|
|
|
|
|
} |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
BEGIN { |
12
|
316
|
|
|
316
|
|
1123
|
$Type::Tiny::AUTHORITY = 'cpan:TOBYINK'; |
13
|
316
|
|
|
|
|
684
|
$Type::Tiny::VERSION = '2.003_000'; |
14
|
316
|
|
|
|
|
35047
|
$Type::Tiny::XS_VERSION = '0.016'; |
15
|
|
|
|
|
|
|
} |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
$Type::Tiny::VERSION =~ tr/_//d; |
18
|
|
|
|
|
|
|
$Type::Tiny::XS_VERSION =~ tr/_//d; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our @InternalPackages = qw( |
21
|
|
|
|
|
|
|
Devel::TypeTiny::Perl56Compat |
22
|
|
|
|
|
|
|
Devel::TypeTiny::Perl58Compat |
23
|
|
|
|
|
|
|
Error::TypeTiny |
24
|
|
|
|
|
|
|
Error::TypeTiny::Assertion |
25
|
|
|
|
|
|
|
Error::TypeTiny::Compilation |
26
|
|
|
|
|
|
|
Error::TypeTiny::WrongNumberOfParameters |
27
|
|
|
|
|
|
|
Eval::TypeTiny |
28
|
|
|
|
|
|
|
Eval::TypeTiny::CodeAccumulator |
29
|
|
|
|
|
|
|
Eval::TypeTiny::Sandbox |
30
|
|
|
|
|
|
|
Exporter::Tiny |
31
|
|
|
|
|
|
|
Reply::Plugin::TypeTiny |
32
|
|
|
|
|
|
|
Test::TypeTiny |
33
|
|
|
|
|
|
|
Type::Coercion |
34
|
|
|
|
|
|
|
Type::Coercion::FromMoose |
35
|
|
|
|
|
|
|
Type::Coercion::Union |
36
|
|
|
|
|
|
|
Type::Library |
37
|
|
|
|
|
|
|
Type::Params |
38
|
|
|
|
|
|
|
Type::Params::Alternatives |
39
|
|
|
|
|
|
|
Type::Params::Parameter |
40
|
|
|
|
|
|
|
Type::Params::Signature |
41
|
|
|
|
|
|
|
Type::Parser |
42
|
|
|
|
|
|
|
Type::Parser::AstBuilder |
43
|
|
|
|
|
|
|
Type::Parser::Token |
44
|
|
|
|
|
|
|
Type::Parser::TokenStream |
45
|
|
|
|
|
|
|
Type::Registry |
46
|
|
|
|
|
|
|
Types::Common |
47
|
|
|
|
|
|
|
Types::Common::Numeric |
48
|
|
|
|
|
|
|
Types::Common::String |
49
|
|
|
|
|
|
|
Types::Standard |
50
|
|
|
|
|
|
|
Types::Standard::_Stringable |
51
|
|
|
|
|
|
|
Types::Standard::ArrayRef |
52
|
|
|
|
|
|
|
Types::Standard::CycleTuple |
53
|
|
|
|
|
|
|
Types::Standard::Dict |
54
|
|
|
|
|
|
|
Types::Standard::HashRef |
55
|
|
|
|
|
|
|
Types::Standard::Map |
56
|
|
|
|
|
|
|
Types::Standard::ScalarRef |
57
|
|
|
|
|
|
|
Types::Standard::StrMatch |
58
|
|
|
|
|
|
|
Types::Standard::Tied |
59
|
|
|
|
|
|
|
Types::Standard::Tuple |
60
|
|
|
|
|
|
|
Types::TypeTiny |
61
|
|
|
|
|
|
|
Type::Tie |
62
|
|
|
|
|
|
|
Type::Tie::ARRAY |
63
|
|
|
|
|
|
|
Type::Tie::BASE |
64
|
|
|
|
|
|
|
Type::Tie::HASH |
65
|
|
|
|
|
|
|
Type::Tie::SCALAR |
66
|
|
|
|
|
|
|
Type::Tiny |
67
|
|
|
|
|
|
|
Type::Tiny::_DeclaredType |
68
|
|
|
|
|
|
|
Type::Tiny::_HalfOp |
69
|
|
|
|
|
|
|
Type::Tiny::Class |
70
|
|
|
|
|
|
|
Type::Tiny::ConsrtainedObject |
71
|
|
|
|
|
|
|
Type::Tiny::Duck |
72
|
|
|
|
|
|
|
Type::Tiny::Enum |
73
|
|
|
|
|
|
|
Type::Tiny::Intersection |
74
|
|
|
|
|
|
|
Type::Tiny::Role |
75
|
|
|
|
|
|
|
Type::Tiny::Union |
76
|
|
|
|
|
|
|
Type::Utils |
77
|
|
|
|
|
|
|
); |
78
|
|
|
|
|
|
|
|
79
|
316
|
|
|
316
|
|
2565
|
use Scalar::Util qw( blessed ); |
|
316
|
|
|
|
|
758
|
|
|
316
|
|
|
|
|
16298
|
|
80
|
316
|
|
|
316
|
|
83364
|
use Types::TypeTiny (); |
|
316
|
|
|
|
|
1614
|
|
|
316
|
|
|
|
|
133178
|
|
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
our $SafePackage = sprintf 'package %s;', __PACKAGE__; |
83
|
|
|
|
|
|
|
|
84
|
16
|
|
|
16
|
|
94
|
sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } |
|
16
|
|
|
|
|
80
|
|
85
|
|
|
|
|
|
|
|
86
|
40159
|
50
|
|
40159
|
|
132488
|
sub _swap { $_[2] ? @_[ 1, 0 ] : @_[ 0, 1 ] } |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
BEGIN { |
89
|
316
|
|
|
316
|
|
1760
|
my $support_smartmatch = 0+ !!( $] >= 5.010001 ); |
90
|
316
|
|
|
|
|
20771
|
eval qq{ sub SUPPORT_SMARTMATCH () { !! $support_smartmatch } }; |
91
|
|
|
|
|
|
|
|
92
|
316
|
|
|
|
|
1694
|
my $fixed_precedence = 0+ !!( $] >= 5.014 ); |
93
|
316
|
|
|
|
|
11730
|
eval qq{ sub _FIXED_PRECEDENCE () { !! $fixed_precedence } }; |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
my $try_xs = |
96
|
|
|
|
|
|
|
exists( $ENV{PERL_TYPE_TINY_XS} ) ? !!$ENV{PERL_TYPE_TINY_XS} |
97
|
|
|
|
|
|
|
: exists( $ENV{PERL_ONLY} ) ? !$ENV{PERL_ONLY} |
98
|
316
|
50
|
|
|
|
2918
|
: 1; |
|
|
50
|
|
|
|
|
|
99
|
|
|
|
|
|
|
|
100
|
316
|
|
|
|
|
662
|
my $use_xs = 0; |
101
|
316
|
50
|
|
|
|
1146
|
$try_xs and eval { |
102
|
316
|
|
|
|
|
2039
|
require Type::Tiny::XS; |
103
|
316
|
|
|
|
|
3591
|
'Type::Tiny::XS'->VERSION( $Type::Tiny::XS_VERSION ); |
104
|
316
|
|
|
|
|
1202
|
$use_xs++; |
105
|
|
|
|
|
|
|
}; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
*_USE_XS = |
108
|
|
|
|
|
|
|
$use_xs |
109
|
|
|
|
|
|
|
? sub () { !!1 } |
110
|
316
|
50
|
|
|
|
1412
|
: sub () { !!0 }; |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
*_USE_MOUSE = |
113
|
|
|
|
|
|
|
$try_xs |
114
|
290
|
100
|
|
290
|
|
2913
|
? sub () { $INC{'Mouse/Util.pm'} and Mouse::Util::MOUSE_XS() } |
115
|
316
|
50
|
|
|
|
1638
|
: sub () { !!0 }; |
116
|
|
|
|
|
|
|
|
117
|
316
|
|
|
|
|
728
|
my $strict_mode = 0; |
118
|
316
|
|
100
|
|
|
3342
|
$ENV{$_} && ++$strict_mode for qw( |
119
|
|
|
|
|
|
|
EXTENDED_TESTING |
120
|
|
|
|
|
|
|
AUTHOR_TESTING |
121
|
|
|
|
|
|
|
RELEASE_TESTING |
122
|
|
|
|
|
|
|
PERL_STRICT |
123
|
|
|
|
|
|
|
); |
124
|
316
|
100
|
|
|
|
10985
|
*_STRICT_MODE = $strict_mode ? sub () { !!1 } : sub () { !!0 }; |
125
|
|
|
|
|
|
|
} #/ BEGIN |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
{ |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub _install_overloads { |
130
|
316
|
|
|
316
|
|
2084
|
no strict 'refs'; |
|
316
|
|
|
|
|
805
|
|
|
316
|
|
|
|
|
11372
|
|
131
|
316
|
|
|
316
|
|
3601
|
no warnings 'redefine', 'once'; |
|
316
|
|
|
|
|
2488
|
|
|
316
|
|
|
|
|
3661222
|
|
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
# Coverage is checked on Perl 5.26 |
134
|
2183
|
50
|
|
2183
|
|
8024
|
if ( $] < 5.010 ) { # uncoverable statement |
135
|
0
|
|
|
|
|
0
|
require overload; # uncoverable statement |
136
|
0
|
|
|
|
|
0
|
push @_, fallback => 1; # uncoverable statement |
137
|
0
|
|
|
|
|
0
|
goto \&overload::OVERLOAD; # uncoverable statement |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
2183
|
|
|
|
|
4296
|
my $class = shift; |
141
|
2183
|
|
|
0
|
|
6047
|
*{ $class . '::((' } = sub { }; |
|
2183
|
|
|
|
|
12417
|
|
142
|
2183
|
|
|
0
|
|
6364
|
*{ $class . '::()' } = sub { }; |
|
2183
|
|
|
|
|
9016
|
|
143
|
2183
|
|
|
|
|
3637
|
*{ $class . '::()' } = do { my $x = 1; \$x }; |
|
2183
|
|
|
|
|
5164
|
|
|
2183
|
|
|
|
|
3263
|
|
|
2183
|
|
|
|
|
3687
|
|
144
|
2183
|
|
|
|
|
6031
|
while ( @_ ) { |
145
|
7818
|
|
|
|
|
12219
|
my $f = shift; |
146
|
7818
|
100
|
|
|
|
14839
|
*{ $class . '::(' . $f } = ref $_[0] ? shift : do { |
|
7818
|
|
|
|
|
35794
|
|
147
|
620
|
|
|
|
|
1413
|
my $m = shift; |
148
|
839
|
|
|
839
|
|
86508
|
sub { shift->$m( @_ ) } |
149
|
620
|
|
|
|
|
2431
|
}; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
} #/ sub _install_overloads |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
__PACKAGE__->_install_overloads( |
155
|
|
|
|
|
|
|
q("") => sub { |
156
|
49864
|
100
|
|
49864
|
|
319012
|
caller =~ m{^(Moo::HandleMoose|Sub::Quote)} |
157
|
|
|
|
|
|
|
? $_[0]->_stringify_no_magic |
158
|
|
|
|
|
|
|
: $_[0]->display_name; |
159
|
|
|
|
|
|
|
}, |
160
|
46784
|
|
|
46784
|
|
200399
|
q(bool) => sub { 1 }, |
161
|
|
|
|
|
|
|
q(&{}) => "_overload_coderef", |
162
|
|
|
|
|
|
|
q(|) => sub { |
163
|
70
|
|
|
70
|
|
5060
|
my @tc = _swap @_; |
164
|
70
|
|
|
|
|
108
|
if ( !_FIXED_PRECEDENCE && $_[2] ) { |
165
|
|
|
|
|
|
|
if ( blessed $tc[0] ) { |
166
|
|
|
|
|
|
|
if ( blessed $tc[0] eq "Type::Tiny::_HalfOp" ) { |
167
|
|
|
|
|
|
|
my $type = $tc[0]->{type}; |
168
|
|
|
|
|
|
|
my $param = $tc[0]->{param}; |
169
|
|
|
|
|
|
|
my $op = $tc[0]->{op}; |
170
|
|
|
|
|
|
|
require Type::Tiny::Union; |
171
|
|
|
|
|
|
|
return "Type::Tiny::_HalfOp"->new( |
172
|
|
|
|
|
|
|
$op, |
173
|
|
|
|
|
|
|
$param, |
174
|
|
|
|
|
|
|
"Type::Tiny::Union"->new_by_overload( type_constraints => [ $type, $tc[1] ] ), |
175
|
|
|
|
|
|
|
); |
176
|
|
|
|
|
|
|
} #/ if ( blessed $tc[0] eq...) |
177
|
|
|
|
|
|
|
} #/ if ( blessed $tc[0] ) |
178
|
|
|
|
|
|
|
elsif ( ref $tc[0] eq 'ARRAY' ) { |
179
|
|
|
|
|
|
|
require Type::Tiny::_HalfOp; |
180
|
|
|
|
|
|
|
return "Type::Tiny::_HalfOp"->new( '|', @tc ); |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
} #/ if ( !_FIXED_PRECEDENCE...) |
183
|
70
|
|
|
|
|
11066
|
require Type::Tiny::Union; |
184
|
70
|
|
|
|
|
390
|
return "Type::Tiny::Union"->new_by_overload( type_constraints => \@tc ); |
185
|
|
|
|
|
|
|
}, |
186
|
|
|
|
|
|
|
q(&) => sub { |
187
|
40059
|
|
|
40059
|
|
1832913
|
my @tc = _swap @_; |
188
|
40059
|
|
|
|
|
61014
|
if ( !_FIXED_PRECEDENCE && $_[2] ) { |
189
|
|
|
|
|
|
|
if ( blessed $tc[0] ) { |
190
|
|
|
|
|
|
|
if ( blessed $tc[0] eq "Type::Tiny::_HalfOp" ) { |
191
|
|
|
|
|
|
|
my $type = $tc[0]->{type}; |
192
|
|
|
|
|
|
|
my $param = $tc[0]->{param}; |
193
|
|
|
|
|
|
|
my $op = $tc[0]->{op}; |
194
|
|
|
|
|
|
|
require Type::Tiny::Intersection; |
195
|
|
|
|
|
|
|
return "Type::Tiny::_HalfOp"->new( |
196
|
|
|
|
|
|
|
$op, |
197
|
|
|
|
|
|
|
$param, |
198
|
|
|
|
|
|
|
"Type::Tiny::Intersection"->new_by_overload( type_constraints => [ $type, $tc[1] ] ), |
199
|
|
|
|
|
|
|
); |
200
|
|
|
|
|
|
|
} #/ if ( blessed $tc[0] eq...) |
201
|
|
|
|
|
|
|
} #/ if ( blessed $tc[0] ) |
202
|
|
|
|
|
|
|
elsif ( ref $tc[0] eq 'ARRAY' ) { |
203
|
|
|
|
|
|
|
require Type::Tiny::_HalfOp; |
204
|
|
|
|
|
|
|
return "Type::Tiny::_HalfOp"->new( '&', @tc ); |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
} #/ if ( !_FIXED_PRECEDENCE...) |
207
|
40059
|
|
|
|
|
216357
|
require Type::Tiny::Intersection; |
208
|
40059
|
|
|
|
|
144529
|
"Type::Tiny::Intersection"->new_by_overload( type_constraints => \@tc ); |
209
|
|
|
|
|
|
|
}, |
210
|
69
|
|
|
69
|
|
1407
|
q(~) => sub { shift->complementary_type }, |
211
|
702
|
|
|
702
|
|
7075
|
q(==) => sub { $_[0]->equals( $_[1] ) }, |
212
|
1
|
|
|
1
|
|
7
|
q(!=) => sub { not $_[0]->equals( $_[1] ) }, |
213
|
8
|
|
|
8
|
|
68
|
q(<) => sub { my $m = $_[0]->can( 'is_subtype_of' ); $m->( _swap @_ ) }, |
|
8
|
|
|
|
|
45
|
|
214
|
|
|
|
|
|
|
q(>) => sub { |
215
|
10
|
|
|
10
|
|
113
|
my $m = $_[0]->can( 'is_subtype_of' ); |
216
|
10
|
|
|
|
|
27
|
$m->( reverse _swap @_ ); |
217
|
|
|
|
|
|
|
}, |
218
|
6
|
|
|
6
|
|
57
|
q(<=) => sub { my $m = $_[0]->can( 'is_a_type_of' ); $m->( _swap @_ ) }, |
|
6
|
|
|
|
|
16
|
|
219
|
|
|
|
|
|
|
q(>=) => sub { |
220
|
6
|
|
|
6
|
|
64
|
my $m = $_[0]->can( 'is_a_type_of' ); |
221
|
6
|
|
|
|
|
15
|
$m->( reverse _swap @_ ); |
222
|
|
|
|
|
|
|
}, |
223
|
28
|
|
|
28
|
|
10785
|
q(eq) => sub { "$_[0]" eq "$_[1]" }, |
224
|
1
|
50
|
|
1
|
|
54
|
q(cmp) => sub { $_[2] ? ( "$_[1]" cmp "$_[0]" ) : ( "$_[0]" cmp "$_[1]" ) }, |
225
|
1
|
|
|
1
|
|
46
|
q(0+) => sub { $_[0]{uniq} }, |
226
|
4
|
100
|
50
|
4
|
|
2626
|
q(/) => sub { ( _STRICT_MODE xor $_[2] ) ? $_[0] : $_[1] }, |
227
|
|
|
|
|
|
|
); |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
__PACKAGE__->_install_overloads( |
230
|
3
|
|
|
3
|
|
475
|
q(~~) => sub { $_[0]->check( $_[1] ) }, |
231
|
|
|
|
|
|
|
) if Type::Tiny::SUPPORT_SMARTMATCH; |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
# Would be easy to just return sub { $self->assert_return(@_) } |
234
|
|
|
|
|
|
|
# but try to build a more efficient coderef whenever possible. |
235
|
|
|
|
|
|
|
# |
236
|
|
|
|
|
|
|
sub _overload_coderef { |
237
|
14387
|
|
|
14387
|
|
32322
|
my $self = shift; |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
# Bypass generating a coderef if we've already got the best possible one. |
240
|
|
|
|
|
|
|
# |
241
|
14387
|
100
|
|
|
|
43924
|
return $self->{_overload_coderef} if $self->{_overload_coderef_no_rebuild}; |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
# Subclasses of Type::Tiny might override assert_return to do some kind |
244
|
|
|
|
|
|
|
# of interesting thing. In that case, we can't rely on it having identical |
245
|
|
|
|
|
|
|
# behaviour to Type::Tiny::inline_assert. |
246
|
|
|
|
|
|
|
# |
247
|
|
|
|
|
|
|
$self->{_overrides_assert_return} = |
248
|
|
|
|
|
|
|
( $self->can( 'assert_return' ) != \&assert_return ) |
249
|
14368
|
100
|
|
|
|
43671
|
unless exists $self->{_overrides_assert_return}; |
250
|
|
|
|
|
|
|
|
251
|
14368
|
100
|
|
|
|
44722
|
if ( $self->{_overrides_assert_return} ) { |
|
|
100
|
|
|
|
|
|
252
|
1
|
|
33
|
|
|
8
|
$self->{_overload_coderef} ||= do { |
253
|
1
|
|
|
|
|
5
|
Scalar::Util::weaken( my $weak = $self ); |
254
|
1
|
|
|
2
|
|
6
|
sub { $weak->assert_return( @_ ) }; |
|
2
|
|
|
|
|
7
|
|
255
|
|
|
|
|
|
|
}; |
256
|
1
|
|
|
|
|
3
|
++$self->{_overload_coderef_no_rebuild}; |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
elsif ( exists( &Sub::Quote::quote_sub ) ) { |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
# Use `=` instead of `||=` because we want to overwrite non-Sub::Quote |
261
|
|
|
|
|
|
|
# coderef if possible. |
262
|
245
|
100
|
|
|
|
568
|
$self->{_overload_coderef} = $self->can_be_inlined |
263
|
|
|
|
|
|
|
? Sub::Quote::quote_sub( |
264
|
|
|
|
|
|
|
$self->inline_assert( '$_[0]' ), |
265
|
|
|
|
|
|
|
) |
266
|
|
|
|
|
|
|
: Sub::Quote::quote_sub( |
267
|
|
|
|
|
|
|
$self->inline_assert( '$_[0]', '$type' ), |
268
|
|
|
|
|
|
|
{ '$type' => \$self }, |
269
|
|
|
|
|
|
|
); |
270
|
245
|
|
|
|
|
20538
|
++$self->{_overload_coderef_no_rebuild}; |
271
|
|
|
|
|
|
|
} #/ elsif ( exists( &Sub::Quote::quote_sub...)) |
272
|
|
|
|
|
|
|
else { |
273
|
14122
|
|
|
|
|
74415
|
require Eval::TypeTiny; |
274
|
14122
|
100
|
66
|
|
|
50177
|
$self->{_overload_coderef} ||= $self->can_be_inlined |
275
|
|
|
|
|
|
|
? Eval::TypeTiny::eval_closure( |
276
|
|
|
|
|
|
|
source => sprintf( |
277
|
|
|
|
|
|
|
'sub { %s }', $self->inline_assert( '$_[0]', undef, no_wrapper => 1 ) |
278
|
|
|
|
|
|
|
), |
279
|
|
|
|
|
|
|
description => sprintf( "compiled assertion 'assert_%s'", $self ), |
280
|
|
|
|
|
|
|
) |
281
|
|
|
|
|
|
|
: Eval::TypeTiny::eval_closure( |
282
|
|
|
|
|
|
|
source => sprintf( |
283
|
|
|
|
|
|
|
'sub { %s }', $self->inline_assert( '$_[0]', '$type', no_wrapper => 1 ) |
284
|
|
|
|
|
|
|
), |
285
|
|
|
|
|
|
|
description => sprintf( "compiled assertion 'assert_%s'", $self ), |
286
|
|
|
|
|
|
|
environment => { '$type' => \$self }, |
287
|
|
|
|
|
|
|
); |
288
|
|
|
|
|
|
|
} #/ else [ if ( $self->{_overrides_assert_return...})] |
289
|
|
|
|
|
|
|
|
290
|
14368
|
|
|
|
|
91848
|
$self->{_overload_coderef}; |
291
|
|
|
|
|
|
|
} #/ sub _overload_coderef |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
our %ALL_TYPES; |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
my $QFS; |
296
|
|
|
|
|
|
|
my $uniq = 1; |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
sub new { |
299
|
95438
|
|
|
95438
|
1
|
175616
|
my $class = shift; |
300
|
95438
|
50
|
|
|
|
316602
|
my %params = ( @_ == 1 ) ? %{ $_[0] } : @_; |
|
0
|
|
|
|
|
0
|
|
301
|
|
|
|
|
|
|
|
302
|
95438
|
|
|
|
|
219001
|
for ( qw/ name display_name library / ) { |
303
|
286314
|
100
|
|
|
|
603648
|
$params{$_} = $params{$_} . '' if defined $params{$_}; |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
95438
|
|
|
|
|
152546
|
my $level = 0; |
307
|
95438
|
|
66
|
|
|
329376
|
while ( not exists $params{definition_context} and $level < 20 ) { |
308
|
232692
|
|
66
|
|
|
406692
|
our $_TT_GUTS ||= do { |
309
|
305
|
|
|
|
|
16203
|
my $g = join '|', map quotemeta, grep !m{^Types::}, @InternalPackages; |
310
|
305
|
|
|
|
|
155576
|
qr/\A(?:$g)\z/o |
311
|
|
|
|
|
|
|
}; |
312
|
232692
|
|
|
|
|
404130
|
my $package = caller $level; |
313
|
232692
|
100
|
|
|
|
1127630
|
if ( $package !~ $_TT_GUTS ) { |
314
|
95438
|
|
|
|
|
506905
|
@{ $params{definition_context} = {} }{ qw/ package file line / } = caller $level; |
|
95438
|
|
|
|
|
391950
|
|
315
|
|
|
|
|
|
|
} |
316
|
232692
|
|
|
|
|
719828
|
++$level; |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
95438
|
100
|
|
|
|
196542
|
if ( exists $params{parent} ) { |
320
|
|
|
|
|
|
|
$params{parent} = |
321
|
|
|
|
|
|
|
ref( $params{parent} ) =~ /^Type::Tiny\b/ |
322
|
|
|
|
|
|
|
? $params{parent} |
323
|
12565
|
50
|
|
|
|
50410
|
: Types::TypeTiny::to_TypeTiny( $params{parent} ); |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
_croak "Parent must be an instance of %s", __PACKAGE__ |
326
|
|
|
|
|
|
|
unless blessed( $params{parent} ) |
327
|
12565
|
50
|
33
|
|
|
61746
|
&& $params{parent}->isa( __PACKAGE__ ); |
328
|
|
|
|
|
|
|
|
329
|
12565
|
100
|
100
|
|
|
36557
|
if ( $params{parent}->deprecated and not exists $params{deprecated} ) { |
330
|
3
|
|
|
|
|
19
|
$params{deprecated} = 1; |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
} #/ if ( exists $params{parent...}) |
333
|
|
|
|
|
|
|
|
334
|
95438
|
100
|
66
|
|
|
367943
|
if ( exists $params{constraint} |
|
|
|
100
|
|
|
|
|
335
|
|
|
|
|
|
|
and defined $params{constraint} |
336
|
|
|
|
|
|
|
and not ref $params{constraint} ) |
337
|
|
|
|
|
|
|
{ |
338
|
79
|
|
|
|
|
414
|
require Eval::TypeTiny; |
339
|
79
|
|
|
|
|
179
|
my $code = $params{constraint}; |
340
|
79
|
|
|
|
|
468
|
$params{constraint} = Eval::TypeTiny::eval_closure( |
341
|
|
|
|
|
|
|
source => sprintf( 'sub ($) { %s }', $code ), |
342
|
|
|
|
|
|
|
description => "anonymous check", |
343
|
|
|
|
|
|
|
); |
344
|
|
|
|
|
|
|
$params{inlined} ||= sub { |
345
|
269
|
|
|
269
|
|
554
|
my ( $type ) = @_; |
346
|
269
|
100
|
|
|
|
1064
|
my $inlined = $_ eq '$_' ? "do { $code }" : "do { local \$_ = $_; $code }"; |
347
|
269
|
100
|
|
|
|
521
|
$type->has_parent ? ( undef, $inlined ) : $inlined; |
348
|
|
|
|
|
|
|
} |
349
|
79
|
50
|
50
|
|
|
518
|
if ( !exists $params{parent} or $params{parent}->can_be_inlined ); |
|
|
|
66
|
|
|
|
|
350
|
|
|
|
|
|
|
} #/ if ( exists $params{constraint...}) |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
# canonicalize to a boolean |
353
|
95438
|
|
|
|
|
187374
|
$params{deprecated} = !!$params{deprecated}; |
354
|
|
|
|
|
|
|
|
355
|
95438
|
100
|
|
|
|
226142
|
$params{name} = "__ANON__" unless exists $params{name}; |
356
|
95438
|
|
|
|
|
159771
|
$params{uniq} = $uniq++; |
357
|
|
|
|
|
|
|
|
358
|
95438
|
100
|
|
|
|
220348
|
if ( $params{name} ne "__ANON__" ) { |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
# First try a fast ASCII-only expression, but fall back to Unicode |
361
|
|
|
|
|
|
|
$params{name} =~ /^_{0,2}[A-Z][A-Za-z0-9_]+$/sm |
362
|
|
|
|
|
|
|
or eval q( use 5.008; $params{name} =~ /^_{0,2}\p{Lu}[\p{L}0-9_]+$/sm ) |
363
|
13053
|
100
|
66
|
|
|
66501
|
or _croak '"%s" is not a valid type name', $params{name}; |
|
1
|
|
|
|
|
26
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
672
|
|
|
1
|
|
|
|
|
44
|
|
|
1
|
|
|
|
|
16
|
|
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
|
366
|
95437
|
100
|
100
|
|
|
212314
|
if ( exists $params{coercion} and !ref $params{coercion} and $params{coercion} ) |
|
|
|
100
|
|
|
|
|
367
|
|
|
|
|
|
|
{ |
368
|
|
|
|
|
|
|
$params{parent}->has_coercion |
369
|
6
|
50
|
|
|
|
30
|
or _croak |
370
|
|
|
|
|
|
|
"coercion => 1 requires type to have a direct parent with a coercion"; |
371
|
|
|
|
|
|
|
|
372
|
6
|
|
|
|
|
44
|
$params{coercion} = $params{parent}->coercion->type_coercion_map; |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
95437
|
100
|
100
|
|
|
537359
|
if ( !exists $params{inlined} |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
376
|
|
|
|
|
|
|
and exists $params{constraint} |
377
|
|
|
|
|
|
|
and ( !exists $params{parent} or $params{parent}->can_be_inlined ) |
378
|
|
|
|
|
|
|
and $QFS ||= "Sub::Quote"->can( "quoted_from_sub" ) ) |
379
|
|
|
|
|
|
|
{ |
380
|
10
|
100
|
|
|
|
20
|
my ( undef, $perlstring, $captures ) = @{ $QFS->( $params{constraint} ) || [] }; |
|
10
|
|
|
|
|
36
|
|
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
$params{inlined} = sub { |
383
|
28
|
|
|
28
|
|
50
|
my ( $self, $var ) = @_; |
384
|
28
|
50
|
|
|
|
124
|
my $code = Sub::Quote::inlinify( |
385
|
|
|
|
|
|
|
$perlstring, |
386
|
|
|
|
|
|
|
$var, |
387
|
|
|
|
|
|
|
$var eq q($_) ? '' : "local \$_ = $var;", |
388
|
|
|
|
|
|
|
1, |
389
|
|
|
|
|
|
|
); |
390
|
28
|
100
|
|
|
|
577
|
$code = sprintf( '%s and %s', $self->parent->inline_check( $var ), $code ) |
391
|
|
|
|
|
|
|
if $self->has_parent; |
392
|
28
|
|
|
|
|
63
|
return $code; |
393
|
|
|
|
|
|
|
} |
394
|
10
|
100
|
100
|
|
|
410
|
if $perlstring && !$captures; |
395
|
|
|
|
|
|
|
} #/ if ( !exists $params{inlined...}) |
396
|
|
|
|
|
|
|
|
397
|
95437
|
|
|
|
|
204150
|
my $self = bless \%params, $class; |
398
|
|
|
|
|
|
|
|
399
|
95437
|
100
|
|
|
|
198321
|
unless ( $params{tmp} ) { |
400
|
95373
|
|
|
|
|
205924
|
my $uniq = $self->{uniq}; |
401
|
|
|
|
|
|
|
|
402
|
95373
|
|
|
|
|
337516
|
$ALL_TYPES{$uniq} = $self; |
403
|
95373
|
|
|
|
|
279652
|
Scalar::Util::weaken( $ALL_TYPES{$uniq} ); |
404
|
|
|
|
|
|
|
|
405
|
95373
|
|
|
|
|
142541
|
my $tmp = $self; |
406
|
95373
|
|
|
|
|
236571
|
Scalar::Util::weaken( $tmp ); |
407
|
95373
|
|
|
3
|
|
379712
|
$Moo::HandleMoose::TYPE_MAP{ $self->_stringify_no_magic } = sub { $tmp }; |
|
3
|
|
|
|
|
18
|
|
408
|
|
|
|
|
|
|
} #/ unless ( $params{tmp} ) |
409
|
|
|
|
|
|
|
|
410
|
95437
|
100
|
|
|
|
327416
|
if ( ref( $params{coercion} ) eq q(CODE) ) { |
|
|
100
|
|
|
|
|
|
411
|
3
|
|
|
|
|
18
|
require Types::Standard; |
412
|
3
|
|
|
|
|
12
|
my $code = delete( $params{coercion} ); |
413
|
3
|
|
|
|
|
11
|
$self->{coercion} = $self->_build_coercion; |
414
|
3
|
|
|
|
|
24
|
$self->coercion->add_type_coercions( Types::Standard::Any(), $code ); |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
elsif ( ref( $params{coercion} ) eq q(ARRAY) ) { |
417
|
9
|
|
|
|
|
31
|
my $arr = delete( $params{coercion} ); |
418
|
9
|
|
|
|
|
37
|
$self->{coercion} = $self->_build_coercion; |
419
|
9
|
|
|
|
|
36
|
$self->coercion->add_type_coercions( @$arr ); |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
# Documenting this here because it's too weird to be in the pod. |
423
|
|
|
|
|
|
|
# There's a secret attribute called "_build_coercion" which takes a |
424
|
|
|
|
|
|
|
# coderef. If present, then when $type->coercion is lazy built, |
425
|
|
|
|
|
|
|
# the blank Type::Coercion object gets passed to the coderef, |
426
|
|
|
|
|
|
|
# allowing the coderef to manipulate it a little. This is used by |
427
|
|
|
|
|
|
|
# Types::TypeTiny to allow it to build a coercion for the TypeTiny |
428
|
|
|
|
|
|
|
# type constraint without needing to load Type::Coercion yet. |
429
|
|
|
|
|
|
|
|
430
|
95437
|
100
|
|
|
|
209089
|
if ( $params{my_methods} ) { |
431
|
1129
|
|
|
|
|
6525
|
require Eval::TypeTiny; |
432
|
|
|
|
|
|
|
Scalar::Util::reftype( $params{my_methods}{$_} ) eq 'CODE' |
433
|
|
|
|
|
|
|
and Eval::TypeTiny::set_subname( |
434
|
|
|
|
|
|
|
sprintf( "%s::my_%s", $self->qualified_name, $_ ), |
435
|
|
|
|
|
|
|
$params{my_methods}{$_}, |
436
|
1129
|
|
66
|
|
|
2320
|
) for keys %{ $params{my_methods} }; |
|
1129
|
|
|
|
|
12109
|
|
437
|
|
|
|
|
|
|
} #/ if ( $params{my_methods...}) |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
# In general, mutating a type constraint after it's been created |
440
|
|
|
|
|
|
|
# is a bad idea and will probably not work. However some places are |
441
|
|
|
|
|
|
|
# especially harmful and can lead to confusing errors, so allow |
442
|
|
|
|
|
|
|
# subclasses to lock down particular keys. |
443
|
|
|
|
|
|
|
# |
444
|
|
|
|
|
|
|
$self->_lockdown( sub { |
445
|
40422
|
|
|
40422
|
|
157659
|
&Internals::SvREADONLY( $_, !!1 ) for @_; |
446
|
95437
|
|
|
|
|
400487
|
} ); |
447
|
|
|
|
|
|
|
|
448
|
95437
|
|
|
|
|
610712
|
return $self; |
449
|
|
|
|
|
|
|
} #/ sub new |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
55015
|
|
|
sub _lockdown {} |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
sub DESTROY { |
454
|
81631
|
|
|
81631
|
|
315664
|
my $self = shift; |
455
|
81631
|
|
|
|
|
228933
|
delete( $ALL_TYPES{ $self->{uniq} } ); |
456
|
81631
|
|
|
|
|
167653
|
delete( $Moo::HandleMoose::TYPE_MAP{ $self->_stringify_no_magic } ); |
457
|
81631
|
|
|
|
|
837530
|
return; |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
sub _clone { |
461
|
106
|
|
|
106
|
|
222
|
my $self = shift; |
462
|
106
|
|
|
|
|
186
|
my %opts; |
463
|
106
|
|
|
|
|
1077
|
$opts{$_} = $self->{$_} for qw< name display_name message >; |
464
|
106
|
|
|
|
|
520
|
$self->create_child_type( %opts ); |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
sub _stringify_no_magic { |
468
|
177008
|
|
|
177008
|
|
1336558
|
sprintf( |
469
|
|
|
|
|
|
|
'%s=%s(0x%08x)', blessed( $_[0] ), Scalar::Util::reftype( $_[0] ), |
470
|
|
|
|
|
|
|
Scalar::Util::refaddr( $_[0] ) |
471
|
|
|
|
|
|
|
); |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
our $DD; |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
sub _dd { |
477
|
4562
|
50
|
|
4562
|
|
11812
|
@_ = $_ unless @_; |
478
|
4562
|
|
|
|
|
9050
|
my ( $value ) = @_; |
479
|
|
|
|
|
|
|
|
480
|
4562
|
100
|
|
|
|
11334
|
goto $DD if ref( $DD ) eq q(CODE); |
481
|
|
|
|
|
|
|
|
482
|
4560
|
|
|
|
|
21173
|
require B; |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
!defined $value ? 'Undef' |
485
|
|
|
|
|
|
|
: !ref $value ? sprintf( 'Value %s', B::perlstring( $value ) ) |
486
|
4560
|
100
|
|
|
|
35075
|
: do { |
|
|
100
|
|
|
|
|
|
487
|
2523
|
50
|
|
|
|
6035
|
my $N = 0+ ( defined( $DD ) ? $DD : 72 ); |
488
|
2523
|
|
|
|
|
88838
|
require Data::Dumper; |
489
|
2523
|
|
|
|
|
781368
|
local $Data::Dumper::Indent = 0; |
490
|
2523
|
|
|
|
|
3936
|
local $Data::Dumper::Useqq = 1; |
491
|
2523
|
|
|
|
|
3925
|
local $Data::Dumper::Terse = 1; |
492
|
2523
|
|
|
|
|
3895
|
local $Data::Dumper::Sortkeys = 1; |
493
|
2523
|
|
|
|
|
3915
|
local $Data::Dumper::Maxdepth = 2; |
494
|
2523
|
|
|
|
|
3454
|
my $str; |
495
|
|
|
|
|
|
|
eval { |
496
|
2523
|
|
|
|
|
7448
|
$str = Data::Dumper::Dumper( $value ); |
497
|
2523
|
100
|
|
|
|
136807
|
$str = substr( $str, 0, $N - 12 ) . '...' . substr( $str, -1, 1 ) |
498
|
|
|
|
|
|
|
if length( $str ) >= $N; |
499
|
2523
|
|
|
|
|
6629
|
1; |
500
|
2523
|
50
|
|
|
|
4090
|
} or do { $str = 'which cannot be dumped' }; |
|
0
|
|
|
|
|
0
|
|
501
|
2523
|
|
|
|
|
22389
|
"Reference $str"; |
502
|
|
|
|
|
|
|
} #/ do |
503
|
|
|
|
|
|
|
} #/ sub _dd |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
sub _loose_to_TypeTiny { |
506
|
29794
|
|
|
29794
|
|
47043
|
my $caller = caller( 1 ); # assumption |
507
|
|
|
|
|
|
|
map +( |
508
|
|
|
|
|
|
|
ref( $_ ) |
509
|
|
|
|
|
|
|
? Types::TypeTiny::to_TypeTiny( $_ ) |
510
|
29794
|
100
|
|
|
|
77646
|
: do { require Type::Utils; Type::Utils::dwim_type( $_, for => $caller ) } |
|
64
|
|
|
|
|
2216
|
|
|
64
|
|
|
|
|
349
|
|
511
|
|
|
|
|
|
|
), @_; |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
|
514
|
104788
|
|
|
104788
|
1
|
503329
|
sub name { $_[0]{name} } |
515
|
51356
|
|
66
|
51356
|
1
|
262641
|
sub display_name { $_[0]{display_name} ||= $_[0]->_build_display_name } |
516
|
155477
|
|
|
155477
|
1
|
312895
|
sub parent { $_[0]{parent} } |
517
|
434147
|
|
66
|
434147
|
1
|
1575019
|
sub constraint { $_[0]{constraint} ||= $_[0]->_build_constraint } |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
sub compiled_check { |
520
|
133796
|
|
66
|
133796
|
1
|
524555
|
$_[0]{compiled_type_constraint} ||= $_[0]->_build_compiled_check; |
521
|
|
|
|
|
|
|
} |
522
|
18775
|
|
66
|
18775
|
1
|
74948
|
sub coercion { $_[0]{coercion} ||= $_[0]->_build_coercion } |
523
|
62
|
|
|
62
|
1
|
270
|
sub message { $_[0]{message} } |
524
|
68
|
|
|
68
|
1
|
1067
|
sub library { $_[0]{library} } |
525
|
49398
|
|
|
49398
|
1
|
141868
|
sub inlined { $_[0]{inlined} } |
526
|
32221
|
|
|
32221
|
1
|
127327
|
sub deprecated { $_[0]{deprecated} } |
527
|
1106
|
|
|
1106
|
1
|
8614
|
sub constraint_generator { $_[0]{constraint_generator} } |
528
|
1137
|
|
|
1137
|
1
|
4495
|
sub inline_generator { $_[0]{inline_generator} } |
529
|
949
|
|
66
|
949
|
1
|
5302
|
sub name_generator { $_[0]{name_generator} ||= $_[0]->_build_name_generator } |
530
|
251
|
|
|
251
|
1
|
1384
|
sub coercion_generator { $_[0]{coercion_generator} } |
531
|
1088
|
|
|
1088
|
1
|
6717
|
sub parameters { $_[0]{parameters} } |
532
|
589
|
|
66
|
589
|
1
|
6146
|
sub moose_type { $_[0]{moose_type} ||= $_[0]->_build_moose_type } |
533
|
4
|
|
66
|
4
|
1
|
43
|
sub mouse_type { $_[0]{mouse_type} ||= $_[0]->_build_mouse_type } |
534
|
101
|
|
|
101
|
1
|
394
|
sub deep_explanation { $_[0]{deep_explanation} } |
535
|
1892
|
|
66
|
1892
|
1
|
6902
|
sub my_methods { $_[0]{my_methods} ||= $_[0]->_build_my_methods } |
536
|
25
|
|
|
25
|
1
|
58
|
sub sorter { $_[0]{sorter} } |
537
|
24076
|
|
66
|
24076
|
1
|
100707
|
sub exception_class { $_[0]{exception_class} ||= $_[0]->_build_exception_class } |
538
|
|
|
|
|
|
|
|
539
|
581668
|
|
|
581668
|
1
|
1465069
|
sub has_parent { exists $_[0]{parent} } |
540
|
110
|
|
|
110
|
1
|
647
|
sub has_library { exists $_[0]{library} } |
541
|
142682
|
|
|
142682
|
1
|
468772
|
sub has_inlined { exists $_[0]{inlined} } |
542
|
15231
|
|
|
15231
|
1
|
75525
|
sub has_constraint_generator { exists $_[0]{constraint_generator} } |
543
|
872
|
|
|
872
|
1
|
5529
|
sub has_inline_generator { exists $_[0]{inline_generator} } |
544
|
1937
|
|
|
1937
|
1
|
7501
|
sub has_coercion_generator { exists $_[0]{coercion_generator} } |
545
|
550
|
|
|
550
|
1
|
2296
|
sub has_parameters { exists $_[0]{parameters} } |
546
|
2151
|
|
|
2151
|
1
|
10161
|
sub has_message { defined $_[0]{message} } |
547
|
103
|
|
|
103
|
1
|
413
|
sub has_deep_explanation { exists $_[0]{deep_explanation} } |
548
|
74
|
|
|
74
|
1
|
179
|
sub has_sorter { exists $_[0]{sorter} } |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
sub _default_message { |
551
|
1992
|
|
66
|
1992
|
|
8914
|
$_[0]{_default_message} ||= $_[0]->_build_default_message; |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
sub has_coercion { |
555
|
30129
|
100
|
|
30129
|
1
|
103130
|
$_[0]->coercion if $_[0]{_build_coercion}; # trigger auto build thing |
556
|
30129
|
100
|
|
|
|
131090
|
$_[0]{coercion} and !!@{ $_[0]{coercion}->type_coercion_map }; |
|
18133
|
|
|
|
|
39172
|
|
557
|
|
|
|
|
|
|
} |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
sub _assert_coercion { |
560
|
697
|
|
|
697
|
|
1229
|
my $self = shift; |
561
|
697
|
100
|
|
|
|
2296
|
return $self->coercion if $self->{_build_coercion}; # trigger auto build thing |
562
|
|
|
|
|
|
|
_croak "No coercion for this type constraint" |
563
|
|
|
|
|
|
|
unless $self->has_coercion |
564
|
552
|
100
|
66
|
|
|
1074
|
&& @{ $self->coercion->type_coercion_map }; |
|
543
|
|
|
|
|
1260
|
|
565
|
543
|
|
|
|
|
1271
|
$self->coercion; |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
my $null_constraint = sub { !!1 }; |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
sub _build_display_name { |
571
|
12832
|
|
|
12832
|
|
25948
|
shift->name; |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
sub _build_constraint { |
575
|
4651
|
|
|
4651
|
|
26853
|
return $null_constraint; |
576
|
|
|
|
|
|
|
} |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
sub _is_null_constraint { |
579
|
373873
|
|
|
373873
|
|
586828
|
shift->constraint == $null_constraint; |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
sub _build_coercion { |
583
|
12409
|
|
|
12409
|
|
188166
|
require Type::Coercion; |
584
|
12409
|
|
|
|
|
19578
|
my $self = shift; |
585
|
12409
|
|
|
|
|
25028
|
my %opts = ( type_constraint => $self ); |
586
|
12409
|
100
|
|
|
|
22947
|
$opts{display_name} = "to_$self" unless $self->is_anon; |
587
|
12409
|
|
|
|
|
47850
|
my $coercion = "Type::Coercion"->new( %opts ); |
588
|
12409
|
100
|
|
|
|
30088
|
$self->{_build_coercion}->( $coercion ) if ref $self->{_build_coercion}; |
589
|
12409
|
|
|
|
|
37777
|
$coercion; |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
sub _build_default_message { |
593
|
308
|
|
|
308
|
|
638
|
my $self = shift; |
594
|
308
|
|
|
|
|
964
|
$self->{is_using_default_message} = 1; |
595
|
66
|
|
|
66
|
|
245
|
return sub { sprintf '%s did not pass type constraint', _dd( $_[0] ) } |
596
|
308
|
100
|
|
|
|
939
|
if "$self" eq "__ANON__"; |
597
|
278
|
|
|
|
|
782
|
my $name = "$self"; |
598
|
|
|
|
|
|
|
return sub { |
599
|
2554
|
|
|
2554
|
|
277551
|
sprintf '%s did not pass type constraint "%s"', _dd( $_[0] ), $name; |
600
|
278
|
|
|
|
|
2321
|
}; |
601
|
|
|
|
|
|
|
} #/ sub _build_default_message |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
sub _build_name_generator { |
604
|
227
|
|
|
227
|
|
555
|
my $self = shift; |
605
|
|
|
|
|
|
|
return sub { |
606
|
799
|
|
33
|
799
|
|
5571
|
defined && s/[\x00-\x1F]//smg for ( my ( $s, @a ) = @_ ); |
607
|
799
|
100
|
100
|
|
|
8387
|
sprintf( '%s[%s]', $s, join q[,], map !defined() ? 'undef' : !ref() && /\W/ ? B::perlstring($_) : $_, @a ); |
|
|
50
|
|
|
|
|
|
608
|
227
|
|
|
|
|
1859
|
}; |
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
sub _build_compiled_check { |
612
|
48003
|
|
|
48003
|
|
82352
|
my $self = shift; |
613
|
|
|
|
|
|
|
|
614
|
48003
|
|
|
|
|
75826
|
local our $AvoidCallbacks = 0; |
615
|
|
|
|
|
|
|
|
616
|
48003
|
100
|
100
|
|
|
104169
|
if ( $self->_is_null_constraint and $self->has_parent ) { |
617
|
3515
|
|
|
|
|
7933
|
return $self->parent->compiled_check; |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
|
620
|
44488
|
|
|
|
|
238023
|
require Eval::TypeTiny; |
621
|
44488
|
100
|
|
|
|
116609
|
return Eval::TypeTiny::eval_closure( |
622
|
|
|
|
|
|
|
source => sprintf( 'sub ($) { %s }', $self->inline_check( '$_[0]' ) ), |
623
|
|
|
|
|
|
|
description => sprintf( "compiled check '%s'", $self ), |
624
|
|
|
|
|
|
|
) if $self->can_be_inlined; |
625
|
|
|
|
|
|
|
|
626
|
40387
|
|
|
|
|
62906
|
my @constraints; |
627
|
40387
|
100
|
|
|
|
76925
|
push @constraints, $self->parent->compiled_check if $self->has_parent; |
628
|
40387
|
50
|
|
|
|
70930
|
push @constraints, $self->constraint if !$self->_is_null_constraint; |
629
|
40387
|
50
|
|
|
|
96293
|
return $null_constraint unless @constraints; |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
return sub ($) { |
632
|
5512
|
|
|
5512
|
|
80407
|
local $_ = $_[0]; |
|
|
|
|
1173
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
|
1157
|
|
|
|
|
|
|
|
24
|
|
|
|
633
|
5512
|
|
|
|
|
8908
|
for my $c ( @constraints ) { |
634
|
8780
|
100
|
|
|
|
25398
|
return unless $c->( @_ ); |
635
|
|
|
|
|
|
|
} |
636
|
3005
|
|
|
|
|
19694
|
return !!1; |
637
|
40387
|
|
|
|
|
232064
|
}; |
638
|
|
|
|
|
|
|
} #/ sub _build_compiled_check |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
sub _build_exception_class { |
641
|
12477
|
|
|
12477
|
|
17543
|
my $self = shift; |
642
|
12477
|
100
|
|
|
|
20067
|
return $self->parent->exception_class if $self->has_parent; |
643
|
1114
|
|
|
|
|
119708
|
require Error::TypeTiny::Assertion; |
644
|
1114
|
|
|
|
|
5503
|
return 'Error::TypeTiny::Assertion'; |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
sub definition_context { |
648
|
1
|
|
|
1
|
1
|
2
|
my $self = shift; |
649
|
|
|
|
|
|
|
my $found = $self->find_parent(sub { |
650
|
1
|
50
|
|
1
|
|
7
|
ref $_->{definition_context} and exists $_->{definition_context}{file}; |
651
|
1
|
|
|
|
|
5
|
}); |
652
|
1
|
50
|
|
|
|
5
|
$found ? $found->{definition_context} : {}; |
653
|
|
|
|
|
|
|
} |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
sub find_constraining_type { |
656
|
4185
|
|
|
4185
|
1
|
5160
|
my $self = shift; |
657
|
4185
|
100
|
100
|
|
|
6230
|
if ( $self->_is_null_constraint and $self->has_parent ) { |
658
|
764
|
|
|
|
|
1593
|
return $self->parent->find_constraining_type; |
659
|
|
|
|
|
|
|
} |
660
|
3421
|
|
|
|
|
6428
|
$self; |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
sub type_default { |
664
|
635
|
|
|
635
|
1
|
6157
|
my ( $self, @args ) = @_; |
665
|
635
|
100
|
|
|
|
2297
|
if ( exists $self->{type_default} ) { |
666
|
491
|
100
|
|
|
|
1506
|
if ( @args ) { |
667
|
1
|
|
|
|
|
2
|
my $td = $self->{type_default}; |
668
|
1
|
|
|
1
|
|
6
|
return sub { local $_ = \@args; &$td; }; |
|
1
|
|
|
|
|
673
|
|
|
1
|
|
|
|
|
3
|
|
669
|
|
|
|
|
|
|
} |
670
|
490
|
|
|
|
|
2533
|
return $self->{type_default}; |
671
|
|
|
|
|
|
|
} |
672
|
144
|
100
|
|
|
|
470
|
if ( my $parent = $self->parent ) { |
673
|
142
|
100
|
|
|
|
406
|
return $parent->type_default( @args ) if $self->_is_null_constraint; |
674
|
|
|
|
|
|
|
} |
675
|
59
|
|
|
|
|
424
|
return undef; |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
our @CMP; |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
sub CMP_SUPERTYPE () { -1 } |
681
|
|
|
|
|
|
|
sub CMP_EQUAL () { 0 } |
682
|
|
|
|
|
|
|
sub CMP_EQUIVALENT () { '0E0' } |
683
|
|
|
|
|
|
|
sub CMP_SUBTYPE () { 1 } |
684
|
|
|
|
|
|
|
sub CMP_UNKNOWN () { ''; } |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
# avoid getting mixed up with cmp operator at compile time |
687
|
|
|
|
|
|
|
*cmp = sub { |
688
|
1614
|
|
|
1614
|
|
17723
|
my ( $A, $B ) = _loose_to_TypeTiny( $_[0], $_[1] ); |
689
|
1614
|
50
|
33
|
|
|
8290
|
return unless blessed( $A ) && $A->isa( "Type::Tiny" ); |
690
|
1614
|
50
|
33
|
|
|
6808
|
return unless blessed( $B ) && $B->isa( "Type::Tiny" ); |
691
|
1614
|
|
|
|
|
4047
|
for my $comparator ( @CMP ) { |
692
|
2103
|
|
|
|
|
4878
|
my $result = $comparator->( $A, $B ); |
693
|
2103
|
100
|
|
|
|
5226
|
next if $result eq CMP_UNKNOWN; |
694
|
1246
|
100
|
|
|
|
2775
|
if ( $result eq CMP_EQUIVALENT ) { |
695
|
53
|
100
|
|
|
|
186
|
my $prefer = @_ == 3 ? $_[2] : CMP_EQUAL; |
696
|
53
|
|
|
|
|
178
|
return $prefer; |
697
|
|
|
|
|
|
|
} |
698
|
1193
|
|
|
|
|
2885
|
return $result; |
699
|
|
|
|
|
|
|
} |
700
|
368
|
|
|
|
|
817
|
return CMP_UNKNOWN; |
701
|
|
|
|
|
|
|
}; |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
push @CMP, sub { |
704
|
|
|
|
|
|
|
my ( $A, $B ) = @_; |
705
|
|
|
|
|
|
|
return CMP_EQUAL |
706
|
|
|
|
|
|
|
if Scalar::Util::refaddr( $A ) == Scalar::Util::refaddr( $B ); |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
return CMP_EQUIVALENT |
709
|
|
|
|
|
|
|
if Scalar::Util::refaddr( $A->compiled_check ) == |
710
|
|
|
|
|
|
|
Scalar::Util::refaddr( $B->compiled_check ); |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
my $A_stem = $A->find_constraining_type; |
713
|
|
|
|
|
|
|
my $B_stem = $B->find_constraining_type; |
714
|
|
|
|
|
|
|
return CMP_EQUIVALENT |
715
|
|
|
|
|
|
|
if Scalar::Util::refaddr( $A_stem ) == Scalar::Util::refaddr( $B_stem ); |
716
|
|
|
|
|
|
|
return CMP_EQUIVALENT |
717
|
|
|
|
|
|
|
if Scalar::Util::refaddr( $A_stem->compiled_check ) == |
718
|
|
|
|
|
|
|
Scalar::Util::refaddr( $B_stem->compiled_check ); |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
if ( $A_stem->can_be_inlined and $B_stem->can_be_inlined ) { |
721
|
|
|
|
|
|
|
return CMP_EQUIVALENT |
722
|
|
|
|
|
|
|
if $A_stem->inline_check( '$WOLFIE' ) eq $B_stem->inline_check( '$WOLFIE' ); |
723
|
|
|
|
|
|
|
} |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
A_IS_SUBTYPE: { |
726
|
|
|
|
|
|
|
my $A_prime = $A_stem; |
727
|
|
|
|
|
|
|
while ( $A_prime->has_parent ) { |
728
|
|
|
|
|
|
|
$A_prime = $A_prime->parent; |
729
|
|
|
|
|
|
|
return CMP_SUBTYPE |
730
|
|
|
|
|
|
|
if Scalar::Util::refaddr( $A_prime ) == Scalar::Util::refaddr( $B_stem ); |
731
|
|
|
|
|
|
|
return CMP_SUBTYPE |
732
|
|
|
|
|
|
|
if Scalar::Util::refaddr( $A_prime->compiled_check ) == |
733
|
|
|
|
|
|
|
Scalar::Util::refaddr( $B_stem->compiled_check ); |
734
|
|
|
|
|
|
|
if ( $A_prime->can_be_inlined and $B_stem->can_be_inlined ) { |
735
|
|
|
|
|
|
|
return CMP_SUBTYPE |
736
|
|
|
|
|
|
|
if $A_prime->inline_check( '$WOLFIE' ) eq $B_stem->inline_check( '$WOLFIE' ); |
737
|
|
|
|
|
|
|
} |
738
|
|
|
|
|
|
|
} #/ while ( $A_prime->has_parent) |
739
|
|
|
|
|
|
|
} #/ A_IS_SUBTYPE: |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
B_IS_SUBTYPE: { |
742
|
|
|
|
|
|
|
my $B_prime = $B_stem; |
743
|
|
|
|
|
|
|
while ( $B_prime->has_parent ) { |
744
|
|
|
|
|
|
|
$B_prime = $B_prime->parent; |
745
|
|
|
|
|
|
|
return CMP_SUPERTYPE |
746
|
|
|
|
|
|
|
if Scalar::Util::refaddr( $B_prime ) == Scalar::Util::refaddr( $A_stem ); |
747
|
|
|
|
|
|
|
return CMP_SUPERTYPE |
748
|
|
|
|
|
|
|
if Scalar::Util::refaddr( $B_prime->compiled_check ) == |
749
|
|
|
|
|
|
|
Scalar::Util::refaddr( $A_stem->compiled_check ); |
750
|
|
|
|
|
|
|
if ( $A_stem->can_be_inlined and $B_prime->can_be_inlined ) { |
751
|
|
|
|
|
|
|
return CMP_SUPERTYPE |
752
|
|
|
|
|
|
|
if $B_prime->inline_check( '$WOLFIE' ) eq $A_stem->inline_check( '$WOLFIE' ); |
753
|
|
|
|
|
|
|
} |
754
|
|
|
|
|
|
|
} #/ while ( $B_prime->has_parent) |
755
|
|
|
|
|
|
|
} #/ B_IS_SUBTYPE: |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
return CMP_UNKNOWN; |
758
|
|
|
|
|
|
|
}; |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
sub equals { |
761
|
764
|
|
|
764
|
1
|
2155
|
my $result = Type::Tiny::cmp( $_[0], $_[1] ); |
762
|
764
|
50
|
|
|
|
1701
|
return unless defined $result; |
763
|
764
|
|
|
|
|
4034
|
$result eq CMP_EQUAL; |
764
|
|
|
|
|
|
|
} |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
sub is_subtype_of { |
767
|
101
|
|
|
101
|
1
|
356
|
my $result = Type::Tiny::cmp( $_[0], $_[1], CMP_SUBTYPE ); |
768
|
101
|
50
|
|
|
|
236
|
return unless defined $result; |
769
|
101
|
|
|
|
|
517
|
$result eq CMP_SUBTYPE; |
770
|
|
|
|
|
|
|
} |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
sub is_supertype_of { |
773
|
19
|
|
|
19
|
1
|
426
|
my $result = Type::Tiny::cmp( $_[0], $_[1], CMP_SUBTYPE ); |
774
|
19
|
50
|
|
|
|
66
|
return unless defined $result; |
775
|
19
|
|
|
|
|
97
|
$result eq CMP_SUPERTYPE; |
776
|
|
|
|
|
|
|
} |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
sub is_a_type_of { |
779
|
686
|
|
|
686
|
1
|
5537
|
my $result = Type::Tiny::cmp( $_[0], $_[1] ); |
780
|
686
|
50
|
|
|
|
1702
|
return unless defined $result; |
781
|
686
|
100
|
100
|
|
|
7623
|
$result eq CMP_SUBTYPE or $result eq CMP_EQUAL or $result eq CMP_EQUIVALENT; |
782
|
|
|
|
|
|
|
} |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
sub strictly_equals { |
785
|
13175
|
|
|
13175
|
1
|
21329
|
my ( $self, $other ) = _loose_to_TypeTiny( @_ ); |
786
|
13175
|
50
|
33
|
|
|
44364
|
return unless blessed( $self ) && $self->isa( "Type::Tiny" ); |
787
|
13175
|
50
|
33
|
|
|
42298
|
return unless blessed( $other ) && $other->isa( "Type::Tiny" ); |
788
|
13175
|
|
|
|
|
52860
|
$self->{uniq} == $other->{uniq}; |
789
|
|
|
|
|
|
|
} |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
sub is_strictly_subtype_of { |
792
|
12635
|
|
|
12635
|
1
|
21147
|
my ( $self, $other ) = _loose_to_TypeTiny( @_ ); |
793
|
12635
|
50
|
33
|
|
|
42898
|
return unless blessed( $self ) && $self->isa( "Type::Tiny" ); |
794
|
12635
|
50
|
33
|
|
|
40703
|
return unless blessed( $other ) && $other->isa( "Type::Tiny" ); |
795
|
|
|
|
|
|
|
|
796
|
12635
|
100
|
|
|
|
25903
|
return unless $self->has_parent; |
797
|
10790
|
100
|
|
|
|
19211
|
$self->parent->strictly_equals( $other ) |
798
|
|
|
|
|
|
|
or $self->parent->is_strictly_subtype_of( $other ); |
799
|
|
|
|
|
|
|
} |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
sub is_strictly_supertype_of { |
802
|
2
|
|
|
2
|
1
|
17
|
my ( $self, $other ) = _loose_to_TypeTiny( @_ ); |
803
|
2
|
50
|
33
|
|
|
18
|
return unless blessed( $self ) && $self->isa( "Type::Tiny" ); |
804
|
2
|
50
|
33
|
|
|
23
|
return unless blessed( $other ) && $other->isa( "Type::Tiny" ); |
805
|
|
|
|
|
|
|
|
806
|
2
|
|
|
|
|
8
|
$other->is_strictly_subtype_of( $self ); |
807
|
|
|
|
|
|
|
} |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
sub is_strictly_a_type_of { |
810
|
2368
|
|
|
2368
|
1
|
12107
|
my ( $self, $other ) = _loose_to_TypeTiny( @_ ); |
811
|
2368
|
50
|
33
|
|
|
10843
|
return unless blessed( $self ) && $self->isa( "Type::Tiny" ); |
812
|
2368
|
50
|
33
|
|
|
9150
|
return unless blessed( $other ) && $other->isa( "Type::Tiny" ); |
813
|
|
|
|
|
|
|
|
814
|
2368
|
50
|
|
|
|
6435
|
$self->strictly_equals( $other ) or $self->is_strictly_subtype_of( $other ); |
815
|
|
|
|
|
|
|
} |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
sub qualified_name { |
818
|
14326
|
|
|
14326
|
1
|
20604
|
my $self = shift; |
819
|
|
|
|
|
|
|
( exists $self->{library} and $self->name ne "__ANON__" ) |
820
|
|
|
|
|
|
|
? "$self->{library}::$self->{name}" |
821
|
14326
|
100
|
66
|
|
|
40325
|
: $self->{name}; |
822
|
|
|
|
|
|
|
} |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
sub is_anon { |
825
|
40650
|
|
|
40650
|
1
|
53376
|
my $self = shift; |
826
|
40650
|
|
|
|
|
65456
|
$self->name eq "__ANON__"; |
827
|
|
|
|
|
|
|
} |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
sub parents { |
830
|
37375
|
|
|
37375
|
1
|
48113
|
my $self = shift; |
831
|
37375
|
100
|
|
|
|
56812
|
return unless $self->has_parent; |
832
|
31076
|
|
|
|
|
54214
|
return ( $self->parent, $self->parent->parents ); |
833
|
|
|
|
|
|
|
} |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
sub find_parent { |
836
|
462
|
|
|
462
|
1
|
890
|
my $self = shift; |
837
|
462
|
|
|
|
|
887
|
my ( $test ) = @_; |
838
|
|
|
|
|
|
|
|
839
|
462
|
|
|
|
|
1561
|
local ( $_, $. ); |
840
|
462
|
|
|
|
|
698
|
my $type = $self; |
841
|
462
|
|
|
|
|
733
|
my $count = 0; |
842
|
462
|
|
|
|
|
1387
|
while ( $type ) { |
843
|
570
|
100
|
|
|
|
1987
|
if ( $test->( $_ = $type, $. = $count ) ) { |
844
|
459
|
100
|
|
|
|
2506
|
return wantarray ? ( $type, $count ) : $type; |
845
|
|
|
|
|
|
|
} |
846
|
|
|
|
|
|
|
else { |
847
|
111
|
|
|
|
|
215
|
$type = $type->parent; |
848
|
111
|
|
|
|
|
270
|
$count++; |
849
|
|
|
|
|
|
|
} |
850
|
|
|
|
|
|
|
} |
851
|
|
|
|
|
|
|
|
852
|
3
|
|
|
|
|
12
|
return; |
853
|
|
|
|
|
|
|
} #/ sub find_parent |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
sub check { |
856
|
143154
|
|
|
143154
|
1
|
1866699
|
my $self = shift; |
857
|
143154
|
|
66
|
|
|
698701
|
( $self->{compiled_type_constraint} ||= $self->_build_compiled_check )->( @_ ); |
858
|
|
|
|
|
|
|
} |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
sub _strict_check { |
861
|
5546
|
|
|
5546
|
|
12180
|
my $self = shift; |
862
|
5546
|
|
|
|
|
10962
|
local $_ = $_[0]; |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
my @constraints = |
865
|
|
|
|
|
|
|
reverse |
866
|
19903
|
|
|
|
|
32055
|
map { $_->constraint } |
867
|
5546
|
|
|
|
|
14383
|
grep { not $_->_is_null_constraint } ( $self, $self->parents ); |
|
32598
|
|
|
|
|
54664
|
|
868
|
|
|
|
|
|
|
|
869
|
5546
|
|
|
|
|
12770
|
for my $c ( @constraints ) { |
870
|
15411
|
100
|
|
|
|
47912
|
return unless $c->( @_ ); |
871
|
|
|
|
|
|
|
} |
872
|
|
|
|
|
|
|
|
873
|
1592
|
|
|
|
|
14553
|
return !!1; |
874
|
|
|
|
|
|
|
} #/ sub _strict_check |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
sub get_message { |
877
|
1817
|
|
|
1817
|
1
|
194915
|
my $self = shift; |
878
|
1817
|
|
|
|
|
3671
|
local $_ = $_[0]; |
879
|
1817
|
100
|
|
|
|
4559
|
$self->has_message |
880
|
|
|
|
|
|
|
? $self->message->( @_ ) |
881
|
|
|
|
|
|
|
: $self->_default_message->( @_ ); |
882
|
|
|
|
|
|
|
} |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
sub validate { |
885
|
3
|
|
|
3
|
1
|
6
|
my $self = shift; |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
return undef |
888
|
3
|
50
|
33
|
|
|
16
|
if ( $self->{compiled_type_constraint} ||= $self->_build_compiled_check ) |
889
|
|
|
|
|
|
|
->( @_ ); |
890
|
|
|
|
|
|
|
|
891
|
3
|
|
|
|
|
40
|
local $_ = $_[0]; |
892
|
3
|
|
|
|
|
11
|
return $self->get_message( @_ ); |
893
|
|
|
|
|
|
|
} #/ sub validate |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
sub validate_explain { |
896
|
2138
|
|
|
2138
|
1
|
4506
|
my $self = shift; |
897
|
2138
|
|
|
|
|
3523
|
my ( $value, $varname ) = @_; |
898
|
2138
|
100
|
|
|
|
3790
|
$varname = '$_' unless defined $varname; |
899
|
|
|
|
|
|
|
|
900
|
2138
|
100
|
|
|
|
3655
|
return undef if $self->check( $value ); |
901
|
|
|
|
|
|
|
|
902
|
1688
|
100
|
|
|
|
5565
|
if ( $self->has_parent ) { |
903
|
1680
|
|
|
|
|
2884
|
my $parent = $self->parent->validate_explain( $value, $varname ); |
904
|
|
|
|
|
|
|
return [ |
905
|
1680
|
100
|
|
|
|
4570
|
sprintf( '"%s" is a subtype of "%s"', $self, $self->parent ), |
906
|
|
|
|
|
|
|
@$parent |
907
|
|
|
|
|
|
|
] |
908
|
|
|
|
|
|
|
if $parent; |
909
|
|
|
|
|
|
|
} |
910
|
|
|
|
|
|
|
|
911
|
458
|
100
|
|
|
|
1101
|
my $message = sprintf( |
912
|
|
|
|
|
|
|
'%s%s', |
913
|
|
|
|
|
|
|
$self->get_message( $value ), |
914
|
|
|
|
|
|
|
$varname eq q{$_} ? '' : sprintf( ' (in %s)', $varname ), |
915
|
|
|
|
|
|
|
); |
916
|
|
|
|
|
|
|
|
917
|
458
|
100
|
100
|
|
|
1404
|
if ( $self->is_parameterized and $self->parent->has_deep_explanation ) { |
918
|
101
|
|
|
|
|
287
|
my $deep = $self->parent->deep_explanation->( $self, $value, $varname ); |
919
|
101
|
50
|
|
|
|
804
|
return [ $message, @$deep ] if $deep; |
920
|
|
|
|
|
|
|
} |
921
|
|
|
|
|
|
|
|
922
|
357
|
|
|
0
|
|
2525
|
local $SIG{__WARN__} = sub {}; |
923
|
|
|
|
|
|
|
return [ |
924
|
357
|
|
|
|
|
1063
|
$message, |
925
|
|
|
|
|
|
|
sprintf( '"%s" is defined as: %s', $self, $self->_perlcode ) |
926
|
|
|
|
|
|
|
]; |
927
|
|
|
|
|
|
|
} #/ sub validate_explain |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
my $b; |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
sub _perlcode { |
932
|
357
|
|
|
357
|
|
564
|
my $self = shift; |
933
|
|
|
|
|
|
|
|
934
|
357
|
|
|
|
|
600
|
local our $AvoidCallbacks = 1; |
935
|
357
|
100
|
|
|
|
896
|
return $self->inline_check( '$_' ) |
936
|
|
|
|
|
|
|
if $self->can_be_inlined; |
937
|
|
|
|
|
|
|
|
938
|
12
|
|
66
|
|
|
58
|
$b ||= do { |
939
|
7
|
|
|
|
|
25
|
local $@; |
940
|
7
|
|
|
|
|
43
|
require B::Deparse; |
941
|
7
|
|
|
|
|
439
|
my $tmp = "B::Deparse"->new; |
942
|
7
|
50
|
|
|
|
531
|
$tmp->ambient_pragmas( strict => "all", warnings => "all" ) |
943
|
|
|
|
|
|
|
if $tmp->can( 'ambient_pragmas' ); |
944
|
7
|
|
|
|
|
36
|
$tmp; |
945
|
|
|
|
|
|
|
}; |
946
|
|
|
|
|
|
|
|
947
|
12
|
|
|
|
|
43
|
my $code = $b->coderef2text( $self->constraint ); |
948
|
12
|
|
|
|
|
131
|
$code =~ s/\s+/ /g; |
949
|
12
|
|
|
|
|
82
|
return "sub $code"; |
950
|
|
|
|
|
|
|
} #/ sub _perlcode |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
sub assert_valid { |
953
|
85
|
|
|
85
|
1
|
6948
|
my $self = shift; |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
return !!1 |
956
|
85
|
100
|
66
|
|
|
458
|
if ( $self->{compiled_type_constraint} ||= $self->_build_compiled_check ) |
957
|
|
|
|
|
|
|
->( @_ ); |
958
|
|
|
|
|
|
|
|
959
|
15
|
|
|
|
|
147
|
local $_ = $_[0]; |
960
|
15
|
|
|
|
|
54
|
$self->_failed_check( "$self", $_ ); |
961
|
|
|
|
|
|
|
} #/ sub assert_valid |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
sub assert_return { |
964
|
115094
|
|
|
115094
|
1
|
176009
|
my $self = shift; |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
return $_[0] |
967
|
115094
|
100
|
66
|
|
|
371698
|
if ( $self->{compiled_type_constraint} ||= $self->_build_compiled_check ) |
968
|
|
|
|
|
|
|
->( @_ ); |
969
|
|
|
|
|
|
|
|
970
|
1
|
|
|
|
|
8
|
local $_ = $_[0]; |
971
|
1
|
|
|
|
|
10
|
$self->_failed_check( "$self", $_ ); |
972
|
|
|
|
|
|
|
} #/ sub assert_return |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
sub can_be_inlined { |
975
|
186235
|
|
|
186235
|
1
|
306831
|
my $self = shift; |
976
|
186235
|
100
|
100
|
|
|
304836
|
return $self->parent->can_be_inlined |
977
|
|
|
|
|
|
|
if $self->has_parent && $self->_is_null_constraint; |
978
|
158605
|
100
|
100
|
|
|
297060
|
return !!1 |
979
|
|
|
|
|
|
|
if !$self->has_parent && $self->_is_null_constraint; |
980
|
145226
|
|
|
|
|
277778
|
return $self->has_inlined; |
981
|
|
|
|
|
|
|
} |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
sub inline_check { |
984
|
67234
|
|
|
67234
|
1
|
119348
|
my $self = shift; |
985
|
67234
|
50
|
|
|
|
105652
|
_croak 'Cannot inline type constraint check for "%s"', $self |
986
|
|
|
|
|
|
|
unless $self->can_be_inlined; |
987
|
|
|
|
|
|
|
|
988
|
67234
|
100
|
100
|
|
|
117383
|
return $self->parent->inline_check( @_ ) |
989
|
|
|
|
|
|
|
if $self->has_parent && $self->_is_null_constraint; |
990
|
55124
|
100
|
100
|
|
|
99993
|
return '(!!1)' |
991
|
|
|
|
|
|
|
if !$self->has_parent && $self->_is_null_constraint; |
992
|
|
|
|
|
|
|
|
993
|
50779
|
|
|
|
|
87002
|
local $_ = $_[0]; |
994
|
50779
|
|
|
|
|
98545
|
my @r = $self->inlined->( $self, @_ ); |
995
|
50779
|
100
|
66
|
|
|
279672
|
if ( @r and not defined $r[0] ) { |
996
|
7046
|
50
|
|
|
|
13723
|
_croak 'Inlining type constraint check for "%s" returned undef!', $self |
997
|
|
|
|
|
|
|
unless $self->has_parent; |
998
|
7046
|
|
|
|
|
15009
|
$r[0] = $self->parent->inline_check( @_ ); |
999
|
|
|
|
|
|
|
} |
1000
|
|
|
|
|
|
|
my $r = join " && " => map { |
1001
|
50779
|
100
|
100
|
|
|
93219
|
/[;{}]/ && !/\Ado \{.+\}\z/ |
|
60975
|
|
|
|
|
358099
|
|
1002
|
|
|
|
|
|
|
? "do { $SafePackage $_ }" |
1003
|
|
|
|
|
|
|
: "($_)" |
1004
|
|
|
|
|
|
|
} @r; |
1005
|
50779
|
100
|
|
|
|
1001555
|
return @r == 1 ? $r : "($r)"; |
1006
|
|
|
|
|
|
|
} #/ sub inline_check |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
sub inline_assert { |
1009
|
12353
|
|
|
12353
|
1
|
46842
|
require B; |
1010
|
12353
|
|
|
|
|
19810
|
my $self = shift; |
1011
|
12353
|
|
|
|
|
36449
|
my ( $varname, $typevarname, %extras ) = @_; |
1012
|
|
|
|
|
|
|
|
1013
|
12353
|
|
33
|
|
|
43651
|
$extras{exception_class} ||= $self->exception_class; |
1014
|
|
|
|
|
|
|
|
1015
|
12353
|
|
|
|
|
18366
|
my $inline_check; |
1016
|
12353
|
100
|
|
|
|
21977
|
if ( $self->can_be_inlined ) { |
|
|
100
|
|
|
|
|
|
1017
|
12202
|
|
|
|
|
29970
|
$inline_check = sprintf( '(%s)', $self->inline_check( $varname ) ); |
1018
|
|
|
|
|
|
|
} |
1019
|
|
|
|
|
|
|
elsif ( $typevarname ) { |
1020
|
150
|
|
|
|
|
513
|
$inline_check = sprintf( '%s->check(%s)', $typevarname, $varname ); |
1021
|
|
|
|
|
|
|
} |
1022
|
|
|
|
|
|
|
else { |
1023
|
1
|
|
|
|
|
3
|
_croak 'Cannot inline type constraint check for "%s"', $self; |
1024
|
|
|
|
|
|
|
} |
1025
|
|
|
|
|
|
|
|
1026
|
12352
|
|
|
|
|
34186
|
my $do_wrapper = !delete $extras{no_wrapper}; |
1027
|
|
|
|
|
|
|
|
1028
|
12352
|
|
|
|
|
17438
|
my $inline_throw; |
1029
|
12352
|
100
|
|
|
|
21345
|
if ( $typevarname ) { |
1030
|
|
|
|
|
|
|
$inline_throw = sprintf( |
1031
|
|
|
|
|
|
|
'Type::Tiny::_failed_check(%s, %s, %s, %s)', |
1032
|
|
|
|
|
|
|
$typevarname, |
1033
|
|
|
|
|
|
|
B::perlstring( "$self" ), |
1034
|
|
|
|
|
|
|
$varname, |
1035
|
|
|
|
|
|
|
join( |
1036
|
151
|
|
|
|
|
502
|
',', map +( B::perlstring( $_ ) => B::perlstring( $extras{$_} ) ), |
1037
|
|
|
|
|
|
|
sort keys %extras |
1038
|
|
|
|
|
|
|
), |
1039
|
|
|
|
|
|
|
); |
1040
|
|
|
|
|
|
|
} #/ if ( $typevarname ) |
1041
|
|
|
|
|
|
|
else { |
1042
|
|
|
|
|
|
|
$inline_throw = sprintf( |
1043
|
|
|
|
|
|
|
'Type::Tiny::_failed_check(%s, %s, %s, %s)', |
1044
|
|
|
|
|
|
|
$self->{uniq}, |
1045
|
|
|
|
|
|
|
B::perlstring( "$self" ), |
1046
|
|
|
|
|
|
|
$varname, |
1047
|
|
|
|
|
|
|
join( |
1048
|
12201
|
|
|
|
|
42174
|
',', map +( B::perlstring( $_ ) => B::perlstring( $extras{$_} ) ), |
1049
|
|
|
|
|
|
|
sort keys %extras |
1050
|
|
|
|
|
|
|
), |
1051
|
|
|
|
|
|
|
); |
1052
|
|
|
|
|
|
|
} #/ else [ if ( $typevarname ) ] |
1053
|
|
|
|
|
|
|
|
1054
|
12352
|
100
|
|
|
|
94495
|
$do_wrapper |
1055
|
|
|
|
|
|
|
? qq[do { no warnings "void"; $SafePackage $inline_check or $inline_throw; $varname };] |
1056
|
|
|
|
|
|
|
: qq[ no warnings "void"; $SafePackage $inline_check or $inline_throw; $varname ]; |
1057
|
|
|
|
|
|
|
} #/ sub inline_assert |
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
sub _failed_check { |
1060
|
421
|
|
|
421
|
|
19901
|
my ( $self, $name, $value, %attrs ) = @_; |
1061
|
421
|
100
|
100
|
|
|
2587
|
$self = $ALL_TYPES{$self} if defined $self && !ref $self; |
1062
|
|
|
|
|
|
|
|
1063
|
|
|
|
|
|
|
my $exception_class = delete( $attrs{exception_class} ) |
1064
|
421
|
|
66
|
|
|
2068
|
|| ( ref $self ? $self->exception_class : 'Error::TypeTiny::Assertion' ); |
1065
|
421
|
|
|
|
|
833
|
my $callback = delete( $attrs{on_die} ); |
1066
|
|
|
|
|
|
|
|
1067
|
421
|
100
|
|
|
|
1658
|
if ( $self ) { |
1068
|
420
|
|
|
|
|
3192
|
return $exception_class->throw_cb( |
1069
|
|
|
|
|
|
|
$callback, |
1070
|
|
|
|
|
|
|
message => $self->get_message( $value ), |
1071
|
|
|
|
|
|
|
type => $self, |
1072
|
|
|
|
|
|
|
value => $value, |
1073
|
|
|
|
|
|
|
%attrs, |
1074
|
|
|
|
|
|
|
); |
1075
|
|
|
|
|
|
|
} |
1076
|
|
|
|
|
|
|
else { |
1077
|
1
|
|
|
|
|
5
|
return $exception_class->throw_cb( |
1078
|
|
|
|
|
|
|
$callback, |
1079
|
|
|
|
|
|
|
message => sprintf( '%s did not pass type constraint "%s"', _dd( $value ), $name ), |
1080
|
|
|
|
|
|
|
value => $value, |
1081
|
|
|
|
|
|
|
%attrs, |
1082
|
|
|
|
|
|
|
); |
1083
|
|
|
|
|
|
|
} |
1084
|
|
|
|
|
|
|
} #/ sub _failed_check |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
sub coerce { |
1087
|
625
|
|
|
625
|
1
|
68420
|
my $self = shift; |
1088
|
625
|
|
|
|
|
1515
|
$self->_assert_coercion->coerce( @_ ); |
1089
|
|
|
|
|
|
|
} |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
sub assert_coerce { |
1092
|
64
|
|
|
64
|
1
|
395
|
my $self = shift; |
1093
|
64
|
|
|
|
|
153
|
$self->_assert_coercion->assert_coerce( @_ ); |
1094
|
|
|
|
|
|
|
} |
1095
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
sub is_parameterizable { |
1097
|
15231
|
|
|
15231
|
1
|
33723
|
shift->has_constraint_generator; |
1098
|
|
|
|
|
|
|
} |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
sub is_parameterized { |
1101
|
548
|
|
|
548
|
1
|
1836
|
shift->has_parameters; |
1102
|
|
|
|
|
|
|
} |
1103
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
{ |
1105
|
|
|
|
|
|
|
my %seen; |
1106
|
|
|
|
|
|
|
|
1107
|
|
|
|
|
|
|
sub ____make_key { |
1108
|
|
|
|
|
|
|
#<<< |
1109
|
|
|
|
|
|
|
join ',', map { |
1110
|
1515
|
|
|
1515
|
|
3338
|
Types::TypeTiny::is_TypeTiny( $_ ) ? sprintf( '$Type::Tiny::ALL_TYPES{%s}', defined( $_->{uniq} ) ? $_->{uniq} : '____CANNOT_KEY____' ) : |
1111
|
7
|
50
|
|
|
|
120
|
ref() eq 'ARRAY' ? do { $seen{$_}++ ? '____CANNOT_KEY____' : sprintf( '[%s]', ____make_key( @$_ ) ) } : |
1112
|
18
|
50
|
|
|
|
190
|
ref() eq 'HASH' ? do { $seen{$_}++ ? '____CANNOT_KEY____' : sprintf( '{%s}', ____make_key( do { my %h = %$_; map +( $_, $h{$_} ), sort keys %h; } ) ) } : |
|
18
|
|
|
|
|
55
|
|
|
18
|
|
|
|
|
90
|
|
1113
|
3
|
50
|
|
|
|
70
|
ref() eq 'SCALAR' || ref() eq 'REF' ? do { $seen{$_}++ ? '____CANNOT_KEY____' : sprintf( '\\(%s)', ____make_key( $$_ ) ) } : |
1114
|
|
|
|
|
|
|
!defined() ? 'undef' : |
1115
|
3695
|
50
|
66
|
|
|
76010
|
!ref() ? do { require B; B::perlstring( $_ ) } : |
|
988
|
100
|
|
|
|
12659
|
|
|
988
|
100
|
|
|
|
5098
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
'____CANNOT_KEY____'; |
1117
|
|
|
|
|
|
|
} @_; |
1118
|
|
|
|
|
|
|
#>>> |
1119
|
|
|
|
|
|
|
} #/ sub ____make_key |
1120
|
|
|
|
|
|
|
my %param_cache; |
1121
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
sub parameterize { |
1123
|
1485
|
|
|
1485
|
1
|
212690
|
my $self = shift; |
1124
|
|
|
|
|
|
|
|
1125
|
1485
|
0
|
|
|
|
4550
|
$self->is_parameterizable |
|
|
50
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
or @_ |
1127
|
|
|
|
|
|
|
? _croak( "Type '%s' does not accept parameters", "$self" ) |
1128
|
|
|
|
|
|
|
: return ( $self ); |
1129
|
|
|
|
|
|
|
|
1130
|
1485
|
|
|
|
|
7028
|
@_ = map Types::TypeTiny::to_TypeTiny( $_ ), @_; |
1131
|
|
|
|
|
|
|
|
1132
|
|
|
|
|
|
|
# Generate a key for caching parameterized type constraints, |
1133
|
|
|
|
|
|
|
# but only if all the parameters are strings or type constraints. |
1134
|
1485
|
|
|
|
|
3694
|
%seen = (); |
1135
|
1485
|
|
|
|
|
5772
|
my $key = $self->____make_key( @_ ); |
1136
|
1485
|
100
|
|
|
|
6462
|
undef( $key ) if $key =~ /____CANNOT_KEY____/; |
1137
|
1485
|
100
|
100
|
|
|
8471
|
return $param_cache{$key} if defined $key && defined $param_cache{$key}; |
1138
|
|
|
|
|
|
|
|
1139
|
1106
|
|
|
|
|
2198
|
local $Type::Tiny::parameterize_type = $self; |
1140
|
1106
|
|
|
|
|
2097
|
local $_ = $_[0]; |
1141
|
1106
|
|
|
|
|
1944
|
my $P; |
1142
|
|
|
|
|
|
|
|
1143
|
1106
|
|
|
|
|
3592
|
my ( $constraint, $compiled ) = $self->constraint_generator->( @_ ); |
1144
|
|
|
|
|
|
|
|
1145
|
1065
|
100
|
|
|
|
24659
|
if ( Types::TypeTiny::is_TypeTiny( $constraint ) ) { |
1146
|
193
|
|
|
|
|
564
|
$P = $constraint; |
1147
|
|
|
|
|
|
|
} |
1148
|
|
|
|
|
|
|
else { |
1149
|
872
|
|
|
|
|
7409
|
my %options = ( |
1150
|
|
|
|
|
|
|
constraint => $constraint, |
1151
|
|
|
|
|
|
|
display_name => $self->name_generator->( $self, @_ ), |
1152
|
|
|
|
|
|
|
parameters => [@_], |
1153
|
|
|
|
|
|
|
); |
1154
|
872
|
100
|
|
|
|
3211
|
$options{compiled_type_constraint} = $compiled |
1155
|
|
|
|
|
|
|
if $compiled; |
1156
|
872
|
100
|
|
|
|
2648
|
$options{inlined} = $self->inline_generator->( @_ ) |
1157
|
|
|
|
|
|
|
if $self->has_inline_generator; |
1158
|
|
|
|
|
|
|
$options{type_default} = $self->{type_default_generator}->( @_ ) |
1159
|
872
|
100
|
|
|
|
4980
|
if exists $self->{type_default_generator}; # undocumented |
1160
|
|
|
|
|
|
|
exists $options{$_} && !defined $options{$_} && delete $options{$_} |
1161
|
872
|
|
66
|
|
|
11433
|
for keys %options; |
|
|
|
66
|
|
|
|
|
1162
|
|
|
|
|
|
|
|
1163
|
872
|
|
|
|
|
3941
|
$P = $self->create_child_type( %options ); |
1164
|
|
|
|
|
|
|
|
1165
|
872
|
100
|
|
|
|
3390
|
if ( $self->has_coercion_generator ) { |
1166
|
463
|
|
|
|
|
1694
|
my @args = @_; |
1167
|
|
|
|
|
|
|
$P->{_build_coercion} = sub { |
1168
|
251
|
|
|
251
|
|
571
|
my $coercion = shift; |
1169
|
251
|
|
|
|
|
927
|
my $built = $self->coercion_generator->( $self, $P, @args ); |
1170
|
251
|
100
|
|
|
|
952
|
$coercion->add_type_coercions( @{ $built->type_coercion_map } ) if $built; |
|
117
|
|
|
|
|
319
|
|
1171
|
251
|
|
|
|
|
1023
|
$coercion->freeze; |
1172
|
463
|
|
|
|
|
3337
|
}; |
1173
|
|
|
|
|
|
|
} |
1174
|
|
|
|
|
|
|
} #/ else [ if ( Types::TypeTiny::is_TypeTiny...)] |
1175
|
|
|
|
|
|
|
|
1176
|
1065
|
100
|
|
|
|
3605
|
if ( defined $key ) { |
1177
|
1030
|
|
|
|
|
3077
|
$param_cache{$key} = $P; |
1178
|
1030
|
|
|
|
|
2960
|
Scalar::Util::weaken( $param_cache{$key} ); |
1179
|
|
|
|
|
|
|
} |
1180
|
|
|
|
|
|
|
|
1181
|
1065
|
100
|
|
|
|
2572
|
$P->coercion->freeze unless $self->has_coercion_generator; |
1182
|
|
|
|
|
|
|
|
1183
|
1065
|
|
|
|
|
5168
|
return $P; |
1184
|
|
|
|
|
|
|
} #/ sub parameterize |
1185
|
|
|
|
|
|
|
} |
1186
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
sub child_type_class { |
1188
|
1526
|
|
|
1526
|
1
|
7191
|
__PACKAGE__; |
1189
|
|
|
|
|
|
|
} |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
sub create_child_type { |
1192
|
1526
|
|
|
1526
|
1
|
8147
|
my $self = shift; |
1193
|
1526
|
|
|
|
|
2421
|
my %moreopts; |
1194
|
1526
|
100
|
|
|
|
4812
|
$moreopts{is_object} = 1 if $self->{is_object}; |
1195
|
1526
|
|
|
|
|
3959
|
return $self->child_type_class->new( parent => $self, %moreopts, @_ ); |
1196
|
|
|
|
|
|
|
} |
1197
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
sub complementary_type { |
1199
|
90
|
|
|
90
|
1
|
207
|
my $self = shift; |
1200
|
90
|
|
66
|
|
|
405
|
my $r = ( $self->{complementary_type} ||= $self->_build_complementary_type ); |
1201
|
|
|
|
|
|
|
Scalar::Util::weaken( $self->{complementary_type} ) |
1202
|
90
|
100
|
|
|
|
403
|
unless Scalar::Util::isweak( $self->{complementary_type} ); |
1203
|
90
|
|
|
|
|
1312
|
return $r; |
1204
|
|
|
|
|
|
|
} |
1205
|
|
|
|
|
|
|
|
1206
|
|
|
|
|
|
|
sub _build_complementary_type { |
1207
|
78
|
|
|
78
|
|
118
|
my $self = shift; |
1208
|
|
|
|
|
|
|
my %opts = ( |
1209
|
116
|
|
|
116
|
|
255
|
constraint => sub { not $self->check( $_ ) }, |
1210
|
78
|
|
|
|
|
458
|
display_name => sprintf( "~%s", $self ), |
1211
|
|
|
|
|
|
|
); |
1212
|
78
|
|
|
|
|
583
|
$opts{display_name} =~ s/^\~{2}//; |
1213
|
339
|
|
|
339
|
|
452
|
$opts{inlined} = sub { shift; "not(" . $self->inline_check( @_ ) . ")" } |
|
339
|
|
|
|
|
739
|
|
1214
|
78
|
100
|
|
|
|
184
|
if $self->can_be_inlined; |
1215
|
|
|
|
|
|
|
$opts{display_name} = $opts{name} = $self->{complement_name} |
1216
|
78
|
100
|
|
|
|
220
|
if $self->{complement_name}; |
1217
|
78
|
|
|
|
|
340
|
return "Type::Tiny"->new( %opts ); |
1218
|
|
|
|
|
|
|
} #/ sub _build_complementary_type |
1219
|
|
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
sub _instantiate_moose_type { |
1221
|
102
|
|
|
102
|
|
215
|
my $self = shift; |
1222
|
102
|
|
|
|
|
364
|
my %opts = @_; |
1223
|
102
|
|
|
|
|
641
|
require Moose::Meta::TypeConstraint; |
1224
|
102
|
|
|
|
|
911
|
return "Moose::Meta::TypeConstraint"->new( %opts ); |
1225
|
|
|
|
|
|
|
} |
1226
|
|
|
|
|
|
|
|
1227
|
|
|
|
|
|
|
sub _build_moose_type { |
1228
|
208
|
|
|
208
|
|
416
|
my $self = shift; |
1229
|
|
|
|
|
|
|
|
1230
|
208
|
|
|
|
|
342
|
my $r; |
1231
|
208
|
100
|
|
|
|
654
|
if ( $self->{_is_core} ) { |
1232
|
101
|
|
|
|
|
542
|
require Moose::Util::TypeConstraints; |
1233
|
101
|
|
|
|
|
321
|
$r = Moose::Util::TypeConstraints::find_type_constraint( $self->name ); |
1234
|
101
|
|
|
|
|
12480
|
$r->{"Types::TypeTiny::to_TypeTiny"} = $self; |
1235
|
101
|
|
|
|
|
365
|
Scalar::Util::weaken( $r->{"Types::TypeTiny::to_TypeTiny"} ); |
1236
|
|
|
|
|
|
|
} |
1237
|
|
|
|
|
|
|
else { |
1238
|
|
|
|
|
|
|
# Type::Tiny is more flexible than Moose, allowing |
1239
|
|
|
|
|
|
|
# inlined to return a list. So we need to wrap the |
1240
|
|
|
|
|
|
|
# inlined coderef to make sure Moose gets a single |
1241
|
|
|
|
|
|
|
# string. |
1242
|
|
|
|
|
|
|
# |
1243
|
|
|
|
|
|
|
my $wrapped_inlined = sub { |
1244
|
74
|
|
|
74
|
|
44382
|
shift; |
1245
|
74
|
|
|
|
|
306
|
$self->inline_check( @_ ); |
1246
|
107
|
|
|
|
|
518
|
}; |
1247
|
|
|
|
|
|
|
|
1248
|
107
|
|
|
|
|
244
|
my %opts; |
1249
|
107
|
100
|
66
|
|
|
319
|
$opts{name} = $self->qualified_name if $self->has_library && !$self->is_anon; |
1250
|
107
|
100
|
|
|
|
406
|
$opts{parent} = $self->parent->moose_type if $self->has_parent; |
1251
|
107
|
100
|
|
|
|
1193
|
$opts{constraint} = $self->constraint unless $self->_is_null_constraint; |
1252
|
107
|
100
|
|
|
|
357
|
$opts{message} = $self->message if $self->has_message; |
1253
|
107
|
100
|
|
|
|
398
|
$opts{inlined} = $wrapped_inlined if $self->has_inlined; |
1254
|
|
|
|
|
|
|
|
1255
|
107
|
|
|
|
|
487
|
$r = $self->_instantiate_moose_type( %opts ); |
1256
|
107
|
|
|
|
|
74861
|
$r->{"Types::TypeTiny::to_TypeTiny"} = $self; |
1257
|
107
|
|
|
|
|
352
|
$self->{moose_type} = $r; # prevent recursion |
1258
|
107
|
100
|
|
|
|
465
|
$r->coercion( $self->coercion->moose_coercion ) if $self->has_coercion; |
1259
|
|
|
|
|
|
|
} #/ else [ if ( $self->{_is_core})] |
1260
|
|
|
|
|
|
|
|
1261
|
208
|
|
|
|
|
1662
|
return $r; |
1262
|
|
|
|
|
|
|
} #/ sub _build_moose_type |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
sub _build_mouse_type { |
1265
|
3
|
|
|
3
|
|
7
|
my $self = shift; |
1266
|
|
|
|
|
|
|
|
1267
|
3
|
|
|
|
|
4
|
my %options; |
1268
|
3
|
50
|
33
|
|
|
7
|
$options{name} = $self->qualified_name if $self->has_library && !$self->is_anon; |
1269
|
3
|
100
|
|
|
|
8
|
$options{parent} = $self->parent->mouse_type if $self->has_parent; |
1270
|
3
|
100
|
|
|
|
12
|
$options{constraint} = $self->constraint unless $self->_is_null_constraint; |
1271
|
3
|
100
|
|
|
|
8
|
$options{message} = $self->message if $self->has_message; |
1272
|
|
|
|
|
|
|
|
1273
|
3
|
|
|
|
|
18
|
require Mouse::Meta::TypeConstraint; |
1274
|
3
|
|
|
|
|
31
|
my $r = "Mouse::Meta::TypeConstraint"->new( %options ); |
1275
|
|
|
|
|
|
|
|
1276
|
3
|
|
|
|
|
150
|
$self->{mouse_type} = $r; # prevent recursion |
1277
|
3
|
50
|
|
|
|
10
|
$r->_add_type_coercions( |
1278
|
|
|
|
|
|
|
$self->coercion->freeze->_codelike_type_coercion_map( 'mouse_type' ) ) |
1279
|
|
|
|
|
|
|
if $self->has_coercion; |
1280
|
|
|
|
|
|
|
|
1281
|
3
|
|
|
|
|
48
|
return $r; |
1282
|
|
|
|
|
|
|
} #/ sub _build_mouse_type |
1283
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
sub exportables { |
1285
|
14197
|
|
|
14197
|
1
|
36479
|
my ( $self, $base_name, $tag ) = ( shift, @_ ); # $tag is undocumented |
1286
|
14197
|
100
|
|
|
|
23994
|
if ( not $self->is_anon ) { |
1287
|
14196
|
|
66
|
|
|
38291
|
$base_name ||= $self->name; |
1288
|
|
|
|
|
|
|
} |
1289
|
14197
|
|
100
|
|
|
52434
|
$tag ||= 0; |
1290
|
|
|
|
|
|
|
|
1291
|
14197
|
|
|
|
|
19716
|
my @exportables; |
1292
|
14197
|
50
|
|
|
|
26072
|
return \@exportables if ! $base_name; |
1293
|
|
|
|
|
|
|
|
1294
|
14197
|
|
|
|
|
74153
|
require Eval::TypeTiny; |
1295
|
|
|
|
|
|
|
|
1296
|
14197
|
100
|
66
|
|
|
72681
|
push @exportables, { |
1297
|
|
|
|
|
|
|
name => $base_name, |
1298
|
|
|
|
|
|
|
code => Eval::TypeTiny::type_to_coderef( $self ), |
1299
|
|
|
|
|
|
|
tags => [ 'types' ], |
1300
|
|
|
|
|
|
|
} if $tag eq 'types' || !$tag; |
1301
|
|
|
|
|
|
|
|
1302
|
14197
|
100
|
100
|
|
|
106683
|
push @exportables, { |
1303
|
|
|
|
|
|
|
name => sprintf( 'is_%s', $base_name ), |
1304
|
|
|
|
|
|
|
code => $self->compiled_check, |
1305
|
|
|
|
|
|
|
tags => [ 'is' ], |
1306
|
|
|
|
|
|
|
} if $tag eq 'is' || !$tag; |
1307
|
|
|
|
|
|
|
|
1308
|
14197
|
100
|
66
|
|
|
85744
|
push @exportables, { |
1309
|
|
|
|
|
|
|
name => sprintf( 'assert_%s', $base_name ), |
1310
|
|
|
|
|
|
|
code => $self->_overload_coderef, |
1311
|
|
|
|
|
|
|
tags => [ 'assert' ], |
1312
|
|
|
|
|
|
|
} if $tag eq 'assert' || !$tag; |
1313
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
push @exportables, { |
1315
|
|
|
|
|
|
|
name => sprintf( 'to_%s', $base_name ), |
1316
|
|
|
|
|
|
|
code => $self->has_coercion && $self->coercion->frozen |
1317
|
|
|
|
|
|
|
? $self->coercion->compiled_coercion |
1318
|
9
|
|
|
9
|
|
4715
|
: sub ($) { $self->coerce( $_[0] ) }, |
|
|
|
|
9
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
|
1250
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
|
12
|
|
|
|
1319
|
14197
|
100
|
100
|
|
|
109181
|
tags => [ 'to' ], |
|
|
100
|
100
|
|
|
|
|
1320
|
|
|
|
|
|
|
} if $tag eq 'to' || !$tag; |
1321
|
|
|
|
|
|
|
|
1322
|
14197
|
|
|
|
|
57592
|
return \@exportables; |
1323
|
|
|
|
|
|
|
} |
1324
|
|
|
|
|
|
|
|
1325
|
|
|
|
|
|
|
sub exportables_by_tag { |
1326
|
604
|
|
|
613
|
1
|
2341
|
my ( $self, $tag, $base_name ) = ( shift, @_ ); |
1327
|
|
|
|
|
|
|
my @matched = grep { |
1328
|
604
|
|
|
|
|
1497
|
my $e = $_; |
1329
|
604
|
50
|
|
|
|
1190
|
grep $_ eq $tag, @{ $e->{tags} || [] }; |
|
604
|
|
|
|
|
5459
|
|
1330
|
604
|
|
|
|
|
1747
|
} @{ $self->exportables( $base_name, $tag ) }; |
|
604
|
|
|
|
|
2959
|
|
1331
|
604
|
100
|
|
|
|
3298
|
return @matched if wantarray; |
1332
|
1
|
50
|
|
|
|
4
|
_croak( 'Expected to find one exportable tagged "%s", found %d', $tag, scalar @matched ) |
1333
|
|
|
|
|
|
|
unless @matched == 1; |
1334
|
1
|
|
|
|
|
3
|
return $matched[0]; |
1335
|
|
|
|
|
|
|
} |
1336
|
|
|
|
|
|
|
|
1337
|
|
|
|
|
|
|
sub _process_coercion_list { |
1338
|
100
|
|
|
105
|
|
254
|
my $self = shift; |
1339
|
|
|
|
|
|
|
|
1340
|
100
|
|
|
|
|
196
|
my @pairs; |
1341
|
100
|
|
|
|
|
360
|
while ( @_ ) { |
1342
|
108
|
|
|
|
|
234
|
my $next = shift; |
1343
|
108
|
100
|
100
|
|
|
710
|
if ( blessed( $next ) |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
1344
|
|
|
|
|
|
|
and $next->isa( 'Type::Coercion' ) |
1345
|
|
|
|
|
|
|
and $next->is_parameterized ) |
1346
|
|
|
|
|
|
|
{ |
1347
|
8
|
|
|
|
|
17
|
push @pairs => ( @{ $next->_reparameterize( $self )->type_coercion_map } ); |
|
8
|
|
|
|
|
23
|
|
1348
|
|
|
|
|
|
|
} |
1349
|
|
|
|
|
|
|
elsif ( blessed( $next ) and $next->can( 'type_coercion_map' ) ) { |
1350
|
|
|
|
|
|
|
push @pairs => ( |
1351
|
9
|
|
|
|
|
16
|
@{ $next->type_coercion_map }, |
|
9
|
|
|
|
|
19
|
|
1352
|
|
|
|
|
|
|
); |
1353
|
|
|
|
|
|
|
} |
1354
|
|
|
|
|
|
|
elsif ( ref( $next ) eq q(ARRAY) ) { |
1355
|
3
|
|
|
|
|
16
|
unshift @_, @$next; |
1356
|
|
|
|
|
|
|
} |
1357
|
|
|
|
|
|
|
else { |
1358
|
88
|
|
|
|
|
401
|
push @pairs => ( |
1359
|
|
|
|
|
|
|
Types::TypeTiny::to_TypeTiny( $next ), |
1360
|
|
|
|
|
|
|
shift, |
1361
|
|
|
|
|
|
|
); |
1362
|
|
|
|
|
|
|
} |
1363
|
|
|
|
|
|
|
} #/ while ( @_ ) |
1364
|
|
|
|
|
|
|
|
1365
|
100
|
|
|
|
|
328
|
return @pairs; |
1366
|
|
|
|
|
|
|
} #/ sub _process_coercion_list |
1367
|
|
|
|
|
|
|
|
1368
|
|
|
|
|
|
|
sub plus_coercions { |
1369
|
97
|
|
|
97
|
1
|
34883
|
my $self = shift; |
1370
|
97
|
|
|
|
|
378
|
my $new = $self->_clone; |
1371
|
|
|
|
|
|
|
$new->coercion->add_type_coercions( |
1372
|
|
|
|
|
|
|
$self->_process_coercion_list( @_ ), |
1373
|
97
|
|
|
|
|
405
|
@{ $self->coercion->type_coercion_map }, |
|
97
|
|
|
|
|
648
|
|
1374
|
|
|
|
|
|
|
); |
1375
|
97
|
|
|
|
|
500
|
$new->coercion->freeze; |
1376
|
97
|
|
|
|
|
453
|
return $new; |
1377
|
|
|
|
|
|
|
} #/ sub plus_coercions |
1378
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
sub plus_fallback_coercions { |
1380
|
2
|
|
|
2
|
1
|
642
|
my $self = shift; |
1381
|
|
|
|
|
|
|
|
1382
|
2
|
|
|
|
|
7
|
my $new = $self->_clone; |
1383
|
|
|
|
|
|
|
$new->coercion->add_type_coercions( |
1384
|
2
|
|
|
|
|
7
|
@{ $self->coercion->type_coercion_map }, |
|
2
|
|
|
|
|
5
|
|
1385
|
|
|
|
|
|
|
$self->_process_coercion_list( @_ ), |
1386
|
|
|
|
|
|
|
); |
1387
|
2
|
|
|
|
|
7
|
$new->coercion->freeze; |
1388
|
2
|
|
|
|
|
5
|
return $new; |
1389
|
|
|
|
|
|
|
} #/ sub plus_fallback_coercions |
1390
|
|
|
|
|
|
|
|
1391
|
|
|
|
|
|
|
sub minus_coercions { |
1392
|
1
|
|
|
1
|
1
|
574
|
my $self = shift; |
1393
|
|
|
|
|
|
|
|
1394
|
1
|
|
|
|
|
3
|
my $new = $self->_clone; |
1395
|
1
|
|
|
|
|
9
|
my @not = grep Types::TypeTiny::is_TypeTiny( $_ ), |
1396
|
|
|
|
|
|
|
$self->_process_coercion_list( $new, @_ ); |
1397
|
|
|
|
|
|
|
|
1398
|
1
|
|
|
|
|
7
|
my @keep; |
1399
|
1
|
|
|
|
|
5
|
my $c = $self->coercion->type_coercion_map; |
1400
|
1
|
|
|
|
|
7
|
for ( my $i = 0 ; $i <= $#$c ; $i += 2 ) { |
1401
|
4
|
|
|
|
|
8
|
my $keep_this = 1; |
1402
|
4
|
|
|
|
|
5
|
NOT: for my $n ( @not ) { |
1403
|
11
|
100
|
|
|
|
28
|
if ( $c->[$i] == $n ) { |
1404
|
2
|
|
|
|
|
3
|
$keep_this = 0; |
1405
|
2
|
|
|
|
|
3
|
last NOT; |
1406
|
|
|
|
|
|
|
} |
1407
|
|
|
|
|
|
|
} |
1408
|
|
|
|
|
|
|
|
1409
|
4
|
100
|
|
|
|
25
|
push @keep, $c->[$i], $c->[ $i + 1 ] if $keep_this; |
1410
|
|
|
|
|
|
|
} #/ for ( my $i = 0 ; $i <=...) |
1411
|
|
|
|
|
|
|
|
1412
|
1
|
|
|
|
|
3
|
$new->coercion->add_type_coercions( @keep ); |
1413
|
1
|
|
|
|
|
6
|
$new->coercion->freeze; |
1414
|
1
|
|
|
|
|
4
|
return $new; |
1415
|
|
|
|
|
|
|
} #/ sub minus_coercions |
1416
|
|
|
|
|
|
|
|
1417
|
|
|
|
|
|
|
sub no_coercions { |
1418
|
6
|
|
|
6
|
1
|
1235
|
my $new = shift->_clone; |
1419
|
6
|
|
|
|
|
29
|
$new->coercion->freeze; |
1420
|
6
|
|
|
|
|
33
|
$new; |
1421
|
|
|
|
|
|
|
} |
1422
|
|
|
|
|
|
|
|
1423
|
|
|
|
|
|
|
sub coercibles { |
1424
|
7
|
|
|
7
|
1
|
251
|
my $self = shift; |
1425
|
7
|
100
|
|
|
|
26
|
$self->has_coercion ? $self->coercion->_source_type_union : $self; |
1426
|
|
|
|
|
|
|
} |
1427
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
sub isa { |
1429
|
280532
|
|
|
280532
|
1
|
2505020
|
my $self = shift; |
1430
|
|
|
|
|
|
|
|
1431
|
280532
|
100
|
100
|
|
|
591782
|
if ( $INC{"Moose.pm"} |
|
|
|
100
|
|
|
|
|
1432
|
|
|
|
|
|
|
and ref( $self ) |
1433
|
|
|
|
|
|
|
and $_[0] =~ /^(?:Class::MOP|MooseX?::Meta)::(.+)$/ ) |
1434
|
|
|
|
|
|
|
{ |
1435
|
143
|
|
|
|
|
515
|
my $meta = $1; |
1436
|
|
|
|
|
|
|
|
1437
|
143
|
100
|
|
|
|
559
|
return !!1 if $meta eq 'TypeConstraint'; |
1438
|
58
|
100
|
|
|
|
424
|
return $self->is_parameterized if $meta eq 'TypeConstraint::Parameterized'; |
1439
|
4
|
100
|
|
|
|
23
|
return $self->is_parameterizable if $meta eq 'TypeConstraint::Parameterizable'; |
1440
|
3
|
100
|
|
|
|
9
|
return $self->isa( 'Type::Tiny::Union' ) if $meta eq 'TypeConstraint::Union'; |
1441
|
|
|
|
|
|
|
|
1442
|
1
|
|
|
|
|
3
|
my $inflate = $self->moose_type; |
1443
|
1
|
|
|
|
|
16
|
return $inflate->isa( @_ ); |
1444
|
|
|
|
|
|
|
} #/ if ( $INC{"Moose.pm"} ...) |
1445
|
|
|
|
|
|
|
|
1446
|
280389
|
100
|
100
|
|
|
505320
|
if ( $INC{"Mouse.pm"} |
|
|
|
100
|
|
|
|
|
1447
|
|
|
|
|
|
|
and ref( $self ) |
1448
|
|
|
|
|
|
|
and $_[0] eq 'Mouse::Meta::TypeConstraint' ) |
1449
|
|
|
|
|
|
|
{ |
1450
|
1
|
|
|
|
|
4
|
return !!1; |
1451
|
|
|
|
|
|
|
} |
1452
|
|
|
|
|
|
|
|
1453
|
280388
|
|
|
|
|
1241625
|
$self->SUPER::isa( @_ ); |
1454
|
|
|
|
|
|
|
} #/ sub isa |
1455
|
|
|
|
|
|
|
|
1456
|
|
|
|
|
|
|
sub _build_my_methods { |
1457
|
141
|
|
|
141
|
|
702
|
return {}; |
1458
|
|
|
|
|
|
|
} |
1459
|
|
|
|
|
|
|
|
1460
|
|
|
|
|
|
|
sub _lookup_my_method { |
1461
|
1278
|
|
|
1278
|
|
1768
|
my $self = shift; |
1462
|
1278
|
|
|
|
|
2868
|
my ( $name ) = @_; |
1463
|
|
|
|
|
|
|
|
1464
|
1278
|
100
|
|
|
|
2386
|
if ( $self->my_methods->{$name} ) { |
1465
|
614
|
|
|
|
|
1195
|
return $self->my_methods->{$name}; |
1466
|
|
|
|
|
|
|
} |
1467
|
|
|
|
|
|
|
|
1468
|
664
|
100
|
|
|
|
1430
|
if ( $self->has_parent ) { |
1469
|
662
|
|
|
|
|
1468
|
return $self->parent->_lookup_my_method( @_ ); |
1470
|
|
|
|
|
|
|
} |
1471
|
|
|
|
|
|
|
|
1472
|
2
|
|
|
|
|
9
|
return; |
1473
|
|
|
|
|
|
|
} #/ sub _lookup_my_method |
1474
|
|
|
|
|
|
|
|
1475
|
|
|
|
|
|
|
my %object_methods = ( |
1476
|
|
|
|
|
|
|
with_attribute_values => 1, stringifies_to => 1, |
1477
|
|
|
|
|
|
|
numifies_to => 1 |
1478
|
|
|
|
|
|
|
); |
1479
|
|
|
|
|
|
|
|
1480
|
|
|
|
|
|
|
sub can { |
1481
|
84836
|
|
|
84836
|
1
|
637062
|
my $self = shift; |
1482
|
|
|
|
|
|
|
|
1483
|
84836
|
50
|
66
|
|
|
203228
|
return !!0 |
|
|
|
33
|
|
|
|
|
1484
|
|
|
|
|
|
|
if $_[0] eq 'type_parameter' |
1485
|
|
|
|
|
|
|
&& blessed( $_[0] ) |
1486
|
|
|
|
|
|
|
&& $_[0]->has_parameters; |
1487
|
|
|
|
|
|
|
|
1488
|
84836
|
|
|
|
|
264559
|
my $can = $self->SUPER::can( @_ ); |
1489
|
84836
|
100
|
|
|
|
756520
|
return $can if $can; |
1490
|
|
|
|
|
|
|
|
1491
|
42657
|
100
|
|
|
|
102432
|
if ( ref( $self ) ) { |
1492
|
42656
|
100
|
|
|
|
85206
|
if ( $INC{"Moose.pm"} ) { |
1493
|
443
|
|
|
|
|
1208
|
my $method = $self->moose_type->can( @_ ); |
1494
|
1
|
|
|
1
|
|
4
|
return sub { shift->moose_type->$method( @_ ) } |
1495
|
443
|
100
|
|
|
|
4852
|
if $method; |
1496
|
|
|
|
|
|
|
} |
1497
|
42646
|
100
|
|
|
|
109253
|
if ( $_[0] =~ /\Amy_(.+)\z/ ) { |
1498
|
4
|
|
|
|
|
10
|
my $method = $self->_lookup_my_method( $1 ); |
1499
|
4
|
100
|
|
|
|
11
|
return $method if $method; |
1500
|
|
|
|
|
|
|
} |
1501
|
42644
|
100
|
100
|
|
|
106400
|
if ( $self->{is_object} && $object_methods{ $_[0] } ) { |
1502
|
1
|
|
|
|
|
754
|
require Type::Tiny::ConstrainedObject; |
1503
|
1
|
|
|
|
|
15
|
return Type::Tiny::ConstrainedObject->can( $_[0] ); |
1504
|
|
|
|
|
|
|
} |
1505
|
42643
|
|
|
|
|
93177
|
for my $util ( qw/ grep map sort rsort first any all assert_any assert_all / ) { |
1506
|
383643
|
100
|
|
|
|
644811
|
if ( $_[0] eq $util ) { |
1507
|
36
|
|
66
|
|
|
132
|
$self->{'_util'}{$util} ||= eval { $self->_build_util( $util ) }; |
|
36
|
|
|
|
|
85
|
|
1508
|
36
|
100
|
|
|
|
138
|
return unless $self->{'_util'}{$util}; |
1509
|
34
|
|
|
0
|
|
164
|
return sub { my $s = shift; $s->{'_util'}{$util}( @_ ) }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1510
|
|
|
|
|
|
|
} |
1511
|
|
|
|
|
|
|
} |
1512
|
|
|
|
|
|
|
} #/ if ( ref( $self ) ) |
1513
|
|
|
|
|
|
|
|
1514
|
42608
|
|
|
|
|
269557
|
return; |
1515
|
|
|
|
|
|
|
} #/ sub can |
1516
|
|
|
|
|
|
|
|
1517
|
|
|
|
|
|
|
sub AUTOLOAD { |
1518
|
689
|
|
|
689
|
|
17617
|
my $self = shift; |
1519
|
689
|
|
|
|
|
4269
|
my ( $m ) = ( our $AUTOLOAD =~ /::(\w+)$/ ); |
1520
|
689
|
50
|
|
|
|
2053
|
return if $m eq 'DESTROY'; |
1521
|
|
|
|
|
|
|
|
1522
|
689
|
50
|
|
|
|
1702
|
if ( ref( $self ) ) { |
1523
|
689
|
100
|
|
|
|
1702
|
if ( $INC{"Moose.pm"} ) { |
1524
|
3
|
|
|
|
|
10
|
my $method = $self->moose_type->can( $m ); |
1525
|
3
|
100
|
|
|
|
38
|
return $self->moose_type->$method( @_ ) if $method; |
1526
|
|
|
|
|
|
|
} |
1527
|
687
|
100
|
|
|
|
2375
|
if ( $m =~ /\Amy_(.+)\z/ ) { |
1528
|
612
|
|
|
|
|
1565
|
my $method = $self->_lookup_my_method( $1 ); |
1529
|
612
|
50
|
|
|
|
2765
|
return &$method( $self, @_ ) if $method; |
1530
|
|
|
|
|
|
|
} |
1531
|
75
|
50
|
66
|
|
|
228
|
if ( $self->{is_object} && $object_methods{$m} ) { |
1532
|
3
|
|
|
|
|
1106
|
require Type::Tiny::ConstrainedObject; |
1533
|
3
|
|
|
|
|
11
|
unshift @_, $self; |
1534
|
316
|
|
|
316
|
|
3427
|
no strict 'refs'; |
|
316
|
|
|
|
|
876
|
|
|
316
|
|
|
|
|
463573
|
|
1535
|
3
|
|
|
|
|
9
|
goto \&{"Type::Tiny::ConstrainedObject::$m"}; |
|
3
|
|
|
|
|
29
|
|
1536
|
|
|
|
|
|
|
} |
1537
|
72
|
|
|
|
|
169
|
for my $util ( qw/ grep map sort rsort first any all assert_any assert_all / ) { |
1538
|
394
|
100
|
|
|
|
715
|
if ( $m eq $util ) { |
1539
|
70
|
|
66
|
|
|
912
|
return ( $self->{'_util'}{$util} ||= $self->_build_util( $util ) )->( @_ ); |
1540
|
|
|
|
|
|
|
} |
1541
|
|
|
|
|
|
|
} |
1542
|
|
|
|
|
|
|
} #/ if ( ref( $self ) ) |
1543
|
|
|
|
|
|
|
|
1544
|
2
|
|
33
|
|
|
33
|
_croak q[Can't locate object method "%s" via package "%s"], $m, |
1545
|
|
|
|
|
|
|
ref( $self ) || $self; |
1546
|
|
|
|
|
|
|
} #/ sub AUTOLOAD |
1547
|
|
|
|
|
|
|
|
1548
|
|
|
|
|
|
|
sub DOES { |
1549
|
45
|
|
|
45
|
1
|
127
|
my $self = shift; |
1550
|
|
|
|
|
|
|
|
1551
|
45
|
50
|
33
|
|
|
201
|
return !!1 |
1552
|
|
|
|
|
|
|
if ref( $self ) |
1553
|
|
|
|
|
|
|
&& $_[0] =~ m{^ Type::API::Constraint (?: ::Coercible | ::Inlinable )? $}x; |
1554
|
45
|
50
|
33
|
|
|
118
|
return !!1 if !ref( $self ) && $_[0] eq 'Type::API::Constraint::Constructor'; |
1555
|
|
|
|
|
|
|
|
1556
|
45
|
50
|
|
|
|
346
|
"UNIVERSAL"->can( "DOES" ) ? $self->SUPER::DOES( @_ ) : $self->isa( @_ ); |
1557
|
|
|
|
|
|
|
} #/ sub DOES |
1558
|
|
|
|
|
|
|
|
1559
|
|
|
|
|
|
|
sub _has_xsub { |
1560
|
1
|
|
|
1
|
|
69937
|
require B; |
1561
|
1
|
|
|
|
|
7
|
!!B::svref_2object( shift->compiled_check )->XSUB; |
1562
|
|
|
|
|
|
|
} |
1563
|
|
|
|
|
|
|
|
1564
|
|
|
|
|
|
|
sub _build_util { |
1565
|
82
|
|
|
82
|
|
194
|
my ( $self, $func ) = @_; |
1566
|
82
|
|
|
|
|
278
|
Scalar::Util::weaken( my $type = $self ); |
1567
|
|
|
|
|
|
|
|
1568
|
82
|
100
|
100
|
|
|
702
|
if ( $func eq 'grep' |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
1569
|
|
|
|
|
|
|
|| $func eq 'first' |
1570
|
|
|
|
|
|
|
|| $func eq 'any' |
1571
|
|
|
|
|
|
|
|| $func eq 'all' |
1572
|
|
|
|
|
|
|
|| $func eq 'assert_any' |
1573
|
|
|
|
|
|
|
|| $func eq 'assert_all' ) |
1574
|
|
|
|
|
|
|
{ |
1575
|
43
|
|
|
|
|
80
|
my ( $inline, $compiled ); |
1576
|
|
|
|
|
|
|
|
1577
|
43
|
100
|
|
|
|
101
|
if ( $self->can_be_inlined ) { |
1578
|
13
|
|
|
|
|
42
|
$inline = $self->inline_check( '$_' ); |
1579
|
|
|
|
|
|
|
} |
1580
|
|
|
|
|
|
|
else { |
1581
|
30
|
|
|
|
|
66
|
$compiled = $self->compiled_check; |
1582
|
30
|
|
|
|
|
60
|
$inline = '$compiled->($_)'; |
1583
|
|
|
|
|
|
|
} |
1584
|
|
|
|
|
|
|
|
1585
|
43
|
100
|
|
|
|
192
|
if ( $func eq 'grep' ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1586
|
5
|
|
|
|
|
585
|
return eval "sub { grep { $inline } \@_ }"; |
1587
|
|
|
|
|
|
|
} |
1588
|
|
|
|
|
|
|
elsif ( $func eq 'first' ) { |
1589
|
5
|
|
|
|
|
586
|
return eval "sub { for (\@_) { return \$_ if ($inline) }; undef; }"; |
1590
|
|
|
|
|
|
|
} |
1591
|
|
|
|
|
|
|
elsif ( $func eq 'any' ) { |
1592
|
8
|
|
|
|
|
878
|
return eval "sub { for (\@_) { return !!1 if ($inline) }; !!0; }"; |
1593
|
|
|
|
|
|
|
} |
1594
|
|
|
|
|
|
|
elsif ( $func eq 'assert_any' ) { |
1595
|
8
|
|
|
|
|
20
|
my $qname = B::perlstring( $self->name ); |
1596
|
|
|
|
|
|
|
return |
1597
|
|
|
|
|
|
|
eval |
1598
|
8
|
|
|
|
|
1152
|
"sub { for (\@_) { return \@_ if ($inline) }; Type::Tiny::_failed_check(\$type, $qname, \@_ ? \$_[-1] : undef); }"; |
1599
|
|
|
|
|
|
|
} |
1600
|
|
|
|
|
|
|
elsif ( $func eq 'all' ) { |
1601
|
9
|
|
|
|
|
1137
|
return eval "sub { for (\@_) { return !!0 unless ($inline) }; !!1; }"; |
1602
|
|
|
|
|
|
|
} |
1603
|
|
|
|
|
|
|
elsif ( $func eq 'assert_all' ) { |
1604
|
8
|
|
|
|
|
18
|
my $qname = B::perlstring( $self->name ); |
1605
|
|
|
|
|
|
|
return |
1606
|
|
|
|
|
|
|
eval |
1607
|
8
|
|
|
|
|
1120
|
"sub { my \$idx = 0; for (\@_) { Type::Tiny::_failed_check(\$type, $qname, \$_, varname => sprintf('\$_[%d]', \$idx)) unless ($inline); ++\$idx }; \@_; }"; |
1608
|
|
|
|
|
|
|
} |
1609
|
|
|
|
|
|
|
} #/ if ( $func eq 'grep' ||...) |
1610
|
|
|
|
|
|
|
|
1611
|
39
|
100
|
|
|
|
101
|
if ( $func eq 'map' ) { |
1612
|
8
|
|
|
|
|
11
|
my ( $inline, $compiled ); |
1613
|
8
|
|
|
|
|
18
|
my $c = $self->_assert_coercion; |
1614
|
|
|
|
|
|
|
|
1615
|
4
|
100
|
|
|
|
12
|
if ( $c->can_be_inlined ) { |
1616
|
1
|
|
|
|
|
5
|
$inline = $c->inline_coercion( '$_' ); |
1617
|
|
|
|
|
|
|
} |
1618
|
|
|
|
|
|
|
else { |
1619
|
3
|
|
|
|
|
8
|
$compiled = $c->compiled_coercion; |
1620
|
3
|
|
|
|
|
6
|
$inline = '$compiled->($_)'; |
1621
|
|
|
|
|
|
|
} |
1622
|
|
|
|
|
|
|
|
1623
|
4
|
|
|
|
|
440
|
return eval "sub { map { $inline } \@_ }"; |
1624
|
|
|
|
|
|
|
} #/ if ( $func eq 'map' ) |
1625
|
|
|
|
|
|
|
|
1626
|
31
|
100
|
100
|
|
|
186
|
if ( $func eq 'sort' || $func eq 'rsort' ) { |
1627
|
29
|
|
|
|
|
51
|
my ( $inline, $compiled ); |
1628
|
|
|
|
|
|
|
|
1629
|
29
|
|
|
76
|
|
166
|
my $ptype = $self->find_parent( sub { $_->has_sorter } ); |
|
76
|
|
|
|
|
155
|
|
1630
|
29
|
100
|
|
|
|
115
|
_croak "No sorter for this type constraint" unless $ptype; |
1631
|
|
|
|
|
|
|
|
1632
|
27
|
|
|
|
|
104
|
my $sorter = $ptype->sorter; |
1633
|
|
|
|
|
|
|
|
1634
|
|
|
|
|
|
|
# Schwarzian transformation |
1635
|
27
|
100
|
|
|
|
75
|
if ( ref( $sorter ) eq 'ARRAY' ) { |
1636
|
6
|
|
|
|
|
9
|
my $sort_key; |
1637
|
6
|
|
|
|
|
16
|
( $sorter, $sort_key ) = @$sorter; |
1638
|
|
|
|
|
|
|
|
1639
|
6
|
100
|
|
|
|
31
|
if ( $func eq 'sort' ) { |
|
|
50
|
|
|
|
|
|
1640
|
|
|
|
|
|
|
return |
1641
|
|
|
|
|
|
|
eval |
1642
|
4
|
|
|
|
|
624
|
"our (\$a, \$b); sub { map \$_->[0], sort { \$sorter->(\$a->[1],\$b->[1]) } map [\$_,\$sort_key->(\$_)], \@_ }"; |
1643
|
|
|
|
|
|
|
} |
1644
|
|
|
|
|
|
|
elsif ( $func eq 'rsort' ) { |
1645
|
|
|
|
|
|
|
return |
1646
|
|
|
|
|
|
|
eval |
1647
|
2
|
|
|
|
|
282
|
"our (\$a, \$b); sub { map \$_->[0], sort { \$sorter->(\$b->[1],\$a->[1]) } map [\$_,\$sort_key->(\$_)], \@_ }"; |
1648
|
|
|
|
|
|
|
} |
1649
|
|
|
|
|
|
|
} #/ if ( ref( $sorter ) eq...) |
1650
|
|
|
|
|
|
|
|
1651
|
|
|
|
|
|
|
# Simple sort |
1652
|
|
|
|
|
|
|
else { |
1653
|
21
|
100
|
|
|
|
68
|
if ( $func eq 'sort' ) { |
|
|
50
|
|
|
|
|
|
1654
|
12
|
|
|
|
|
1362
|
return eval "our (\$a, \$b); sub { sort { \$sorter->(\$a,\$b) } \@_ }"; |
1655
|
|
|
|
|
|
|
} |
1656
|
|
|
|
|
|
|
elsif ( $func eq 'rsort' ) { |
1657
|
9
|
|
|
|
|
920
|
return eval "our (\$a, \$b); sub { sort { \$sorter->(\$b,\$a) } \@_ }"; |
1658
|
|
|
|
|
|
|
} |
1659
|
|
|
|
|
|
|
} |
1660
|
|
|
|
|
|
|
} #/ if ( $func eq 'sort' ||...) |
1661
|
|
|
|
|
|
|
|
1662
|
2
|
|
|
|
|
22
|
die "Unknown function: $func"; |
1663
|
|
|
|
|
|
|
} #/ sub _build_util |
1664
|
|
|
|
|
|
|
|
1665
|
304
|
|
|
304
|
1
|
9720
|
sub of { shift->parameterize( @_ ) } |
1666
|
138
|
|
|
138
|
1
|
45229
|
sub where { shift->create_child_type( constraint => @_ ) } |
1667
|
|
|
|
|
|
|
|
1668
|
|
|
|
|
|
|
# fill out Moose-compatible API |
1669
|
277
|
|
|
277
|
1
|
3908
|
sub inline_environment { +{} } |
1670
|
144
|
|
|
144
|
|
2685
|
sub _inline_check { shift->inline_check( @_ ) } |
1671
|
85
|
|
|
85
|
|
3884
|
sub _compiled_type_constraint { shift->compiled_check( @_ ) } |
1672
|
1
|
|
|
1
|
1
|
15
|
sub meta { _croak( "Not really a Moose::Meta::TypeConstraint. Sorry!" ) } |
1673
|
2
|
|
|
2
|
1
|
18
|
sub compile_type_constraint { shift->compiled_check } |
1674
|
2
|
|
|
2
|
|
33
|
sub _actually_compile_type_constraint { shift->_build_compiled_check } |
1675
|
1
|
|
|
1
|
1
|
394
|
sub hand_optimized_type_constraint { shift->{hand_optimized_type_constraint} } |
1676
|
|
|
|
|
|
|
|
1677
|
|
|
|
|
|
|
sub has_hand_optimized_type_constraint { |
1678
|
1
|
|
|
1
|
1
|
19
|
exists( shift->{hand_optimized_type_constraint} ); |
1679
|
|
|
|
|
|
|
} |
1680
|
381
|
|
100
|
381
|
1
|
2385
|
sub type_parameter { ( shift->parameters || [] )->[0] } |
1681
|
|
|
|
|
|
|
|
1682
|
|
|
|
|
|
|
sub parameterized_from { |
1683
|
5
|
50
|
|
5
|
1
|
22
|
$_[0]->is_parameterized ? shift->parent : _croak( "Not a parameterized type" ); |
1684
|
|
|
|
|
|
|
} |
1685
|
2
|
|
|
2
|
1
|
15
|
sub has_parameterized_from { $_[0]->is_parameterized } |
1686
|
|
|
|
|
|
|
|
1687
|
|
|
|
|
|
|
# some stuff for Mouse-compatible API |
1688
|
2
|
|
|
2
|
|
16
|
sub __is_parameterized { shift->is_parameterized( @_ ) } |
1689
|
1
|
|
|
1
|
|
12
|
sub _add_type_coercions { shift->coercion->add_type_coercions( @_ ) } |
1690
|
1
|
|
|
1
|
|
660
|
sub _as_string { shift->qualified_name( @_ ) } |
1691
|
1
|
|
|
1
|
|
5
|
sub _compiled_type_coercion { shift->coercion->compiled_coercion( @_ ) } |
1692
|
2
|
|
|
2
|
|
600
|
sub _identity { Scalar::Util::refaddr( shift ) } |
1693
|
|
|
|
|
|
|
|
1694
|
|
|
|
|
|
|
sub _unite { |
1695
|
1
|
|
|
1
|
|
486
|
require Type::Tiny::Union; |
1696
|
1
|
|
|
|
|
7
|
"Type::Tiny::Union"->new( type_constraints => \@_ ); |
1697
|
|
|
|
|
|
|
} |
1698
|
|
|
|
|
|
|
|
1699
|
|
|
|
|
|
|
# Hooks for Type::Tie |
1700
|
|
|
|
|
|
|
sub TIESCALAR { |
1701
|
1
|
|
|
1
|
|
1623
|
require Type::Tie; |
1702
|
1
|
|
|
|
|
7
|
unshift @_, 'Type::Tie::SCALAR'; |
1703
|
1
|
|
|
|
|
5
|
goto \&Type::Tie::SCALAR::TIESCALAR; |
1704
|
|
|
|
|
|
|
} |
1705
|
|
|
|
|
|
|
|
1706
|
|
|
|
|
|
|
sub TIEARRAY { |
1707
|
1
|
|
|
1
|
|
2737
|
require Type::Tie; |
1708
|
1
|
|
|
|
|
5
|
unshift @_, 'Type::Tie::ARRAY'; |
1709
|
1
|
|
|
|
|
4
|
goto \&Type::Tie::ARRAY::TIEARRAY; |
1710
|
|
|
|
|
|
|
} |
1711
|
|
|
|
|
|
|
|
1712
|
|
|
|
|
|
|
sub TIEHASH { |
1713
|
1
|
|
|
1
|
|
2291
|
require Type::Tie; |
1714
|
1
|
|
|
|
|
3
|
unshift @_, 'Type::Tie::HASH'; |
1715
|
1
|
|
|
|
|
4
|
goto \&Type::Tie::HASH::TIEHASH; |
1716
|
|
|
|
|
|
|
} |
1717
|
|
|
|
|
|
|
|
1718
|
|
|
|
|
|
|
1; |
1719
|
|
|
|
|
|
|
|
1720
|
|
|
|
|
|
|
__END__ |
1721
|
|
|
|
|
|
|
|
1722
|
|
|
|
|
|
|
=pod |
1723
|
|
|
|
|
|
|
|
1724
|
|
|
|
|
|
|
=encoding utf-8 |
1725
|
|
|
|
|
|
|
|
1726
|
|
|
|
|
|
|
=for stopwords Moo(se)-compatible MooseX MouseX MooX Moose-compat invocant |
1727
|
|
|
|
|
|
|
|
1728
|
|
|
|
|
|
|
=head1 NAME |
1729
|
|
|
|
|
|
|
|
1730
|
|
|
|
|
|
|
Type::Tiny - tiny, yet Moo(se)-compatible type constraint |
1731
|
|
|
|
|
|
|
|
1732
|
|
|
|
|
|
|
=head1 SYNOPSIS |
1733
|
|
|
|
|
|
|
|
1734
|
|
|
|
|
|
|
use v5.12; |
1735
|
|
|
|
|
|
|
use strict; |
1736
|
|
|
|
|
|
|
use warnings; |
1737
|
|
|
|
|
|
|
|
1738
|
|
|
|
|
|
|
package Horse { |
1739
|
|
|
|
|
|
|
use Moo; |
1740
|
|
|
|
|
|
|
use Types::Standard qw( Str Int Enum ArrayRef Object ); |
1741
|
|
|
|
|
|
|
use Type::Params qw( signature ); |
1742
|
|
|
|
|
|
|
use namespace::autoclean; |
1743
|
|
|
|
|
|
|
|
1744
|
|
|
|
|
|
|
has name => ( |
1745
|
|
|
|
|
|
|
is => 'ro', |
1746
|
|
|
|
|
|
|
isa => Str, |
1747
|
|
|
|
|
|
|
required => 1, |
1748
|
|
|
|
|
|
|
); |
1749
|
|
|
|
|
|
|
has gender => ( |
1750
|
|
|
|
|
|
|
is => 'ro', |
1751
|
|
|
|
|
|
|
isa => Enum[qw( f m )], |
1752
|
|
|
|
|
|
|
); |
1753
|
|
|
|
|
|
|
has age => ( |
1754
|
|
|
|
|
|
|
is => 'rw', |
1755
|
|
|
|
|
|
|
isa => Int->where( '$_ >= 0' ), |
1756
|
|
|
|
|
|
|
); |
1757
|
|
|
|
|
|
|
has children => ( |
1758
|
|
|
|
|
|
|
is => 'ro', |
1759
|
|
|
|
|
|
|
isa => ArrayRef[Object], |
1760
|
|
|
|
|
|
|
default => sub { return [] }, |
1761
|
|
|
|
|
|
|
); |
1762
|
|
|
|
|
|
|
|
1763
|
|
|
|
|
|
|
sub add_child { |
1764
|
|
|
|
|
|
|
state $check = signature( |
1765
|
|
|
|
|
|
|
method => Object, |
1766
|
|
|
|
|
|
|
positional => [ Object ], |
1767
|
|
|
|
|
|
|
); # method signature |
1768
|
|
|
|
|
|
|
my ( $self, $child ) = $check->( @_ ); # unpack @_ |
1769
|
|
|
|
|
|
|
|
1770
|
|
|
|
|
|
|
push @{ $self->children }, $child; |
1771
|
|
|
|
|
|
|
return $self; |
1772
|
|
|
|
|
|
|
} |
1773
|
|
|
|
|
|
|
} |
1774
|
|
|
|
|
|
|
|
1775
|
|
|
|
|
|
|
package main; |
1776
|
|
|
|
|
|
|
|
1777
|
|
|
|
|
|
|
my $boldruler = Horse->new( |
1778
|
|
|
|
|
|
|
name => "Bold Ruler", |
1779
|
|
|
|
|
|
|
gender => 'm', |
1780
|
|
|
|
|
|
|
age => 16, |
1781
|
|
|
|
|
|
|
); |
1782
|
|
|
|
|
|
|
|
1783
|
|
|
|
|
|
|
my $secretariat = Horse->new( |
1784
|
|
|
|
|
|
|
name => "Secretariat", |
1785
|
|
|
|
|
|
|
gender => 'm', |
1786
|
|
|
|
|
|
|
age => 0, |
1787
|
|
|
|
|
|
|
); |
1788
|
|
|
|
|
|
|
|
1789
|
|
|
|
|
|
|
$boldruler->add_child( $secretariat ); |
1790
|
|
|
|
|
|
|
|
1791
|
|
|
|
|
|
|
=head1 STATUS |
1792
|
|
|
|
|
|
|
|
1793
|
|
|
|
|
|
|
This module is covered by the |
1794
|
|
|
|
|
|
|
L<Type-Tiny stability policy|Type::Tiny::Manual::Policies/"STABILITY">. |
1795
|
|
|
|
|
|
|
|
1796
|
|
|
|
|
|
|
=head1 DESCRIPTION |
1797
|
|
|
|
|
|
|
|
1798
|
|
|
|
|
|
|
This documents the internals of the L<Type::Tiny> class. L<Type::Tiny::Manual> |
1799
|
|
|
|
|
|
|
is a better starting place if you're new. |
1800
|
|
|
|
|
|
|
|
1801
|
|
|
|
|
|
|
L<Type::Tiny> is a small class for creating Moose-like type constraint |
1802
|
|
|
|
|
|
|
objects which are compatible with Moo, Moose and Mouse. |
1803
|
|
|
|
|
|
|
|
1804
|
|
|
|
|
|
|
use Scalar::Util qw(looks_like_number); |
1805
|
|
|
|
|
|
|
use Type::Tiny; |
1806
|
|
|
|
|
|
|
|
1807
|
|
|
|
|
|
|
my $NUM = "Type::Tiny"->new( |
1808
|
|
|
|
|
|
|
name => "Number", |
1809
|
|
|
|
|
|
|
constraint => sub { looks_like_number($_) }, |
1810
|
|
|
|
|
|
|
message => sub { "$_ ain't a number" }, |
1811
|
|
|
|
|
|
|
); |
1812
|
|
|
|
|
|
|
|
1813
|
|
|
|
|
|
|
package Ermintrude { |
1814
|
|
|
|
|
|
|
use Moo; |
1815
|
|
|
|
|
|
|
has favourite_number => (is => "ro", isa => $NUM); |
1816
|
|
|
|
|
|
|
} |
1817
|
|
|
|
|
|
|
|
1818
|
|
|
|
|
|
|
package Bullwinkle { |
1819
|
|
|
|
|
|
|
use Moose; |
1820
|
|
|
|
|
|
|
has favourite_number => (is => "ro", isa => $NUM); |
1821
|
|
|
|
|
|
|
} |
1822
|
|
|
|
|
|
|
|
1823
|
|
|
|
|
|
|
package Maisy { |
1824
|
|
|
|
|
|
|
use Mouse; |
1825
|
|
|
|
|
|
|
has favourite_number => (is => "ro", isa => $NUM); |
1826
|
|
|
|
|
|
|
} |
1827
|
|
|
|
|
|
|
|
1828
|
|
|
|
|
|
|
Type::Tiny conforms to L<Type::API::Constraint>, |
1829
|
|
|
|
|
|
|
L<Type::API::Constraint::Coercible>, |
1830
|
|
|
|
|
|
|
L<Type::API::Constraint::Constructor>, and |
1831
|
|
|
|
|
|
|
L<Type::API::Constraint::Inlinable>. |
1832
|
|
|
|
|
|
|
|
1833
|
|
|
|
|
|
|
Maybe now we won't need to have separate MooseX, MouseX and MooX versions |
1834
|
|
|
|
|
|
|
of everything? We can but hope... |
1835
|
|
|
|
|
|
|
|
1836
|
|
|
|
|
|
|
=head2 Constructor |
1837
|
|
|
|
|
|
|
|
1838
|
|
|
|
|
|
|
=over |
1839
|
|
|
|
|
|
|
|
1840
|
|
|
|
|
|
|
=item C<< new(%attributes) >> |
1841
|
|
|
|
|
|
|
|
1842
|
|
|
|
|
|
|
Moose-style constructor function. |
1843
|
|
|
|
|
|
|
|
1844
|
|
|
|
|
|
|
=back |
1845
|
|
|
|
|
|
|
|
1846
|
|
|
|
|
|
|
=head2 Attributes |
1847
|
|
|
|
|
|
|
|
1848
|
|
|
|
|
|
|
Attributes are named values that may be passed to the constructor. For |
1849
|
|
|
|
|
|
|
each attribute, there is a corresponding reader method. For example: |
1850
|
|
|
|
|
|
|
|
1851
|
|
|
|
|
|
|
my $type = Type::Tiny->new( name => "Foo" ); |
1852
|
|
|
|
|
|
|
print $type->name, "\n"; # says "Foo" |
1853
|
|
|
|
|
|
|
|
1854
|
|
|
|
|
|
|
=head3 Important attributes |
1855
|
|
|
|
|
|
|
|
1856
|
|
|
|
|
|
|
These are the attributes you are likely to be most interested in |
1857
|
|
|
|
|
|
|
providing when creating your own type constraints, and most interested |
1858
|
|
|
|
|
|
|
in reading when dealing with type constraint objects. |
1859
|
|
|
|
|
|
|
|
1860
|
|
|
|
|
|
|
=over |
1861
|
|
|
|
|
|
|
|
1862
|
|
|
|
|
|
|
=item C<< constraint >> |
1863
|
|
|
|
|
|
|
|
1864
|
|
|
|
|
|
|
Coderef to validate a value (C<< $_ >>) against the type constraint. |
1865
|
|
|
|
|
|
|
The coderef will not be called unless the value is known to pass any |
1866
|
|
|
|
|
|
|
parent type constraint (see C<parent> below). |
1867
|
|
|
|
|
|
|
|
1868
|
|
|
|
|
|
|
Alternatively, a string of Perl code checking C<< $_ >> can be passed |
1869
|
|
|
|
|
|
|
as a parameter to the constructor, and will be converted to a coderef. |
1870
|
|
|
|
|
|
|
|
1871
|
|
|
|
|
|
|
Defaults to C<< sub { 1 } >> - i.e. a coderef that passes all values. |
1872
|
|
|
|
|
|
|
|
1873
|
|
|
|
|
|
|
=item C<< parent >> |
1874
|
|
|
|
|
|
|
|
1875
|
|
|
|
|
|
|
Optional attribute; parent type constraint. For example, an "Integer" |
1876
|
|
|
|
|
|
|
type constraint might have a parent "Number". |
1877
|
|
|
|
|
|
|
|
1878
|
|
|
|
|
|
|
If provided, must be a Type::Tiny object. |
1879
|
|
|
|
|
|
|
|
1880
|
|
|
|
|
|
|
=item C<< inlined >> |
1881
|
|
|
|
|
|
|
|
1882
|
|
|
|
|
|
|
A coderef which returns a string of Perl code suitable for inlining this |
1883
|
|
|
|
|
|
|
type. Optional. |
1884
|
|
|
|
|
|
|
|
1885
|
|
|
|
|
|
|
(The coderef will be called in list context and can actually return |
1886
|
|
|
|
|
|
|
a list of strings which will be joined with C<< && >>. If the first item |
1887
|
|
|
|
|
|
|
on the list is undef, it will be substituted with the type's parent's |
1888
|
|
|
|
|
|
|
inline check.) |
1889
|
|
|
|
|
|
|
|
1890
|
|
|
|
|
|
|
If C<constraint> (above) is a coderef generated via L<Sub::Quote>, then |
1891
|
|
|
|
|
|
|
Type::Tiny I<may> be able to automatically generate C<inlined> for you. |
1892
|
|
|
|
|
|
|
If C<constraint> (above) is a string, it will be able to. |
1893
|
|
|
|
|
|
|
|
1894
|
|
|
|
|
|
|
=item C<< name >> |
1895
|
|
|
|
|
|
|
|
1896
|
|
|
|
|
|
|
The name of the type constraint. These need to conform to certain naming |
1897
|
|
|
|
|
|
|
rules (they must begin with an uppercase letter and continue using only |
1898
|
|
|
|
|
|
|
letters, digits 0-9 and underscores). |
1899
|
|
|
|
|
|
|
|
1900
|
|
|
|
|
|
|
Optional; if not supplied will be an anonymous type constraint. |
1901
|
|
|
|
|
|
|
|
1902
|
|
|
|
|
|
|
=item C<< display_name >> |
1903
|
|
|
|
|
|
|
|
1904
|
|
|
|
|
|
|
A name to display for the type constraint when stringified. These don't |
1905
|
|
|
|
|
|
|
have to conform to any naming rules. Optional; a default name will be |
1906
|
|
|
|
|
|
|
calculated from the C<name>. |
1907
|
|
|
|
|
|
|
|
1908
|
|
|
|
|
|
|
=item C<< library >> |
1909
|
|
|
|
|
|
|
|
1910
|
|
|
|
|
|
|
The package name of the type library this type is associated with. |
1911
|
|
|
|
|
|
|
Optional. Informational only: setting this attribute does not install |
1912
|
|
|
|
|
|
|
the type into the package. |
1913
|
|
|
|
|
|
|
|
1914
|
|
|
|
|
|
|
=item C<< deprecated >> |
1915
|
|
|
|
|
|
|
|
1916
|
|
|
|
|
|
|
Optional boolean indicating whether a type constraint is deprecated. |
1917
|
|
|
|
|
|
|
L<Type::Library> will issue a warning if you attempt to import a deprecated |
1918
|
|
|
|
|
|
|
type constraint, but otherwise the type will continue to function as normal. |
1919
|
|
|
|
|
|
|
There will not be deprecation warnings every time you validate a value, for |
1920
|
|
|
|
|
|
|
instance. If omitted, defaults to the parent's deprecation status (or false |
1921
|
|
|
|
|
|
|
if there's no parent). |
1922
|
|
|
|
|
|
|
|
1923
|
|
|
|
|
|
|
=item C<< message >> |
1924
|
|
|
|
|
|
|
|
1925
|
|
|
|
|
|
|
Coderef that returns an error message when C<< $_ >> does not validate |
1926
|
|
|
|
|
|
|
against the type constraint. Optional (there's a vaguely sensible default.) |
1927
|
|
|
|
|
|
|
|
1928
|
|
|
|
|
|
|
=item C<< coercion >> |
1929
|
|
|
|
|
|
|
|
1930
|
|
|
|
|
|
|
A L<Type::Coercion> object associated with this type. |
1931
|
|
|
|
|
|
|
|
1932
|
|
|
|
|
|
|
Generally speaking this attribute should not be passed to the constructor; |
1933
|
|
|
|
|
|
|
you should rely on the default lazily-built coercion object. |
1934
|
|
|
|
|
|
|
|
1935
|
|
|
|
|
|
|
You may pass C<< coercion => 1 >> to the constructor to inherit coercions |
1936
|
|
|
|
|
|
|
from the constraint's parent. (This requires the parent constraint to have |
1937
|
|
|
|
|
|
|
a coercion.) |
1938
|
|
|
|
|
|
|
|
1939
|
|
|
|
|
|
|
=item C<< sorter >> |
1940
|
|
|
|
|
|
|
|
1941
|
|
|
|
|
|
|
A coderef which can be passed two values conforming to this type constraint |
1942
|
|
|
|
|
|
|
and returns -1, 0, or 1 to put them in order. Alternatively an arrayref |
1943
|
|
|
|
|
|
|
containing a pair of coderefs — a sorter and a pre-processor for the |
1944
|
|
|
|
|
|
|
Schwarzian transform. Optional. |
1945
|
|
|
|
|
|
|
|
1946
|
|
|
|
|
|
|
The idea is to allow for: |
1947
|
|
|
|
|
|
|
|
1948
|
|
|
|
|
|
|
@sorted = Int->sort( 2, 1, 11 ); # => 1, 2, 11 |
1949
|
|
|
|
|
|
|
@sorted = Str->sort( 2, 1, 11 ); # => 1, 11, 2 |
1950
|
|
|
|
|
|
|
|
1951
|
|
|
|
|
|
|
=item C<< type_default >> |
1952
|
|
|
|
|
|
|
|
1953
|
|
|
|
|
|
|
A coderef which returns a sensible default value for this type. For example, |
1954
|
|
|
|
|
|
|
for a B<Counter> type, a sensible default might be "0": |
1955
|
|
|
|
|
|
|
|
1956
|
|
|
|
|
|
|
my $Size = Type::Tiny->new( |
1957
|
|
|
|
|
|
|
name => 'Size', |
1958
|
|
|
|
|
|
|
parent => Types::Standard::Enum[ qw( XS S M L XL ) ], |
1959
|
|
|
|
|
|
|
type_default => sub { return 'M'; }, |
1960
|
|
|
|
|
|
|
); |
1961
|
|
|
|
|
|
|
|
1962
|
|
|
|
|
|
|
package Tshirt { |
1963
|
|
|
|
|
|
|
use Moo; |
1964
|
|
|
|
|
|
|
has size => ( |
1965
|
|
|
|
|
|
|
is => 'ro', |
1966
|
|
|
|
|
|
|
isa => $Size, |
1967
|
|
|
|
|
|
|
default => $Size->type_default, |
1968
|
|
|
|
|
|
|
); |
1969
|
|
|
|
|
|
|
} |
1970
|
|
|
|
|
|
|
|
1971
|
|
|
|
|
|
|
Child types will inherit a type default from their parent unless the child |
1972
|
|
|
|
|
|
|
has a C<constraint>. If a type neither has nor inherits a type default, then |
1973
|
|
|
|
|
|
|
calling C<type_default> will return undef. |
1974
|
|
|
|
|
|
|
|
1975
|
|
|
|
|
|
|
As a special case, this: |
1976
|
|
|
|
|
|
|
|
1977
|
|
|
|
|
|
|
$type->type_default( @args ) |
1978
|
|
|
|
|
|
|
|
1979
|
|
|
|
|
|
|
Will return: |
1980
|
|
|
|
|
|
|
|
1981
|
|
|
|
|
|
|
sub { |
1982
|
|
|
|
|
|
|
local $_ = \@args; |
1983
|
|
|
|
|
|
|
$type->type_default->( @_ ); |
1984
|
|
|
|
|
|
|
} |
1985
|
|
|
|
|
|
|
|
1986
|
|
|
|
|
|
|
Many of the types defined in L<Types::Standard> and other bundled type |
1987
|
|
|
|
|
|
|
libraries have type defaults, but discovering them is left as an exercise |
1988
|
|
|
|
|
|
|
for the reader. |
1989
|
|
|
|
|
|
|
|
1990
|
|
|
|
|
|
|
=item C<< my_methods >> |
1991
|
|
|
|
|
|
|
|
1992
|
|
|
|
|
|
|
Experimental hashref of additional methods that can be called on the type |
1993
|
|
|
|
|
|
|
constraint object. |
1994
|
|
|
|
|
|
|
|
1995
|
|
|
|
|
|
|
=item C<< exception_class >> |
1996
|
|
|
|
|
|
|
|
1997
|
|
|
|
|
|
|
The class used to throw an exception when a value fails its type check. |
1998
|
|
|
|
|
|
|
Defaults to "Error::TypeTiny::Assertion", which is usually good. This class |
1999
|
|
|
|
|
|
|
is expected to provide a C<throw_cb> method compatible with the method of |
2000
|
|
|
|
|
|
|
that name in L<Error::TypeTiny>. |
2001
|
|
|
|
|
|
|
|
2002
|
|
|
|
|
|
|
If a parent type constraint has a custom C<exception_class>, then this |
2003
|
|
|
|
|
|
|
will be "inherited" by its children. |
2004
|
|
|
|
|
|
|
|
2005
|
|
|
|
|
|
|
=back |
2006
|
|
|
|
|
|
|
|
2007
|
|
|
|
|
|
|
=head3 Attributes related to parameterizable and parameterized types |
2008
|
|
|
|
|
|
|
|
2009
|
|
|
|
|
|
|
The following additional attributes are used for parameterizable (e.g. |
2010
|
|
|
|
|
|
|
C<ArrayRef>) and parameterized (e.g. C<< ArrayRef[Int] >>) type |
2011
|
|
|
|
|
|
|
constraints. Unlike Moose, these aren't handled by separate subclasses. |
2012
|
|
|
|
|
|
|
|
2013
|
|
|
|
|
|
|
=over |
2014
|
|
|
|
|
|
|
|
2015
|
|
|
|
|
|
|
=item C<< constraint_generator >> |
2016
|
|
|
|
|
|
|
|
2017
|
|
|
|
|
|
|
Coderef that is called when a type constraint is parameterized. When called, |
2018
|
|
|
|
|
|
|
it is passed the list of parameters, though any parameter which looks like a |
2019
|
|
|
|
|
|
|
foreign type constraint (Moose type constraints, Mouse type constraints, etc, |
2020
|
|
|
|
|
|
|
I<< and coderefs(!!!) >>) is first coerced to a native Type::Tiny object. |
2021
|
|
|
|
|
|
|
|
2022
|
|
|
|
|
|
|
Note that for compatibility with the Moose API, the base type is I<not> |
2023
|
|
|
|
|
|
|
passed to the constraint generator, but can be found in the package variable |
2024
|
|
|
|
|
|
|
C<< $Type::Tiny::parameterize_type >>. The first parameter is also available |
2025
|
|
|
|
|
|
|
as C<< $_ >>. |
2026
|
|
|
|
|
|
|
|
2027
|
|
|
|
|
|
|
Types I<can> be parameterized with an empty parameter list. For example, |
2028
|
|
|
|
|
|
|
in L<Types::Standard>, C<Tuple> is just an alias for C<ArrayRef> but |
2029
|
|
|
|
|
|
|
C<< Tuple[] >> will only allow zero-length arrayrefs to pass the constraint. |
2030
|
|
|
|
|
|
|
If you wish C<< YourType >> and C<< YourType[] >> to mean the same thing, |
2031
|
|
|
|
|
|
|
then do: |
2032
|
|
|
|
|
|
|
|
2033
|
|
|
|
|
|
|
return $Type::Tiny::parameterize_type unless @_; |
2034
|
|
|
|
|
|
|
|
2035
|
|
|
|
|
|
|
The constraint generator should generate and return a new constraint coderef |
2036
|
|
|
|
|
|
|
based on the parameters. Alternatively, the constraint generator can return a |
2037
|
|
|
|
|
|
|
fully-formed Type::Tiny object, in which case the C<name_generator>, |
2038
|
|
|
|
|
|
|
C<inline_generator>, and C<coercion_generator> attributes documented below |
2039
|
|
|
|
|
|
|
are ignored. |
2040
|
|
|
|
|
|
|
|
2041
|
|
|
|
|
|
|
Optional; providing a generator makes this type into a parameterizable |
2042
|
|
|
|
|
|
|
type constraint. If there is no generator, attempting to parameterize the |
2043
|
|
|
|
|
|
|
type constraint will throw an exception. |
2044
|
|
|
|
|
|
|
|
2045
|
|
|
|
|
|
|
=item C<< name_generator >> |
2046
|
|
|
|
|
|
|
|
2047
|
|
|
|
|
|
|
A coderef which generates a new display_name based on parameters. Called with |
2048
|
|
|
|
|
|
|
the same parameters and package variables as the C<constraint_generator>. |
2049
|
|
|
|
|
|
|
Expected to return a string. |
2050
|
|
|
|
|
|
|
|
2051
|
|
|
|
|
|
|
Optional; the default is reasonable. |
2052
|
|
|
|
|
|
|
|
2053
|
|
|
|
|
|
|
=item C<< inline_generator >> |
2054
|
|
|
|
|
|
|
|
2055
|
|
|
|
|
|
|
A coderef which generates a new inlining coderef based on parameters. Called |
2056
|
|
|
|
|
|
|
with the same parameters and package variables as the C<constraint_generator>. |
2057
|
|
|
|
|
|
|
Expected to return a coderef. |
2058
|
|
|
|
|
|
|
|
2059
|
|
|
|
|
|
|
Optional. |
2060
|
|
|
|
|
|
|
|
2061
|
|
|
|
|
|
|
=item C<< coercion_generator >> |
2062
|
|
|
|
|
|
|
|
2063
|
|
|
|
|
|
|
A coderef which generates a new L<Type::Coercion> object based on parameters. |
2064
|
|
|
|
|
|
|
Called with the same parameters and package variables as the |
2065
|
|
|
|
|
|
|
C<constraint_generator>. Expected to return a blessed object. |
2066
|
|
|
|
|
|
|
|
2067
|
|
|
|
|
|
|
Optional. |
2068
|
|
|
|
|
|
|
|
2069
|
|
|
|
|
|
|
=item C<< deep_explanation >> |
2070
|
|
|
|
|
|
|
|
2071
|
|
|
|
|
|
|
This API is not finalized. Coderef used by L<Error::TypeTiny::Assertion> to |
2072
|
|
|
|
|
|
|
peek inside parameterized types and figure out why a value doesn't pass the |
2073
|
|
|
|
|
|
|
constraint. |
2074
|
|
|
|
|
|
|
|
2075
|
|
|
|
|
|
|
=item C<< parameters >> |
2076
|
|
|
|
|
|
|
|
2077
|
|
|
|
|
|
|
In parameterized types, returns an arrayref of the parameters. |
2078
|
|
|
|
|
|
|
|
2079
|
|
|
|
|
|
|
=back |
2080
|
|
|
|
|
|
|
|
2081
|
|
|
|
|
|
|
=head3 Lazy generated attributes |
2082
|
|
|
|
|
|
|
|
2083
|
|
|
|
|
|
|
The following attributes should not be usually passed to the constructor; |
2084
|
|
|
|
|
|
|
unless you're doing something especially unusual, you should rely on the |
2085
|
|
|
|
|
|
|
default lazily-built return values. |
2086
|
|
|
|
|
|
|
|
2087
|
|
|
|
|
|
|
=over |
2088
|
|
|
|
|
|
|
|
2089
|
|
|
|
|
|
|
=item C<< compiled_check >> |
2090
|
|
|
|
|
|
|
|
2091
|
|
|
|
|
|
|
Coderef to validate a value (C<< $_[0] >>) against the type constraint. |
2092
|
|
|
|
|
|
|
This coderef is expected to also handle all validation for the parent |
2093
|
|
|
|
|
|
|
type constraints. |
2094
|
|
|
|
|
|
|
|
2095
|
|
|
|
|
|
|
=item C<< definition_context >> |
2096
|
|
|
|
|
|
|
|
2097
|
|
|
|
|
|
|
Hashref of information indicating where the type constraint was originally |
2098
|
|
|
|
|
|
|
defined. Type::Tiny will generate this based on C<caller> if you do not |
2099
|
|
|
|
|
|
|
supply it. The hashref will ordinarily contain keys C<"package">, C<"file">, |
2100
|
|
|
|
|
|
|
and C<"line">. |
2101
|
|
|
|
|
|
|
|
2102
|
|
|
|
|
|
|
For parameterized types and compound types (e.g. unions and intersections), |
2103
|
|
|
|
|
|
|
this may not be especially meaningful information. |
2104
|
|
|
|
|
|
|
|
2105
|
|
|
|
|
|
|
=item C<< complementary_type >> |
2106
|
|
|
|
|
|
|
|
2107
|
|
|
|
|
|
|
A complementary type for this type. For example, the complementary type |
2108
|
|
|
|
|
|
|
for an integer type would be all things that are not integers, including |
2109
|
|
|
|
|
|
|
floating point numbers, but also alphabetic strings, arrayrefs, filehandles, |
2110
|
|
|
|
|
|
|
etc. |
2111
|
|
|
|
|
|
|
|
2112
|
|
|
|
|
|
|
=item C<< moose_type >>, C<< mouse_type >> |
2113
|
|
|
|
|
|
|
|
2114
|
|
|
|
|
|
|
Objects equivalent to this type constraint, but as a |
2115
|
|
|
|
|
|
|
L<Moose::Meta::TypeConstraint> or L<Mouse::Meta::TypeConstraint>. |
2116
|
|
|
|
|
|
|
|
2117
|
|
|
|
|
|
|
It should rarely be necessary to obtain a L<Moose::Meta::TypeConstraint> |
2118
|
|
|
|
|
|
|
object from L<Type::Tiny> because the L<Type::Tiny> object itself should |
2119
|
|
|
|
|
|
|
be usable pretty much anywhere a L<Moose::Meta::TypeConstraint> is expected. |
2120
|
|
|
|
|
|
|
|
2121
|
|
|
|
|
|
|
=back |
2122
|
|
|
|
|
|
|
|
2123
|
|
|
|
|
|
|
=head2 Methods |
2124
|
|
|
|
|
|
|
|
2125
|
|
|
|
|
|
|
=head3 Predicate methods |
2126
|
|
|
|
|
|
|
|
2127
|
|
|
|
|
|
|
These methods return booleans indicating information about the type |
2128
|
|
|
|
|
|
|
constraint. They are each tightly associated with a particular attribute. |
2129
|
|
|
|
|
|
|
(See L</"Attributes">.) |
2130
|
|
|
|
|
|
|
|
2131
|
|
|
|
|
|
|
=over |
2132
|
|
|
|
|
|
|
|
2133
|
|
|
|
|
|
|
=item C<has_parent>, C<has_library>, C<has_inlined>, C<has_constraint_generator>, C<has_inline_generator>, C<has_coercion_generator>, C<has_parameters>, C<has_message>, C<has_deep_explanation>, C<has_sorter> |
2134
|
|
|
|
|
|
|
|
2135
|
|
|
|
|
|
|
Simple Moose-style predicate methods indicating the presence or |
2136
|
|
|
|
|
|
|
absence of an attribute. |
2137
|
|
|
|
|
|
|
|
2138
|
|
|
|
|
|
|
=item C<has_coercion> |
2139
|
|
|
|
|
|
|
|
2140
|
|
|
|
|
|
|
Predicate method with a little extra DWIM. Returns false if the coercion is |
2141
|
|
|
|
|
|
|
a no-op. |
2142
|
|
|
|
|
|
|
|
2143
|
|
|
|
|
|
|
=item C<< is_anon >> |
2144
|
|
|
|
|
|
|
|
2145
|
|
|
|
|
|
|
Returns true iff the type constraint does not have a C<name>. |
2146
|
|
|
|
|
|
|
|
2147
|
|
|
|
|
|
|
=item C<< is_parameterized >>, C<< is_parameterizable >> |
2148
|
|
|
|
|
|
|
|
2149
|
|
|
|
|
|
|
Indicates whether a type has been parameterized (e.g. C<< ArrayRef[Int] >>) |
2150
|
|
|
|
|
|
|
or could potentially be (e.g. C<< ArrayRef >>). |
2151
|
|
|
|
|
|
|
|
2152
|
|
|
|
|
|
|
=item C<< has_parameterized_from >> |
2153
|
|
|
|
|
|
|
|
2154
|
|
|
|
|
|
|
Useless alias for C<is_parameterized>. |
2155
|
|
|
|
|
|
|
|
2156
|
|
|
|
|
|
|
=back |
2157
|
|
|
|
|
|
|
|
2158
|
|
|
|
|
|
|
=head3 Validation and coercion |
2159
|
|
|
|
|
|
|
|
2160
|
|
|
|
|
|
|
The following methods are used for coercing and validating values |
2161
|
|
|
|
|
|
|
against a type constraint: |
2162
|
|
|
|
|
|
|
|
2163
|
|
|
|
|
|
|
=over |
2164
|
|
|
|
|
|
|
|
2165
|
|
|
|
|
|
|
=item C<< check($value) >> |
2166
|
|
|
|
|
|
|
|
2167
|
|
|
|
|
|
|
Returns true iff the value passes the type constraint. |
2168
|
|
|
|
|
|
|
|
2169
|
|
|
|
|
|
|
=item C<< validate($value) >> |
2170
|
|
|
|
|
|
|
|
2171
|
|
|
|
|
|
|
Returns the error message for the value; returns an explicit undef if the |
2172
|
|
|
|
|
|
|
value passes the type constraint. |
2173
|
|
|
|
|
|
|
|
2174
|
|
|
|
|
|
|
=item C<< assert_valid($value) >> |
2175
|
|
|
|
|
|
|
|
2176
|
|
|
|
|
|
|
Like C<< check($value) >> but dies if the value does not pass the type |
2177
|
|
|
|
|
|
|
constraint. |
2178
|
|
|
|
|
|
|
|
2179
|
|
|
|
|
|
|
Yes, that's three very similar methods. Blame L<Moose::Meta::TypeConstraint> |
2180
|
|
|
|
|
|
|
whose API I'm attempting to emulate. :-) |
2181
|
|
|
|
|
|
|
|
2182
|
|
|
|
|
|
|
=item C<< assert_return($value) >> |
2183
|
|
|
|
|
|
|
|
2184
|
|
|
|
|
|
|
Like C<< assert_valid($value) >> but returns the value if it passes the type |
2185
|
|
|
|
|
|
|
constraint. |
2186
|
|
|
|
|
|
|
|
2187
|
|
|
|
|
|
|
This seems a more useful behaviour than C<< assert_valid($value) >>. I would |
2188
|
|
|
|
|
|
|
have just changed C<< assert_valid($value) >> to do this, except that there |
2189
|
|
|
|
|
|
|
are edge cases where it could break Moose compatibility. |
2190
|
|
|
|
|
|
|
|
2191
|
|
|
|
|
|
|
=item C<< get_message($value) >> |
2192
|
|
|
|
|
|
|
|
2193
|
|
|
|
|
|
|
Returns the error message for the value; even if the value passes the type |
2194
|
|
|
|
|
|
|
constraint. |
2195
|
|
|
|
|
|
|
|
2196
|
|
|
|
|
|
|
=item C<< validate_explain($value, $varname) >> |
2197
|
|
|
|
|
|
|
|
2198
|
|
|
|
|
|
|
Like C<validate> but instead of a string error message, returns an arrayref |
2199
|
|
|
|
|
|
|
of strings explaining the reasoning why the value does not meet the type |
2200
|
|
|
|
|
|
|
constraint, examining parent types, etc. |
2201
|
|
|
|
|
|
|
|
2202
|
|
|
|
|
|
|
The C<< $varname >> is an optional string like C<< '$foo' >> indicating the |
2203
|
|
|
|
|
|
|
name of the variable being checked. |
2204
|
|
|
|
|
|
|
|
2205
|
|
|
|
|
|
|
=item C<< coerce($value) >> |
2206
|
|
|
|
|
|
|
|
2207
|
|
|
|
|
|
|
Attempt to coerce C<< $value >> to this type. |
2208
|
|
|
|
|
|
|
|
2209
|
|
|
|
|
|
|
=item C<< assert_coerce($value) >> |
2210
|
|
|
|
|
|
|
|
2211
|
|
|
|
|
|
|
Attempt to coerce C<< $value >> to this type. Throws an exception if this is |
2212
|
|
|
|
|
|
|
not possible. |
2213
|
|
|
|
|
|
|
|
2214
|
|
|
|
|
|
|
=back |
2215
|
|
|
|
|
|
|
|
2216
|
|
|
|
|
|
|
=head3 Child type constraint creation and parameterization |
2217
|
|
|
|
|
|
|
|
2218
|
|
|
|
|
|
|
These methods generate new type constraint objects that inherit from the |
2219
|
|
|
|
|
|
|
constraint they are called upon: |
2220
|
|
|
|
|
|
|
|
2221
|
|
|
|
|
|
|
=over |
2222
|
|
|
|
|
|
|
|
2223
|
|
|
|
|
|
|
=item C<< create_child_type(%attributes) >> |
2224
|
|
|
|
|
|
|
|
2225
|
|
|
|
|
|
|
Construct a new Type::Tiny object with this object as its parent. |
2226
|
|
|
|
|
|
|
|
2227
|
|
|
|
|
|
|
=item C<< where($coderef) >> |
2228
|
|
|
|
|
|
|
|
2229
|
|
|
|
|
|
|
Shortcut for creating an anonymous child type constraint. Use it like |
2230
|
|
|
|
|
|
|
C<< HashRef->where(sub { exists($_->{name}) }) >>. That said, you can |
2231
|
|
|
|
|
|
|
get a similar result using overloaded C<< & >>: |
2232
|
|
|
|
|
|
|
|
2233
|
|
|
|
|
|
|
HashRef & sub { exists($_->{name}) } |
2234
|
|
|
|
|
|
|
|
2235
|
|
|
|
|
|
|
Like the C<< constraint >> attribute, this will accept a string of Perl |
2236
|
|
|
|
|
|
|
code: |
2237
|
|
|
|
|
|
|
|
2238
|
|
|
|
|
|
|
HashRef->where('exists($_->{name})') |
2239
|
|
|
|
|
|
|
|
2240
|
|
|
|
|
|
|
=item C<< child_type_class >> |
2241
|
|
|
|
|
|
|
|
2242
|
|
|
|
|
|
|
The class that create_child_type will construct by default. |
2243
|
|
|
|
|
|
|
|
2244
|
|
|
|
|
|
|
=item C<< parameterize(@parameters) >> |
2245
|
|
|
|
|
|
|
|
2246
|
|
|
|
|
|
|
Creates a new parameterized type; throws an exception if called on a |
2247
|
|
|
|
|
|
|
non-parameterizable type. |
2248
|
|
|
|
|
|
|
|
2249
|
|
|
|
|
|
|
=item C<< of(@parameters) >> |
2250
|
|
|
|
|
|
|
|
2251
|
|
|
|
|
|
|
A cute alias for C<parameterize>. Use it like C<< ArrayRef->of(Int) >>. |
2252
|
|
|
|
|
|
|
|
2253
|
|
|
|
|
|
|
=item C<< plus_coercions($type1, $code1, ...) >> |
2254
|
|
|
|
|
|
|
|
2255
|
|
|
|
|
|
|
Shorthand for creating a new child type constraint with the same coercions |
2256
|
|
|
|
|
|
|
as this one, but then adding some extra coercions (at a higher priority than |
2257
|
|
|
|
|
|
|
the existing ones). |
2258
|
|
|
|
|
|
|
|
2259
|
|
|
|
|
|
|
=item C<< plus_fallback_coercions($type1, $code1, ...) >> |
2260
|
|
|
|
|
|
|
|
2261
|
|
|
|
|
|
|
Like C<plus_coercions>, but added at a lower priority. |
2262
|
|
|
|
|
|
|
|
2263
|
|
|
|
|
|
|
=item C<< minus_coercions($type1, ...) >> |
2264
|
|
|
|
|
|
|
|
2265
|
|
|
|
|
|
|
Shorthand for creating a new child type constraint with fewer type coercions. |
2266
|
|
|
|
|
|
|
|
2267
|
|
|
|
|
|
|
=item C<< no_coercions >> |
2268
|
|
|
|
|
|
|
|
2269
|
|
|
|
|
|
|
Shorthand for creating a new child type constraint with no coercions at all. |
2270
|
|
|
|
|
|
|
|
2271
|
|
|
|
|
|
|
=back |
2272
|
|
|
|
|
|
|
|
2273
|
|
|
|
|
|
|
=head3 Type relationship introspection methods |
2274
|
|
|
|
|
|
|
|
2275
|
|
|
|
|
|
|
These methods allow you to determine a type constraint's relationship to |
2276
|
|
|
|
|
|
|
other type constraints in an organised hierarchy: |
2277
|
|
|
|
|
|
|
|
2278
|
|
|
|
|
|
|
=over |
2279
|
|
|
|
|
|
|
|
2280
|
|
|
|
|
|
|
=item C<< equals($other) >>, C<< is_subtype_of($other) >>, C<< is_supertype_of($other) >>, C<< is_a_type_of($other) >> |
2281
|
|
|
|
|
|
|
|
2282
|
|
|
|
|
|
|
Compare two types. See L<Moose::Meta::TypeConstraint> for what these all mean. |
2283
|
|
|
|
|
|
|
(OK, Moose doesn't define C<is_supertype_of>, but you get the idea, right?) |
2284
|
|
|
|
|
|
|
|
2285
|
|
|
|
|
|
|
Note that these have a slightly DWIM side to them. If you create two |
2286
|
|
|
|
|
|
|
L<Type::Tiny::Class> objects which test the same class, they're considered |
2287
|
|
|
|
|
|
|
equal. And: |
2288
|
|
|
|
|
|
|
|
2289
|
|
|
|
|
|
|
my $subtype_of_Num = Types::Standard::Num->create_child_type; |
2290
|
|
|
|
|
|
|
my $subtype_of_Int = Types::Standard::Int->create_child_type; |
2291
|
|
|
|
|
|
|
$subtype_of_Int->is_subtype_of( $subtype_of_Num ); # true |
2292
|
|
|
|
|
|
|
|
2293
|
|
|
|
|
|
|
=item C<< strictly_equals($other) >>, C<< is_strictly_subtype_of($other) >>, C<< is_strictly_supertype_of($other) >>, C<< is_strictly_a_type_of($other) >> |
2294
|
|
|
|
|
|
|
|
2295
|
|
|
|
|
|
|
Stricter versions of the type comparison functions. These only care about |
2296
|
|
|
|
|
|
|
explicit inheritance via C<parent>. |
2297
|
|
|
|
|
|
|
|
2298
|
|
|
|
|
|
|
my $subtype_of_Num = Types::Standard::Num->create_child_type; |
2299
|
|
|
|
|
|
|
my $subtype_of_Int = Types::Standard::Int->create_child_type; |
2300
|
|
|
|
|
|
|
$subtype_of_Int->is_strictly_subtype_of( $subtype_of_Num ); # false |
2301
|
|
|
|
|
|
|
|
2302
|
|
|
|
|
|
|
=item C<< parents >> |
2303
|
|
|
|
|
|
|
|
2304
|
|
|
|
|
|
|
Returns a list of all this type constraint's ancestor constraints. For |
2305
|
|
|
|
|
|
|
example, if called on the C<Str> type constraint would return the list |
2306
|
|
|
|
|
|
|
C<< (Value, Defined, Item, Any) >>. |
2307
|
|
|
|
|
|
|
|
2308
|
|
|
|
|
|
|
I<< Due to a historical misunderstanding, this differs from the Moose |
2309
|
|
|
|
|
|
|
implementation of the C<parents> method. In Moose, C<parents> only returns the |
2310
|
|
|
|
|
|
|
immediate parent type constraints, and because type constraints only have |
2311
|
|
|
|
|
|
|
one immediate parent, this is effectively an alias for C<parent>. The |
2312
|
|
|
|
|
|
|
extension module L<MooseX::Meta::TypeConstraint::Intersection> is the only |
2313
|
|
|
|
|
|
|
place where multiple type constraints are returned; and they are returned |
2314
|
|
|
|
|
|
|
as an arrayref in violation of the base class' documentation. I'm keeping |
2315
|
|
|
|
|
|
|
my behaviour as it seems more useful. >> |
2316
|
|
|
|
|
|
|
|
2317
|
|
|
|
|
|
|
=item C<< find_parent($coderef) >> |
2318
|
|
|
|
|
|
|
|
2319
|
|
|
|
|
|
|
Loops through the parent type constraints I<< including the invocant |
2320
|
|
|
|
|
|
|
itself >> and returns the nearest ancestor type constraint where the |
2321
|
|
|
|
|
|
|
coderef evaluates to true. Within the coderef the ancestor currently |
2322
|
|
|
|
|
|
|
being checked is C<< $_ >>. Returns undef if there is no match. |
2323
|
|
|
|
|
|
|
|
2324
|
|
|
|
|
|
|
In list context also returns the number of type constraints which had |
2325
|
|
|
|
|
|
|
been looped through before the matching constraint was found. |
2326
|
|
|
|
|
|
|
|
2327
|
|
|
|
|
|
|
=item C<< find_constraining_type >> |
2328
|
|
|
|
|
|
|
|
2329
|
|
|
|
|
|
|
Finds the nearest ancestor type constraint (including the type itself) |
2330
|
|
|
|
|
|
|
which has a C<constraint> coderef. |
2331
|
|
|
|
|
|
|
|
2332
|
|
|
|
|
|
|
Equivalent to: |
2333
|
|
|
|
|
|
|
|
2334
|
|
|
|
|
|
|
$type->find_parent(sub { not $_->_is_null_constraint }) |
2335
|
|
|
|
|
|
|
|
2336
|
|
|
|
|
|
|
=item C<< coercibles >> |
2337
|
|
|
|
|
|
|
|
2338
|
|
|
|
|
|
|
Return a type constraint which is the union of type constraints that can be |
2339
|
|
|
|
|
|
|
coerced to this one (including this one). If this type constraint has no |
2340
|
|
|
|
|
|
|
coercions, returns itself. |
2341
|
|
|
|
|
|
|
|
2342
|
|
|
|
|
|
|
=item C<< type_parameter >> |
2343
|
|
|
|
|
|
|
|
2344
|
|
|
|
|
|
|
In parameterized type constraints, returns the first item on the list of |
2345
|
|
|
|
|
|
|
parameters; otherwise returns undef. For example: |
2346
|
|
|
|
|
|
|
|
2347
|
|
|
|
|
|
|
( ArrayRef[Int] )->type_parameter; # returns Int |
2348
|
|
|
|
|
|
|
( ArrayRef[Int] )->parent; # returns ArrayRef |
2349
|
|
|
|
|
|
|
|
2350
|
|
|
|
|
|
|
Note that parameterizable type constraints can perfectly legitimately take |
2351
|
|
|
|
|
|
|
multiple parameters (several of the parameterizable type constraints in |
2352
|
|
|
|
|
|
|
L<Types::Standard> do). This method only returns the first such parameter. |
2353
|
|
|
|
|
|
|
L</"Attributes related to parameterizable and parameterized types"> |
2354
|
|
|
|
|
|
|
documents the C<parameters> attribute, which returns an arrayref of all |
2355
|
|
|
|
|
|
|
the parameters. |
2356
|
|
|
|
|
|
|
|
2357
|
|
|
|
|
|
|
=item C<< parameterized_from >> |
2358
|
|
|
|
|
|
|
|
2359
|
|
|
|
|
|
|
Harder to spell alias for C<parent> that only works for parameterized |
2360
|
|
|
|
|
|
|
types. |
2361
|
|
|
|
|
|
|
|
2362
|
|
|
|
|
|
|
=back |
2363
|
|
|
|
|
|
|
|
2364
|
|
|
|
|
|
|
I<< Hint for people subclassing Type::Tiny: >> |
2365
|
|
|
|
|
|
|
Since version 1.006000, the methods for determining subtype, supertype, and |
2366
|
|
|
|
|
|
|
type equality should I<not> be overridden in subclasses of Type::Tiny. This |
2367
|
|
|
|
|
|
|
is because of the problem of diamond inheritance. If X and Y are both |
2368
|
|
|
|
|
|
|
subclasses of Type::Tiny, they I<both> need to be consulted to figure out |
2369
|
|
|
|
|
|
|
how type constraints are related; not just one of them should be overriding |
2370
|
|
|
|
|
|
|
these methods. See the source code for L<Type::Tiny::Enum> for an example of |
2371
|
|
|
|
|
|
|
how subclasses can give hints about type relationships to Type::Tiny. |
2372
|
|
|
|
|
|
|
Summary: push a coderef onto C<< @Type::Tiny::CMP >>. This coderef will be |
2373
|
|
|
|
|
|
|
passed two type constraints. It should then return one of the constants |
2374
|
|
|
|
|
|
|
Type::Tiny::CMP_SUBTYPE (first type is a subtype of second type), |
2375
|
|
|
|
|
|
|
Type::Tiny::CMP_SUPERTYPE (second type is a subtype of first type), |
2376
|
|
|
|
|
|
|
Type::Tiny::CMP_EQUAL (the two types are exactly the same), |
2377
|
|
|
|
|
|
|
Type::Tiny::CMP_EQUIVALENT (the two types are effectively the same), or |
2378
|
|
|
|
|
|
|
Type::Tiny::CMP_UNKNOWN (your coderef couldn't establish any relationship). |
2379
|
|
|
|
|
|
|
|
2380
|
|
|
|
|
|
|
=head3 Type relationship introspection function |
2381
|
|
|
|
|
|
|
|
2382
|
|
|
|
|
|
|
=over |
2383
|
|
|
|
|
|
|
|
2384
|
|
|
|
|
|
|
=item C<< Type::Tiny::cmp($type1, $type2) >> |
2385
|
|
|
|
|
|
|
|
2386
|
|
|
|
|
|
|
The subtype/supertype relationship between types results in a partial |
2387
|
|
|
|
|
|
|
ordering of type constraints. |
2388
|
|
|
|
|
|
|
|
2389
|
|
|
|
|
|
|
This function will return one of the constants: |
2390
|
|
|
|
|
|
|
Type::Tiny::CMP_SUBTYPE (first type is a subtype of second type), |
2391
|
|
|
|
|
|
|
Type::Tiny::CMP_SUPERTYPE (second type is a subtype of first type), |
2392
|
|
|
|
|
|
|
Type::Tiny::CMP_EQUAL (the two types are exactly the same), |
2393
|
|
|
|
|
|
|
Type::Tiny::CMP_EQUIVALENT (the two types are effectively the same), or |
2394
|
|
|
|
|
|
|
Type::Tiny::CMP_UNKNOWN (couldn't establish any relationship). |
2395
|
|
|
|
|
|
|
In numeric contexts, these evaluate to -1, 1, 0, 0, and 0, making it |
2396
|
|
|
|
|
|
|
potentially usable with C<sort> (though you may need to silence warnings |
2397
|
|
|
|
|
|
|
about treating the empty string as a numeric value). |
2398
|
|
|
|
|
|
|
|
2399
|
|
|
|
|
|
|
=back |
2400
|
|
|
|
|
|
|
|
2401
|
|
|
|
|
|
|
=head3 List processing methods |
2402
|
|
|
|
|
|
|
|
2403
|
|
|
|
|
|
|
=over |
2404
|
|
|
|
|
|
|
|
2405
|
|
|
|
|
|
|
=item C<< grep(@list) >> |
2406
|
|
|
|
|
|
|
|
2407
|
|
|
|
|
|
|
Filters a list to return just the items that pass the type check. |
2408
|
|
|
|
|
|
|
|
2409
|
|
|
|
|
|
|
@integers = Int->grep(@list); |
2410
|
|
|
|
|
|
|
|
2411
|
|
|
|
|
|
|
=item C<< first(@list) >> |
2412
|
|
|
|
|
|
|
|
2413
|
|
|
|
|
|
|
Filters the list to return the first item on the list that passes |
2414
|
|
|
|
|
|
|
the type check, or undef if none do. |
2415
|
|
|
|
|
|
|
|
2416
|
|
|
|
|
|
|
$first_lady = Woman->first(@people); |
2417
|
|
|
|
|
|
|
|
2418
|
|
|
|
|
|
|
=item C<< map(@list) >> |
2419
|
|
|
|
|
|
|
|
2420
|
|
|
|
|
|
|
Coerces a list of items. Only works on types which have a coercion. |
2421
|
|
|
|
|
|
|
|
2422
|
|
|
|
|
|
|
@truths = Bool->map(@list); |
2423
|
|
|
|
|
|
|
|
2424
|
|
|
|
|
|
|
=item C<< sort(@list) >> |
2425
|
|
|
|
|
|
|
|
2426
|
|
|
|
|
|
|
Sorts a list of items according to the type's preferred sorting mechanism, |
2427
|
|
|
|
|
|
|
or if the type doesn't have a sorter coderef, uses the parent type. If no |
2428
|
|
|
|
|
|
|
ancestor type constraint has a sorter, throws an exception. The C<Str>, |
2429
|
|
|
|
|
|
|
C<StrictNum>, C<LaxNum>, and C<Enum> type constraints include sorters. |
2430
|
|
|
|
|
|
|
|
2431
|
|
|
|
|
|
|
@sorted_numbers = Num->sort( Num->grep(@list) ); |
2432
|
|
|
|
|
|
|
|
2433
|
|
|
|
|
|
|
=item C<< rsort(@list) >> |
2434
|
|
|
|
|
|
|
|
2435
|
|
|
|
|
|
|
Like C<sort> but backwards. |
2436
|
|
|
|
|
|
|
|
2437
|
|
|
|
|
|
|
=item C<< any(@list) >> |
2438
|
|
|
|
|
|
|
|
2439
|
|
|
|
|
|
|
Returns true if any of the list match the type. |
2440
|
|
|
|
|
|
|
|
2441
|
|
|
|
|
|
|
if ( Int->any(@numbers) ) { |
2442
|
|
|
|
|
|
|
say "there was at least one integer"; |
2443
|
|
|
|
|
|
|
} |
2444
|
|
|
|
|
|
|
|
2445
|
|
|
|
|
|
|
=item C<< all(@list) >> |
2446
|
|
|
|
|
|
|
|
2447
|
|
|
|
|
|
|
Returns true if all of the list match the type. |
2448
|
|
|
|
|
|
|
|
2449
|
|
|
|
|
|
|
if ( Int->all(@numbers) ) { |
2450
|
|
|
|
|
|
|
say "they were all integers"; |
2451
|
|
|
|
|
|
|
} |
2452
|
|
|
|
|
|
|
|
2453
|
|
|
|
|
|
|
=item C<< assert_any(@list) >> |
2454
|
|
|
|
|
|
|
|
2455
|
|
|
|
|
|
|
Like C<any> but instead of returning a boolean, returns the entire original |
2456
|
|
|
|
|
|
|
list if any item on it matches the type, and dies if none does. |
2457
|
|
|
|
|
|
|
|
2458
|
|
|
|
|
|
|
=item C<< assert_all(@list) >> |
2459
|
|
|
|
|
|
|
|
2460
|
|
|
|
|
|
|
Like C<all> but instead of returning a boolean, returns the original list if |
2461
|
|
|
|
|
|
|
all items on it match the type, but dies as soon as it finds one that does |
2462
|
|
|
|
|
|
|
not. |
2463
|
|
|
|
|
|
|
|
2464
|
|
|
|
|
|
|
=back |
2465
|
|
|
|
|
|
|
|
2466
|
|
|
|
|
|
|
=head3 Inlining methods |
2467
|
|
|
|
|
|
|
|
2468
|
|
|
|
|
|
|
=for stopwords uated |
2469
|
|
|
|
|
|
|
|
2470
|
|
|
|
|
|
|
The following methods are used to generate strings of Perl code which |
2471
|
|
|
|
|
|
|
may be pasted into stringy C<eval>uated subs to perform type checks: |
2472
|
|
|
|
|
|
|
|
2473
|
|
|
|
|
|
|
=over |
2474
|
|
|
|
|
|
|
|
2475
|
|
|
|
|
|
|
=item C<< can_be_inlined >> |
2476
|
|
|
|
|
|
|
|
2477
|
|
|
|
|
|
|
Returns boolean indicating if this type can be inlined. |
2478
|
|
|
|
|
|
|
|
2479
|
|
|
|
|
|
|
=item C<< inline_check($varname) >> |
2480
|
|
|
|
|
|
|
|
2481
|
|
|
|
|
|
|
Creates a type constraint check for a particular variable as a string of |
2482
|
|
|
|
|
|
|
Perl code. For example: |
2483
|
|
|
|
|
|
|
|
2484
|
|
|
|
|
|
|
print( Types::Standard::Num->inline_check('$foo') ); |
2485
|
|
|
|
|
|
|
|
2486
|
|
|
|
|
|
|
prints the following output: |
2487
|
|
|
|
|
|
|
|
2488
|
|
|
|
|
|
|
(!ref($foo) && Scalar::Util::looks_like_number($foo)) |
2489
|
|
|
|
|
|
|
|
2490
|
|
|
|
|
|
|
For Moose-compat, there is an alias C<< _inline_check >> for this method. |
2491
|
|
|
|
|
|
|
|
2492
|
|
|
|
|
|
|
=item C<< inline_assert($varname) >> |
2493
|
|
|
|
|
|
|
|
2494
|
|
|
|
|
|
|
Much like C<inline_check> but outputs a statement of the form: |
2495
|
|
|
|
|
|
|
|
2496
|
|
|
|
|
|
|
... or die ...; |
2497
|
|
|
|
|
|
|
|
2498
|
|
|
|
|
|
|
Can also be called line C<< inline_assert($varname, $typevarname, %extras) >>. |
2499
|
|
|
|
|
|
|
In this case, it will generate a string of code that may include |
2500
|
|
|
|
|
|
|
C<< $typevarname >> which is supposed to be the name of a variable holding |
2501
|
|
|
|
|
|
|
the type itself. (This is kinda complicated, but it allows a useful string |
2502
|
|
|
|
|
|
|
to still be produced if the type is not inlineable.) The C<< %extras >> are |
2503
|
|
|
|
|
|
|
additional options to be passed to L<Error::TypeTiny::Assertion>'s constructor |
2504
|
|
|
|
|
|
|
and must be key-value pairs of strings only, no references or undefs. |
2505
|
|
|
|
|
|
|
|
2506
|
|
|
|
|
|
|
=back |
2507
|
|
|
|
|
|
|
|
2508
|
|
|
|
|
|
|
=head3 Other methods |
2509
|
|
|
|
|
|
|
|
2510
|
|
|
|
|
|
|
=over |
2511
|
|
|
|
|
|
|
|
2512
|
|
|
|
|
|
|
=item C<< qualified_name >> |
2513
|
|
|
|
|
|
|
|
2514
|
|
|
|
|
|
|
For non-anonymous type constraints that have a library, returns a qualified |
2515
|
|
|
|
|
|
|
C<< "MyLib::MyType" >> sort of name. Otherwise, returns the same as C<name>. |
2516
|
|
|
|
|
|
|
|
2517
|
|
|
|
|
|
|
=item C<< isa($class) >>, C<< can($method) >>, C<< AUTOLOAD(@args) >> |
2518
|
|
|
|
|
|
|
|
2519
|
|
|
|
|
|
|
If Moose is loaded, then the combination of these methods is used to mock |
2520
|
|
|
|
|
|
|
a Moose::Meta::TypeConstraint. |
2521
|
|
|
|
|
|
|
|
2522
|
|
|
|
|
|
|
If Mouse is loaded, then C<isa> mocks Mouse::Meta::TypeConstraint. |
2523
|
|
|
|
|
|
|
|
2524
|
|
|
|
|
|
|
=item C<< DOES($role) >> |
2525
|
|
|
|
|
|
|
|
2526
|
|
|
|
|
|
|
Overridden to advertise support for various roles. |
2527
|
|
|
|
|
|
|
|
2528
|
|
|
|
|
|
|
See also L<Type::API::Constraint>, etc. |
2529
|
|
|
|
|
|
|
|
2530
|
|
|
|
|
|
|
=item C<< TIESCALAR >>, C<< TIEARRAY >>, C<< TIEHASH >> |
2531
|
|
|
|
|
|
|
|
2532
|
|
|
|
|
|
|
These are provided as hooks that wrap L<Type::Tie>. They allow the following |
2533
|
|
|
|
|
|
|
to work: |
2534
|
|
|
|
|
|
|
|
2535
|
|
|
|
|
|
|
use Types::Standard qw(Int); |
2536
|
|
|
|
|
|
|
tie my @list, Int; |
2537
|
|
|
|
|
|
|
push @list, 123, 456; # ok |
2538
|
|
|
|
|
|
|
push @list, "Hello"; # dies |
2539
|
|
|
|
|
|
|
|
2540
|
|
|
|
|
|
|
=item C<< exportables( $base_name ) >> |
2541
|
|
|
|
|
|
|
|
2542
|
|
|
|
|
|
|
Returns a list of the functions a type library should export if it contains |
2543
|
|
|
|
|
|
|
this type constraint. |
2544
|
|
|
|
|
|
|
|
2545
|
|
|
|
|
|
|
Example: |
2546
|
|
|
|
|
|
|
|
2547
|
|
|
|
|
|
|
[ |
2548
|
|
|
|
|
|
|
{ name => 'Int', tags => [ 'types' ], code => sub { ... } }, |
2549
|
|
|
|
|
|
|
{ name => 'is_Int', tags => [ 'is' ], code => sub { ... } }, |
2550
|
|
|
|
|
|
|
{ name => 'assert_Int', tags => [ 'assert' ], code => sub { ... } }, |
2551
|
|
|
|
|
|
|
{ name => 'to_Int', tags => [ 'to' ], code => sub { ... } }, |
2552
|
|
|
|
|
|
|
] |
2553
|
|
|
|
|
|
|
|
2554
|
|
|
|
|
|
|
C<< $base_name >> is optional, but allows you to get a list of exportables |
2555
|
|
|
|
|
|
|
using a specific name. This is useful if the type constraint has a name |
2556
|
|
|
|
|
|
|
which wouldn't be a legal Perl function name. |
2557
|
|
|
|
|
|
|
|
2558
|
|
|
|
|
|
|
=item C<< exportables_by_tag( $tag, $base_name ) >> |
2559
|
|
|
|
|
|
|
|
2560
|
|
|
|
|
|
|
Filters C<exportables> by a specific tag name. In list context, returns all |
2561
|
|
|
|
|
|
|
matching exportables. In scalar context returns a single matching exportable |
2562
|
|
|
|
|
|
|
and dies if multiple exportables match, or none do! |
2563
|
|
|
|
|
|
|
|
2564
|
|
|
|
|
|
|
=back |
2565
|
|
|
|
|
|
|
|
2566
|
|
|
|
|
|
|
The following methods exist for Moose/Mouse compatibility, but do not do |
2567
|
|
|
|
|
|
|
anything useful. |
2568
|
|
|
|
|
|
|
|
2569
|
|
|
|
|
|
|
=over |
2570
|
|
|
|
|
|
|
|
2571
|
|
|
|
|
|
|
=item C<< compile_type_constraint >> |
2572
|
|
|
|
|
|
|
|
2573
|
|
|
|
|
|
|
=item C<< hand_optimized_type_constraint >> |
2574
|
|
|
|
|
|
|
|
2575
|
|
|
|
|
|
|
=item C<< has_hand_optimized_type_constraint >> |
2576
|
|
|
|
|
|
|
|
2577
|
|
|
|
|
|
|
=item C<< inline_environment >> |
2578
|
|
|
|
|
|
|
|
2579
|
|
|
|
|
|
|
=item C<< meta >> |
2580
|
|
|
|
|
|
|
|
2581
|
|
|
|
|
|
|
=back |
2582
|
|
|
|
|
|
|
|
2583
|
|
|
|
|
|
|
=head2 Overloading |
2584
|
|
|
|
|
|
|
|
2585
|
|
|
|
|
|
|
=over |
2586
|
|
|
|
|
|
|
|
2587
|
|
|
|
|
|
|
=item * |
2588
|
|
|
|
|
|
|
|
2589
|
|
|
|
|
|
|
Stringification is overloaded to return the qualified name. |
2590
|
|
|
|
|
|
|
|
2591
|
|
|
|
|
|
|
=item * |
2592
|
|
|
|
|
|
|
|
2593
|
|
|
|
|
|
|
Boolification is overloaded to always return true. |
2594
|
|
|
|
|
|
|
|
2595
|
|
|
|
|
|
|
=item * |
2596
|
|
|
|
|
|
|
|
2597
|
|
|
|
|
|
|
Coderefification is overloaded to call C<assert_return>. |
2598
|
|
|
|
|
|
|
|
2599
|
|
|
|
|
|
|
=item * |
2600
|
|
|
|
|
|
|
|
2601
|
|
|
|
|
|
|
On Perl 5.10.1 and above, smart match is overloaded to call C<check>. |
2602
|
|
|
|
|
|
|
|
2603
|
|
|
|
|
|
|
=item * |
2604
|
|
|
|
|
|
|
|
2605
|
|
|
|
|
|
|
The C<< == >> operator is overloaded to call C<equals>. |
2606
|
|
|
|
|
|
|
|
2607
|
|
|
|
|
|
|
=item * |
2608
|
|
|
|
|
|
|
|
2609
|
|
|
|
|
|
|
The C<< < >> and C<< > >> operators are overloaded to call C<is_subtype_of> |
2610
|
|
|
|
|
|
|
and C<is_supertype_of>. |
2611
|
|
|
|
|
|
|
|
2612
|
|
|
|
|
|
|
=item * |
2613
|
|
|
|
|
|
|
|
2614
|
|
|
|
|
|
|
The C<< ~ >> operator is overloaded to call C<complementary_type>. |
2615
|
|
|
|
|
|
|
|
2616
|
|
|
|
|
|
|
=item * |
2617
|
|
|
|
|
|
|
|
2618
|
|
|
|
|
|
|
The C<< | >> operator is overloaded to build a union of two type constraints. |
2619
|
|
|
|
|
|
|
See L<Type::Tiny::Union>. |
2620
|
|
|
|
|
|
|
|
2621
|
|
|
|
|
|
|
=item * |
2622
|
|
|
|
|
|
|
|
2623
|
|
|
|
|
|
|
The C<< & >> operator is overloaded to build the intersection of two type |
2624
|
|
|
|
|
|
|
constraints. See L<Type::Tiny::Intersection>. |
2625
|
|
|
|
|
|
|
|
2626
|
|
|
|
|
|
|
=item * |
2627
|
|
|
|
|
|
|
|
2628
|
|
|
|
|
|
|
The C<< / >> operator provides magical L<Devel::StrictMode> support. |
2629
|
|
|
|
|
|
|
If C<< $ENV{PERL_STRICT} >> (or a few other environment variables) is true, |
2630
|
|
|
|
|
|
|
then it returns the left operand. Normally it returns the right operand. |
2631
|
|
|
|
|
|
|
|
2632
|
|
|
|
|
|
|
=back |
2633
|
|
|
|
|
|
|
|
2634
|
|
|
|
|
|
|
Previous versions of Type::Tiny would overload the C<< + >> operator to |
2635
|
|
|
|
|
|
|
call C<plus_coercions> or C<plus_fallback_coercions> as appropriate. |
2636
|
|
|
|
|
|
|
Support for this was dropped after 0.040. |
2637
|
|
|
|
|
|
|
|
2638
|
|
|
|
|
|
|
=head2 Constants |
2639
|
|
|
|
|
|
|
|
2640
|
|
|
|
|
|
|
=over |
2641
|
|
|
|
|
|
|
|
2642
|
|
|
|
|
|
|
=item C<< Type::Tiny::SUPPORT_SMARTMATCH >> |
2643
|
|
|
|
|
|
|
|
2644
|
|
|
|
|
|
|
Indicates whether the smart match overload is supported on your |
2645
|
|
|
|
|
|
|
version of Perl. |
2646
|
|
|
|
|
|
|
|
2647
|
|
|
|
|
|
|
=back |
2648
|
|
|
|
|
|
|
|
2649
|
|
|
|
|
|
|
=head2 Package Variables |
2650
|
|
|
|
|
|
|
|
2651
|
|
|
|
|
|
|
=over |
2652
|
|
|
|
|
|
|
|
2653
|
|
|
|
|
|
|
=item C<< $Type::Tiny::DD >> |
2654
|
|
|
|
|
|
|
|
2655
|
|
|
|
|
|
|
This undef by default but may be set to a coderef that Type::Tiny |
2656
|
|
|
|
|
|
|
and related modules will use to dump data structures in things like |
2657
|
|
|
|
|
|
|
error messages. |
2658
|
|
|
|
|
|
|
|
2659
|
|
|
|
|
|
|
Otherwise Type::Tiny uses it's own routine to dump data structures. |
2660
|
|
|
|
|
|
|
C<< $DD >> may then be set to a number to limit the lengths of the |
2661
|
|
|
|
|
|
|
dumps. (Default limit is 72.) |
2662
|
|
|
|
|
|
|
|
2663
|
|
|
|
|
|
|
This is a package variable (rather than get/set class methods) to allow |
2664
|
|
|
|
|
|
|
for easy localization. |
2665
|
|
|
|
|
|
|
|
2666
|
|
|
|
|
|
|
=item C<< $Type::Tiny::AvoidCallbacks >> |
2667
|
|
|
|
|
|
|
|
2668
|
|
|
|
|
|
|
If this variable is set to true (you should usually do it in a |
2669
|
|
|
|
|
|
|
C<local> scope), it acts as a hint for type constraints, when |
2670
|
|
|
|
|
|
|
generating inlined code, to avoid making any callbacks to |
2671
|
|
|
|
|
|
|
variables and functions defined outside the inlined code itself. |
2672
|
|
|
|
|
|
|
|
2673
|
|
|
|
|
|
|
This should have the effect that C<< $type->inline_check('$foo') >> |
2674
|
|
|
|
|
|
|
will return a string of code capable of checking the type on |
2675
|
|
|
|
|
|
|
Perl installations that don't have Type::Tiny installed. This |
2676
|
|
|
|
|
|
|
is intended to allow Type::Tiny to be used with things like |
2677
|
|
|
|
|
|
|
L<Mite>. |
2678
|
|
|
|
|
|
|
|
2679
|
|
|
|
|
|
|
The variable works on the honour system. Types need to explicitly |
2680
|
|
|
|
|
|
|
check it and decide to generate different code based on its |
2681
|
|
|
|
|
|
|
truth value. The bundled types in L<Types::Standard>, |
2682
|
|
|
|
|
|
|
L<Types::Common::Numeric>, and L<Types::Common::String> all do. |
2683
|
|
|
|
|
|
|
(B<StrMatch> is sometimes unable to, and will issue a warning |
2684
|
|
|
|
|
|
|
if it needs to rely on callbacks when asked not to.) |
2685
|
|
|
|
|
|
|
|
2686
|
|
|
|
|
|
|
Most normal users can ignore this. |
2687
|
|
|
|
|
|
|
|
2688
|
|
|
|
|
|
|
=item C<< $Type::Tiny::SafePackage >> |
2689
|
|
|
|
|
|
|
|
2690
|
|
|
|
|
|
|
This is the string "package Type::Tiny;" which is sometimes inserted |
2691
|
|
|
|
|
|
|
into strings of inlined code to avoid namespace clashes. In most cases, |
2692
|
|
|
|
|
|
|
you do not need to change this. However, if you are inlining type |
2693
|
|
|
|
|
|
|
constraint code, saving that code into Perl modules, and uploading them |
2694
|
|
|
|
|
|
|
to CPAN, you may wish to change it to avoid problems with the CPAN |
2695
|
|
|
|
|
|
|
indexer. Most normal users of Type::Tiny do not need to be aware of this. |
2696
|
|
|
|
|
|
|
|
2697
|
|
|
|
|
|
|
=back |
2698
|
|
|
|
|
|
|
|
2699
|
|
|
|
|
|
|
=head2 Environment |
2700
|
|
|
|
|
|
|
|
2701
|
|
|
|
|
|
|
=over |
2702
|
|
|
|
|
|
|
|
2703
|
|
|
|
|
|
|
=item C<PERL_TYPE_TINY_XS> |
2704
|
|
|
|
|
|
|
|
2705
|
|
|
|
|
|
|
Currently this has more effect on L<Types::Standard> than Type::Tiny. In |
2706
|
|
|
|
|
|
|
future it may be used to trigger or suppress the loading XS implementations |
2707
|
|
|
|
|
|
|
of parts of Type::Tiny. |
2708
|
|
|
|
|
|
|
|
2709
|
|
|
|
|
|
|
=back |
2710
|
|
|
|
|
|
|
|
2711
|
|
|
|
|
|
|
=head1 BUGS |
2712
|
|
|
|
|
|
|
|
2713
|
|
|
|
|
|
|
Please report any bugs to |
2714
|
|
|
|
|
|
|
L<https://github.com/tobyink/p5-type-tiny/issues>. |
2715
|
|
|
|
|
|
|
|
2716
|
|
|
|
|
|
|
=head1 SEE ALSO |
2717
|
|
|
|
|
|
|
|
2718
|
|
|
|
|
|
|
L<The Type::Tiny homepage|https://typetiny.toby.ink/>. |
2719
|
|
|
|
|
|
|
|
2720
|
|
|
|
|
|
|
L<Type::Tiny::Manual>, L<Type::API>. |
2721
|
|
|
|
|
|
|
|
2722
|
|
|
|
|
|
|
L<Type::Library>, L<Type::Utils>, L<Types::Standard>, L<Type::Coercion>. |
2723
|
|
|
|
|
|
|
|
2724
|
|
|
|
|
|
|
L<Type::Tiny::Class>, L<Type::Tiny::Role>, L<Type::Tiny::Duck>, |
2725
|
|
|
|
|
|
|
L<Type::Tiny::Enum>, L<Type::Tiny::Union>, L<Type::Tiny::Intersection>. |
2726
|
|
|
|
|
|
|
|
2727
|
|
|
|
|
|
|
L<Moose::Meta::TypeConstraint>, |
2728
|
|
|
|
|
|
|
L<Mouse::Meta::TypeConstraint>. |
2729
|
|
|
|
|
|
|
|
2730
|
|
|
|
|
|
|
L<Type::Params>. |
2731
|
|
|
|
|
|
|
|
2732
|
|
|
|
|
|
|
L<Type::Tiny on GitHub|https://github.com/tobyink/p5-type-tiny>, |
2733
|
|
|
|
|
|
|
L<Type::Tiny on Travis-CI|https://travis-ci.com/tobyink/p5-type-tiny>, |
2734
|
|
|
|
|
|
|
L<Type::Tiny on AppVeyor|https://ci.appveyor.com/project/tobyink/p5-type-tiny>, |
2735
|
|
|
|
|
|
|
L<Type::Tiny on Codecov|https://codecov.io/gh/tobyink/p5-type-tiny>, |
2736
|
|
|
|
|
|
|
L<Type::Tiny on Coveralls|https://coveralls.io/github/tobyink/p5-type-tiny>. |
2737
|
|
|
|
|
|
|
|
2738
|
|
|
|
|
|
|
=head1 AUTHOR |
2739
|
|
|
|
|
|
|
|
2740
|
|
|
|
|
|
|
Toby Inkster E<lt>tobyink@cpan.orgE<gt>. |
2741
|
|
|
|
|
|
|
|
2742
|
|
|
|
|
|
|
=head1 THANKS |
2743
|
|
|
|
|
|
|
|
2744
|
|
|
|
|
|
|
Thanks to Matt S Trout for advice on L<Moo> integration. |
2745
|
|
|
|
|
|
|
|
2746
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENCE |
2747
|
|
|
|
|
|
|
|
2748
|
|
|
|
|
|
|
This software is copyright (c) 2013-2014, 2017-2023 by Toby Inkster. |
2749
|
|
|
|
|
|
|
|
2750
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
2751
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
2752
|
|
|
|
|
|
|
|
2753
|
|
|
|
|
|
|
=head1 DISCLAIMER OF WARRANTIES |
2754
|
|
|
|
|
|
|
|
2755
|
|
|
|
|
|
|
THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED |
2756
|
|
|
|
|
|
|
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF |
2757
|
|
|
|
|
|
|
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. |