Commit | Line | Data |
06d02aac |
1 | package Moose::Util::TypeConstraints::Builtins; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
9882ca98 |
6 | use Scalar::Util qw( blessed looks_like_number reftype ); |
06d02aac |
7 | |
8 | sub type { goto &Moose::Util::TypeConstraints::type } |
9 | sub subtype { goto &Moose::Util::TypeConstraints::subtype } |
10 | sub as { goto &Moose::Util::TypeConstraints::as } |
11 | sub where (&) { goto &Moose::Util::TypeConstraints::where } |
12 | sub optimize_as (&) { goto &Moose::Util::TypeConstraints::optimize_as } |
4e36cf24 |
13 | sub inline_as (&) { goto &Moose::Util::TypeConstraints::inline_as } |
06d02aac |
14 | |
15 | sub define_builtins { |
16 | my $registry = shift; |
17 | |
4e36cf24 |
18 | type 'Any' # meta-type including all |
19 | => where {1} |
20 | => inline_as { '1' }; |
06d02aac |
21 | |
4e36cf24 |
22 | subtype 'Item' # base-type |
23 | => as 'Any'; |
24 | |
25 | subtype 'Undef' |
26 | => as 'Item' |
27 | => where { !defined($_) } |
28 | => inline_as { "! defined $_[0]" }; |
29 | |
30 | subtype 'Defined' |
31 | => as 'Item' |
32 | => where { defined($_) } |
33 | => inline_as { "defined $_[0]" }; |
06d02aac |
34 | |
35 | subtype 'Bool' |
36 | => as 'Item' |
4e36cf24 |
37 | => where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' } |
38 | => inline_as { qq{!defined($_[0]) || $_[0] eq "" || "$_[0]" eq '1' || "$_[0]" eq '0'} }; |
06d02aac |
39 | |
40 | subtype 'Value' |
41 | => as 'Defined' |
42 | => where { !ref($_) } |
4e36cf24 |
43 | => optimize_as( \&_Value ) |
44 | => inline_as { "defined $_[0] && ! ref $_[0]" }; |
06d02aac |
45 | |
46 | subtype 'Ref' |
47 | => as 'Defined' |
48 | => where { ref($_) } |
4e36cf24 |
49 | => optimize_as( \&_Ref ) |
50 | => inline_as { "ref $_[0]" }; |
06d02aac |
51 | |
52 | subtype 'Str' |
53 | => as 'Value' |
54 | => where { ref(\$_) eq 'SCALAR' } |
4e36cf24 |
55 | => optimize_as( \&_Str ) |
56 | => inline_as { |
57 | return ( qq{defined $_[0]} |
58 | . qq{&& ( ref(\\ $_[0] ) eq 'SCALAR'} |
59 | . qq{ || ref(\\(my \$value = $_[0])) eq 'SCALAR')} ); |
60 | }; |
06d02aac |
61 | |
62 | subtype 'Num' |
63 | => as 'Str' |
64 | => where { Scalar::Util::looks_like_number($_) } |
4e36cf24 |
65 | => optimize_as( \&_Num ) |
66 | => inline_as { "!ref $_[0] && Scalar::Util::looks_like_number($_[0])" }; |
06d02aac |
67 | |
68 | subtype 'Int' |
69 | => as 'Num' |
70 | => where { "$_" =~ /^-?[0-9]+$/ } |
4e36cf24 |
71 | => optimize_as( \&_Int ) |
72 | => inline_as { |
73 | return ( qq{defined $_[0]} |
74 | . qq{&& ! ref $_[0]} |
75 | . qq{&& ( my \$value = $_[0] ) =~ /\\A-?[0-9]+\\z/} ); |
76 | }; |
06d02aac |
77 | |
78 | subtype 'CodeRef' |
79 | => as 'Ref' |
80 | => where { ref($_) eq 'CODE' } |
4e36cf24 |
81 | => optimize_as( \&_CodeRef ) |
82 | => inline_as { qq{ref( $_[0] ) eq 'CODE'} }; |
06d02aac |
83 | |
84 | subtype 'RegexpRef' |
85 | => as 'Ref' |
9882ca98 |
86 | => where( \&_RegexpRef ) |
4e36cf24 |
87 | => optimize_as( \&_RegexpRef ) |
88 | => inline_as { "_RegexpRef( $_[0] )" }; |
06d02aac |
89 | |
90 | subtype 'GlobRef' |
91 | => as 'Ref' |
92 | => where { ref($_) eq 'GLOB' } |
4e36cf24 |
93 | => optimize_as( \&_GlobRef ) |
94 | => inline_as { qq{ref( $_[0] ) eq 'GLOB'} }; |
06d02aac |
95 | |
96 | # NOTE: scalar filehandles are GLOB refs, but a GLOB ref is not always a |
97 | # filehandle |
98 | subtype 'FileHandle' |
99 | => as 'GlobRef' |
100 | => where { |
101 | Scalar::Util::openhandle($_) || ( blessed($_) && $_->isa("IO::Handle") ); |
102 | } |
4e36cf24 |
103 | => optimize_as( \&_FileHandle ) |
104 | => inline_as { |
105 | return ( qq{ref( $_[0] ) eq 'GLOB'} |
106 | . qq{&& Scalar::Util::openhandle( $_[0] )} |
107 | . qq{or blessed( $_[0] ) && $_[0]->isa("IO::Handle")} ); |
108 | }; |
06d02aac |
109 | |
110 | subtype 'Object' |
111 | => as 'Ref' |
112 | => where { blessed($_) } |
4e36cf24 |
113 | => optimize_as( \&_Object ) |
114 | => inline_as { "Scalar::Util::blessed( $_[0] )" }; |
06d02aac |
115 | |
116 | # This type is deprecated. |
117 | subtype 'Role' |
118 | => as 'Object' |
119 | => where { $_->can('does') } |
4e36cf24 |
120 | => optimize_as( \&_Role ); |
06d02aac |
121 | |
122 | subtype 'ClassName' |
123 | => as 'Str' |
124 | => where { Class::MOP::is_class_loaded($_) } |
4e36cf24 |
125 | => optimize_as( \&_ClassName ) |
126 | => inline_as { "Class::MOP::is_class_loaded( $_[0] )" }; |
06d02aac |
127 | |
128 | subtype 'RoleName' |
129 | => as 'ClassName' |
130 | => where { |
131 | (Class::MOP::class_of($_) || return)->isa('Moose::Meta::Role'); |
132 | } |
4e36cf24 |
133 | => optimize_as( \&_RoleName ) |
134 | => inline_as { |
135 | return ( qq{Class::MOP::is_class_loaded( $_[0] )} |
136 | . qq{&& ( Class::MOP::class_of( $_[0] ) || return )} |
137 | . qq{ ->isa('Moose::Meta::Role')} ); |
138 | }; |
06d02aac |
139 | |
140 | $registry->add_type_constraint( |
141 | Moose::Meta::TypeConstraint::Parameterizable->new( |
142 | name => 'ScalarRef', |
143 | package_defined_in => __PACKAGE__, |
144 | parent => |
145 | Moose::Util::TypeConstraints::find_type_constraint('Ref'), |
146 | constraint => sub { ref($_) eq 'SCALAR' || ref($_) eq 'REF' }, |
9882ca98 |
147 | optimized => \&_ScalarRef, |
06d02aac |
148 | constraint_generator => sub { |
149 | my $type_parameter = shift; |
150 | my $check = $type_parameter->_compiled_type_constraint; |
151 | return sub { |
152 | return $check->( ${$_} ); |
153 | }; |
154 | } |
155 | ) |
156 | ); |
157 | |
158 | $registry->add_type_constraint( |
159 | Moose::Meta::TypeConstraint::Parameterizable->new( |
160 | name => 'ArrayRef', |
161 | package_defined_in => __PACKAGE__, |
162 | parent => |
163 | Moose::Util::TypeConstraints::find_type_constraint('Ref'), |
164 | constraint => sub { ref($_) eq 'ARRAY' }, |
9882ca98 |
165 | optimized => \&_ArrayRef, |
06d02aac |
166 | constraint_generator => sub { |
167 | my $type_parameter = shift; |
168 | my $check = $type_parameter->_compiled_type_constraint; |
169 | return sub { |
170 | foreach my $x (@$_) { |
171 | ( $check->($x) ) || return; |
172 | } |
173 | 1; |
174 | } |
175 | } |
176 | ) |
177 | ); |
178 | |
179 | $registry->add_type_constraint( |
180 | Moose::Meta::TypeConstraint::Parameterizable->new( |
181 | name => 'HashRef', |
182 | package_defined_in => __PACKAGE__, |
183 | parent => |
184 | Moose::Util::TypeConstraints::find_type_constraint('Ref'), |
185 | constraint => sub { ref($_) eq 'HASH' }, |
9882ca98 |
186 | optimized => \&_HashRef, |
06d02aac |
187 | constraint_generator => sub { |
188 | my $type_parameter = shift; |
189 | my $check = $type_parameter->_compiled_type_constraint; |
190 | return sub { |
191 | foreach my $x ( values %$_ ) { |
192 | ( $check->($x) ) || return; |
193 | } |
194 | 1; |
195 | } |
196 | } |
197 | ) |
198 | ); |
199 | |
200 | $registry->add_type_constraint( |
201 | Moose::Meta::TypeConstraint::Parameterizable->new( |
202 | name => 'Maybe', |
203 | package_defined_in => __PACKAGE__, |
204 | parent => |
205 | Moose::Util::TypeConstraints::find_type_constraint('Item'), |
206 | constraint => sub {1}, |
207 | constraint_generator => sub { |
208 | my $type_parameter = shift; |
209 | my $check = $type_parameter->_compiled_type_constraint; |
210 | return sub { |
211 | return 1 if not( defined($_) ) || $check->($_); |
212 | return; |
213 | } |
214 | } |
215 | ) |
216 | ); |
217 | } |
218 | |
9882ca98 |
219 | sub _Value { defined($_[0]) && !ref($_[0]) } |
220 | |
221 | sub _Ref { ref($_[0]) } |
222 | |
223 | # We might need to use a temporary here to flatten LVALUEs, for instance as in |
224 | # Str(substr($_,0,255)). |
225 | sub _Str { |
226 | defined($_[0]) |
227 | && ( ref(\ $_[0] ) eq 'SCALAR' |
228 | || ref(\(my $value = $_[0])) eq 'SCALAR') |
229 | } |
230 | |
231 | sub _Num { !ref($_[0]) && looks_like_number($_[0]) } |
232 | |
233 | # using a temporary here because regex matching promotes an IV to a PV, |
234 | # and that confuses some things (like JSON.pm) |
235 | sub _Int { |
236 | my $value = $_[0]; |
237 | defined($value) && !ref($value) && $value =~ /\A-?[0-9]+\z/ |
238 | } |
239 | |
240 | sub _ScalarRef { ref($_[0]) eq 'SCALAR' || ref($_[0]) eq 'REF' } |
241 | sub _ArrayRef { ref($_[0]) eq 'ARRAY' } |
242 | sub _HashRef { ref($_[0]) eq 'HASH' } |
243 | sub _CodeRef { ref($_[0]) eq 'CODE' } |
244 | sub _GlobRef { ref($_[0]) eq 'GLOB' } |
245 | |
246 | # RegexpRef is implemented in Moose.xs |
247 | |
248 | sub _FileHandle { |
249 | ref( $_[0] ) eq 'GLOB' && Scalar::Util::openhandle( $_[0] ) |
250 | or blessed( $_[0] ) && $_[0]->isa("IO::Handle"); |
251 | } |
252 | |
253 | sub _Object { blessed($_[0]) } |
254 | |
255 | sub _Role { |
256 | Moose::Deprecated::deprecated( |
257 | feature => 'Role type', |
258 | message => |
259 | 'The Role type has been deprecated. Maybe you meant to create a RoleName type? This type be will be removed in Moose 2.0200.' |
260 | ); |
261 | blessed( $_[0] ) && $_[0]->can('does'); |
262 | } |
263 | |
264 | sub _ClassName { |
265 | return Class::MOP::is_class_loaded( $_[0] ); |
266 | } |
267 | |
268 | sub _RoleName { |
4e36cf24 |
269 | _ClassName( $_[0] ) |
9882ca98 |
270 | && ( Class::MOP::class_of( $_[0] ) || return ) |
271 | ->isa('Moose::Meta::Role'); |
272 | } |
273 | |
06d02aac |
274 | 1; |