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 | |
43165725 |
69 | package |
70 | Mouse::Meta::Module; |
71 | |
72 | sub name { $_[0]->{package} } |
73 | |
74 | package |
75 | Mouse::Meta::Class; |
76 | |
77 | sub is_anon_class{ |
78 | return exists $_[0]->{anon_serial_id}; |
79 | } |
80 | |
81 | sub roles { $_[0]->{roles} } |
82 | |
83 | package |
84 | Mouse::Meta::Role; |
85 | |
86 | sub is_anon_role{ |
87 | return exists $_[0]->{anon_serial_id}; |
88 | } |
89 | |
90 | sub get_roles { $_[0]->{roles} } |
91 | |
92 | package |
93 | Mouse::Meta::Attribute; |
94 | |
95 | |
96 | # readers |
97 | |
98 | sub name { $_[0]->{name} } |
99 | sub associated_class { $_[0]->{associated_class} } |
100 | |
101 | sub accessor { $_[0]->{accessor} } |
102 | sub reader { $_[0]->{reader} } |
103 | sub writer { $_[0]->{writer} } |
104 | sub predicate { $_[0]->{predicate} } |
105 | sub clearer { $_[0]->{clearer} } |
106 | sub handles { $_[0]->{handles} } |
107 | |
108 | sub _is_metadata { $_[0]->{is} } |
109 | sub is_required { $_[0]->{required} } |
110 | sub default { $_[0]->{default} } |
111 | sub is_lazy { $_[0]->{lazy} } |
112 | sub is_lazy_build { $_[0]->{lazy_build} } |
113 | sub is_weak_ref { $_[0]->{weak_ref} } |
114 | sub init_arg { $_[0]->{init_arg} } |
115 | sub type_constraint { $_[0]->{type_constraint} } |
116 | |
117 | sub trigger { $_[0]->{trigger} } |
118 | sub builder { $_[0]->{builder} } |
119 | sub should_auto_deref { $_[0]->{auto_deref} } |
120 | sub should_coerce { $_[0]->{coerce} } |
121 | |
122 | # predicates |
123 | |
124 | sub has_accessor { exists $_[0]->{accessor} } |
125 | sub has_reader { exists $_[0]->{reader} } |
126 | sub has_writer { exists $_[0]->{writer} } |
127 | sub has_predicate { exists $_[0]->{predicate} } |
128 | sub has_clearer { exists $_[0]->{clearer} } |
129 | sub has_handles { exists $_[0]->{handles} } |
130 | |
131 | sub has_default { exists $_[0]->{default} } |
132 | sub has_type_constraint { exists $_[0]->{type_constraint} } |
133 | sub has_trigger { exists $_[0]->{trigger} } |
134 | sub has_builder { exists $_[0]->{builder} } |
135 | |
136 | package |
137 | Mouse::Meta::TypeConstraint; |
138 | |
139 | sub name { $_[0]->{name} } |
140 | sub parent { $_[0]->{parent} } |
141 | sub message { $_[0]->{message} } |
142 | |
143 | sub _compiled_type_constraint{ $_[0]->{compiled_type_constraint} } |
144 | |
145 | sub has_coercion{ exists $_[0]->{_compiled_type_coercion} } |
df6dd016 |
146 | |
147 | package |
148 | Mouse::Meta::Method::Accessor; |
149 | |
150 | 1; |
151 | __END__ |