2 package Class::MOP::Package;
7 use Scalar::Util 'blessed';
10 our $VERSION = '0.02';
15 require Class::MOP::Class;
16 Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
23 my $package_name = shift;
24 # we hand-construct the class
25 # until we can bootstrap it
26 return bless { '$:package' => $package_name } => $class;
32 # all these attribute readers will be bootstrapped
33 # away in the Class::MOP bootstrap section
35 sub name { $_[0]->{'$:package'} }
47 sub add_package_symbol {
48 my ($self, $variable, $initial_value) = @_;
51 || confess "You must pass a variable name";
53 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
56 || confess "The variable name must include a sigil";
58 (exists $SIGIL_MAP{$sigil})
59 || confess "I do not recognize that sigil '$sigil'";
62 no warnings 'misc', 'redefine';
63 *{$self->name . '::' . $name} = $initial_value;
66 sub has_package_symbol {
67 my ($self, $variable) = @_;
69 || confess "You must pass a variable name";
71 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
74 || confess "The variable name must include a sigil";
76 (exists $SIGIL_MAP{$sigil})
77 || confess "I do not recognize that sigil '$sigil'";
80 defined *{$self->name . '::' . $name}{$SIGIL_MAP{$sigil}} ? 1 : 0;
84 sub get_package_symbol {
85 my ($self, $variable) = @_;
87 || confess "You must pass a variable name";
89 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
92 || confess "The variable name must include a sigil";
94 (exists $SIGIL_MAP{$sigil})
95 || confess "I do not recognize that sigil '$sigil'";
98 return *{$self->name . '::' . $name}{$SIGIL_MAP{$sigil}};
102 sub remove_package_symbol {
103 my ($self, $variable) = @_;
106 || confess "You must pass a variable name";
108 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
111 || confess "The variable name must include a sigil";
113 (exists $SIGIL_MAP{$sigil})
114 || confess "I do not recognize that sigil '$sigil'";
117 if ($SIGIL_MAP{$sigil} eq 'SCALAR') {
118 undef ${$self->name . '::' . $name};
120 elsif ($SIGIL_MAP{$sigil} eq 'ARRAY') {
121 undef @{$self->name . '::' . $name};
123 elsif ($SIGIL_MAP{$sigil} eq 'HASH') {
124 undef %{$self->name . '::' . $name};
126 elsif ($SIGIL_MAP{$sigil} eq 'CODE') {
128 # this is crap, it is probably much
129 # easier to write this in XS.
130 my ($scalar, @array, %hash);
131 $scalar = ${$self->name . '::' . $name} if defined *{$self->name . '::' . $name}{SCALAR};
132 @array = @{$self->name . '::' . $name} if defined *{$self->name . '::' . $name}{ARRAY};
133 %hash = %{$self->name . '::' . $name} if defined *{$self->name . '::' . $name}{HASH};
134 delete ${$self->name . '::'}{$name};
135 ${$self->name . '::' . $name} = $scalar if defined $scalar;
136 @{$self->name . '::' . $name} = @array if scalar @array;
137 %{$self->name . '::' . $name} = %hash if keys %hash;
140 confess "This should never ever ever happen";
146 sub list_all_package_symbols {
149 return keys %{$self->name . '::'};
160 Class::MOP::Package - Package Meta Object
176 =item B<add_package_symbol>
178 =item B<get_package_symbol>
180 =item B<has_package_symbol>
182 =item B<remove_package_symbol>
184 =item B<list_all_package_symbols>
190 Stevan Little E<lt>stevan@iinteractive.comE<gt>
192 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
194 =head1 COPYRIGHT AND LICENSE
196 Copyright 2006 by Infinity Interactive, Inc.
198 L<http://www.iinteractive.com>
200 This library is free software; you can redistribute it and/or modify
201 it under the same terms as Perl itself.