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