2 package Class::MOP::Class;
8 use Scalar::Util 'blessed', 'reftype';
9 use Sub::Name 'subname';
10 use B 'svref_2object';
12 our $VERSION = '0.11';
16 sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) }
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?
27 # means of accessing all the metaclasses that have
28 # been initialized thus far (for mugwumps obj browser)
29 sub get_all_metaclasses { %METAS }
30 sub get_all_metaclass_instances { values %METAS }
31 sub get_all_metaclass_names { keys %METAS }
35 my $package_name = shift;
36 (defined $package_name && $package_name && !blessed($package_name))
37 || confess "You must pass a package name and it cannot be blessed";
38 $class->construct_class_instance(':package' => $package_name, @_);
41 # NOTE: (meta-circularity)
42 # this is a special form of &construct_instance
43 # (see below), which is used to construct class
44 # meta-object instances for any Class::MOP::*
45 # class. All other classes will use the more
46 # normal &construct_instance.
47 sub construct_class_instance {
50 my $package_name = $options{':package'};
51 (defined $package_name && $package_name)
52 || confess "You must pass a package name";
54 # return the metaclass if we have it cached,
55 # and it is still defined (it has not been
56 # reaped by DESTROY yet, which can happen
57 # annoyingly enough during global destruction)
58 return $METAS{$package_name}
59 if exists $METAS{$package_name} && defined $METAS{$package_name};
60 $class = blessed($class) || $class;
61 # now create the metaclass
63 if ($class =~ /^Class::MOP::/) {
65 '$:package' => $package_name,
67 '$:attribute_metaclass' => $options{':attribute_metaclass'} || 'Class::MOP::Attribute',
68 '$:method_metaclass' => $options{':method_metaclass'} || 'Class::MOP::Method',
73 # it is safe to use meta here because
74 # class will always be a subclass of
75 # Class::MOP::Class, which defines meta
76 $meta = bless $class->meta->construct_instance(%options) => $class
78 # and check the metaclass compatibility
79 $meta->check_metaclass_compatability();
80 $METAS{$package_name} = $meta;
83 sub check_metaclass_compatability {
86 # this is always okay ...
87 return if blessed($self) eq 'Class::MOP::Class';
89 my @class_list = $self->class_precedence_list;
90 shift @class_list; # shift off $self->name
92 foreach my $class_name (@class_list) {
93 my $meta = $METAS{$class_name} || next;
94 ($self->isa(blessed($meta)))
95 || confess $self->name . "->meta => (" . (blessed($self)) . ")" .
96 " is not compatible with the " .
97 $class_name . "->meta => (" . (blessed($meta)) . ")";
103 my ($class, $package_name, $package_version, %options) = @_;
104 (defined $package_name && $package_name)
105 || confess "You must pass a package name";
106 my $code = "package $package_name;";
107 $code .= "\$$package_name\:\:VERSION = '$package_version';"
108 if defined $package_version;
110 confess "creation of $package_name failed : $@" if $@;
111 my $meta = $class->initialize($package_name);
113 $meta->add_method('meta' => sub {
114 Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
117 $meta->superclasses(@{$options{superclasses}})
118 if exists $options{superclasses};
120 # process attributes first, so that they can
121 # install accessors, but locally defined methods
122 # can then overwrite them. It is maybe a little odd, but
123 # I think this should be the order of things.
124 if (exists $options{attributes}) {
125 foreach my $attr (@{$options{attributes}}) {
126 $meta->add_attribute($attr);
129 if (exists $options{methods}) {
130 foreach my $method_name (keys %{$options{methods}}) {
131 $meta->add_method($method_name, $options{methods}->{$method_name});
137 sub create_anon_class {
138 my ($class, %options) = @_;
140 my $package_name = 'Class::MOP::Class::__ANON__::' . Digest::MD5::md5_hex({} . time() . $$ . rand());
141 return $class->create($package_name, '0.00', %options);
147 # all these attribute readers will be bootstrapped
148 # away in the Class::MOP bootstrap section
150 sub name { $_[0]->{'$:package'} }
151 sub get_attribute_map { $_[0]->{'%:attributes'} }
152 sub attribute_metaclass { $_[0]->{'$:attribute_metaclass'} }
153 sub method_metaclass { $_[0]->{'$:method_metaclass'} }
155 # Instance Construction & Cloning
160 # we need to protect the integrity of the
161 # Class::MOP::Class singletons here, so we
162 # delegate this to &construct_class_instance
163 # which will deal with the singletons
164 return $class->construct_class_instance(@_)
165 if $class->name->isa('Class::MOP::Class');
166 bless $class->construct_instance(@_) => $class->name;
169 sub construct_instance {
170 my ($class, %params) = @_;
172 foreach my $attr ($class->compute_all_applicable_attributes()) {
173 my $init_arg = $attr->init_arg();
174 # try to fetch the init arg from the %params ...
176 $val = $params{$init_arg} if exists $params{$init_arg};
177 # if nothing was in the %params, we can use the
178 # attribute's default value (if it has one)
179 if (!defined $val && $attr->has_default) {
180 $val = $attr->default($instance);
182 $instance->{$attr->name} = $val;
189 my $instance = shift;
190 (blessed($instance) && $instance->isa($class->name))
191 || confess "You must pass an instance ($instance) of the metaclass (" . $class->name . ")";
193 # we need to protect the integrity of the
194 # Class::MOP::Class singletons here, they
195 # should not be cloned.
196 return $instance if $instance->isa('Class::MOP::Class');
197 bless $class->clone_instance($instance, @_) => blessed($instance);
201 my ($class, $instance, %params) = @_;
203 || confess "You can only clone instances, \$self is not a blessed instance";
204 my $clone = { %$instance, %params };
210 # &name should be here too, but it is above
211 # because it gets bootstrapped away
215 ${$self->get_package_variable('$VERSION')};
224 @{$self->get_package_variable('@ISA')} = @supers;
226 @{$self->get_package_variable('@ISA')};
229 sub class_precedence_list {
232 # We need to check for ciruclar inheirtance here.
233 # This will do nothing if all is well, and blow
234 # up otherwise. Yes, it's an ugly hack, better
235 # suggestions are welcome.
236 { $self->name->isa('This is a test for circular inheritance') }
237 # ... and now back to our regularly scheduled program
241 $self->initialize($_)->class_precedence_list()
242 } $self->superclasses()
249 my ($self, $method_name, $method) = @_;
250 (defined $method_name && $method_name)
251 || confess "You must define a method name";
252 # use reftype here to allow for blessed subs ...
253 ('CODE' eq (reftype($method) || ''))
254 || confess "Your code block must be a CODE reference";
255 my $full_method_name = ($self->name . '::' . $method_name);
257 $method = $self->method_metaclass->wrap($method) unless blessed($method);
260 no warnings 'redefine';
261 *{$full_method_name} = subname $full_method_name => $method;
265 my $fetch_and_prepare_method = sub {
266 my ($self, $method_name) = @_;
268 my $method = $self->get_method($method_name);
269 # if we dont have local ...
271 # make sure this method even exists ...
272 ($self->find_next_method_by_name($method_name))
273 || confess "The method '$method_name' is not found in the inherience hierarchy for this class";
274 # if so, then create a local which just
275 # calls the next applicable method ...
276 $self->add_method($method_name => sub {
277 $self->find_next_method_by_name($method_name)->(@_);
279 $method = $self->get_method($method_name);
282 # now make sure we wrap it properly
283 # (if it isnt already)
284 unless ($method->isa('Class::MOP::Method::Wrapped')) {
285 $method = Class::MOP::Method::Wrapped->wrap($method);
286 $self->add_method($method_name => $method);
291 sub add_before_method_modifier {
292 my ($self, $method_name, $method_modifier) = @_;
293 (defined $method_name && $method_name)
294 || confess "You must pass in a method name";
295 my $method = $fetch_and_prepare_method->($self, $method_name);
296 $method->add_before_modifier(subname ':before' => $method_modifier);
299 sub add_after_method_modifier {
300 my ($self, $method_name, $method_modifier) = @_;
301 (defined $method_name && $method_name)
302 || confess "You must pass in a method name";
303 my $method = $fetch_and_prepare_method->($self, $method_name);
304 $method->add_after_modifier(subname ':after' => $method_modifier);
307 sub add_around_method_modifier {
308 my ($self, $method_name, $method_modifier) = @_;
309 (defined $method_name && $method_name)
310 || confess "You must pass in a method name";
311 my $method = $fetch_and_prepare_method->($self, $method_name);
312 $method->add_around_modifier(subname ':around' => $method_modifier);
316 # the methods above used to be named like this:
317 # ${pkg}::${method}:(before|after|around)
318 # but this proved problematic when using one modifier
319 # to wrap multiple methods (something which is likely
320 # to happen pretty regularly IMO). So instead of naming
321 # it like this, I have chosen to just name them purely
322 # with their modifier names, like so:
323 # :(before|after|around)
324 # The fact is that in a stack trace, it will be fairly
325 # evident from the context what method they are attached
326 # to, and so don't need the fully qualified name.
330 my ($self, $method_name, $method) = @_;
331 (defined $method_name && $method_name)
332 || confess "You must define a method name";
333 # use reftype here to allow for blessed subs ...
334 ('CODE' eq (reftype($method) || ''))
335 || confess "Your code block must be a CODE reference";
336 my $full_method_name = ($self->name . '::' . $method_name);
338 $method = $self->method_metaclass->wrap($method) unless blessed($method);
341 no warnings 'redefine';
342 *{$full_method_name} = $method;
346 my ($self, $method_name) = @_;
347 (defined $method_name && $method_name)
348 || confess "You must define a method name";
350 my $sub_name = ($self->name . '::' . $method_name);
353 return 0 if !defined(&{$sub_name});
354 my $method = \&{$sub_name};
355 return 0 if (svref_2object($method)->GV->STASH->NAME || '') ne $self->name &&
356 (svref_2object($method)->GV->NAME || '') ne '__ANON__';
358 # at this point we are relatively sure
359 # it is our method, so we bless/wrap it
360 $self->method_metaclass->wrap($method) unless blessed($method);
365 my ($self, $method_name) = @_;
366 (defined $method_name && $method_name)
367 || confess "You must define a method name";
369 return unless $self->has_method($method_name);
372 return \&{$self->name . '::' . $method_name};
376 my ($self, $method_name) = @_;
377 (defined $method_name && $method_name)
378 || confess "You must define a method name";
380 my $removed_method = $self->get_method($method_name);
383 delete ${$self->name . '::'}{$method_name}
384 if defined $removed_method;
386 return $removed_method;
389 sub get_method_list {
392 grep { $self->has_method($_) } %{$self->name . '::'};
395 sub compute_all_applicable_methods {
398 # keep a record of what we have seen
399 # here, this will handle all the
400 # inheritence issues because we are
401 # using the &class_precedence_list
402 my (%seen_class, %seen_method);
403 foreach my $class ($self->class_precedence_list()) {
404 next if $seen_class{$class};
405 $seen_class{$class}++;
406 # fetch the meta-class ...
407 my $meta = $self->initialize($class);
408 foreach my $method_name ($meta->get_method_list()) {
409 next if exists $seen_method{$method_name};
410 $seen_method{$method_name}++;
412 name => $method_name,
414 code => $meta->get_method($method_name)
421 sub find_all_methods_by_name {
422 my ($self, $method_name) = @_;
423 (defined $method_name && $method_name)
424 || confess "You must define a method name to find";
426 # keep a record of what we have seen
427 # here, this will handle all the
428 # inheritence issues because we are
429 # using the &class_precedence_list
431 foreach my $class ($self->class_precedence_list()) {
432 next if $seen_class{$class};
433 $seen_class{$class}++;
434 # fetch the meta-class ...
435 my $meta = $self->initialize($class);
437 name => $method_name,
439 code => $meta->get_method($method_name)
440 } if $meta->has_method($method_name);
445 sub find_next_method_by_name {
446 my ($self, $method_name) = @_;
447 (defined $method_name && $method_name)
448 || confess "You must define a method name to find";
449 # keep a record of what we have seen
450 # here, this will handle all the
451 # inheritence issues because we are
452 # using the &class_precedence_list
454 my @cpl = $self->class_precedence_list();
455 shift @cpl; # discard ourselves
456 foreach my $class (@cpl) {
457 next if $seen_class{$class};
458 $seen_class{$class}++;
459 # fetch the meta-class ...
460 my $meta = $self->initialize($class);
461 return $meta->get_method($method_name)
462 if $meta->has_method($method_name);
471 # either we have an attribute object already
472 # or we need to create one from the args provided
473 my $attribute = blessed($_[0]) ? $_[0] : $self->attribute_metaclass->new(@_);
474 # make sure it is derived from the correct type though
475 ($attribute->isa('Class::MOP::Attribute'))
476 || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";
477 $attribute->attach_to_class($self);
478 $attribute->install_accessors();
479 $self->get_attribute_map->{$attribute->name} = $attribute;
483 my ($self, $attribute_name) = @_;
484 (defined $attribute_name && $attribute_name)
485 || confess "You must define an attribute name";
486 exists $self->get_attribute_map->{$attribute_name} ? 1 : 0;
490 my ($self, $attribute_name) = @_;
491 (defined $attribute_name && $attribute_name)
492 || confess "You must define an attribute name";
493 return $self->get_attribute_map->{$attribute_name}
494 if $self->has_attribute($attribute_name);
498 sub remove_attribute {
499 my ($self, $attribute_name) = @_;
500 (defined $attribute_name && $attribute_name)
501 || confess "You must define an attribute name";
502 my $removed_attribute = $self->get_attribute_map->{$attribute_name};
503 return unless defined $removed_attribute;
504 delete $self->get_attribute_map->{$attribute_name};
505 $removed_attribute->remove_accessors();
506 $removed_attribute->detach_from_class();
507 return $removed_attribute;
510 sub get_attribute_list {
512 keys %{$self->get_attribute_map};
515 sub compute_all_applicable_attributes {
518 # keep a record of what we have seen
519 # here, this will handle all the
520 # inheritence issues because we are
521 # using the &class_precedence_list
522 my (%seen_class, %seen_attr);
523 foreach my $class ($self->class_precedence_list()) {
524 next if $seen_class{$class};
525 $seen_class{$class}++;
526 # fetch the meta-class ...
527 my $meta = $self->initialize($class);
528 foreach my $attr_name ($meta->get_attribute_list()) {
529 next if exists $seen_attr{$attr_name};
530 $seen_attr{$attr_name}++;
531 push @attrs => $meta->get_attribute($attr_name);
539 sub add_package_variable {
540 my ($self, $variable, $initial_value) = @_;
541 (defined $variable && $variable =~ /^[\$\@\%]/)
542 || confess "variable name does not have a sigil";
544 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
545 if (defined $initial_value) {
547 *{$self->name . '::' . $name} = $initial_value;
553 # We HAVE to localize $@ or all
554 # hell breaks loose. It is not
555 # good, believe me, not good.
557 eval $sigil . $self->name . '::' . $name;
560 confess "Could not create package variable ($variable) because : $e" if $e;
564 sub has_package_variable {
565 my ($self, $variable) = @_;
566 (defined $variable && $variable =~ /^[\$\@\%]/)
567 || confess "variable name does not have a sigil";
568 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
570 defined ${$self->name . '::'}{$name} ? 1 : 0;
573 sub get_package_variable {
574 my ($self, $variable) = @_;
575 (defined $variable && $variable =~ /^[\$\@\%]/)
576 || confess "variable name does not have a sigil";
577 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
581 # We HAVE to localize $@ or all
582 # hell breaks loose. It is not
583 # good, believe me, not good.
585 $ref = eval '\\' . $sigil . $self->name . '::' . $name;
588 confess "Could not get the package variable ($variable) because : $e" if $e;
589 # if we didn't die, then we can return it
593 sub remove_package_variable {
594 my ($self, $variable) = @_;
595 (defined $variable && $variable =~ /^[\$\@\%]/)
596 || confess "variable name does not have a sigil";
597 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
599 delete ${$self->name . '::'}{$name};
610 Class::MOP::Class - Class Meta Object
614 # assuming that class Foo
615 # has been defined, you can
617 # use this for introspection ...
619 # add a method to Foo ...
620 Foo->meta->add_method('bar' => sub { ... })
622 # get a list of all the classes searched
623 # the method dispatcher in the correct order
624 Foo->meta->class_precedence_list()
626 # remove a method from Foo
627 Foo->meta->remove_method('bar');
629 # or use this to actually create classes ...
631 Class::MOP::Class->create('Bar' => '0.01' => (
632 superclasses => [ 'Foo' ],
634 Class::MOP:::Attribute->new('$bar'),
635 Class::MOP:::Attribute->new('$baz'),
638 calculate_bar => sub { ... },
639 construct_baz => sub { ... }
645 This is the largest and currently most complex part of the Perl 5
646 meta-object protocol. It controls the introspection and
647 manipulation of Perl 5 classes (and it can create them too). The
648 best way to understand what this module can do, is to read the
649 documentation for each of it's methods.
653 =head2 Self Introspection
659 This will return a B<Class::MOP::Class> instance which is related
660 to this class. Thereby allowing B<Class::MOP::Class> to actually
663 As with B<Class::MOP::Attribute>, B<Class::MOP> will actually
664 bootstrap this module by installing a number of attribute meta-objects
665 into it's metaclass. This will allow this class to reap all the benifits
666 of the MOP when subclassing it.
668 =item B<get_all_metaclasses>
670 This will return an hash of all the metaclass instances that have
671 been cached by B<Class::MOP::Class> keyed by the package name.
673 =item B<get_all_metaclass_instances>
675 This will return an array of all the metaclass instances that have
676 been cached by B<Class::MOP::Class>.
678 =item B<get_all_metaclass_names>
680 This will return an array of all the metaclass names that have
681 been cached by B<Class::MOP::Class>.
685 =head2 Class construction
687 These methods will handle creating B<Class::MOP::Class> objects,
688 which can be used to both create new classes, and analyze
689 pre-existing classes.
691 This module will internally store references to all the instances
692 you create with these methods, so that they do not need to be
693 created any more than nessecary. Basically, they are singletons.
697 =item B<create ($package_name, ?$package_version,
698 superclasses =E<gt> ?@superclasses,
699 methods =E<gt> ?%methods,
700 attributes =E<gt> ?%attributes)>
702 This returns a B<Class::MOP::Class> object, bringing the specified
703 C<$package_name> into existence and adding any of the
704 C<$package_version>, C<@superclasses>, C<%methods> and C<%attributes>
707 =item B<create_anon_class (superclasses =E<gt> ?@superclasses,
708 methods =E<gt> ?%methods,
709 attributes =E<gt> ?%attributes)>
711 This will create an anonymous class, it works much like C<create> but
712 it does not need a C<$package_name>. Instead it will create a suitably
713 unique package name for you to stash things into.
715 =item B<initialize ($package_name)>
717 This initializes and returns returns a B<Class::MOP::Class> object
718 for a given a C<$package_name>.
720 =item B<construct_class_instance (%options)>
722 This will construct an instance of B<Class::MOP::Class>, it is
723 here so that we can actually "tie the knot" for B<Class::MOP::Class>
724 to use C<construct_instance> once all the bootstrapping is done. This
725 method is used internally by C<initialize> and should never be called
726 from outside of that method really.
728 =item B<check_metaclass_compatability>
730 This method is called as the very last thing in the
731 C<construct_class_instance> method. This will check that the
732 metaclass you are creating is compatible with the metaclasses of all
733 your ancestors. For more inforamtion about metaclass compatibility
734 see the C<About Metaclass compatibility> section in L<Class::MOP>.
738 =head2 Object instance construction and cloning
740 These methods are B<entirely optional>, it is up to you whether you want
745 =item B<new_object (%params)>
747 This is a convience method for creating a new object of the class, and
748 blessing it into the appropriate package as well. Ideally your class
749 would call a C<new> this method like so:
752 my ($class, %param) = @_;
753 $class->meta->new_object(%params);
756 Of course the ideal place for this would actually be in C<UNIVERSAL::>
757 but that is considered bad style, so we do not do that.
759 =item B<construct_instance (%params)>
761 This method is used to construct an instace structure suitable for
762 C<bless>-ing into your package of choice. It works in conjunction
763 with the Attribute protocol to collect all applicable attributes.
765 This will construct and instance using a HASH ref as storage
766 (currently only HASH references are supported). This will collect all
767 the applicable attributes and layout out the fields in the HASH ref,
768 it will then initialize them using either use the corresponding key
769 in C<%params> or any default value or initializer found in the
770 attribute meta-object.
772 =item B<clone_object ($instance, %params)>
774 This is a convience method for cloning an object instance, then
775 blessing it into the appropriate package. This method will call
776 C<clone_instance>, which performs a shallow copy of the object,
777 see that methods documentation for more details. Ideally your
778 class would call a C<clone> this method like so:
781 my ($self, %param) = @_;
782 $self->meta->clone_object($self, %params);
785 Of course the ideal place for this would actually be in C<UNIVERSAL::>
786 but that is considered bad style, so we do not do that.
788 =item B<clone_instance($instance, %params)>
790 This method is a compliment of C<construct_instance> (which means if
791 you override C<construct_instance>, you need to override this one too),
792 and clones the instance shallowly.
794 The cloned structure returned is (like with C<construct_instance>) an
795 unC<bless>ed HASH reference, it is your responsibility to then bless
796 this cloned structure into the right class (which C<clone_object> will
799 As of 0.11, this method will clone the C<$instance> structure shallowly,
800 as opposed to the deep cloning implemented in prior versions. After much
801 thought, research and discussion, I have decided that anything but basic
802 shallow cloning is outside the scope of the meta-object protocol. I
803 think Yuval "nothingmuch" Kogman put it best when he said that cloning
804 is too I<context-specific> to be part of the MOP.
814 This is a read-only attribute which returns the package name for the
815 given B<Class::MOP::Class> instance.
819 This is a read-only attribute which returns the C<$VERSION> of the
820 package for the given B<Class::MOP::Class> instance.
824 =head2 Inheritance Relationships
828 =item B<superclasses (?@superclasses)>
830 This is a read-write attribute which represents the superclass
831 relationships of the class the B<Class::MOP::Class> instance is
832 associated with. Basically, it can get and set the C<@ISA> for you.
835 Perl will occasionally perform some C<@ISA> and method caching, if
836 you decide to change your superclass relationship at runtime (which
837 is quite insane and very much not recommened), then you should be
838 aware of this and the fact that this module does not make any
839 attempt to address this issue.
841 =item B<class_precedence_list>
843 This computes the a list of all the class's ancestors in the same order
844 in which method dispatch will be done. This is similair to
845 what B<Class::ISA::super_path> does, but we don't remove duplicate names.
853 =item B<method_metaclass>
855 =item B<add_method ($method_name, $method)>
857 This will take a C<$method_name> and CODE reference to that
858 C<$method> and install it into the class's package.
861 This does absolutely nothing special to C<$method>
862 other than use B<Sub::Name> to make sure it is tagged with the
863 correct name, and therefore show up correctly in stack traces and
866 =item B<alias_method ($method_name, $method)>
868 This will take a C<$method_name> and CODE reference to that
869 C<$method> and alias the method into the class's package.
872 Unlike C<add_method>, this will B<not> try to name the
873 C<$method> using B<Sub::Name>, it only aliases the method in
876 =item B<has_method ($method_name)>
878 This just provides a simple way to check if the class implements
879 a specific C<$method_name>. It will I<not> however, attempt to check
880 if the class inherits the method (use C<UNIVERSAL::can> for that).
882 This will correctly handle functions defined outside of the package
883 that use a fully qualified name (C<sub Package::name { ... }>).
885 This will correctly handle functions renamed with B<Sub::Name> and
886 installed using the symbol tables. However, if you are naming the
887 subroutine outside of the package scope, you must use the fully
888 qualified name, including the package name, for C<has_method> to
889 correctly identify it.
891 This will attempt to correctly ignore functions imported from other
892 packages using B<Exporter>. It breaks down if the function imported
893 is an C<__ANON__> sub (such as with C<use constant>), which very well
894 may be a valid method being applied to the class.
896 In short, this method cannot always be trusted to determine if the
897 C<$method_name> is actually a method. However, it will DWIM about
898 90% of the time, so it's a small trade off I think.
900 =item B<get_method ($method_name)>
902 This will return a CODE reference of the specified C<$method_name>,
903 or return undef if that method does not exist.
905 =item B<remove_method ($method_name)>
907 This will attempt to remove a given C<$method_name> from the class.
908 It will return the CODE reference that it has removed, and will
909 attempt to use B<Sub::Name> to clear the methods associated name.
911 =item B<get_method_list>
913 This will return a list of method names for all I<locally> defined
914 methods. It does B<not> provide a list of all applicable methods,
915 including any inherited ones. If you want a list of all applicable
916 methods, use the C<compute_all_applicable_methods> method.
918 =item B<compute_all_applicable_methods>
920 This will return a list of all the methods names this class will
921 respond to, taking into account inheritance. The list will be a list of
922 HASH references, each one containing the following information; method
923 name, the name of the class in which the method lives and a CODE
924 reference for the actual method.
926 =item B<find_all_methods_by_name ($method_name)>
928 This will traverse the inheritence hierarchy and locate all methods
929 with a given C<$method_name>. Similar to
930 C<compute_all_applicable_methods> it returns a list of HASH references
931 with the following information; method name (which will always be the
932 same as C<$method_name>), the name of the class in which the method
933 lives and a CODE reference for the actual method.
935 The list of methods produced is a distinct list, meaning there are no
936 duplicates in it. This is especially useful for things like object
937 initialization and destruction where you only want the method called
938 once, and in the correct order.
940 =item B<find_next_method_by_name ($method_name)>
942 This will return the first method to match a given C<$method_name> in
943 the superclasses, this is basically equivalent to calling
944 C<SUPER::$method_name>, but it can be dispatched at runtime.
948 =head2 Method Modifiers
950 Method modifiers are a concept borrowed from CLOS, in which a method
951 can be wrapped with I<before>, I<after> and I<around> method modifiers
952 that will be called everytime the method is called.
954 =head3 How method modifiers work?
956 Method modifiers work by wrapping the original method and then replacing
957 it in the classes symbol table. The wrappers will handle calling all the
958 modifiers in the appropariate orders and preserving the calling context
959 for the original method.
961 Each method modifier serves a particular purpose, which may not be
962 obvious to users of other method wrapping modules. To start with, the
963 return values of I<before> and I<after> modifiers are ignored. This is
964 because thier purpose is B<not> to filter the input and output of the
965 primary method (this is done with an I<around> modifier). This may seem
966 like an odd restriction to some, but doing this allows for simple code
967 to be added at the begining or end of a method call without jeapordizing
968 the normal functioning of the primary method or placing any extra
969 responsibility on the code of the modifier. Of course if you have more
970 complex needs, then use the I<around> modifier, which uses a variation
971 of continutation passing style to allow for a high degree of flexibility.
973 Before and around modifiers are called in last-defined-first-called order,
974 while after modifiers are called in first-defined-first-called order. So
975 the call tree might looks something like this:
985 To see examples of using method modifiers, see the following examples
986 included in the distribution; F<InstanceCountingClass>, F<Perl6Attribute>,
987 F<AttributesWithHistory> and F<C3MethodDispatchOrder>. There is also a
988 classic CLOS usage example in the test F<017_add_method_modifier.t>.
990 =head3 What is the performance impact?
992 Of course there is a performance cost associated with method modifiers,
993 but we have made every effort to make that cost be directly proportional
994 to the amount of modifier features you utilize.
996 The wrapping method does it's best to B<only> do as much work as it
997 absolutely needs to. In order to do this we have moved some of the
998 performance costs to set-up time, where they are easier to amortize.
1000 All this said, my benchmarks have indicated the following:
1002 simple wrapper with no modifiers 100% slower
1003 simple wrapper with simple before modifier 400% slower
1004 simple wrapper with simple after modifier 450% slower
1005 simple wrapper with simple around modifier 500-550% slower
1006 simple wrapper with all 3 modifiers 1100% slower
1008 These numbers may seem daunting, but you must remember, every feature
1009 comes with some cost. To put things in perspective, just doing a simple
1010 C<AUTOLOAD> which does nothing but extract the name of the method called
1011 and return it costs about 400% over a normal method call.
1015 =item B<add_before_method_modifier ($method_name, $code)>
1017 This will wrap the method at C<$method_name> and the supplied C<$code>
1018 will be passed the C<@_> arguments, and called before the original
1019 method is called. As specified above, the return value of the I<before>
1020 method modifiers is ignored, and it's ability to modify C<@_> is
1021 fairly limited. If you need to do either of these things, use an
1022 C<around> method modifier.
1024 =item B<add_after_method_modifier ($method_name, $code)>
1026 This will wrap the method at C<$method_name> so that the original
1027 method will be called, it's return values stashed, and then the
1028 supplied C<$code> will be passed the C<@_> arguments, and called.
1029 As specified above, the return value of the I<after> method
1030 modifiers is ignored, and it cannot modify the return values of
1031 the original method. If you need to do either of these things, use an
1032 C<around> method modifier.
1034 =item B<add_around_method_modifier ($method_name, $code)>
1036 This will wrap the method at C<$method_name> so that C<$code>
1037 will be called and passed the original method as an extra argument
1038 at the begining of the C<@_> argument list. This is a variation of
1039 continuation passing style, where the function prepended to C<@_>
1040 can be considered a continuation. It is up to C<$code> if it calls
1041 the original method or not, there is no restriction on what the
1042 C<$code> can or cannot do.
1048 It should be noted that since there is no one consistent way to define
1049 the attributes of a class in Perl 5. These methods can only work with
1050 the information given, and can not easily discover information on
1051 their own. See L<Class::MOP::Attribute> for more details.
1055 =item B<attribute_metaclass>
1057 =item B<get_attribute_map>
1059 =item B<add_attribute ($attribute_name, $attribute_meta_object)>
1061 This stores a C<$attribute_meta_object> in the B<Class::MOP::Class>
1062 instance associated with the given class, and associates it with
1063 the C<$attribute_name>. Unlike methods, attributes within the MOP
1064 are stored as meta-information only. They will be used later to
1065 construct instances from (see C<construct_instance> above).
1066 More details about the attribute meta-objects can be found in the
1067 L<Class::MOP::Attribute> or the L<Class::MOP/The Attribute protocol>
1070 It should be noted that any accessor, reader/writer or predicate
1071 methods which the C<$attribute_meta_object> has will be installed
1072 into the class at this time.
1074 =item B<has_attribute ($attribute_name)>
1076 Checks to see if this class has an attribute by the name of
1077 C<$attribute_name> and returns a boolean.
1079 =item B<get_attribute ($attribute_name)>
1081 Returns the attribute meta-object associated with C<$attribute_name>,
1082 if none is found, it will return undef.
1084 =item B<remove_attribute ($attribute_name)>
1086 This will remove the attribute meta-object stored at
1087 C<$attribute_name>, then return the removed attribute meta-object.
1090 Removing an attribute will only affect future instances of
1091 the class, it will not make any attempt to remove the attribute from
1092 any existing instances of the class.
1094 It should be noted that any accessor, reader/writer or predicate
1095 methods which the attribute meta-object stored at C<$attribute_name>
1096 has will be removed from the class at this time. This B<will> make
1097 these attributes somewhat inaccessable in previously created
1098 instances. But if you are crazy enough to do this at runtime, then
1099 you are crazy enough to deal with something like this :).
1101 =item B<get_attribute_list>
1103 This returns a list of attribute names which are defined in the local
1104 class. If you want a list of all applicable attributes for a class,
1105 use the C<compute_all_applicable_attributes> method.
1107 =item B<compute_all_applicable_attributes>
1109 This will traverse the inheritance heirachy and return a list of all
1110 the applicable attributes for this class. It does not construct a
1111 HASH reference like C<compute_all_applicable_methods> because all
1112 that same information is discoverable through the attribute
1117 =head2 Package Variables
1119 Since Perl's classes are built atop the Perl package system, it is
1120 fairly common to use package scoped variables for things like static
1121 class variables. The following methods are convience methods for
1122 the creation and inspection of package scoped variables.
1126 =item B<add_package_variable ($variable_name, ?$initial_value)>
1128 Given a C<$variable_name>, which must contain a leading sigil, this
1129 method will create that variable within the package which houses the
1130 class. It also takes an optional C<$initial_value>, which must be a
1131 reference of the same type as the sigil of the C<$variable_name>
1134 =item B<get_package_variable ($variable_name)>
1136 This will return a reference to the package variable in
1139 =item B<has_package_variable ($variable_name)>
1141 Returns true (C<1>) if there is a package variable defined for
1142 C<$variable_name>, and false (C<0>) otherwise.
1144 =item B<remove_package_variable ($variable_name)>
1146 This will attempt to remove the package variable at C<$variable_name>.
1152 Stevan Little E<lt>stevan@iinteractive.comE<gt>
1154 =head1 COPYRIGHT AND LICENSE
1156 Copyright 2006 by Infinity Interactive, Inc.
1158 L<http://www.iinteractive.com>
1160 This library is free software; you can redistribute it and/or modify
1161 it under the same terms as Perl itself.