Commit | Line | Data |
df6dd016 |
1 | package |
2 | Mouse::Util; |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
7 | use warnings FATAL => 'redefine'; # to avoid to load Mouse::PurePerl |
8 | |
9 | use B (); |
10 | |
11 | sub is_class_loaded { |
12 | my $class = shift; |
13 | |
14 | return 0 if ref($class) || !defined($class) || !length($class); |
15 | |
16 | # walk the symbol table tree to avoid autovififying |
17 | # \*{${main::}{"Foo::"}} == \*main::Foo:: |
18 | |
19 | my $pack = \%::; |
20 | foreach my $part (split('::', $class)) { |
21 | my $entry = \$pack->{$part . '::'}; |
22 | return 0 if ref($entry) ne 'GLOB'; |
23 | $pack = *{$entry}{HASH} or return 0; |
24 | } |
25 | |
26 | # check for $VERSION or @ISA |
27 | return 1 if exists $pack->{VERSION} |
28 | && defined *{$pack->{VERSION}}{SCALAR} && defined ${ $pack->{VERSION} }; |
29 | return 1 if exists $pack->{ISA} |
30 | && defined *{$pack->{ISA}}{ARRAY} && @{ $pack->{ISA} } != 0; |
31 | |
32 | # check for any method |
33 | foreach my $name( keys %{$pack} ) { |
34 | my $entry = \$pack->{$name}; |
35 | return 1 if ref($entry) ne 'GLOB' || defined *{$entry}{CODE}; |
36 | } |
37 | |
38 | # fail |
39 | return 0; |
40 | } |
41 | |
42 | |
43 | # taken from Sub::Identify |
44 | sub get_code_info { |
45 | my ($coderef) = @_; |
46 | ref($coderef) or return; |
47 | |
48 | my $cv = B::svref_2object($coderef); |
49 | $cv->isa('B::CV') or return; |
50 | |
51 | my $gv = $cv->GV; |
52 | $gv->isa('B::GV') or return; |
53 | |
54 | return ($gv->STASH->NAME, $gv->NAME); |
55 | } |
56 | |
57 | sub get_code_package{ |
58 | my($coderef) = @_; |
59 | |
60 | my $cv = B::svref_2object($coderef); |
61 | $cv->isa('B::CV') or return ''; |
62 | |
63 | my $gv = $cv->GV; |
64 | $gv->isa('B::GV') or return ''; |
65 | |
66 | return $gv->STASH->NAME; |
67 | } |
68 | |
7d96ae4d |
69 | sub get_code_ref{ |
70 | my($package, $name) = @_; |
71 | no strict 'refs'; |
72 | no warnings 'once'; |
73 | use warnings FATAL => 'uninitialized'; |
74 | return *{$package . '::' . $name}{CODE}; |
75 | } |
76 | |
77 | package |
78 | Mouse::Util::TypeConstraints; |
79 | |
80 | sub Any { 1 } |
81 | sub Item { 1 } |
82 | sub Maybe { 1 } |
83 | |
84 | sub Bool { $_[0] ? $_[0] eq '1' : 1 } |
85 | sub Undef { !defined($_[0]) } |
86 | sub Defined { defined($_[0]) } |
87 | sub Value { defined($_[0]) && !ref($_[0]) } |
88 | sub Num { !ref($_[0]) && looks_like_number($_[0]) } |
89 | sub Int { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ } |
90 | sub Str { defined($_[0]) && !ref($_[0]) } |
91 | |
92 | sub Ref { ref($_[0]) } |
93 | sub ScalarRef { ref($_[0]) eq 'SCALAR' } |
94 | sub ArrayRef { ref($_[0]) eq 'ARRAY' } |
95 | sub HashRef { ref($_[0]) eq 'HASH' } |
96 | sub CodeRef { ref($_[0]) eq 'CODE' } |
97 | sub RegexpRef { ref($_[0]) eq 'Regexp' } |
98 | sub GlobRef { ref($_[0]) eq 'GLOB' } |
99 | |
100 | sub FileHandle { |
101 | openhandle($_[0]) || (blessed($_[0]) && $_[0]->isa("IO::Handle")) |
102 | } |
103 | |
104 | sub Object { blessed($_[0]) && blessed($_[0]) ne 'Regexp' } |
105 | |
106 | sub ClassName { Mouse::Util::is_class_loaded($_[0]) } |
107 | sub RoleName { (Mouse::Util::class_of($_[0]) || return 0)->isa('Mouse::Meta::Role') } |
108 | |
109 | |
43165725 |
110 | package |
111 | Mouse::Meta::Module; |
112 | |
113 | sub name { $_[0]->{package} } |
114 | |
2591e962 |
115 | sub namespace{ |
116 | my $name = $_[0]->{package}; |
117 | no strict 'refs'; |
118 | return \%{ $name . '::' }; |
119 | } |
120 | |
43165725 |
121 | package |
122 | Mouse::Meta::Class; |
123 | |
124 | sub is_anon_class{ |
125 | return exists $_[0]->{anon_serial_id}; |
126 | } |
127 | |
128 | sub roles { $_[0]->{roles} } |
129 | |
cccb83de |
130 | sub linearized_isa { @{ get_linear_isa($_[0]->{package}) } } |
131 | |
43165725 |
132 | package |
133 | Mouse::Meta::Role; |
134 | |
135 | sub is_anon_role{ |
136 | return exists $_[0]->{anon_serial_id}; |
137 | } |
138 | |
139 | sub get_roles { $_[0]->{roles} } |
140 | |
141 | package |
142 | Mouse::Meta::Attribute; |
143 | |
144 | |
145 | # readers |
146 | |
147 | sub name { $_[0]->{name} } |
148 | sub associated_class { $_[0]->{associated_class} } |
149 | |
150 | sub accessor { $_[0]->{accessor} } |
151 | sub reader { $_[0]->{reader} } |
152 | sub writer { $_[0]->{writer} } |
153 | sub predicate { $_[0]->{predicate} } |
154 | sub clearer { $_[0]->{clearer} } |
155 | sub handles { $_[0]->{handles} } |
156 | |
157 | sub _is_metadata { $_[0]->{is} } |
158 | sub is_required { $_[0]->{required} } |
159 | sub default { $_[0]->{default} } |
160 | sub is_lazy { $_[0]->{lazy} } |
161 | sub is_lazy_build { $_[0]->{lazy_build} } |
162 | sub is_weak_ref { $_[0]->{weak_ref} } |
163 | sub init_arg { $_[0]->{init_arg} } |
164 | sub type_constraint { $_[0]->{type_constraint} } |
165 | |
166 | sub trigger { $_[0]->{trigger} } |
167 | sub builder { $_[0]->{builder} } |
168 | sub should_auto_deref { $_[0]->{auto_deref} } |
169 | sub should_coerce { $_[0]->{coerce} } |
170 | |
d899d3e7 |
171 | sub documentation { $_[0]->{documentation} } |
172 | |
43165725 |
173 | # predicates |
174 | |
175 | sub has_accessor { exists $_[0]->{accessor} } |
176 | sub has_reader { exists $_[0]->{reader} } |
177 | sub has_writer { exists $_[0]->{writer} } |
178 | sub has_predicate { exists $_[0]->{predicate} } |
179 | sub has_clearer { exists $_[0]->{clearer} } |
180 | sub has_handles { exists $_[0]->{handles} } |
181 | |
182 | sub has_default { exists $_[0]->{default} } |
183 | sub has_type_constraint { exists $_[0]->{type_constraint} } |
184 | sub has_trigger { exists $_[0]->{trigger} } |
185 | sub has_builder { exists $_[0]->{builder} } |
186 | |
d899d3e7 |
187 | sub has_documentation { exists $_[0]->{documentation} } |
188 | |
93540011 |
189 | sub accessor_metaclass(){ 'Mouse::Meta::Method::Accessor' } |
190 | |
43165725 |
191 | package |
192 | Mouse::Meta::TypeConstraint; |
193 | |
194 | sub name { $_[0]->{name} } |
195 | sub parent { $_[0]->{parent} } |
196 | sub message { $_[0]->{message} } |
197 | |
198 | sub _compiled_type_constraint{ $_[0]->{compiled_type_constraint} } |
199 | |
93540011 |
200 | sub _compiled_type_coercion { $_[0]->{_compiled_type_coercion} } |
df6dd016 |
201 | |
93540011 |
202 | |
203 | sub has_coercion{ exists $_[0]->{_compiled_type_coercion} } |
df6dd016 |
204 | |
205 | 1; |
206 | __END__ |