Commit | Line | Data |
---|---|---|
5d2f0933 | 1 | package Moose::Util::TypeConstraints::OptimizedConstraints; |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | ||
28412c0b | 6 | use Scalar::Util 'blessed', 'looks_like_number'; |
7 | ||
a7be0f85 | 8 | our $VERSION = '0.69'; |
75b95414 | 9 | $VERSION = eval $VERSION; |
28412c0b | 10 | our $AUTHORITY = 'cpan:STEVAN'; |
5d2f0933 | 11 | |
fd542f49 | 12 | sub Value { defined($_[0]) && !ref($_[0]) } |
5d2f0933 | 13 | |
fd542f49 | 14 | sub Ref { ref($_[0]) } |
5d2f0933 | 15 | |
fd542f49 | 16 | sub Str { defined($_[0]) && !ref($_[0]) } |
bc47531e | 17 | |
fd542f49 | 18 | sub Num { !ref($_[0]) && looks_like_number($_[0]) } |
5d2f0933 | 19 | |
fd542f49 | 20 | sub Int { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ } |
21 | ||
267f8179 | 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' } | |
fd542f49 | 28 | |
29 | sub FileHandle { ref($_[0]) eq 'GLOB' && Scalar::Util::openhandle($_[0]) or blessed($_[0]) && $_[0]->isa("IO::Handle") } | |
30 | ||
31 | sub Object { blessed($_[0]) && blessed($_[0]) ne 'Regexp' } | |
32 | ||
33 | sub Role { blessed($_[0]) && $_[0]->can('does') } | |
34 | ||
e151db23 | 35 | sub ClassName { |
36 | return 0 if ref($_[0]) || !defined($_[0]) || !length($_[0]); | |
37 | ||
38 | # walk the symbol table tree to avoid autovififying | |
39 | # \*{${main::}{"Foo::"}} == \*main::Foo:: | |
40 | ||
41 | my $pack = \*::; | |
42 | foreach my $part (split('::', $_[0])) { | |
43 | return 0 unless exists ${$$pack}{"${part}::"}; | |
44 | $pack = \*{${$$pack}{"${part}::"}}; | |
45 | } | |
46 | ||
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}; | |
52 | ||
53 | # check for any method | |
54 | foreach ( keys %{$$pack} ) { | |
55 | next if substr($_, -2, 2) eq '::'; | |
56 | return 1 if defined *{${$$pack}{$_}}{CODE}; | |
57 | } | |
58 | ||
59 | # fail | |
60 | return 0; | |
61 | } | |
62 | ||
f0cac16f | 63 | sub RoleName { |
64 | ClassName($_[0]) | |
65 | && (($_[0]->can('meta') || return)->($_[0]) || return)->isa('Moose::Meta::Role') | |
66 | } | |
67 | ||
fd542f49 | 68 | # NOTE: |
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 | |
5d2f0933 | 72 | |
28412c0b | 73 | 1; |
5d2f0933 | 74 | |
75 | __END__ | |
76 | ||
77 | =pod | |
78 | ||
79 | =head1 NAME | |
80 | ||
81 | Moose::Util::TypeConstraints::OptimizedConstraints - Optimized constraint | |
82 | bodies for various moose types | |
83 | ||
5d2f0933 | 84 | =head1 DESCRIPTION |
85 | ||
004222dc | 86 | This file contains the hand optimized versions of Moose type constraints, |
87 | no user serviceable parts inside. | |
5d2f0933 | 88 | |
89 | =head1 FUNCTIONS | |
90 | ||
91 | =over 4 | |
92 | ||
6549b0d1 | 93 | =item C<Value> |
5d2f0933 | 94 | |
6549b0d1 | 95 | =item C<Ref> |
5d2f0933 | 96 | |
6549b0d1 | 97 | =item C<Str> |
5d2f0933 | 98 | |
6549b0d1 | 99 | =item C<Num> |
5d2f0933 | 100 | |
6549b0d1 | 101 | =item C<Int> |
5d2f0933 | 102 | |
6549b0d1 | 103 | =item C<ScalarRef> |
5d2f0933 | 104 | |
6549b0d1 | 105 | =item C<ArrayRef> |
5d2f0933 | 106 | |
6549b0d1 | 107 | =item C<HashRef> |
5d2f0933 | 108 | |
6549b0d1 | 109 | =item C<CodeRef> |
5d2f0933 | 110 | |
6549b0d1 | 111 | =item C<RegexpRef> |
5d2f0933 | 112 | |
6549b0d1 | 113 | =item C<GlobRef> |
5d2f0933 | 114 | |
6549b0d1 | 115 | =item C<FileHandle> |
5d2f0933 | 116 | |
6549b0d1 | 117 | =item C<Object> |
5d2f0933 | 118 | |
6549b0d1 | 119 | =item C<Role> |
5d2f0933 | 120 | |
6549b0d1 | 121 | =item C<ClassName> |
e151db23 | 122 | |
5d2f0933 | 123 | =back |
28412c0b | 124 | |
125 | =head1 BUGS | |
126 | ||
127 | All complex software has bugs lurking in it, and this module is no | |
128 | exception. If you find a bug please either email me, or add the bug | |
129 | to cpan-RT. | |
130 | ||
131 | =head1 AUTHOR | |
132 | ||
133 | Yuval Kogman E<lt>nothingmuch@cpan.orgE<gt> | |
134 | ||
135 | =head1 COPYRIGHT AND LICENSE | |
136 | ||
2840a3b2 | 137 | Copyright 2007-2009 by Infinity Interactive, Inc. |
28412c0b | 138 | |
139 | L<http://www.iinteractive.com> | |
140 | ||
141 | This library is free software; you can redistribute it and/or modify | |
142 | it under the same terms as Perl itself. | |
143 | ||
144 | =cut |