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;
529 # We HAVE to localize $@ or all
530 # hell breaks loose. It is not
531 # good, believe me, not good.
533 eval $sigil . $self->name . '::' . $name;
536 confess "Could not create package variable ($variable) because : $e" if $e;
540 sub has_package_variable {
541 my ($self, $variable) = @_;
542 (defined $variable && $variable =~ /^[\$\@\%]/)
543 || confess "variable name does not have a sigil";
544 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
546 defined ${$self->name . '::'}{$name} ? 1 : 0;
549 sub get_package_variable {
550 my ($self, $variable) = @_;
551 (defined $variable && $variable =~ /^[\$\@\%]/)
552 || confess "variable name does not have a sigil";
553 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
557 # We HAVE to localize $@ or all
558 # hell breaks loose. It is not
559 # good, believe me, not good.
561 $ref = eval '\\' . $sigil . $self->name . '::' . $name;
564 confess "Could not get the package variable ($variable) because : $e" if $e;
565 # if we didn't die, then we can return it
569 sub remove_package_variable {
570 my ($self, $variable) = @_;
571 (defined $variable && $variable =~ /^[\$\@\%]/)
572 || confess "variable name does not have a sigil";
573 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
575 delete ${$self->name . '::'}{$name};
586 Class::MOP::Class - Class Meta Object
590 # use this for introspection ...
592 # add a method to Foo ...
593 Foo->meta->add_method('bar' => sub { ... })
595 # get a list of all the classes searched
596 # the method dispatcher in the correct order
597 Foo->meta->class_precedence_list()
599 # remove a method from Foo
600 Foo->meta->remove_method('bar');
602 # or use this to actually create classes ...
604 Class::MOP::Class->create('Bar' => '0.01' => (
605 superclasses => [ 'Foo' ],
607 Class::MOP:::Attribute->new('$bar'),
608 Class::MOP:::Attribute->new('$baz'),
611 calculate_bar => sub { ... },
612 construct_baz => sub { ... }
618 This is the largest and currently most complex part of the Perl 5
619 meta-object protocol. It controls the introspection and
620 manipulation of Perl 5 classes (and it can create them too). The
621 best way to understand what this module can do, is to read the
622 documentation for each of it's methods.
626 =head2 Self Introspection
632 This will return a B<Class::MOP::Class> instance which is related
633 to this class. Thereby allowing B<Class::MOP::Class> to actually
636 As with B<Class::MOP::Attribute>, B<Class::MOP> will actually
637 bootstrap this module by installing a number of attribute meta-objects
638 into it's metaclass. This will allow this class to reap all the benifits
639 of the MOP when subclassing it.
643 =head2 Class construction
645 These methods will handle creating B<Class::MOP::Class> objects,
646 which can be used to both create new classes, and analyze
647 pre-existing classes.
649 This module will internally store references to all the instances
650 you create with these methods, so that they do not need to be
651 created any more than nessecary. Basically, they are singletons.
655 =item B<create ($package_name, ?$package_version,
656 superclasses =E<gt> ?@superclasses,
657 methods =E<gt> ?%methods,
658 attributes =E<gt> ?%attributes)>
660 This returns a B<Class::MOP::Class> object, bringing the specified
661 C<$package_name> into existence and adding any of the
662 C<$package_version>, C<@superclasses>, C<%methods> and C<%attributes>
665 =item B<initialize ($package_name)>
667 This initializes and returns returns a B<Class::MOP::Class> object
668 for a given a C<$package_name>.
670 =item B<construct_class_instance (%options)>
672 This will construct an instance of B<Class::MOP::Class>, it is
673 here so that we can actually "tie the knot" for B<Class::MOP::Class>
674 to use C<construct_instance> once all the bootstrapping is done. This
675 method is used internally by C<initialize> and should never be called
676 from outside of that method really.
678 =item B<check_metaclass_compatability>
680 This method is called as the very last thing in the
681 C<construct_class_instance> method. This will check that the
682 metaclass you are creating is compatible with the metaclasses of all
683 your ancestors. For more inforamtion about metaclass compatibility
684 see the C<About Metaclass compatibility> section in L<Class::MOP>.
688 =head2 Object instance construction and cloning
690 These methods are B<entirely optional>, it is up to you whether you want
695 =item B<new_object (%params)>
697 This is a convience method for creating a new object of the class, and
698 blessing it into the appropriate package as well. Ideally your class
699 would call a C<new> this method like so:
702 my ($class, %param) = @_;
703 $class->meta->new_object(%params);
706 Of course the ideal place for this would actually be in C<UNIVERSAL::>
707 but that is considered bad style, so we do not do that.
709 =item B<construct_instance (%params)>
711 This method is used to construct an instace structure suitable for
712 C<bless>-ing into your package of choice. It works in conjunction
713 with the Attribute protocol to collect all applicable attributes.
715 This will construct and instance using a HASH ref as storage
716 (currently only HASH references are supported). This will collect all
717 the applicable attributes and layout out the fields in the HASH ref,
718 it will then initialize them using either use the corresponding key
719 in C<%params> or any default value or initializer found in the
720 attribute meta-object.
722 =item B<clone_object ($instance, %params)>
724 This is a convience method for cloning an object instance, then
725 blessing it into the appropriate package. This method will call
726 C<clone_instance>, which performs a shallow copy of the object,
727 see that methods documentation for more details. Ideally your
728 class would call a C<clone> this method like so:
731 my ($self, %param) = @_;
732 $self->meta->clone_object($self, %params);
735 Of course the ideal place for this would actually be in C<UNIVERSAL::>
736 but that is considered bad style, so we do not do that.
738 =item B<clone_instance($instance, %params)>
740 This method is a compliment of C<construct_instance> (which means if
741 you override C<construct_instance>, you need to override this one too),
742 and clones the instance shallowly.
744 The cloned structure returned is (like with C<construct_instance>) an
745 unC<bless>ed HASH reference, it is your responsibility to then bless
746 this cloned structure into the right class (which C<clone_object> will
749 As of 0.11, this method will clone the C<$instance> structure shallowly,
750 as opposed to the deep cloning implemented in prior versions. After much
751 thought, research and discussion, I have decided that anything but basic
752 shallow cloning is outside the scope of the meta-object protocol. I
753 think Yuval "nothingmuch" Kogman put it best when he said that cloning
754 is too I<context-specific> to be part of the MOP.
764 This is a read-only attribute which returns the package name for the
765 given B<Class::MOP::Class> instance.
769 This is a read-only attribute which returns the C<$VERSION> of the
770 package for the given B<Class::MOP::Class> instance.
774 =head2 Inheritance Relationships
778 =item B<superclasses (?@superclasses)>
780 This is a read-write attribute which represents the superclass
781 relationships of the class the B<Class::MOP::Class> instance is
782 associated with. Basically, it can get and set the C<@ISA> for you.
785 Perl will occasionally perform some C<@ISA> and method caching, if
786 you decide to change your superclass relationship at runtime (which
787 is quite insane and very much not recommened), then you should be
788 aware of this and the fact that this module does not make any
789 attempt to address this issue.
791 =item B<class_precedence_list>
793 This computes the a list of all the class's ancestors in the same order
794 in which method dispatch will be done. This is similair to
795 what B<Class::ISA::super_path> does, but we don't remove duplicate names.
803 =item B<method_metaclass>
805 =item B<add_method ($method_name, $method)>
807 This will take a C<$method_name> and CODE reference to that
808 C<$method> and install it into the class's package.
811 This does absolutely nothing special to C<$method>
812 other than use B<Sub::Name> to make sure it is tagged with the
813 correct name, and therefore show up correctly in stack traces and
816 =item B<alias_method ($method_name, $method)>
818 This will take a C<$method_name> and CODE reference to that
819 C<$method> and alias the method into the class's package.
822 Unlike C<add_method>, this will B<not> try to name the
823 C<$method> using B<Sub::Name>, it only aliases the method in
826 =item B<has_method ($method_name)>
828 This just provides a simple way to check if the class implements
829 a specific C<$method_name>. It will I<not> however, attempt to check
830 if the class inherits the method (use C<UNIVERSAL::can> for that).
832 This will correctly handle functions defined outside of the package
833 that use a fully qualified name (C<sub Package::name { ... }>).
835 This will correctly handle functions renamed with B<Sub::Name> and
836 installed using the symbol tables. However, if you are naming the
837 subroutine outside of the package scope, you must use the fully
838 qualified name, including the package name, for C<has_method> to
839 correctly identify it.
841 This will attempt to correctly ignore functions imported from other
842 packages using B<Exporter>. It breaks down if the function imported
843 is an C<__ANON__> sub (such as with C<use constant>), which very well
844 may be a valid method being applied to the class.
846 In short, this method cannot always be trusted to determine if the
847 C<$method_name> is actually a method. However, it will DWIM about
848 90% of the time, so it's a small trade off I think.
850 =item B<get_method ($method_name)>
852 This will return a CODE reference of the specified C<$method_name>,
853 or return undef if that method does not exist.
855 =item B<remove_method ($method_name)>
857 This will attempt to remove a given C<$method_name> from the class.
858 It will return the CODE reference that it has removed, and will
859 attempt to use B<Sub::Name> to clear the methods associated name.
861 =item B<get_method_list>
863 This will return a list of method names for all I<locally> defined
864 methods. It does B<not> provide a list of all applicable methods,
865 including any inherited ones. If you want a list of all applicable
866 methods, use the C<compute_all_applicable_methods> method.
868 =item B<compute_all_applicable_methods>
870 This will return a list of all the methods names this class will
871 respond to, taking into account inheritance. The list will be a list of
872 HASH references, each one containing the following information; method
873 name, the name of the class in which the method lives and a CODE
874 reference for the actual method.
876 =item B<find_all_methods_by_name ($method_name)>
878 This will traverse the inheritence hierarchy and locate all methods
879 with a given C<$method_name>. Similar to
880 C<compute_all_applicable_methods> it returns a list of HASH references
881 with the following information; method name (which will always be the
882 same as C<$method_name>), the name of the class in which the method
883 lives and a CODE reference for the actual method.
885 The list of methods produced is a distinct list, meaning there are no
886 duplicates in it. This is especially useful for things like object
887 initialization and destruction where you only want the method called
888 once, and in the correct order.
890 =item B<find_next_method_by_name ($method_name)>
892 This will return the first method to match a given C<$method_name> in
893 the superclasses, this is basically equivalent to calling
894 C<SUPER::$method_name>, but it can be dispatched at runtime.
898 =head2 Method Modifiers
900 Method modifiers are a concept borrowed from CLOS, in which a method
901 can be wrapped with I<before>, I<after> and I<around> method modifiers
902 that will be called everytime the method is called.
904 =head3 How method modifiers work?
906 Method modifiers work by wrapping the original method and then replacing
907 it in the classes symbol table. The wrappers will handle calling all the
908 modifiers in the appropariate orders and preserving the calling context
909 for the original method.
911 Each method modifier serves a particular purpose, which may not be
912 obvious to users of other method wrapping modules. To start with, the
913 return values of I<before> and I<after> modifiers are ignored. This is
914 because thier purpose is B<not> to filter the input and output of the
915 primary method (this is done with an I<around> modifier). This may seem
916 like an odd restriction to some, but doing this allows for simple code
917 to be added at the begining or end of a method call without jeapordizing
918 the normal functioning of the primary method or placing any extra
919 responsibility on the code of the modifier. Of course if you have more
920 complex needs, then use the I<around> modifier, which uses a variation
921 of continutation passing style to allow for a high degree of flexibility.
923 Before and around modifiers are called in last-defined-first-called order,
924 while after modifiers are called in first-defined-first-called order. So
925 the call tree might looks something like this:
935 To see examples of using method modifiers, see the following examples
936 included in the distribution; F<InstanceCountingClass>, F<Perl6Attribute>,
937 F<AttributesWithHistory> and F<C3MethodDispatchOrder>. There is also a
938 classic CLOS usage example in the test F<017_add_method_modifier.t>.
940 =head3 What is the performance impact?
942 Of course there is a performance cost associated with method modifiers,
943 but we have made every effort to make that cost be directly proportional
944 to the amount of modifier features you utilize.
946 The wrapping method does it's best to B<only> do as much work as it
947 absolutely needs to. In order to do this we have moved some of the
948 performance costs to set-up time, where they are easier to amortize.
950 All this said, my benchmarks have indicated the following:
952 simple wrapper with no modifiers 100% slower
953 simple wrapper with simple before modifier 400% slower
954 simple wrapper with simple after modifier 450% slower
955 simple wrapper with simple around modifier 500-550% slower
956 simple wrapper with all 3 modifiers 1100% slower
958 These numbers may seem daunting, but you must remember, every feature
959 comes with some cost. To put things in perspective, just doing a simple
960 C<AUTOLOAD> which does nothing but extract the name of the method called
961 and return it costs about 400% over a normal method call.
965 =item B<add_before_method_modifier ($method_name, $code)>
967 This will wrap the method at C<$method_name> and the supplied C<$code>
968 will be passed the C<@_> arguments, and called before the original
969 method is called. As specified above, the return value of the I<before>
970 method modifiers is ignored, and it's ability to modify C<@_> is
971 fairly limited. If you need to do either of these things, use an
972 C<around> method modifier.
974 =item B<add_after_method_modifier ($method_name, $code)>
976 This will wrap the method at C<$method_name> so that the original
977 method will be called, it's return values stashed, and then the
978 supplied C<$code> will be passed the C<@_> arguments, and called.
979 As specified above, the return value of the I<after> method
980 modifiers is ignored, and it cannot modify the return values of
981 the original method. If you need to do either of these things, use an
982 C<around> method modifier.
984 =item B<add_around_method_modifier ($method_name, $code)>
986 This will wrap the method at C<$method_name> so that C<$code>
987 will be called and passed the original method as an extra argument
988 at the begining of the C<@_> argument list. This is a variation of
989 continuation passing style, where the function prepended to C<@_>
990 can be considered a continuation. It is up to C<$code> if it calls
991 the original method or not, there is no restriction on what the
992 C<$code> can or cannot do.
998 It should be noted that since there is no one consistent way to define
999 the attributes of a class in Perl 5. These methods can only work with
1000 the information given, and can not easily discover information on
1001 their own. See L<Class::MOP::Attribute> for more details.
1005 =item B<attribute_metaclass>
1007 =item B<get_attribute_map>
1009 =item B<add_attribute ($attribute_name, $attribute_meta_object)>
1011 This stores a C<$attribute_meta_object> in the B<Class::MOP::Class>
1012 instance associated with the given class, and associates it with
1013 the C<$attribute_name>. Unlike methods, attributes within the MOP
1014 are stored as meta-information only. They will be used later to
1015 construct instances from (see C<construct_instance> above).
1016 More details about the attribute meta-objects can be found in the
1017 L<Class::MOP::Attribute> or the L<Class::MOP/The Attribute protocol>
1020 It should be noted that any accessor, reader/writer or predicate
1021 methods which the C<$attribute_meta_object> has will be installed
1022 into the class at this time.
1024 =item B<has_attribute ($attribute_name)>
1026 Checks to see if this class has an attribute by the name of
1027 C<$attribute_name> and returns a boolean.
1029 =item B<get_attribute ($attribute_name)>
1031 Returns the attribute meta-object associated with C<$attribute_name>,
1032 if none is found, it will return undef.
1034 =item B<remove_attribute ($attribute_name)>
1036 This will remove the attribute meta-object stored at
1037 C<$attribute_name>, then return the removed attribute meta-object.
1040 Removing an attribute will only affect future instances of
1041 the class, it will not make any attempt to remove the attribute from
1042 any existing instances of the class.
1044 It should be noted that any accessor, reader/writer or predicate
1045 methods which the attribute meta-object stored at C<$attribute_name>
1046 has will be removed from the class at this time. This B<will> make
1047 these attributes somewhat inaccessable in previously created
1048 instances. But if you are crazy enough to do this at runtime, then
1049 you are crazy enough to deal with something like this :).
1051 =item B<get_attribute_list>
1053 This returns a list of attribute names which are defined in the local
1054 class. If you want a list of all applicable attributes for a class,
1055 use the C<compute_all_applicable_attributes> method.
1057 =item B<compute_all_applicable_attributes>
1059 This will traverse the inheritance heirachy and return a list of all
1060 the applicable attributes for this class. It does not construct a
1061 HASH reference like C<compute_all_applicable_methods> because all
1062 that same information is discoverable through the attribute
1067 =head2 Package Variables
1069 Since Perl's classes are built atop the Perl package system, it is
1070 fairly common to use package scoped variables for things like static
1071 class variables. The following methods are convience methods for
1072 the creation and inspection of package scoped variables.
1076 =item B<add_package_variable ($variable_name, ?$initial_value)>
1078 Given a C<$variable_name>, which must contain a leading sigil, this
1079 method will create that variable within the package which houses the
1080 class. It also takes an optional C<$initial_value>, which must be a
1081 reference of the same type as the sigil of the C<$variable_name>
1084 =item B<get_package_variable ($variable_name)>
1086 This will return a reference to the package variable in
1089 =item B<has_package_variable ($variable_name)>
1091 Returns true (C<1>) if there is a package variable defined for
1092 C<$variable_name>, and false (C<0>) otherwise.
1094 =item B<remove_package_variable ($variable_name)>
1096 This will attempt to remove the package variable at C<$variable_name>.
1102 Stevan Little E<lt>stevan@iinteractive.comE<gt>
1104 =head1 COPYRIGHT AND LICENSE
1106 Copyright 2006 by Infinity Interactive, Inc.
1108 L<http://www.iinteractive.com>
1110 This library is free software; you can redistribute it and/or modify
1111 it under the same terms as Perl itself.