cleaned up the class_construct_instance handleing so that it works like construct...
[gitmo/Class-MOP.git] / lib / Class / MOP / Class.pm
CommitLineData
8b978dd5 1
2package Class::MOP::Class;
3
4use strict;
5use warnings;
6
7use Carp 'confess';
0882828e 8use Scalar::Util 'blessed', 'reftype';
8b978dd5 9use Sub::Name 'subname';
10use B 'svref_2object';
11
99e5b7e8 12our $VERSION = '0.03';
8b978dd5 13
2eb717d5 14# Self-introspection
15
99e5b7e8 16sub meta { Class::MOP::Class->initialize($_[0]) }
2eb717d5 17
8b978dd5 18# Creation
19
bfe4d0fc 20{
21 # Metaclasses are singletons, so we cache them here.
22 # there is no need to worry about destruction though
23 # because they should die only when the program dies.
24 # After all, do package definitions even get reaped?
651955fb 25 my %METAS;
26
bfe4d0fc 27 sub initialize {
351bd7d4 28 my $class = shift;
29 my $package_name = shift;
bfe4d0fc 30 (defined $package_name && $package_name)
c9e77dbb 31 || confess "You must pass a package name";
32 # make sure the package name is not blessed
33 $package_name = blessed($package_name) || $package_name;
651955fb 34 $class->construct_class_instance(':package' => $package_name, @_);
727919c5 35 }
36
37 # NOTE: (meta-circularity)
38 # this is a special form of &construct_instance
39 # (see below), which is used to construct class
1a7ebbb3 40 # meta-object instances for any Class::MOP::*
41 # class. All other classes will use the more
42 # normal &construct_instance.
727919c5 43 sub construct_class_instance {
351bd7d4 44 my $class = shift;
651955fb 45 my %options = @_;
46 my $package_name = $options{':package'};
727919c5 47 (defined $package_name && $package_name)
651955fb 48 || confess "You must pass a package name";
49 return $METAS{$package_name} if exists $METAS{$package_name};
1a7ebbb3 50 $class = blessed($class) || $class;
51 if ($class =~ /^Class::MOP::/) {
651955fb 52 $METAS{$package_name} = bless {
351bd7d4 53 '$:package' => $package_name,
54 '%:attributes' => {},
55 '$:attribute_metaclass' => 'Class::MOP::Attribute',
56 '$:method_metaclass' => 'Class::MOP::Method',
1a7ebbb3 57 } => $class;
58 }
59 else {
5f3c057a 60 # NOTE:
61 # it is safe to use meta here because
62 # class will always be a subclass of
63 # Class::MOP::Class, which defines meta
651955fb 64 $METAS{$package_name} = bless $class->meta->construct_instance(%options) => $class
1a7ebbb3 65 }
bfe4d0fc 66 }
8b978dd5 67}
68
69sub create {
70 my ($class, $package_name, $package_version, %options) = @_;
bfe4d0fc 71 (defined $package_name && $package_name)
8b978dd5 72 || confess "You must pass a package name";
73 my $code = "package $package_name;";
74 $code .= "\$$package_name\:\:VERSION = '$package_version';"
75 if defined $package_version;
76 eval $code;
77 confess "creation of $package_name failed : $@" if $@;
bfe4d0fc 78 my $meta = $class->initialize($package_name);
8b978dd5 79 $meta->superclasses(@{$options{superclasses}})
80 if exists $options{superclasses};
2eb717d5 81 # NOTE:
82 # process attributes first, so that they can
83 # install accessors, but locally defined methods
84 # can then overwrite them. It is maybe a little odd, but
85 # I think this should be the order of things.
86 if (exists $options{attributes}) {
cbd9f942 87 foreach my $attr (@{$options{attributes}}) {
88 $meta->add_attribute($attr);
2eb717d5 89 }
90 }
bfe4d0fc 91 if (exists $options{methods}) {
92 foreach my $method_name (keys %{$options{methods}}) {
93 $meta->add_method($method_name, $options{methods}->{$method_name});
94 }
2eb717d5 95 }
8b978dd5 96 return $meta;
97}
98
7b31baf4 99## Attribute readers
100
101# NOTE:
102# all these attribute readers will be bootstrapped
103# away in the Class::MOP bootstrap section
104
105sub name { $_[0]->{'$:package'} }
106sub get_attribute_map { $_[0]->{'%:attributes'} }
107sub attribute_metaclass { $_[0]->{'$:attribute_metaclass'} }
108sub method_metaclass { $_[0]->{'$:method_metaclass'} }
109
c9e77dbb 110# Instance Construction & Cloning
111
5f3c057a 112sub new_object {
113 my $class = shift;
651955fb 114 # NOTE:
115 # we need to protect the integrity of the
116 # Class::MOP::Class singletons here, so we
117 # delegate this to &construct_class_instance
118 # which will deal with the singletons
119 return $class->construct_class_instance(@_)
120 if $class->name->isa('Class::MOP::Class');
5f3c057a 121 bless $class->construct_instance(@_) => $class->name;
122}
e16da3e6 123
124sub construct_instance {
cbd9f942 125 my ($class, %params) = @_;
126 my $instance = {};
c9e77dbb 127 foreach my $attr ($class->compute_all_applicable_attributes()) {
651955fb 128 my $init_arg = $attr->init_arg();
cbd9f942 129 # try to fetch the init arg from the %params ...
130 my $val;
131 $val = $params{$init_arg} if exists $params{$init_arg};
132 # if nothing was in the %params, we can use the
133 # attribute's default value (if it has one)
c9e77dbb 134 $val ||= $attr->default($instance) if $attr->has_default();
cbd9f942 135 $instance->{$attr->name} = $val;
136 }
137 return $instance;
e16da3e6 138}
139
5f3c057a 140sub clone_object {
141 my $class = shift;
7b31baf4 142 my $instance = shift;
651955fb 143 (blessed($instance) && $instance->isa($class->name))
144 || confess "You must pass an instance ($instance) of the metaclass (" . $class->name . ")";
145 # NOTE:
146 # we need to protect the integrity of the
147 # Class::MOP::Class singletons here, they
148 # should not be cloned
149 return $instance if $instance->isa('Class::MOP::Class');
150 bless $class->clone_instance($instance, @_) => blessed($instance);
5f3c057a 151}
152
c9e77dbb 153sub clone_instance {
651955fb 154 my ($class, $instance, %params) = @_;
155 (blessed($instance))
c9e77dbb 156 || confess "You can only clone instances, \$self is not a blessed instance";
157 # NOTE:
158 # this should actually do a deep clone
159 # instead of this cheap hack. I will
160 # add that in later.
161 # (use the Class::Cloneable::Util code)
651955fb 162 my $clone = { %{$instance} };
c9e77dbb 163 foreach my $attr ($class->compute_all_applicable_attributes()) {
651955fb 164 my $init_arg = $attr->init_arg();
c9e77dbb 165 # try to fetch the init arg from the %params ...
166 $clone->{$attr->name} = $params{$init_arg}
167 if exists $params{$init_arg};
168 }
169 return $clone;
170}
171
8b978dd5 172# Informational
173
7b31baf4 174# &name should be here too, but it is above
175# because it gets bootstrapped away
8b978dd5 176
177sub version {
178 my $self = shift;
179 no strict 'refs';
180 ${$self->name . '::VERSION'};
181}
182
183# Inheritance
184
185sub superclasses {
186 my $self = shift;
187 no strict 'refs';
188 if (@_) {
189 my @supers = @_;
190 @{$self->name . '::ISA'} = @supers;
191 }
192 @{$self->name . '::ISA'};
193}
194
195sub class_precedence_list {
196 my $self = shift;
bfe4d0fc 197 # NOTE:
198 # We need to check for ciruclar inheirtance here.
199 # This will do nothing if all is well, and blow
200 # up otherwise. Yes, it's an ugly hack, better
201 # suggestions are welcome.
202 { $self->name->isa('This is a test for circular inheritance') }
203 # ... and no back to our regularly scheduled program
8b978dd5 204 (
205 $self->name,
206 map {
bfe4d0fc 207 $self->initialize($_)->class_precedence_list()
8b978dd5 208 } $self->superclasses()
209 );
210}
211
0882828e 212## Methods
213
214sub add_method {
215 my ($self, $method_name, $method) = @_;
216 (defined $method_name && $method_name)
217 || confess "You must define a method name";
a5eca695 218 # use reftype here to allow for blessed subs ...
0882828e 219 (reftype($method) && reftype($method) eq 'CODE')
220 || confess "Your code block must be a CODE reference";
221 my $full_method_name = ($self->name . '::' . $method_name);
222
223 no strict 'refs';
c9b8b7f9 224 no warnings 'redefine';
0882828e 225 *{$full_method_name} = subname $full_method_name => $method;
226}
227
bfe4d0fc 228{
229
230 ## private utility functions for has_method
2eb717d5 231 my $_find_subroutine_package_name = sub { eval { svref_2object($_[0])->GV->STASH->NAME } || '' };
232 my $_find_subroutine_name = sub { eval { svref_2object($_[0])->GV->NAME } || '' };
bfe4d0fc 233
234 sub has_method {
c9b8b7f9 235 my ($self, $method_name) = @_;
bfe4d0fc 236 (defined $method_name && $method_name)
237 || confess "You must define a method name";
0882828e 238
bfe4d0fc 239 my $sub_name = ($self->name . '::' . $method_name);
0882828e 240
bfe4d0fc 241 no strict 'refs';
242 return 0 if !defined(&{$sub_name});
243 return 0 if $_find_subroutine_package_name->(\&{$sub_name}) ne $self->name &&
244 $_find_subroutine_name->(\&{$sub_name}) ne '__ANON__';
245 return 1;
246 }
247
0882828e 248}
249
250sub get_method {
c9b8b7f9 251 my ($self, $method_name) = @_;
0882828e 252 (defined $method_name && $method_name)
253 || confess "You must define a method name";
254
255 no strict 'refs';
256 return \&{$self->name . '::' . $method_name}
bfe4d0fc 257 if $self->has_method($method_name);
c9b8b7f9 258 return; # <- make sure to return undef
259}
260
261sub remove_method {
262 my ($self, $method_name) = @_;
263 (defined $method_name && $method_name)
264 || confess "You must define a method name";
265
266 my $removed_method = $self->get_method($method_name);
267
268 no strict 'refs';
269 delete ${$self->name . '::'}{$method_name}
270 if defined $removed_method;
271
272 return $removed_method;
273}
274
275sub get_method_list {
276 my $self = shift;
277 no strict 'refs';
a5eca695 278 grep { $self->has_method($_) } %{$self->name . '::'};
279}
280
281sub compute_all_applicable_methods {
282 my $self = shift;
283 my @methods;
284 # keep a record of what we have seen
285 # here, this will handle all the
286 # inheritence issues because we are
287 # using the &class_precedence_list
288 my (%seen_class, %seen_method);
289 foreach my $class ($self->class_precedence_list()) {
290 next if $seen_class{$class};
291 $seen_class{$class}++;
292 # fetch the meta-class ...
293 my $meta = $self->initialize($class);
294 foreach my $method_name ($meta->get_method_list()) {
295 next if exists $seen_method{$method_name};
296 $seen_method{$method_name}++;
297 push @methods => {
298 name => $method_name,
299 class => $class,
300 code => $meta->get_method($method_name)
301 };
302 }
303 }
304 return @methods;
305}
306
a5eca695 307sub find_all_methods_by_name {
308 my ($self, $method_name) = @_;
309 (defined $method_name && $method_name)
310 || confess "You must define a method name to find";
311 my @methods;
312 # keep a record of what we have seen
313 # here, this will handle all the
314 # inheritence issues because we are
315 # using the &class_precedence_list
316 my %seen_class;
317 foreach my $class ($self->class_precedence_list()) {
318 next if $seen_class{$class};
319 $seen_class{$class}++;
320 # fetch the meta-class ...
321 my $meta = $self->initialize($class);
322 push @methods => {
323 name => $method_name,
324 class => $class,
325 code => $meta->get_method($method_name)
326 } if $meta->has_method($method_name);
327 }
328 return @methods;
329
8b978dd5 330}
331
552e3d24 332## Attributes
333
e16da3e6 334sub add_attribute {
2e41896e 335 my $self = shift;
336 # either we have an attribute object already
337 # or we need to create one from the args provided
338 my $attribute = blessed($_[0]) ? $_[0] : $self->attribute_metaclass->new(@_);
339 # make sure it is derived from the correct type though
340 ($attribute->isa('Class::MOP::Attribute'))
341 || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";
9ec169fe 342 $attribute->attach_to_class($self);
343 $attribute->install_accessors();
7b31baf4 344 $self->get_attribute_map->{$attribute->name} = $attribute;
e16da3e6 345}
346
347sub has_attribute {
348 my ($self, $attribute_name) = @_;
349 (defined $attribute_name && $attribute_name)
350 || confess "You must define an attribute name";
7b31baf4 351 exists $self->get_attribute_map->{$attribute_name} ? 1 : 0;
e16da3e6 352}
353
354sub get_attribute {
355 my ($self, $attribute_name) = @_;
356 (defined $attribute_name && $attribute_name)
357 || confess "You must define an attribute name";
7b31baf4 358 return $self->get_attribute_map->{$attribute_name}
e16da3e6 359 if $self->has_attribute($attribute_name);
360}
361
362sub remove_attribute {
363 my ($self, $attribute_name) = @_;
364 (defined $attribute_name && $attribute_name)
365 || confess "You must define an attribute name";
7b31baf4 366 my $removed_attribute = $self->get_attribute_map->{$attribute_name};
367 delete $self->get_attribute_map->{$attribute_name}
9ec169fe 368 if defined $removed_attribute;
369 $removed_attribute->remove_accessors();
370 $removed_attribute->detach_from_class();
e16da3e6 371 return $removed_attribute;
372}
373
374sub get_attribute_list {
375 my $self = shift;
7b31baf4 376 keys %{$self->get_attribute_map};
e16da3e6 377}
378
379sub compute_all_applicable_attributes {
380 my $self = shift;
381 my @attrs;
382 # keep a record of what we have seen
383 # here, this will handle all the
384 # inheritence issues because we are
385 # using the &class_precedence_list
386 my (%seen_class, %seen_attr);
387 foreach my $class ($self->class_precedence_list()) {
388 next if $seen_class{$class};
389 $seen_class{$class}++;
390 # fetch the meta-class ...
391 my $meta = $self->initialize($class);
392 foreach my $attr_name ($meta->get_attribute_list()) {
393 next if exists $seen_attr{$attr_name};
394 $seen_attr{$attr_name}++;
c9e77dbb 395 push @attrs => $meta->get_attribute($attr_name);
e16da3e6 396 }
397 }
398 return @attrs;
399}
2eb717d5 400
52e8a34c 401# Class attributes
402
403sub add_package_variable {
404 my ($self, $variable, $initial_value) = @_;
405 (defined $variable && $variable =~ /^[\$\@\%]/)
406 || confess "variable name does not have a sigil";
407
408 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
409 if (defined $initial_value) {
410 no strict 'refs';
411 *{$self->name . '::' . $name} = $initial_value;
412 }
413 else {
414 eval $sigil . $self->name . '::' . $name;
415 confess "Could not create package variable ($variable) because : $@" if $@;
416 }
417}
418
419sub has_package_variable {
420 my ($self, $variable) = @_;
421 (defined $variable && $variable =~ /^[\$\@\%]/)
422 || confess "variable name does not have a sigil";
423 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
424 no strict 'refs';
425 defined ${$self->name . '::'}{$name} ? 1 : 0;
426}
427
428sub get_package_variable {
429 my ($self, $variable) = @_;
430 (defined $variable && $variable =~ /^[\$\@\%]/)
431 || confess "variable name does not have a sigil";
432 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
433 no strict 'refs';
434 # try to fetch it first,.. see what happens
435 eval '\\' . $sigil . $self->name . '::' . $name;
436 confess "Could not get the package variable ($variable) because : $@" if $@;
437 # if we didn't die, then we can return it
438 # NOTE:
439 # this is not ideal, better suggestions are welcome
440 eval '\\' . $sigil . $self->name . '::' . $name;
441}
442
443sub remove_package_variable {
444 my ($self, $variable) = @_;
445 (defined $variable && $variable =~ /^[\$\@\%]/)
446 || confess "variable name does not have a sigil";
447 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
448 no strict 'refs';
449 delete ${$self->name . '::'}{$name};
450}
451
8b978dd5 4521;
453
454__END__
455
456=pod
457
458=head1 NAME
459
460Class::MOP::Class - Class Meta Object
461
462=head1 SYNOPSIS
463
fe122940 464 # use this for introspection ...
465
466 package Foo;
467 sub meta { Class::MOP::Class->initialize(__PACKAGE__) }
468
469 # elsewhere in the code ...
470
471 # add a method to Foo ...
472 Foo->meta->add_method('bar' => sub { ... })
473
474 # get a list of all the classes searched
475 # the method dispatcher in the correct order
476 Foo->meta->class_precedence_list()
477
478 # remove a method from Foo
479 Foo->meta->remove_method('bar');
480
481 # or use this to actually create classes ...
482
483 Class::MOP::Class->create('Bar' => '0.01' => (
484 superclasses => [ 'Foo' ],
485 attributes => [
486 Class::MOP:::Attribute->new('$bar'),
487 Class::MOP:::Attribute->new('$baz'),
488 ],
489 methods => {
490 calculate_bar => sub { ... },
491 construct_baz => sub { ... }
492 }
493 ));
494
8b978dd5 495=head1 DESCRIPTION
496
fe122940 497This is the largest and currently most complex part of the Perl 5
498meta-object protocol. It controls the introspection and
499manipulation of Perl 5 classes (and it can create them too). The
500best way to understand what this module can do, is to read the
501documentation for each of it's methods.
502
552e3d24 503=head1 METHODS
504
2eb717d5 505=head2 Self Introspection
506
507=over 4
508
509=item B<meta>
510
fe122940 511This will return a B<Class::MOP::Class> instance which is related
512to this class. Thereby allowing B<Class::MOP::Class> to actually
513introspect itself.
514
515As with B<Class::MOP::Attribute>, B<Class::MOP> will actually
516bootstrap this module by installing a number of attribute meta-objects
517into it's metaclass. This will allow this class to reap all the benifits
518of the MOP when subclassing it.
2eb717d5 519
520=back
521
552e3d24 522=head2 Class construction
523
a2e85e6c 524These methods will handle creating B<Class::MOP::Class> objects,
525which can be used to both create new classes, and analyze
526pre-existing classes.
552e3d24 527
528This module will internally store references to all the instances
529you create with these methods, so that they do not need to be
530created any more than nessecary. Basically, they are singletons.
531
532=over 4
533
534=item B<create ($package_name, ?$package_version,
a2e85e6c 535 superclasses =E<gt> ?@superclasses,
536 methods =E<gt> ?%methods,
537 attributes =E<gt> ?%attributes)>
552e3d24 538
a2e85e6c 539This returns a B<Class::MOP::Class> object, bringing the specified
552e3d24 540C<$package_name> into existence and adding any of the
541C<$package_version>, C<@superclasses>, C<%methods> and C<%attributes>
542to it.
543
544=item B<initialize ($package_name)>
545
a2e85e6c 546This initializes and returns returns a B<Class::MOP::Class> object
547for a given a C<$package_name>.
548
651955fb 549=item B<construct_class_instance (%options)>
a2e85e6c 550
551This will construct an instance of B<Class::MOP::Class>, it is
552here so that we can actually "tie the knot" for B<Class::MOP::Class>
553to use C<construct_instance> once all the bootstrapping is done. This
554method is used internally by C<initialize> and should never be called
555from outside of that method really.
552e3d24 556
557=back
558
c9e77dbb 559=head2 Object instance construction and cloning
a2e85e6c 560
c9e77dbb 561These methods are B<entirely optional>, it is up to you whether you want
562to use them or not.
552e3d24 563
564=over 4
565
5f3c057a 566=item B<new_object (%params)>
567
568This is a convience method for creating a new object of the class, and
569blessing it into the appropriate package as well. Ideally your class
570would call a C<new> this method like so:
571
572 sub MyClass::new {
573 my ($class, %param) = @_;
574 $class->meta->new_object(%params);
575 }
576
577Of course the ideal place for this would actually be in C<UNIVERSAL::>
578but that is considered bad style, so we do not do that.
579
cbd9f942 580=item B<construct_instance (%params)>
552e3d24 581
c9e77dbb 582This method is used to construct an instace structure suitable for
583C<bless>-ing into your package of choice. It works in conjunction
584with the Attribute protocol to collect all applicable attributes.
585
cbd9f942 586This will construct and instance using a HASH ref as storage
552e3d24 587(currently only HASH references are supported). This will collect all
a2e85e6c 588the applicable attributes and layout out the fields in the HASH ref,
589it will then initialize them using either use the corresponding key
590in C<%params> or any default value or initializer found in the
591attribute meta-object.
727919c5 592
5f3c057a 593=item B<clone_object ($instance, %params)>
594
595This is a convience method for cloning an object instance, then
596blessing it into the appropriate package. Ideally your class
597would call a C<clone> this method like so:
598
599 sub MyClass::clone {
600 my ($self, %param) = @_;
601 $self->meta->clone_object($self, %params);
602 }
603
604Of course the ideal place for this would actually be in C<UNIVERSAL::>
605but that is considered bad style, so we do not do that.
606
c9e77dbb 607=item B<clone_instance($instance, %params)>
608
609This method is a compliment of C<construct_instance> (which means if
610you override C<construct_instance>, you need to override this one too).
611
612This method will clone the C<$instance> structure created by the
613C<construct_instance> method, and apply any C<%params> passed to it
614to change the attribute values. The structure returned is (like with
615C<construct_instance>) an unC<bless>ed HASH reference, it is your
616responsibility to then bless this cloned structure into the right
617class.
618
552e3d24 619=back
620
621=head2 Informational
622
623=over 4
624
625=item B<name>
626
a2e85e6c 627This is a read-only attribute which returns the package name for the
628given B<Class::MOP::Class> instance.
552e3d24 629
630=item B<version>
631
632This is a read-only attribute which returns the C<$VERSION> of the
a2e85e6c 633package for the given B<Class::MOP::Class> instance.
552e3d24 634
635=back
636
637=head2 Inheritance Relationships
638
639=over 4
640
641=item B<superclasses (?@superclasses)>
642
643This is a read-write attribute which represents the superclass
a2e85e6c 644relationships of the class the B<Class::MOP::Class> instance is
645associated with. Basically, it can get and set the C<@ISA> for you.
552e3d24 646
343203ee 647B<NOTE:>
648Perl will occasionally perform some C<@ISA> and method caching, if
649you decide to change your superclass relationship at runtime (which
650is quite insane and very much not recommened), then you should be
651aware of this and the fact that this module does not make any
652attempt to address this issue.
653
552e3d24 654=item B<class_precedence_list>
655
a2e85e6c 656This computes the a list of all the class's ancestors in the same order
657in which method dispatch will be done. This is similair to
658what B<Class::ISA::super_path> does, but we don't remove duplicate names.
552e3d24 659
660=back
661
662=head2 Methods
663
664=over 4
665
2e41896e 666=item B<method_metaclass>
667
552e3d24 668=item B<add_method ($method_name, $method)>
669
670This will take a C<$method_name> and CODE reference to that
a2e85e6c 671C<$method> and install it into the class's package.
552e3d24 672
a2e85e6c 673B<NOTE>:
674This does absolutely nothing special to C<$method>
552e3d24 675other than use B<Sub::Name> to make sure it is tagged with the
676correct name, and therefore show up correctly in stack traces and
677such.
678
679=item B<has_method ($method_name)>
680
a2e85e6c 681This just provides a simple way to check if the class implements
552e3d24 682a specific C<$method_name>. It will I<not> however, attempt to check
a2e85e6c 683if the class inherits the method (use C<UNIVERSAL::can> for that).
552e3d24 684
685This will correctly handle functions defined outside of the package
686that use a fully qualified name (C<sub Package::name { ... }>).
687
688This will correctly handle functions renamed with B<Sub::Name> and
689installed using the symbol tables. However, if you are naming the
690subroutine outside of the package scope, you must use the fully
691qualified name, including the package name, for C<has_method> to
692correctly identify it.
693
694This will attempt to correctly ignore functions imported from other
695packages using B<Exporter>. It breaks down if the function imported
696is an C<__ANON__> sub (such as with C<use constant>), which very well
697may be a valid method being applied to the class.
698
699In short, this method cannot always be trusted to determine if the
700C<$method_name> is actually a method. However, it will DWIM about
a2e85e6c 70190% of the time, so it's a small trade off I think.
552e3d24 702
703=item B<get_method ($method_name)>
704
705This will return a CODE reference of the specified C<$method_name>,
706or return undef if that method does not exist.
707
708=item B<remove_method ($method_name)>
709
a2e85e6c 710This will attempt to remove a given C<$method_name> from the class.
552e3d24 711It will return the CODE reference that it has removed, and will
712attempt to use B<Sub::Name> to clear the methods associated name.
713
714=item B<get_method_list>
715
716This will return a list of method names for all I<locally> defined
717methods. It does B<not> provide a list of all applicable methods,
718including any inherited ones. If you want a list of all applicable
719methods, use the C<compute_all_applicable_methods> method.
720
721=item B<compute_all_applicable_methods>
722
a2e85e6c 723This will return a list of all the methods names this class will
724respond to, taking into account inheritance. The list will be a list of
552e3d24 725HASH references, each one containing the following information; method
726name, the name of the class in which the method lives and a CODE
727reference for the actual method.
728
729=item B<find_all_methods_by_name ($method_name)>
730
731This will traverse the inheritence hierarchy and locate all methods
732with a given C<$method_name>. Similar to
733C<compute_all_applicable_methods> it returns a list of HASH references
734with the following information; method name (which will always be the
735same as C<$method_name>), the name of the class in which the method
736lives and a CODE reference for the actual method.
737
738The list of methods produced is a distinct list, meaning there are no
739duplicates in it. This is especially useful for things like object
740initialization and destruction where you only want the method called
741once, and in the correct order.
742
743=back
744
745=head2 Attributes
746
747It should be noted that since there is no one consistent way to define
748the attributes of a class in Perl 5. These methods can only work with
749the information given, and can not easily discover information on
a2e85e6c 750their own. See L<Class::MOP::Attribute> for more details.
552e3d24 751
752=over 4
753
2e41896e 754=item B<attribute_metaclass>
755
7b31baf4 756=item B<get_attribute_map>
757
552e3d24 758=item B<add_attribute ($attribute_name, $attribute_meta_object)>
759
a2e85e6c 760This stores a C<$attribute_meta_object> in the B<Class::MOP::Class>
761instance associated with the given class, and associates it with
762the C<$attribute_name>. Unlike methods, attributes within the MOP
763are stored as meta-information only. They will be used later to
764construct instances from (see C<construct_instance> above).
552e3d24 765More details about the attribute meta-objects can be found in the
a2e85e6c 766L<Class::MOP::Attribute> or the L<Class::MOP/The Attribute protocol>
767section.
768
769It should be noted that any accessor, reader/writer or predicate
770methods which the C<$attribute_meta_object> has will be installed
771into the class at this time.
552e3d24 772
773=item B<has_attribute ($attribute_name)>
774
a2e85e6c 775Checks to see if this class has an attribute by the name of
552e3d24 776C<$attribute_name> and returns a boolean.
777
778=item B<get_attribute ($attribute_name)>
779
780Returns the attribute meta-object associated with C<$attribute_name>,
781if none is found, it will return undef.
782
783=item B<remove_attribute ($attribute_name)>
784
785This will remove the attribute meta-object stored at
786C<$attribute_name>, then return the removed attribute meta-object.
787
a2e85e6c 788B<NOTE:>
789Removing an attribute will only affect future instances of
552e3d24 790the class, it will not make any attempt to remove the attribute from
791any existing instances of the class.
792
a2e85e6c 793It should be noted that any accessor, reader/writer or predicate
794methods which the attribute meta-object stored at C<$attribute_name>
795has will be removed from the class at this time. This B<will> make
796these attributes somewhat inaccessable in previously created
797instances. But if you are crazy enough to do this at runtime, then
798you are crazy enough to deal with something like this :).
799
552e3d24 800=item B<get_attribute_list>
801
802This returns a list of attribute names which are defined in the local
803class. If you want a list of all applicable attributes for a class,
804use the C<compute_all_applicable_attributes> method.
805
806=item B<compute_all_applicable_attributes>
807
c9e77dbb 808This will traverse the inheritance heirachy and return a list of all
809the applicable attributes for this class. It does not construct a
810HASH reference like C<compute_all_applicable_methods> because all
811that same information is discoverable through the attribute
812meta-object itself.
552e3d24 813
814=back
815
52e8a34c 816=head2 Package Variables
817
818Since Perl's classes are built atop the Perl package system, it is
819fairly common to use package scoped variables for things like static
820class variables. The following methods are convience methods for
821the creation and inspection of package scoped variables.
822
823=over 4
824
825=item B<add_package_variable ($variable_name, ?$initial_value)>
826
827Given a C<$variable_name>, which must contain a leading sigil, this
828method will create that variable within the package which houses the
829class. It also takes an optional C<$initial_value>, which must be a
830reference of the same type as the sigil of the C<$variable_name>
831implies.
832
833=item B<get_package_variable ($variable_name)>
834
835This will return a reference to the package variable in
836C<$variable_name>.
837
838=item B<has_package_variable ($variable_name)>
839
840Returns true (C<1>) if there is a package variable defined for
841C<$variable_name>, and false (C<0>) otherwise.
842
843=item B<remove_package_variable ($variable_name)>
844
845This will attempt to remove the package variable at C<$variable_name>.
846
847=back
848
8b978dd5 849=head1 AUTHOR
850
a2e85e6c 851Stevan Little E<lt>stevan@iinteractive.comE<gt>
8b978dd5 852
853=head1 COPYRIGHT AND LICENSE
854
855Copyright 2006 by Infinity Interactive, Inc.
856
857L<http://www.iinteractive.com>
858
859This library is free software; you can redistribute it and/or modify
860it under the same terms as Perl itself.
861
862=cut