1 package Moose::Util::TypeConstraints::OptimizedConstraints;
6 use Scalar::Util 'blessed', 'looks_like_number';
9 $VERSION = eval $VERSION;
10 our $AUTHORITY = 'cpan:STEVAN';
12 sub Value { defined($_[0]) && !ref($_[0]) }
14 sub Ref { ref($_[0]) }
16 sub Str { defined($_[0]) && !ref($_[0]) }
18 sub Num { !ref($_[0]) && looks_like_number($_[0]) }
20 sub Int { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ }
22 sub ScalarRef { ref($_[0]) eq 'SCALAR' }
23 sub ArrayRef { ref($_[0]) eq 'ARRAY' }
24 sub HashRef { ref($_[0]) eq 'HASH' }
25 sub CodeRef { ref($_[0]) eq 'CODE' }
26 sub RegexpRef { ref($_[0]) eq 'Regexp' }
27 sub GlobRef { ref($_[0]) eq 'GLOB' }
29 sub FileHandle { ref($_[0]) eq 'GLOB' && Scalar::Util::openhandle($_[0]) or blessed($_[0]) && $_[0]->isa("IO::Handle") }
31 sub Object { blessed($_[0]) && blessed($_[0]) ne 'Regexp' }
33 sub Role { blessed($_[0]) && $_[0]->can('does') }
36 return 0 if ref($_[0]) || !defined($_[0]) || !length($_[0]);
38 # walk the symbol table tree to avoid autovififying
39 # \*{${main::}{"Foo::"}} == \*main::Foo::
42 foreach my $part (split('::', $_[0])) {
43 return 0 unless exists ${$$pack}{"${part}::"};
44 $pack = \*{${$$pack}{"${part}::"}};
47 # check for $VERSION or @ISA
48 return 1 if exists ${$$pack}{VERSION}
49 && defined *{${$$pack}{VERSION}}{SCALAR};
50 return 1 if exists ${$$pack}{ISA}
51 && defined *{${$$pack}{ISA}}{ARRAY};
53 # check for any method
54 foreach ( keys %{$$pack} ) {
55 next if substr($_, -2, 2) eq '::';
56 return 1 if defined *{${$$pack}{$_}}{CODE};
65 && (($_[0]->can('meta') || return)->($_[0]) || return)->isa('Moose::Meta::Role')
69 # we have XS versions too, ...
70 # 04:09 <@konobi> nothingmuch: konobi.co.uk/code/utilsxs.tar.gz
71 # 04:09 <@konobi> or utilxs.tar.gz iirc
81 Moose::Util::TypeConstraints::OptimizedConstraints - Optimized constraint
82 bodies for various moose types
86 This file contains the hand optimized versions of Moose type constraints,
87 no user serviceable parts inside.
129 All complex software has bugs lurking in it, and this module is no
130 exception. If you find a bug please either email me, or add the bug
135 Yuval Kogman E<lt>nothingmuch@cpan.orgE<gt>
137 =head1 COPYRIGHT AND LICENSE
139 Copyright 2007-2009 by Infinity Interactive, Inc.
141 L<http://www.iinteractive.com>
143 This library is free software; you can redistribute it and/or modify
144 it under the same terms as Perl itself.