1 package Moose::Util::TypeConstraints::Builtins;
6 use List::MoreUtils ();
7 use Scalar::Util qw( blessed looks_like_number reftype );
9 sub type { goto &Moose::Util::TypeConstraints::type }
10 sub subtype { goto &Moose::Util::TypeConstraints::subtype }
11 sub as { goto &Moose::Util::TypeConstraints::as }
12 sub where (&) { goto &Moose::Util::TypeConstraints::where }
13 sub optimize_as (&) { goto &Moose::Util::TypeConstraints::optimize_as }
14 sub inline_as (&) { goto &Moose::Util::TypeConstraints::inline_as }
19 type 'Any' # meta-type including all
23 subtype 'Item' # base type
29 => where { !defined($_) }
31 $_[0]->parent()->_inline_check($_[1])
32 . ' && !defined(' . $_[1] . ')'
37 => where { defined($_) }
39 $_[0]->parent()->_inline_check($_[1])
40 . ' && defined(' . $_[1] . ')'
45 => where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' }
47 $_[0]->parent()->_inline_check($_[1])
49 . '!defined(' . $_[1] . ') '
50 . '|| ' . $_[1] . ' eq "" '
51 . '|| "' . $_[1] . '" eq "1" '
52 . '|| "' . $_[1] . '" eq "0"'
60 $_[0]->parent()->_inline_check($_[1])
61 . ' && !ref(' . $_[1] . ')'
67 # no need to call parent - ref also checks for definedness
68 => inline_as { 'ref(' . $_[1] . ')' };
72 => where { ref(\$_) eq 'SCALAR' || ref(\(my $val = $_)) eq 'SCALAR' }
74 $_[0]->parent()->_inline_check($_[1])
76 . 'ref(\\' . $_[1] . ') eq "SCALAR"'
77 . ' || ref(\\(my $val = ' . $_[1] . ')) eq "SCALAR"'
81 my $value_type = Moose::Util::TypeConstraints::find_type_constraint('Value');
84 => where { Scalar::Util::looks_like_number($_) }
86 # the long Str tests are redundant here
87 $value_type->_inline_check($_[1])
88 . ' && Scalar::Util::looks_like_number(' . $_[1] . ')'
93 => where { (my $val = $_) =~ /\A-?[0-9]+\z/ }
95 $value_type->_inline_check($_[1])
96 . ' && (my $val = ' . $_[1] . ') =~ /\A-?[0-9]+\z/'
101 => where { ref($_) eq 'CODE' }
102 => inline_as { 'ref(' . $_[1] . ') eq "CODE"' };
106 => where( \&_RegexpRef )
108 'Moose::Util::TypeConstraints::Builtins::_RegexpRef(' . $_[1] . ')'
113 => where { ref($_) eq 'GLOB' }
114 => inline_as { 'ref(' . $_[1] . ') eq "GLOB"' };
116 # NOTE: scalar filehandles are GLOB refs, but a GLOB ref is not always a
121 (ref($_) eq "GLOB" && Scalar::Util::openhandle($_))
122 || (blessed($_) && $_->isa("IO::Handle"));
125 '(ref(' . $_[1] . ') eq "GLOB" '
126 . '&& Scalar::Util::openhandle(' . $_[1] . ')) '
127 . '|| (Scalar::Util::blessed(' . $_[1] . ') '
128 . '&& ' . $_[1] . '->isa("IO::Handle"))'
133 => where { blessed($_) }
134 => inline_as { 'Scalar::Util::blessed(' . $_[1] . ')' };
136 # This type is deprecated.
139 => where { $_->can('does') };
143 => where { Class::MOP::is_class_loaded($_) }
144 # the long Str tests are redundant here
145 => inline_as { 'Class::MOP::is_class_loaded(' . $_[1] . ')' };
150 (Class::MOP::class_of($_) || return)->isa('Moose::Meta::Role');
153 $_[0]->parent()->_inline_check($_[1])
155 . 'my $meta = Class::MOP::class_of(' . $_[1] . ');'
156 . '$meta && $meta->isa("Moose::Meta::Role");'
160 $registry->add_type_constraint(
161 Moose::Meta::TypeConstraint::Parameterizable->new(
163 package_defined_in => __PACKAGE__,
165 Moose::Util::TypeConstraints::find_type_constraint('Ref'),
166 constraint => sub { ref($_) eq 'SCALAR' || ref($_) eq 'REF' },
167 constraint_generator => sub {
168 my $type_parameter = shift;
169 my $check = $type_parameter->_compiled_type_constraint;
171 return $check->( ${$_} );
175 'ref(' . $_[1] . ') eq "SCALAR" '
176 . '|| ref(' . $_[1] . ') eq "REF"'
178 inline_generator => sub {
180 my $type_parameter = shift;
182 '(ref(' . $val . ') eq "SCALAR" || ref(' . $val . ') eq "REF") '
183 . '&& ' . $type_parameter->_inline_check('${(' . $val . ')}')
188 $registry->add_type_constraint(
189 Moose::Meta::TypeConstraint::Parameterizable->new(
191 package_defined_in => __PACKAGE__,
193 Moose::Util::TypeConstraints::find_type_constraint('Ref'),
194 constraint => sub { ref($_) eq 'ARRAY' },
195 constraint_generator => sub {
196 my $type_parameter = shift;
197 my $check = $type_parameter->_compiled_type_constraint;
199 foreach my $x (@$_) {
200 ( $check->($x) ) || return;
205 inlined => sub { 'ref(' . $_[1] . ') eq "ARRAY"' },
206 inline_generator => sub {
208 my $type_parameter = shift;
212 . 'my $check = ' . $val . ';'
213 . 'ref($check) eq "ARRAY" '
214 . '&& &List::MoreUtils::all('
215 . 'sub { ' . $type_parameter->_inline_check('$_') . ' }, '
223 $registry->add_type_constraint(
224 Moose::Meta::TypeConstraint::Parameterizable->new(
226 package_defined_in => __PACKAGE__,
228 Moose::Util::TypeConstraints::find_type_constraint('Ref'),
229 constraint => sub { ref($_) eq 'HASH' },
230 constraint_generator => sub {
231 my $type_parameter = shift;
232 my $check = $type_parameter->_compiled_type_constraint;
234 foreach my $x ( values %$_ ) {
235 ( $check->($x) ) || return;
240 inlined => sub { 'ref(' . $_[1] . ') eq "HASH"' },
241 inline_generator => sub {
243 my $type_parameter = shift;
247 . 'my $check = ' . $val . ';'
248 . 'ref($check) eq "HASH" '
249 . '&& &List::MoreUtils::all('
250 . 'sub { ' . $type_parameter->_inline_check('$_') . ' }, '
258 $registry->add_type_constraint(
259 Moose::Meta::TypeConstraint::Parameterizable->new(
261 package_defined_in => __PACKAGE__,
263 Moose::Util::TypeConstraints::find_type_constraint('Item'),
264 constraint => sub {1},
265 constraint_generator => sub {
266 my $type_parameter = shift;
267 my $check = $type_parameter->_compiled_type_constraint;
269 return 1 if not( defined($_) ) || $check->($_);
273 inlined => sub {'1'},
274 inline_generator => sub {
276 my $type_parameter = shift;
278 '!defined(' . $val . ') '
279 . '|| (' . $type_parameter->_inline_check($val) . ')'
291 =for pod_coverage_needs_some_pod