2 package Class::MOP::Package;
7 use Scalar::Util 'blessed', 'reftype';
11 our $VERSION = '1.12';
12 $VERSION = eval $VERSION;
13 our $AUTHORITY = 'cpan:STEVAN';
15 use base 'Class::MOP::Object';
20 my ( $class, @args ) = @_;
22 unshift @args, "package" if @args % 2;
25 my $package_name = $options{package};
28 # we hand-construct the class
29 # until we can bootstrap it
30 if ( my $meta = Class::MOP::get_metaclass_by_name($package_name) ) {
33 my $meta = ( ref $class || $class )->_new({
34 'package' => $package_name,
37 Class::MOP::store_metaclass_by_name($package_name, $meta);
44 my ( $class, @args ) = @_;
46 unshift @args, "package" if @args % 2;
49 my $package_name = delete $options{package};
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";
55 $package_name = $package_name->name
56 if blessed $package_name;
58 Class::MOP::remove_metaclass_by_name($package_name);
60 $class->initialize($package_name, %options); # call with first arg form for compat
66 return Class::MOP::Class->initialize($class)->new_object(@_)
67 if $class ne __PACKAGE__;
69 my $params = @_ == 1 ? $_[0] : {@_};
72 package => $params->{package},
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 :\
90 # all these attribute readers will be bootstrapped
91 # away in the Class::MOP bootstrap section
94 $_[0]->{_package_stash} ||= Package::Stash->new($_[0]->name)
97 $_[0]->_package_stash->namespace
102 # ... these functions have to touch the symbol table itself,.. yuk
104 sub add_package_symbol {
106 $self->_package_stash->add_symbol(@_);
109 sub remove_package_glob {
111 $self->_package_stash->remove_glob(@_);
114 # ... these functions deal with stuff on the namespace level
116 sub has_package_symbol {
118 $self->_package_stash->has_symbol(@_);
121 sub get_package_symbol {
123 $self->_package_stash->get_symbol(@_);
126 sub get_or_add_package_symbol {
128 $self->_package_stash->get_or_add_symbol(@_);
131 sub remove_package_symbol {
133 $self->_package_stash->remove_symbol(@_);
136 sub list_all_package_symbols {
138 $self->_package_stash->list_all_symbols(@_);
141 sub get_all_package_symbols {
143 $self->_package_stash->get_all_symbols(@_);
154 Class::MOP::Package - Package Meta Object
158 The Package Protocol provides an abstraction of a Perl 5 package. A
159 package is basically namespace, and this module provides methods for
160 looking at and changing that namespace's symbol table.
166 =item B<< Class::MOP::Package->initialize($package_name) >>
168 This method creates a new C<Class::MOP::Package> instance which
169 represents specified package. If an existing metaclass object exists
170 for the package, that will be returned instead.
172 =item B<< Class::MOP::Package->reinitialize($package) >>
174 This method forcibly removes any existing metaclass for the package
175 before calling C<initialize>. In contrast to C<initialize>, you may
176 also pass an existing C<Class::MOP::Package> instance instead of just
177 a package name as C<$package>.
179 Do not call this unless you know what you are doing.
181 =item B<< $metapackage->name >>
183 This is returns the package's name, as passed to the constructor.
185 =item B<< $metapackage->namespace >>
187 This returns a hash reference to the package's symbol table. The keys
188 are symbol names and the values are typeglob references.
190 =item B<< $metapackage->add_package_symbol($variable_name, $initial_value) >>
192 This method accepts a variable name and an optional initial value. The
193 C<$variable_name> must contain a leading sigil.
195 This method creates the variable in the package's symbol table, and
196 sets it to the initial value if one was provided.
198 =item B<< $metapackage->get_package_symbol($variable_name) >>
200 Given a variable name, this method returns the variable as a reference
201 or undef if it does not exist. The C<$variable_name> must contain a
204 =item B<< $metapackage->get_or_add_package_symbol($variable_name) >>
206 Given a variable name, this method returns the variable as a reference.
207 If it does not exist, a default value will be generated if possible. The
208 C<$variable_name> must contain a leading sigil.
210 =item B<< $metapackage->has_package_symbol($variable_name) >>
212 Returns true if there is a package variable defined for
213 C<$variable_name>. The C<$variable_name> must contain a leading sigil.
215 =item B<< $metapackage->remove_package_symbol($variable_name) >>
217 This will remove the package variable specified C<$variable_name>. The
218 C<$variable_name> must contain a leading sigil.
220 =item B<< $metapackage->remove_package_glob($glob_name) >>
222 Given the name of a glob, this will remove that glob from the
223 package's symbol table. Glob names do not include a sigil. Removing
224 the glob removes all variables and subroutines with the specified
227 =item B<< $metapackage->list_all_package_symbols($type_filter) >>
229 This will list all the glob names associated with the current
230 package. These names do not have leading sigils.
232 You can provide an optional type filter, which should be one of
233 'SCALAR', 'ARRAY', 'HASH', or 'CODE'.
235 =item B<< $metapackage->get_all_package_symbols($type_filter) >>
237 This works much like C<list_all_package_symbols>, but it returns a
238 hash reference. The keys are glob names and the values are references
239 to the value for that name.
241 =item B<< Class::MOP::Package->meta >>
243 This will return a L<Class::MOP::Class> instance for this class.
249 Stevan Little E<lt>stevan@iinteractive.comE<gt>
251 =head1 COPYRIGHT AND LICENSE
253 Copyright 2006-2010 by Infinity Interactive, Inc.
255 L<http://www.iinteractive.com>
257 This library is free software; you can redistribute it and/or modify
258 it under the same terms as Perl itself.