Commit | Line | Data |
2243a22b |
1 | |
2 | package Class::MOP::Package; |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
812d58f9 |
7 | use Scalar::Util 'blessed', 'reftype'; |
6d5355c3 |
8 | use Carp 'confess'; |
407a4276 |
9 | use Package::Stash; |
2243a22b |
10 | |
a9f48b4b |
11 | our $VERSION = '1.11'; |
d519662a |
12 | $VERSION = eval $VERSION; |
f0480c45 |
13 | our $AUTHORITY = 'cpan:STEVAN'; |
2243a22b |
14 | |
f197afa6 |
15 | use base 'Class::MOP::Object'; |
6e57504d |
16 | |
6d5355c3 |
17 | # creation ... |
18 | |
19 | sub initialize { |
3be6bc1c |
20 | my ( $class, @args ) = @_; |
21 | |
22 | unshift @args, "package" if @args % 2; |
23 | |
24 | my %options = @args; |
25 | my $package_name = $options{package}; |
26 | |
27 | |
9d6dce77 |
28 | # we hand-construct the class |
29 | # until we can bootstrap it |
a19fcb5b |
30 | if ( my $meta = Class::MOP::get_metaclass_by_name($package_name) ) { |
973de492 |
31 | return $meta; |
a19fcb5b |
32 | } else { |
973de492 |
33 | my $meta = ( ref $class || $class )->_new({ |
34 | 'package' => $package_name, |
11ac821d |
35 | %options, |
973de492 |
36 | }); |
973de492 |
37 | Class::MOP::store_metaclass_by_name($package_name, $meta); |
a19fcb5b |
38 | |
973de492 |
39 | return $meta; |
a19fcb5b |
40 | } |
41 | } |
42 | |
43 | sub reinitialize { |
3be6bc1c |
44 | my ( $class, @args ) = @_; |
45 | |
46 | unshift @args, "package" if @args % 2; |
47 | |
48 | my %options = @args; |
3eda22f8 |
49 | my $package_name = delete $options{package}; |
3be6bc1c |
50 | |
7975280a |
51 | (defined $package_name && $package_name |
52 | && (!blessed $package_name || $package_name->isa('Class::MOP::Package'))) |
53 | || confess "You must pass a package name or an existing Class::MOP::Package instance"; |
54 | |
55 | $package_name = $package_name->name |
56 | if blessed $package_name; |
3be6bc1c |
57 | |
a19fcb5b |
58 | Class::MOP::remove_metaclass_by_name($package_name); |
3be6bc1c |
59 | |
3eda22f8 |
60 | $class->initialize($package_name, %options); # call with first arg form for compat |
682655a3 |
61 | } |
62 | |
63 | sub _new { |
0bfc85b8 |
64 | my $class = shift; |
812d58f9 |
65 | |
ec9e38e5 |
66 | return Class::MOP::Class->initialize($class)->new_object(@_) |
812d58f9 |
67 | if $class ne __PACKAGE__; |
682655a3 |
68 | |
ec9e38e5 |
69 | my $params = @_ == 1 ? $_[0] : {@_}; |
70 | |
71 | return bless { |
72 | package => $params->{package}, |
73 | |
74 | # NOTE: |
75 | # because of issues with the Perl API |
76 | # to the typeglob in some versions, we |
77 | # need to just always grab a new |
78 | # reference to the hash in the accessor. |
79 | # Ideally we could just store a ref and |
80 | # it would Just Work, but oh well :\ |
81 | |
82 | namespace => \undef, |
0bfc85b8 |
83 | |
ec9e38e5 |
84 | } => $class; |
6d5355c3 |
85 | } |
86 | |
87 | # Attributes |
88 | |
89 | # NOTE: |
90 | # all these attribute readers will be bootstrapped |
91 | # away in the Class::MOP bootstrap section |
92 | |
407a4276 |
93 | sub _package_stash { |
94 | $_[0]->{_package_stash} ||= Package::Stash->new($_[0]->name) |
56dcfc1a |
95 | } |
407a4276 |
96 | sub namespace { |
97 | $_[0]->_package_stash->namespace |
a5e51f0b |
98 | } |
6d5355c3 |
99 | |
a5e51f0b |
100 | # Class attributes |
6d5355c3 |
101 | |
c46b802b |
102 | # ... these functions have to touch the symbol table itself,.. yuk |
103 | |
86e1c8d8 |
104 | sub add_package_symbol { |
407a4276 |
105 | my $self = shift; |
106 | $self->_package_stash->add_package_symbol(@_); |
86e1c8d8 |
107 | } |
108 | |
c46b802b |
109 | sub remove_package_glob { |
407a4276 |
110 | my $self = shift; |
111 | $self->_package_stash->remove_package_glob(@_); |
86e1c8d8 |
112 | } |
113 | |
114 | # ... these functions deal with stuff on the namespace level |
115 | |
116 | sub has_package_symbol { |
407a4276 |
117 | my $self = shift; |
118 | $self->_package_stash->has_package_symbol(@_); |
86e1c8d8 |
119 | } |
120 | |
121 | sub get_package_symbol { |
407a4276 |
122 | my $self = shift; |
123 | $self->_package_stash->get_package_symbol(@_); |
a5e51f0b |
124 | } |
6d5355c3 |
125 | |
e4093599 |
126 | sub get_or_add_package_symbol { |
127 | my $self = shift; |
128 | $self->_package_stash->get_or_add_package_symbol(@_); |
129 | } |
130 | |
a5e51f0b |
131 | sub remove_package_symbol { |
407a4276 |
132 | my $self = shift; |
133 | $self->_package_stash->remove_package_symbol(@_); |
9d6dce77 |
134 | } |
c0cbf4d9 |
135 | |
9d6dce77 |
136 | sub list_all_package_symbols { |
407a4276 |
137 | my $self = shift; |
138 | $self->_package_stash->list_all_package_symbols(@_); |
6d5355c3 |
139 | } |
140 | |
2243a22b |
141 | 1; |
142 | |
143 | __END__ |
144 | |
145 | =pod |
146 | |
147 | =head1 NAME |
148 | |
149 | Class::MOP::Package - Package Meta Object |
150 | |
2243a22b |
151 | =head1 DESCRIPTION |
152 | |
116a9f45 |
153 | The Package Protocol provides an abstraction of a Perl 5 package. A |
154 | package is basically namespace, and this module provides methods for |
155 | looking at and changing that namespace's symbol table. |
121991f6 |
156 | |
2243a22b |
157 | =head1 METHODS |
158 | |
159 | =over 4 |
160 | |
116a9f45 |
161 | =item B<< Class::MOP::Package->initialize($package_name) >> |
162 | |
163 | This method creates a new C<Class::MOP::Package> instance which |
164 | represents specified package. If an existing metaclass object exists |
165 | for the package, that will be returned instead. |
166 | |
7975280a |
167 | =item B<< Class::MOP::Package->reinitialize($package) >> |
2243a22b |
168 | |
116a9f45 |
169 | This method forcibly removes any existing metaclass for the package |
7975280a |
170 | before calling C<initialize>. In contrast to C<initialize>, you may |
171 | also pass an existing C<Class::MOP::Package> instance instead of just |
172 | a package name as C<$package>. |
127d39a7 |
173 | |
116a9f45 |
174 | Do not call this unless you know what you are doing. |
6d5355c3 |
175 | |
116a9f45 |
176 | =item B<< $metapackage->name >> |
127d39a7 |
177 | |
116a9f45 |
178 | This is returns the package's name, as passed to the constructor. |
a19fcb5b |
179 | |
116a9f45 |
180 | =item B<< $metapackage->namespace >> |
a19fcb5b |
181 | |
116a9f45 |
182 | This returns a hash reference to the package's symbol table. The keys |
183 | are symbol names and the values are typeglob references. |
6d5355c3 |
184 | |
116a9f45 |
185 | =item B<< $metapackage->add_package_symbol($variable_name, $initial_value) >> |
b9d9fc0b |
186 | |
116a9f45 |
187 | This method accepts a variable name and an optional initial value. The |
188 | C<$variable_name> must contain a leading sigil. |
a5e51f0b |
189 | |
116a9f45 |
190 | This method creates the variable in the package's symbol table, and |
191 | sets it to the initial value if one was provided. |
b9d9fc0b |
192 | |
116a9f45 |
193 | =item B<< $metapackage->get_package_symbol($variable_name) >> |
b9d9fc0b |
194 | |
116a9f45 |
195 | Given a variable name, this method returns the variable as a reference |
196 | or undef if it does not exist. The C<$variable_name> must contain a |
197 | leading sigil. |
b9d9fc0b |
198 | |
e4093599 |
199 | =item B<< $metapackage->get_or_add_package_symbol($variable_name) >> |
200 | |
201 | Given a variable name, this method returns the variable as a reference. |
202 | If it does not exist, a default value will be generated if possible. The |
203 | C<$variable_name> must contain a leading sigil. |
204 | |
116a9f45 |
205 | =item B<< $metapackage->has_package_symbol($variable_name) >> |
6d5355c3 |
206 | |
116a9f45 |
207 | Returns true if there is a package variable defined for |
208 | C<$variable_name>. The C<$variable_name> must contain a leading sigil. |
6d5355c3 |
209 | |
116a9f45 |
210 | =item B<< $metapackage->remove_package_symbol($variable_name) >> |
6d5355c3 |
211 | |
116a9f45 |
212 | This will remove the package variable specified C<$variable_name>. The |
213 | C<$variable_name> must contain a leading sigil. |
6d5355c3 |
214 | |
116a9f45 |
215 | =item B<< $metapackage->remove_package_glob($glob_name) >> |
b9d9fc0b |
216 | |
116a9f45 |
217 | Given the name of a glob, this will remove that glob from the |
218 | package's symbol table. Glob names do not include a sigil. Removing |
219 | the glob removes all variables and subroutines with the specified |
220 | name. |
b9d9fc0b |
221 | |
116a9f45 |
222 | =item B<< $metapackage->list_all_package_symbols($type_filter) >> |
b9d9fc0b |
223 | |
116a9f45 |
224 | This will list all the glob names associated with the current |
225 | package. These names do not have leading sigils. |
c46b802b |
226 | |
116a9f45 |
227 | You can provide an optional type filter, which should be one of |
228 | 'SCALAR', 'ARRAY', 'HASH', or 'CODE'. |
9d6dce77 |
229 | |
116a9f45 |
230 | =item B<< $metapackage->get_all_package_symbols($type_filter) >> |
b9d9fc0b |
231 | |
116a9f45 |
232 | This works much like C<list_all_package_symbols>, but it returns a |
233 | hash reference. The keys are glob names and the values are references |
234 | to the value for that name. |
92330ee2 |
235 | |
116a9f45 |
236 | =item B<< Class::MOP::Package->meta >> |
ae234dc6 |
237 | |
116a9f45 |
238 | This will return a L<Class::MOP::Class> instance for this class. |
ae234dc6 |
239 | |
2243a22b |
240 | =back |
241 | |
1a09d9cc |
242 | =head1 AUTHORS |
2243a22b |
243 | |
244 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
245 | |
246 | =head1 COPYRIGHT AND LICENSE |
247 | |
3e2c8600 |
248 | Copyright 2006-2010 by Infinity Interactive, Inc. |
2243a22b |
249 | |
250 | L<http://www.iinteractive.com> |
251 | |
252 | This library is free software; you can redistribute it and/or modify |
253 | it under the same terms as Perl itself. |
254 | |
92af7fdf |
255 | =cut |