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 '!defined(' . $_[1] . ')'
36 => where { defined($_) }
38 'defined(' . $_[1] . ')'
43 => where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' }
46 . '!defined(' . $_[1] . ') '
47 . '|| ' . $_[1] . ' eq "" '
48 . '|| (' . $_[1] . '."") eq "1" '
49 . '|| (' . $_[1] . '."") eq "0"'
57 $_[0]->parent()->_inline_check($_[1])
58 . ' && !ref(' . $_[1] . ')'
64 # no need to call parent - ref also checks for definedness
65 => inline_as { 'ref(' . $_[1] . ')' };
69 => where { ref(\$_) eq 'SCALAR' || ref(\(my $val = $_)) eq 'SCALAR' }
71 $_[0]->parent()->_inline_check($_[1])
73 . 'ref(\\' . $_[1] . ') eq "SCALAR"'
74 . ' || ref(\\(my $val = ' . $_[1] . ')) eq "SCALAR"'
78 my $value_type = Moose::Util::TypeConstraints::find_type_constraint('Value');
81 => where { Scalar::Util::looks_like_number($_) }
83 # the long Str tests are redundant here
84 $value_type->_inline_check($_[1])
85 . ' && Scalar::Util::looks_like_number(' . $_[1] . ')'
90 => where { (my $val = $_) =~ /\A-?[0-9]+\z/ }
92 $value_type->_inline_check($_[1])
93 . ' && (my $val = ' . $_[1] . ') =~ /\A-?[0-9]+\z/'
98 => where { ref($_) eq 'CODE' }
99 => inline_as { 'ref(' . $_[1] . ') eq "CODE"' };
103 => where( \&_RegexpRef )
105 'Moose::Util::TypeConstraints::Builtins::_RegexpRef(' . $_[1] . ')'
110 => where { ref($_) eq 'GLOB' }
111 => inline_as { 'ref(' . $_[1] . ') eq "GLOB"' };
113 # NOTE: scalar filehandles are GLOB refs, but a GLOB ref is not always a
118 (ref($_) eq "GLOB" && Scalar::Util::openhandle($_))
119 || (blessed($_) && $_->isa("IO::Handle"));
122 '(ref(' . $_[1] . ') eq "GLOB" '
123 . '&& Scalar::Util::openhandle(' . $_[1] . ')) '
124 . '|| (Scalar::Util::blessed(' . $_[1] . ') '
125 . '&& ' . $_[1] . '->isa("IO::Handle"))'
130 => where { blessed($_) }
131 => inline_as { 'Scalar::Util::blessed(' . $_[1] . ')' };
135 => where { Class::MOP::is_class_loaded($_) }
136 # the long Str tests are redundant here
137 => inline_as { 'Class::MOP::is_class_loaded(' . $_[1] . ')' };
142 (Class::MOP::class_of($_) || return)->isa('Moose::Meta::Role');
145 $_[0]->parent()->_inline_check($_[1])
147 . 'my $meta = Class::MOP::class_of(' . $_[1] . ');'
148 . '$meta && $meta->isa("Moose::Meta::Role");'
152 $registry->add_type_constraint(
153 Moose::Meta::TypeConstraint::Parameterizable->new(
155 package_defined_in => __PACKAGE__,
157 Moose::Util::TypeConstraints::find_type_constraint('Ref'),
158 constraint => sub { ref($_) eq 'SCALAR' || ref($_) eq 'REF' },
159 constraint_generator => sub {
160 my $type_parameter = shift;
161 my $check = $type_parameter->_compiled_type_constraint;
163 return $check->( ${$_} );
167 'ref(' . $_[1] . ') eq "SCALAR" '
168 . '|| ref(' . $_[1] . ') eq "REF"'
170 inline_generator => sub {
172 my $type_parameter = shift;
174 '(ref(' . $val . ') eq "SCALAR" || ref(' . $val . ') eq "REF") '
175 . '&& ' . $type_parameter->_inline_check('${(' . $val . ')}')
180 $registry->add_type_constraint(
181 Moose::Meta::TypeConstraint::Parameterizable->new(
183 package_defined_in => __PACKAGE__,
185 Moose::Util::TypeConstraints::find_type_constraint('Ref'),
186 constraint => sub { ref($_) eq 'ARRAY' },
187 constraint_generator => sub {
188 my $type_parameter = shift;
189 my $check = $type_parameter->_compiled_type_constraint;
191 foreach my $x (@$_) {
192 ( $check->($x) ) || return;
197 inlined => sub { 'ref(' . $_[1] . ') eq "ARRAY"' },
198 inline_generator => sub {
200 my $type_parameter = shift;
204 . 'my $check = ' . $val . ';'
205 . 'ref($check) eq "ARRAY" '
206 . '&& &List::MoreUtils::all('
207 . 'sub { ' . $type_parameter->_inline_check('$_') . ' }, '
215 $registry->add_type_constraint(
216 Moose::Meta::TypeConstraint::Parameterizable->new(
218 package_defined_in => __PACKAGE__,
220 Moose::Util::TypeConstraints::find_type_constraint('Ref'),
221 constraint => sub { ref($_) eq 'HASH' },
222 constraint_generator => sub {
223 my $type_parameter = shift;
224 my $check = $type_parameter->_compiled_type_constraint;
226 foreach my $x ( values %$_ ) {
227 ( $check->($x) ) || return;
232 inlined => sub { 'ref(' . $_[1] . ') eq "HASH"' },
233 inline_generator => sub {
235 my $type_parameter = shift;
239 . 'my $check = ' . $val . ';'
240 . 'ref($check) eq "HASH" '
241 . '&& &List::MoreUtils::all('
242 . 'sub { ' . $type_parameter->_inline_check('$_') . ' }, '
250 $registry->add_type_constraint(
251 Moose::Meta::TypeConstraint::Parameterizable->new(
253 package_defined_in => __PACKAGE__,
255 Moose::Util::TypeConstraints::find_type_constraint('Item'),
256 constraint => sub {1},
257 constraint_generator => sub {
258 my $type_parameter = shift;
259 my $check = $type_parameter->_compiled_type_constraint;
261 return 1 if not( defined($_) ) || $check->($_);
265 inlined => sub {'1'},
266 inline_generator => sub {
268 my $type_parameter = shift;
270 '!defined(' . $val . ') '
271 . '|| (' . $type_parameter->_inline_check($val) . ')'
283 =for pod_coverage_needs_some_pod