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.08';
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?
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, @_);
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 {
44 my $package_name = $options{':package'};
45 (defined $package_name && $package_name)
46 || confess "You must pass a package name";
48 # return the metaclass if we have it cached,
49 # and it is still defined (it has not been
50 # reaped by DESTROY yet, which can happen
51 # annoyingly enough during global destruction)
52 return $METAS{$package_name}
53 if exists $METAS{$package_name} && defined $METAS{$package_name};
54 $class = blessed($class) || $class;
55 # now create the metaclass
57 if ($class =~ /^Class::MOP::/) {
59 '$:package' => $package_name,
61 '$:attribute_metaclass' => $options{':attribute_metaclass'} || 'Class::MOP::Attribute',
62 '$:method_metaclass' => $options{':method_metaclass'} || 'Class::MOP::Method',
67 # it is safe to use meta here because
68 # class will always be a subclass of
69 # Class::MOP::Class, which defines meta
70 $meta = bless $class->meta->construct_instance(%options) => $class
72 # and check the metaclass compatibility
73 $meta->check_metaclass_compatability();
74 $METAS{$package_name} = $meta;
77 sub check_metaclass_compatability {
80 # this is always okay ...
81 return if blessed($self) eq 'Class::MOP::Class';
83 my @class_list = $self->class_precedence_list;
84 shift @class_list; # shift off $self->name
86 foreach my $class_name (@class_list) {
87 my $meta = $METAS{$class_name} || next;
88 ($self->isa(blessed($meta)))
89 || confess $self->name . "->meta => (" . (blessed($self)) . ")" .
90 " is not compatible with the " .
91 $class_name . "->meta => (" . (blessed($meta)) . ")";
97 my ($class, $package_name, $package_version, %options) = @_;
98 (defined $package_name && $package_name)
99 || confess "You must pass a package name";
100 my $code = "package $package_name;";
101 $code .= "\$$package_name\:\:VERSION = '$package_version';"
102 if defined $package_version;
104 confess "creation of $package_name failed : $@" if $@;
105 my $meta = $class->initialize($package_name);
107 $meta->add_method('meta' => sub {
108 Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
111 $meta->superclasses(@{$options{superclasses}})
112 if exists $options{superclasses};
114 # process attributes first, so that they can
115 # install accessors, but locally defined methods
116 # can then overwrite them. It is maybe a little odd, but
117 # I think this should be the order of things.
118 if (exists $options{attributes}) {
119 foreach my $attr (@{$options{attributes}}) {
120 $meta->add_attribute($attr);
123 if (exists $options{methods}) {
124 foreach my $method_name (keys %{$options{methods}}) {
125 $meta->add_method($method_name, $options{methods}->{$method_name});
134 # all these attribute readers will be bootstrapped
135 # away in the Class::MOP bootstrap section
137 sub name { $_[0]->{'$:package'} }
138 sub get_attribute_map { $_[0]->{'%:attributes'} }
139 sub attribute_metaclass { $_[0]->{'$:attribute_metaclass'} }
140 sub method_metaclass { $_[0]->{'$:method_metaclass'} }
142 # Instance Construction & Cloning
147 # we need to protect the integrity of the
148 # Class::MOP::Class singletons here, so we
149 # delegate this to &construct_class_instance
150 # which will deal with the singletons
151 return $class->construct_class_instance(@_)
152 if $class->name->isa('Class::MOP::Class');
153 bless $class->construct_instance(@_) => $class->name;
156 sub construct_instance {
157 my ($class, %params) = @_;
159 foreach my $attr ($class->compute_all_applicable_attributes()) {
160 my $init_arg = $attr->init_arg();
161 # try to fetch the init arg from the %params ...
163 $val = $params{$init_arg} if exists $params{$init_arg};
164 # if nothing was in the %params, we can use the
165 # attribute's default value (if it has one)
166 $val ||= $attr->default($instance) if $attr->has_default();
167 $instance->{$attr->name} = $val;
174 my $instance = shift;
175 (blessed($instance) && $instance->isa($class->name))
176 || confess "You must pass an instance ($instance) of the metaclass (" . $class->name . ")";
178 # we need to protect the integrity of the
179 # Class::MOP::Class singletons here, they
180 # should not be cloned.
181 return $instance if $instance->isa('Class::MOP::Class');
182 bless $class->clone_instance($instance, @_) => blessed($instance);
186 my ($class, $instance, %params) = @_;
188 || confess "You can only clone instances, \$self is not a blessed instance";
189 my $clone = { %$instance, %params };
195 # &name should be here too, but it is above
196 # because it gets bootstrapped away
200 ${$self->get_package_variable('$VERSION')};
209 @{$self->get_package_variable('@ISA')} = @supers;
211 @{$self->get_package_variable('@ISA')};
214 sub class_precedence_list {
217 # We need to check for ciruclar inheirtance here.
218 # This will do nothing if all is well, and blow
219 # up otherwise. Yes, it's an ugly hack, better
220 # suggestions are welcome.
221 { $self->name->isa('This is a test for circular inheritance') }
222 # ... and no back to our regularly scheduled program
226 $self->initialize($_)->class_precedence_list()
227 } $self->superclasses()
234 my ($self, $method_name, $method) = @_;
235 (defined $method_name && $method_name)
236 || confess "You must define a method name";
237 # use reftype here to allow for blessed subs ...
238 ('CODE' eq (reftype($method) || ''))
239 || confess "Your code block must be a CODE reference";
240 my $full_method_name = ($self->name . '::' . $method_name);
242 $method = $self->method_metaclass->wrap($method) unless blessed($method);
245 no warnings 'redefine';
246 *{$full_method_name} = subname $full_method_name => $method;
250 my $fetch_and_prepare_method = sub {
251 my ($self, $method_name) = @_;
253 my $method = $self->get_method($method_name);
254 # if we dont have local ...
256 # make sure this method even exists ...
257 ($self->find_next_method_by_name($method_name))
258 || confess "The method '$method_name' is not found in the inherience hierarchy for this class";
259 # if so, then create a local which just
260 # calls the next applicable method ...
261 $self->add_method($method_name => sub {
262 $self->find_next_method_by_name($method_name)->(@_);
264 $method = $self->get_method($method_name);
267 # now make sure we wrap it properly
268 # (if it isnt already)
269 unless ($method->isa('Class::MOP::Method::Wrapped')) {
270 $method = Class::MOP::Method::Wrapped->wrap($method);
271 $self->add_method($method_name => $method);
276 sub add_before_method_modifier {
277 my ($self, $method_name, $method_modifier) = @_;
278 (defined $method_name && $method_name)
279 || confess "You must pass in a method name";
280 my $full_method_modifier_name = ($self->name . '::' . $method_name . ':before');
281 my $method = $fetch_and_prepare_method->($self, $method_name);
282 $method->add_before_modifier(subname $full_method_modifier_name => $method_modifier);
285 sub add_after_method_modifier {
286 my ($self, $method_name, $method_modifier) = @_;
287 (defined $method_name && $method_name)
288 || confess "You must pass in a method name";
289 my $full_method_modifier_name = ($self->name . '::' . $method_name . ':after');
290 my $method = $fetch_and_prepare_method->($self, $method_name);
291 $method->add_after_modifier(subname $full_method_modifier_name => $method_modifier);
294 sub add_around_method_modifier {
295 my ($self, $method_name, $method_modifier) = @_;
296 (defined $method_name && $method_name)
297 || confess "You must pass in a method name";
298 my $full_method_modifier_name = ($self->name . '::' . $method_name . ':around');
299 my $method = $fetch_and_prepare_method->($self, $method_name);
300 $method->add_around_modifier(subname $full_method_modifier_name => $method_modifier);
306 my ($self, $method_name, $method) = @_;
307 (defined $method_name && $method_name)
308 || confess "You must define a method name";
309 # use reftype here to allow for blessed subs ...
310 ('CODE' eq (reftype($method) || ''))
311 || confess "Your code block must be a CODE reference";
312 my $full_method_name = ($self->name . '::' . $method_name);
314 $method = $self->method_metaclass->wrap($method) unless blessed($method);
317 no warnings 'redefine';
318 *{$full_method_name} = $method;
322 my ($self, $method_name) = @_;
323 (defined $method_name && $method_name)
324 || confess "You must define a method name";
326 my $sub_name = ($self->name . '::' . $method_name);
329 return 0 if !defined(&{$sub_name});
330 my $method = \&{$sub_name};
331 return 0 if (svref_2object($method)->GV->STASH->NAME || '') ne $self->name &&
332 (svref_2object($method)->GV->NAME || '') ne '__ANON__';
334 # at this point we are relatively sure
335 # it is our method, so we bless/wrap it
336 $self->method_metaclass->wrap($method) unless blessed($method);
341 my ($self, $method_name) = @_;
342 (defined $method_name && $method_name)
343 || confess "You must define a method name";
345 return unless $self->has_method($method_name);
348 return \&{$self->name . '::' . $method_name};
352 my ($self, $method_name) = @_;
353 (defined $method_name && $method_name)
354 || confess "You must define a method name";
356 my $removed_method = $self->get_method($method_name);
359 delete ${$self->name . '::'}{$method_name}
360 if defined $removed_method;
362 return $removed_method;
365 sub get_method_list {
368 grep { $self->has_method($_) } %{$self->name . '::'};
371 sub compute_all_applicable_methods {
374 # keep a record of what we have seen
375 # here, this will handle all the
376 # inheritence issues because we are
377 # using the &class_precedence_list
378 my (%seen_class, %seen_method);
379 foreach my $class ($self->class_precedence_list()) {
380 next if $seen_class{$class};
381 $seen_class{$class}++;
382 # fetch the meta-class ...
383 my $meta = $self->initialize($class);
384 foreach my $method_name ($meta->get_method_list()) {
385 next if exists $seen_method{$method_name};
386 $seen_method{$method_name}++;
388 name => $method_name,
390 code => $meta->get_method($method_name)
397 sub find_all_methods_by_name {
398 my ($self, $method_name) = @_;
399 (defined $method_name && $method_name)
400 || confess "You must define a method name to find";
402 # keep a record of what we have seen
403 # here, this will handle all the
404 # inheritence issues because we are
405 # using the &class_precedence_list
407 foreach my $class ($self->class_precedence_list()) {
408 next if $seen_class{$class};
409 $seen_class{$class}++;
410 # fetch the meta-class ...
411 my $meta = $self->initialize($class);
413 name => $method_name,
415 code => $meta->get_method($method_name)
416 } if $meta->has_method($method_name);
421 sub find_next_method_by_name {
422 my ($self, $method_name) = @_;
423 (defined $method_name && $method_name)
424 || confess "You must define a method name to find";
425 # keep a record of what we have seen
426 # here, this will handle all the
427 # inheritence issues because we are
428 # using the &class_precedence_list
430 my @cpl = $self->class_precedence_list();
431 shift @cpl; # discard ourselves
432 foreach my $class (@cpl) {
433 next if $seen_class{$class};
434 $seen_class{$class}++;
435 # fetch the meta-class ...
436 my $meta = $self->initialize($class);
437 return $meta->get_method($method_name)
438 if $meta->has_method($method_name);
447 # either we have an attribute object already
448 # or we need to create one from the args provided
449 my $attribute = blessed($_[0]) ? $_[0] : $self->attribute_metaclass->new(@_);
450 # make sure it is derived from the correct type though
451 ($attribute->isa('Class::MOP::Attribute'))
452 || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";
453 $attribute->attach_to_class($self);
454 $attribute->install_accessors();
455 $self->get_attribute_map->{$attribute->name} = $attribute;
459 my ($self, $attribute_name) = @_;
460 (defined $attribute_name && $attribute_name)
461 || confess "You must define an attribute name";
462 exists $self->get_attribute_map->{$attribute_name} ? 1 : 0;
466 my ($self, $attribute_name) = @_;
467 (defined $attribute_name && $attribute_name)
468 || confess "You must define an attribute name";
469 return $self->get_attribute_map->{$attribute_name}
470 if $self->has_attribute($attribute_name);
474 sub remove_attribute {
475 my ($self, $attribute_name) = @_;
476 (defined $attribute_name && $attribute_name)
477 || confess "You must define an attribute name";
478 my $removed_attribute = $self->get_attribute_map->{$attribute_name};
479 return unless defined $removed_attribute;
480 delete $self->get_attribute_map->{$attribute_name};
481 $removed_attribute->remove_accessors();
482 $removed_attribute->detach_from_class();
483 return $removed_attribute;
486 sub get_attribute_list {
488 keys %{$self->get_attribute_map};
491 sub compute_all_applicable_attributes {
494 # keep a record of what we have seen
495 # here, this will handle all the
496 # inheritence issues because we are
497 # using the &class_precedence_list
498 my (%seen_class, %seen_attr);
499 foreach my $class ($self->class_precedence_list()) {
500 next if $seen_class{$class};
501 $seen_class{$class}++;
502 # fetch the meta-class ...
503 my $meta = $self->initialize($class);
504 foreach my $attr_name ($meta->get_attribute_list()) {
505 next if exists $seen_attr{$attr_name};
506 $seen_attr{$attr_name}++;
507 push @attrs => $meta->get_attribute($attr_name);
515 sub add_package_variable {
516 my ($self, $variable, $initial_value) = @_;
517 (defined $variable && $variable =~ /^[\$\@\%]/)
518 || confess "variable name does not have a sigil";
520 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
521 if (defined $initial_value) {
523 *{$self->name . '::' . $name} = $initial_value;
527 # We HAVE to localize $@ or all
528 # hell breaks loose. It is not
529 # good, believe me, not good.
531 eval $sigil . $self->name . '::' . $name;
532 confess "Could not create package variable ($variable) because : $@" if $@;
536 sub has_package_variable {
537 my ($self, $variable) = @_;
538 (defined $variable && $variable =~ /^[\$\@\%]/)
539 || confess "variable name does not have a sigil";
540 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
542 defined ${$self->name . '::'}{$name} ? 1 : 0;
545 sub get_package_variable {
546 my ($self, $variable) = @_;
547 (defined $variable && $variable =~ /^[\$\@\%]/)
548 || confess "variable name does not have a sigil";
549 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
552 # We HAVE to localize $@ or all
553 # hell breaks loose. It is not
554 # good, believe me, not good.
556 my $ref = eval '\\' . $sigil . $self->name . '::' . $name;
557 confess "Could not get the package variable ($variable) because : $@" if $@;
558 # if we didn't die, then we can return it
562 sub remove_package_variable {
563 my ($self, $variable) = @_;
564 (defined $variable && $variable =~ /^[\$\@\%]/)
565 || confess "variable name does not have a sigil";
566 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
568 delete ${$self->name . '::'}{$name};
579 Class::MOP::Class - Class Meta Object
583 # use this for introspection ...
585 # add a method to Foo ...
586 Foo->meta->add_method('bar' => sub { ... })
588 # get a list of all the classes searched
589 # the method dispatcher in the correct order
590 Foo->meta->class_precedence_list()
592 # remove a method from Foo
593 Foo->meta->remove_method('bar');
595 # or use this to actually create classes ...
597 Class::MOP::Class->create('Bar' => '0.01' => (
598 superclasses => [ 'Foo' ],
600 Class::MOP:::Attribute->new('$bar'),
601 Class::MOP:::Attribute->new('$baz'),
604 calculate_bar => sub { ... },
605 construct_baz => sub { ... }
611 This is the largest and currently most complex part of the Perl 5
612 meta-object protocol. It controls the introspection and
613 manipulation of Perl 5 classes (and it can create them too). The
614 best way to understand what this module can do, is to read the
615 documentation for each of it's methods.
619 =head2 Self Introspection
625 This will return a B<Class::MOP::Class> instance which is related
626 to this class. Thereby allowing B<Class::MOP::Class> to actually
629 As with B<Class::MOP::Attribute>, B<Class::MOP> will actually
630 bootstrap this module by installing a number of attribute meta-objects
631 into it's metaclass. This will allow this class to reap all the benifits
632 of the MOP when subclassing it.
636 =head2 Class construction
638 These methods will handle creating B<Class::MOP::Class> objects,
639 which can be used to both create new classes, and analyze
640 pre-existing classes.
642 This module will internally store references to all the instances
643 you create with these methods, so that they do not need to be
644 created any more than nessecary. Basically, they are singletons.
648 =item B<create ($package_name, ?$package_version,
649 superclasses =E<gt> ?@superclasses,
650 methods =E<gt> ?%methods,
651 attributes =E<gt> ?%attributes)>
653 This returns a B<Class::MOP::Class> object, bringing the specified
654 C<$package_name> into existence and adding any of the
655 C<$package_version>, C<@superclasses>, C<%methods> and C<%attributes>
658 =item B<initialize ($package_name)>
660 This initializes and returns returns a B<Class::MOP::Class> object
661 for a given a C<$package_name>.
663 =item B<construct_class_instance (%options)>
665 This will construct an instance of B<Class::MOP::Class>, it is
666 here so that we can actually "tie the knot" for B<Class::MOP::Class>
667 to use C<construct_instance> once all the bootstrapping is done. This
668 method is used internally by C<initialize> and should never be called
669 from outside of that method really.
671 =item B<check_metaclass_compatability>
673 This method is called as the very last thing in the
674 C<construct_class_instance> method. This will check that the
675 metaclass you are creating is compatible with the metaclasses of all
676 your ancestors. For more inforamtion about metaclass compatibility
677 see the C<About Metaclass compatibility> section in L<Class::MOP>.
681 =head2 Object instance construction and cloning
683 These methods are B<entirely optional>, it is up to you whether you want
688 =item B<new_object (%params)>
690 This is a convience method for creating a new object of the class, and
691 blessing it into the appropriate package as well. Ideally your class
692 would call a C<new> this method like so:
695 my ($class, %param) = @_;
696 $class->meta->new_object(%params);
699 Of course the ideal place for this would actually be in C<UNIVERSAL::>
700 but that is considered bad style, so we do not do that.
702 =item B<construct_instance (%params)>
704 This method is used to construct an instace structure suitable for
705 C<bless>-ing into your package of choice. It works in conjunction
706 with the Attribute protocol to collect all applicable attributes.
708 This will construct and instance using a HASH ref as storage
709 (currently only HASH references are supported). This will collect all
710 the applicable attributes and layout out the fields in the HASH ref,
711 it will then initialize them using either use the corresponding key
712 in C<%params> or any default value or initializer found in the
713 attribute meta-object.
715 =item B<clone_object ($instance, %params)>
717 This is a convience method for cloning an object instance, then
718 blessing it into the appropriate package. This method will call
719 C<clone_instance>, which performs a shallow copy of the object,
720 see that methods documentation for more details. Ideally your
721 class would call a C<clone> this method like so:
724 my ($self, %param) = @_;
725 $self->meta->clone_object($self, %params);
728 Of course the ideal place for this would actually be in C<UNIVERSAL::>
729 but that is considered bad style, so we do not do that.
731 =item B<clone_instance($instance, %params)>
733 This method is a compliment of C<construct_instance> (which means if
734 you override C<construct_instance>, you need to override this one too),
735 and clones the instance shallowly.
737 The cloned structure returned is (like with C<construct_instance>) an
738 unC<bless>ed HASH reference, it is your responsibility to then bless
739 this cloned structure into the right class (which C<clone_object> will
742 As of 0.11, this method will clone the C<$instance> structure shallowly,
743 as opposed to the deep cloning implemented in prior versions. After much
744 thought, research and discussion, I have decided that anything but basic
745 shallow cloning is outside the scope of the meta-object protocol. I
746 think Yuval "nothingmuch" Kogman put it best when he said that cloning
747 is too I<context-specific> to be part of the MOP.
757 This is a read-only attribute which returns the package name for the
758 given B<Class::MOP::Class> instance.
762 This is a read-only attribute which returns the C<$VERSION> of the
763 package for the given B<Class::MOP::Class> instance.
767 =head2 Inheritance Relationships
771 =item B<superclasses (?@superclasses)>
773 This is a read-write attribute which represents the superclass
774 relationships of the class the B<Class::MOP::Class> instance is
775 associated with. Basically, it can get and set the C<@ISA> for you.
778 Perl will occasionally perform some C<@ISA> and method caching, if
779 you decide to change your superclass relationship at runtime (which
780 is quite insane and very much not recommened), then you should be
781 aware of this and the fact that this module does not make any
782 attempt to address this issue.
784 =item B<class_precedence_list>
786 This computes the a list of all the class's ancestors in the same order
787 in which method dispatch will be done. This is similair to
788 what B<Class::ISA::super_path> does, but we don't remove duplicate names.
796 =item B<method_metaclass>
798 =item B<add_method ($method_name, $method)>
800 This will take a C<$method_name> and CODE reference to that
801 C<$method> and install it into the class's package.
804 This does absolutely nothing special to C<$method>
805 other than use B<Sub::Name> to make sure it is tagged with the
806 correct name, and therefore show up correctly in stack traces and
809 =item B<alias_method ($method_name, $method)>
811 This will take a C<$method_name> and CODE reference to that
812 C<$method> and alias the method into the class's package.
815 Unlike C<add_method>, this will B<not> try to name the
816 C<$method> using B<Sub::Name>, it only aliases the method in
819 =item B<has_method ($method_name)>
821 This just provides a simple way to check if the class implements
822 a specific C<$method_name>. It will I<not> however, attempt to check
823 if the class inherits the method (use C<UNIVERSAL::can> for that).
825 This will correctly handle functions defined outside of the package
826 that use a fully qualified name (C<sub Package::name { ... }>).
828 This will correctly handle functions renamed with B<Sub::Name> and
829 installed using the symbol tables. However, if you are naming the
830 subroutine outside of the package scope, you must use the fully
831 qualified name, including the package name, for C<has_method> to
832 correctly identify it.
834 This will attempt to correctly ignore functions imported from other
835 packages using B<Exporter>. It breaks down if the function imported
836 is an C<__ANON__> sub (such as with C<use constant>), which very well
837 may be a valid method being applied to the class.
839 In short, this method cannot always be trusted to determine if the
840 C<$method_name> is actually a method. However, it will DWIM about
841 90% of the time, so it's a small trade off I think.
843 =item B<get_method ($method_name)>
845 This will return a CODE reference of the specified C<$method_name>,
846 or return undef if that method does not exist.
848 =item B<remove_method ($method_name)>
850 This will attempt to remove a given C<$method_name> from the class.
851 It will return the CODE reference that it has removed, and will
852 attempt to use B<Sub::Name> to clear the methods associated name.
854 =item B<get_method_list>
856 This will return a list of method names for all I<locally> defined
857 methods. It does B<not> provide a list of all applicable methods,
858 including any inherited ones. If you want a list of all applicable
859 methods, use the C<compute_all_applicable_methods> method.
861 =item B<compute_all_applicable_methods>
863 This will return a list of all the methods names this class will
864 respond to, taking into account inheritance. The list will be a list of
865 HASH references, each one containing the following information; method
866 name, the name of the class in which the method lives and a CODE
867 reference for the actual method.
869 =item B<find_all_methods_by_name ($method_name)>
871 This will traverse the inheritence hierarchy and locate all methods
872 with a given C<$method_name>. Similar to
873 C<compute_all_applicable_methods> it returns a list of HASH references
874 with the following information; method name (which will always be the
875 same as C<$method_name>), the name of the class in which the method
876 lives and a CODE reference for the actual method.
878 The list of methods produced is a distinct list, meaning there are no
879 duplicates in it. This is especially useful for things like object
880 initialization and destruction where you only want the method called
881 once, and in the correct order.
883 =item B<find_next_method_by_name ($method_name)>
885 This will return the first method to match a given C<$method_name> in
886 the superclasses, this is basically equivalent to calling
887 C<SUPER::$method_name>, but it can be dispatched at runtime.
891 =head2 Method Modifiers
893 Method modifiers are a concept borrowed from CLOS, in which a method
894 can be wrapped with I<before>, I<after> and I<around> method modifiers
895 that will be called everytime the method is called.
897 =head3 How method modifiers work?
899 Method modifiers work by wrapping the original method and then replacing
900 it in the classes symbol table. The wrappers will handle calling all the
901 modifiers in the appropariate orders and preserving the calling context
902 for the original method.
904 Each method modifier serves a particular purpose, which may not be
905 obvious to users of other method wrapping modules. To start with, the
906 return values of I<before> and I<after> modifiers are ignored. This is
907 because thier purpose is B<not> to filter the input and output of the
908 primary method (this is done with an I<around> modifier). This may seem
909 like an odd restriction to some, but doing this allows for simple code
910 to be added at the begining or end of a method call without jeapordizing
911 the normal functioning of the primary method or placing any extra
912 responsibility on the code of the modifier. Of course if you have more
913 complex needs, then use the I<around> modifier, which uses a variation
914 of continutation passing style to allow for a high degree of flexibility.
916 Before and around modifiers are called in last-defined-first-called order,
917 while after modifiers are called in first-defined-first-called order. So
918 the call tree might looks something like this:
928 To see examples of using method modifiers, see the following examples
929 included in the distribution; F<InstanceCountingClass>, F<Perl6Attribute>,
930 F<AttributesWithHistory> and F<C3MethodDispatchOrder>. There is also a
931 classic CLOS usage example in the test F<017_add_method_modifier.t>.
933 =head3 What is the performance impact?
935 Of course there is a performance cost associated with method modifiers,
936 but we have made every effort to make that cost be directly proportional
937 to the amount of modifier features you utilize.
939 The wrapping method does it's best to B<only> do as much work as it
940 absolutely needs to. In order to do this we have moved some of the
941 performance costs to set-up time, where they are easier to amortize.
943 All this said, my benchmarks have indicated the following:
945 simple wrapper with no modifiers 100% slower
946 simple wrapper with simple before modifier 400% slower
947 simple wrapper with simple after modifier 450% slower
948 simple wrapper with simple around modifier 500-550% slower
949 simple wrapper with all 3 modifiers 1100% slower
951 These numbers may seem daunting, but you must remember, every feature
952 comes with some cost. To put things in perspective, just doing a simple
953 C<AUTOLOAD> which does nothing but extract the name of the method called
954 and return it costs about 400% over a normal method call.
958 =item B<add_before_method_modifier ($method_name, $code)>
960 This will wrap the method at C<$method_name> and the supplied C<$code>
961 will be passed the C<@_> arguments, and called before the original
962 method is called. As specified above, the return value of the I<before>
963 method modifiers is ignored, and it's ability to modify C<@_> is
964 fairly limited. If you need to do either of these things, use an
965 C<around> method modifier.
967 =item B<add_after_method_modifier ($method_name, $code)>
969 This will wrap the method at C<$method_name> so that the original
970 method will be called, it's return values stashed, and then the
971 supplied C<$code> will be passed the C<@_> arguments, and called.
972 As specified above, the return value of the I<after> method
973 modifiers is ignored, and it cannot modify the return values of
974 the original method. If you need to do either of these things, use an
975 C<around> method modifier.
977 =item B<add_around_method_modifier ($method_name, $code)>
979 This will wrap the method at C<$method_name> so that C<$code>
980 will be called and passed the original method as an extra argument
981 at the begining of the C<@_> argument list. This is a variation of
982 continuation passing style, where the function prepended to C<@_>
983 can be considered a continuation. It is up to C<$code> if it calls
984 the original method or not, there is no restriction on what the
985 C<$code> can or cannot do.
991 It should be noted that since there is no one consistent way to define
992 the attributes of a class in Perl 5. These methods can only work with
993 the information given, and can not easily discover information on
994 their own. See L<Class::MOP::Attribute> for more details.
998 =item B<attribute_metaclass>
1000 =item B<get_attribute_map>
1002 =item B<add_attribute ($attribute_name, $attribute_meta_object)>
1004 This stores a C<$attribute_meta_object> in the B<Class::MOP::Class>
1005 instance associated with the given class, and associates it with
1006 the C<$attribute_name>. Unlike methods, attributes within the MOP
1007 are stored as meta-information only. They will be used later to
1008 construct instances from (see C<construct_instance> above).
1009 More details about the attribute meta-objects can be found in the
1010 L<Class::MOP::Attribute> or the L<Class::MOP/The Attribute protocol>
1013 It should be noted that any accessor, reader/writer or predicate
1014 methods which the C<$attribute_meta_object> has will be installed
1015 into the class at this time.
1017 =item B<has_attribute ($attribute_name)>
1019 Checks to see if this class has an attribute by the name of
1020 C<$attribute_name> and returns a boolean.
1022 =item B<get_attribute ($attribute_name)>
1024 Returns the attribute meta-object associated with C<$attribute_name>,
1025 if none is found, it will return undef.
1027 =item B<remove_attribute ($attribute_name)>
1029 This will remove the attribute meta-object stored at
1030 C<$attribute_name>, then return the removed attribute meta-object.
1033 Removing an attribute will only affect future instances of
1034 the class, it will not make any attempt to remove the attribute from
1035 any existing instances of the class.
1037 It should be noted that any accessor, reader/writer or predicate
1038 methods which the attribute meta-object stored at C<$attribute_name>
1039 has will be removed from the class at this time. This B<will> make
1040 these attributes somewhat inaccessable in previously created
1041 instances. But if you are crazy enough to do this at runtime, then
1042 you are crazy enough to deal with something like this :).
1044 =item B<get_attribute_list>
1046 This returns a list of attribute names which are defined in the local
1047 class. If you want a list of all applicable attributes for a class,
1048 use the C<compute_all_applicable_attributes> method.
1050 =item B<compute_all_applicable_attributes>
1052 This will traverse the inheritance heirachy and return a list of all
1053 the applicable attributes for this class. It does not construct a
1054 HASH reference like C<compute_all_applicable_methods> because all
1055 that same information is discoverable through the attribute
1060 =head2 Package Variables
1062 Since Perl's classes are built atop the Perl package system, it is
1063 fairly common to use package scoped variables for things like static
1064 class variables. The following methods are convience methods for
1065 the creation and inspection of package scoped variables.
1069 =item B<add_package_variable ($variable_name, ?$initial_value)>
1071 Given a C<$variable_name>, which must contain a leading sigil, this
1072 method will create that variable within the package which houses the
1073 class. It also takes an optional C<$initial_value>, which must be a
1074 reference of the same type as the sigil of the C<$variable_name>
1077 =item B<get_package_variable ($variable_name)>
1079 This will return a reference to the package variable in
1082 =item B<has_package_variable ($variable_name)>
1084 Returns true (C<1>) if there is a package variable defined for
1085 C<$variable_name>, and false (C<0>) otherwise.
1087 =item B<remove_package_variable ($variable_name)>
1089 This will attempt to remove the package variable at C<$variable_name>.
1095 Stevan Little E<lt>stevan@iinteractive.comE<gt>
1097 =head1 COPYRIGHT AND LICENSE
1099 Copyright 2006 by Infinity Interactive, Inc.
1101 L<http://www.iinteractive.com>
1103 This library is free software; you can redistribute it and/or modify
1104 it under the same terms as Perl itself.