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