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