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.09';
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 if (!defined $val && $attr->has_default) {
167 $val = $attr->default($instance);
169 $instance->{$attr->name} = $val;
176 my $instance = shift;
177 (blessed($instance) && $instance->isa($class->name))
178 || confess "You must pass an instance ($instance) of the metaclass (" . $class->name . ")";
180 # we need to protect the integrity of the
181 # Class::MOP::Class singletons here, they
182 # should not be cloned.
183 return $instance if $instance->isa('Class::MOP::Class');
184 bless $class->clone_instance($instance, @_) => blessed($instance);
188 my ($class, $instance, %params) = @_;
190 || confess "You can only clone instances, \$self is not a blessed instance";
191 my $clone = { %$instance, %params };
197 # &name should be here too, but it is above
198 # because it gets bootstrapped away
202 ${$self->get_package_variable('$VERSION')};
211 @{$self->get_package_variable('@ISA')} = @supers;
213 @{$self->get_package_variable('@ISA')};
216 sub class_precedence_list {
219 # We need to check for ciruclar inheirtance here.
220 # This will do nothing if all is well, and blow
221 # up otherwise. Yes, it's an ugly hack, better
222 # suggestions are welcome.
223 { $self->name->isa('This is a test for circular inheritance') }
224 # ... and no back to our regularly scheduled program
228 $self->initialize($_)->class_precedence_list()
229 } $self->superclasses()
236 my ($self, $method_name, $method) = @_;
237 (defined $method_name && $method_name)
238 || confess "You must define a method name";
239 # use reftype here to allow for blessed subs ...
240 ('CODE' eq (reftype($method) || ''))
241 || confess "Your code block must be a CODE reference";
242 my $full_method_name = ($self->name . '::' . $method_name);
244 $method = $self->method_metaclass->wrap($method) unless blessed($method);
247 no warnings 'redefine';
248 *{$full_method_name} = subname $full_method_name => $method;
252 my $fetch_and_prepare_method = sub {
253 my ($self, $method_name) = @_;
255 my $method = $self->get_method($method_name);
256 # if we dont have local ...
258 # make sure this method even exists ...
259 ($self->find_next_method_by_name($method_name))
260 || confess "The method '$method_name' is not found in the inherience hierarchy for this class";
261 # if so, then create a local which just
262 # calls the next applicable method ...
263 $self->add_method($method_name => sub {
264 $self->find_next_method_by_name($method_name)->(@_);
266 $method = $self->get_method($method_name);
269 # now make sure we wrap it properly
270 # (if it isnt already)
271 unless ($method->isa('Class::MOP::Method::Wrapped')) {
272 $method = Class::MOP::Method::Wrapped->wrap($method);
273 $self->add_method($method_name => $method);
278 sub add_before_method_modifier {
279 my ($self, $method_name, $method_modifier) = @_;
280 (defined $method_name && $method_name)
281 || confess "You must pass in a method name";
282 my $full_method_modifier_name = ($self->name . '::' . $method_name . ':before');
283 my $method = $fetch_and_prepare_method->($self, $method_name);
284 $method->add_before_modifier(subname $full_method_modifier_name => $method_modifier);
287 sub add_after_method_modifier {
288 my ($self, $method_name, $method_modifier) = @_;
289 (defined $method_name && $method_name)
290 || confess "You must pass in a method name";
291 my $full_method_modifier_name = ($self->name . '::' . $method_name . ':after');
292 my $method = $fetch_and_prepare_method->($self, $method_name);
293 $method->add_after_modifier(subname $full_method_modifier_name => $method_modifier);
296 sub add_around_method_modifier {
297 my ($self, $method_name, $method_modifier) = @_;
298 (defined $method_name && $method_name)
299 || confess "You must pass in a method name";
300 my $full_method_modifier_name = ($self->name . '::' . $method_name . ':around');
301 my $method = $fetch_and_prepare_method->($self, $method_name);
302 $method->add_around_modifier(subname $full_method_modifier_name => $method_modifier);
308 my ($self, $method_name, $method) = @_;
309 (defined $method_name && $method_name)
310 || confess "You must define a method name";
311 # use reftype here to allow for blessed subs ...
312 ('CODE' eq (reftype($method) || ''))
313 || confess "Your code block must be a CODE reference";
314 my $full_method_name = ($self->name . '::' . $method_name);
316 $method = $self->method_metaclass->wrap($method) unless blessed($method);
319 no warnings 'redefine';
320 *{$full_method_name} = $method;
324 my ($self, $method_name) = @_;
325 (defined $method_name && $method_name)
326 || confess "You must define a method name";
328 my $sub_name = ($self->name . '::' . $method_name);
331 return 0 if !defined(&{$sub_name});
332 my $method = \&{$sub_name};
333 return 0 if (svref_2object($method)->GV->STASH->NAME || '') ne $self->name &&
334 (svref_2object($method)->GV->NAME || '') ne '__ANON__';
336 # at this point we are relatively sure
337 # it is our method, so we bless/wrap it
338 $self->method_metaclass->wrap($method) unless blessed($method);
343 my ($self, $method_name) = @_;
344 (defined $method_name && $method_name)
345 || confess "You must define a method name";
347 return unless $self->has_method($method_name);
350 return \&{$self->name . '::' . $method_name};
354 my ($self, $method_name) = @_;
355 (defined $method_name && $method_name)
356 || confess "You must define a method name";
358 my $removed_method = $self->get_method($method_name);
361 delete ${$self->name . '::'}{$method_name}
362 if defined $removed_method;
364 return $removed_method;
367 sub get_method_list {
370 grep { $self->has_method($_) } %{$self->name . '::'};
373 sub compute_all_applicable_methods {
376 # keep a record of what we have seen
377 # here, this will handle all the
378 # inheritence issues because we are
379 # using the &class_precedence_list
380 my (%seen_class, %seen_method);
381 foreach my $class ($self->class_precedence_list()) {
382 next if $seen_class{$class};
383 $seen_class{$class}++;
384 # fetch the meta-class ...
385 my $meta = $self->initialize($class);
386 foreach my $method_name ($meta->get_method_list()) {
387 next if exists $seen_method{$method_name};
388 $seen_method{$method_name}++;
390 name => $method_name,
392 code => $meta->get_method($method_name)
399 sub find_all_methods_by_name {
400 my ($self, $method_name) = @_;
401 (defined $method_name && $method_name)
402 || confess "You must define a method name to find";
404 # keep a record of what we have seen
405 # here, this will handle all the
406 # inheritence issues because we are
407 # using the &class_precedence_list
409 foreach my $class ($self->class_precedence_list()) {
410 next if $seen_class{$class};
411 $seen_class{$class}++;
412 # fetch the meta-class ...
413 my $meta = $self->initialize($class);
415 name => $method_name,
417 code => $meta->get_method($method_name)
418 } if $meta->has_method($method_name);
423 sub find_next_method_by_name {
424 my ($self, $method_name) = @_;
425 (defined $method_name && $method_name)
426 || confess "You must define a method name to find";
427 # keep a record of what we have seen
428 # here, this will handle all the
429 # inheritence issues because we are
430 # using the &class_precedence_list
432 my @cpl = $self->class_precedence_list();
433 shift @cpl; # discard ourselves
434 foreach my $class (@cpl) {
435 next if $seen_class{$class};
436 $seen_class{$class}++;
437 # fetch the meta-class ...
438 my $meta = $self->initialize($class);
439 return $meta->get_method($method_name)
440 if $meta->has_method($method_name);
449 # either we have an attribute object already
450 # or we need to create one from the args provided
451 my $attribute = blessed($_[0]) ? $_[0] : $self->attribute_metaclass->new(@_);
452 # make sure it is derived from the correct type though
453 ($attribute->isa('Class::MOP::Attribute'))
454 || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";
455 $attribute->attach_to_class($self);
456 $attribute->install_accessors();
457 $self->get_attribute_map->{$attribute->name} = $attribute;
461 my ($self, $attribute_name) = @_;
462 (defined $attribute_name && $attribute_name)
463 || confess "You must define an attribute name";
464 exists $self->get_attribute_map->{$attribute_name} ? 1 : 0;
468 my ($self, $attribute_name) = @_;
469 (defined $attribute_name && $attribute_name)
470 || confess "You must define an attribute name";
471 return $self->get_attribute_map->{$attribute_name}
472 if $self->has_attribute($attribute_name);
476 sub remove_attribute {
477 my ($self, $attribute_name) = @_;
478 (defined $attribute_name && $attribute_name)
479 || confess "You must define an attribute name";
480 my $removed_attribute = $self->get_attribute_map->{$attribute_name};
481 return unless defined $removed_attribute;
482 delete $self->get_attribute_map->{$attribute_name};
483 $removed_attribute->remove_accessors();
484 $removed_attribute->detach_from_class();
485 return $removed_attribute;
488 sub get_attribute_list {
490 keys %{$self->get_attribute_map};
493 sub compute_all_applicable_attributes {
496 # keep a record of what we have seen
497 # here, this will handle all the
498 # inheritence issues because we are
499 # using the &class_precedence_list
500 my (%seen_class, %seen_attr);
501 foreach my $class ($self->class_precedence_list()) {
502 next if $seen_class{$class};
503 $seen_class{$class}++;
504 # fetch the meta-class ...
505 my $meta = $self->initialize($class);
506 foreach my $attr_name ($meta->get_attribute_list()) {
507 next if exists $seen_attr{$attr_name};
508 $seen_attr{$attr_name}++;
509 push @attrs => $meta->get_attribute($attr_name);
517 sub add_package_variable {
518 my ($self, $variable, $initial_value) = @_;
519 (defined $variable && $variable =~ /^[\$\@\%]/)
520 || confess "variable name does not have a sigil";
522 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
523 if (defined $initial_value) {
525 *{$self->name . '::' . $name} = $initial_value;
531 # We HAVE to localize $@ or all
532 # hell breaks loose. It is not
533 # good, believe me, not good.
535 eval $sigil . $self->name . '::' . $name;
538 confess "Could not create package variable ($variable) because : $e" if $e;
542 sub has_package_variable {
543 my ($self, $variable) = @_;
544 (defined $variable && $variable =~ /^[\$\@\%]/)
545 || confess "variable name does not have a sigil";
546 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
548 defined ${$self->name . '::'}{$name} ? 1 : 0;
551 sub get_package_variable {
552 my ($self, $variable) = @_;
553 (defined $variable && $variable =~ /^[\$\@\%]/)
554 || confess "variable name does not have a sigil";
555 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
559 # We HAVE to localize $@ or all
560 # hell breaks loose. It is not
561 # good, believe me, not good.
563 $ref = eval '\\' . $sigil . $self->name . '::' . $name;
566 confess "Could not get the package variable ($variable) because : $e" if $e;
567 # if we didn't die, then we can return it
571 sub remove_package_variable {
572 my ($self, $variable) = @_;
573 (defined $variable && $variable =~ /^[\$\@\%]/)
574 || confess "variable name does not have a sigil";
575 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
577 delete ${$self->name . '::'}{$name};
588 Class::MOP::Class - Class Meta Object
592 # use this for introspection ...
594 # add a method to Foo ...
595 Foo->meta->add_method('bar' => sub { ... })
597 # get a list of all the classes searched
598 # the method dispatcher in the correct order
599 Foo->meta->class_precedence_list()
601 # remove a method from Foo
602 Foo->meta->remove_method('bar');
604 # or use this to actually create classes ...
606 Class::MOP::Class->create('Bar' => '0.01' => (
607 superclasses => [ 'Foo' ],
609 Class::MOP:::Attribute->new('$bar'),
610 Class::MOP:::Attribute->new('$baz'),
613 calculate_bar => sub { ... },
614 construct_baz => sub { ... }
620 This is the largest and currently most complex part of the Perl 5
621 meta-object protocol. It controls the introspection and
622 manipulation of Perl 5 classes (and it can create them too). The
623 best way to understand what this module can do, is to read the
624 documentation for each of it's methods.
628 =head2 Self Introspection
634 This will return a B<Class::MOP::Class> instance which is related
635 to this class. Thereby allowing B<Class::MOP::Class> to actually
638 As with B<Class::MOP::Attribute>, B<Class::MOP> will actually
639 bootstrap this module by installing a number of attribute meta-objects
640 into it's metaclass. This will allow this class to reap all the benifits
641 of the MOP when subclassing it.
645 =head2 Class construction
647 These methods will handle creating B<Class::MOP::Class> objects,
648 which can be used to both create new classes, and analyze
649 pre-existing classes.
651 This module will internally store references to all the instances
652 you create with these methods, so that they do not need to be
653 created any more than nessecary. Basically, they are singletons.
657 =item B<create ($package_name, ?$package_version,
658 superclasses =E<gt> ?@superclasses,
659 methods =E<gt> ?%methods,
660 attributes =E<gt> ?%attributes)>
662 This returns a B<Class::MOP::Class> object, bringing the specified
663 C<$package_name> into existence and adding any of the
664 C<$package_version>, C<@superclasses>, C<%methods> and C<%attributes>
667 =item B<initialize ($package_name)>
669 This initializes and returns returns a B<Class::MOP::Class> object
670 for a given a C<$package_name>.
672 =item B<construct_class_instance (%options)>
674 This will construct an instance of B<Class::MOP::Class>, it is
675 here so that we can actually "tie the knot" for B<Class::MOP::Class>
676 to use C<construct_instance> once all the bootstrapping is done. This
677 method is used internally by C<initialize> and should never be called
678 from outside of that method really.
680 =item B<check_metaclass_compatability>
682 This method is called as the very last thing in the
683 C<construct_class_instance> method. This will check that the
684 metaclass you are creating is compatible with the metaclasses of all
685 your ancestors. For more inforamtion about metaclass compatibility
686 see the C<About Metaclass compatibility> section in L<Class::MOP>.
690 =head2 Object instance construction and cloning
692 These methods are B<entirely optional>, it is up to you whether you want
697 =item B<new_object (%params)>
699 This is a convience method for creating a new object of the class, and
700 blessing it into the appropriate package as well. Ideally your class
701 would call a C<new> this method like so:
704 my ($class, %param) = @_;
705 $class->meta->new_object(%params);
708 Of course the ideal place for this would actually be in C<UNIVERSAL::>
709 but that is considered bad style, so we do not do that.
711 =item B<construct_instance (%params)>
713 This method is used to construct an instace structure suitable for
714 C<bless>-ing into your package of choice. It works in conjunction
715 with the Attribute protocol to collect all applicable attributes.
717 This will construct and instance using a HASH ref as storage
718 (currently only HASH references are supported). This will collect all
719 the applicable attributes and layout out the fields in the HASH ref,
720 it will then initialize them using either use the corresponding key
721 in C<%params> or any default value or initializer found in the
722 attribute meta-object.
724 =item B<clone_object ($instance, %params)>
726 This is a convience method for cloning an object instance, then
727 blessing it into the appropriate package. This method will call
728 C<clone_instance>, which performs a shallow copy of the object,
729 see that methods documentation for more details. Ideally your
730 class would call a C<clone> this method like so:
733 my ($self, %param) = @_;
734 $self->meta->clone_object($self, %params);
737 Of course the ideal place for this would actually be in C<UNIVERSAL::>
738 but that is considered bad style, so we do not do that.
740 =item B<clone_instance($instance, %params)>
742 This method is a compliment of C<construct_instance> (which means if
743 you override C<construct_instance>, you need to override this one too),
744 and clones the instance shallowly.
746 The cloned structure returned is (like with C<construct_instance>) an
747 unC<bless>ed HASH reference, it is your responsibility to then bless
748 this cloned structure into the right class (which C<clone_object> will
751 As of 0.11, this method will clone the C<$instance> structure shallowly,
752 as opposed to the deep cloning implemented in prior versions. After much
753 thought, research and discussion, I have decided that anything but basic
754 shallow cloning is outside the scope of the meta-object protocol. I
755 think Yuval "nothingmuch" Kogman put it best when he said that cloning
756 is too I<context-specific> to be part of the MOP.
766 This is a read-only attribute which returns the package name for the
767 given B<Class::MOP::Class> instance.
771 This is a read-only attribute which returns the C<$VERSION> of the
772 package for the given B<Class::MOP::Class> instance.
776 =head2 Inheritance Relationships
780 =item B<superclasses (?@superclasses)>
782 This is a read-write attribute which represents the superclass
783 relationships of the class the B<Class::MOP::Class> instance is
784 associated with. Basically, it can get and set the C<@ISA> for you.
787 Perl will occasionally perform some C<@ISA> and method caching, if
788 you decide to change your superclass relationship at runtime (which
789 is quite insane and very much not recommened), then you should be
790 aware of this and the fact that this module does not make any
791 attempt to address this issue.
793 =item B<class_precedence_list>
795 This computes the a list of all the class's ancestors in the same order
796 in which method dispatch will be done. This is similair to
797 what B<Class::ISA::super_path> does, but we don't remove duplicate names.
805 =item B<method_metaclass>
807 =item B<add_method ($method_name, $method)>
809 This will take a C<$method_name> and CODE reference to that
810 C<$method> and install it into the class's package.
813 This does absolutely nothing special to C<$method>
814 other than use B<Sub::Name> to make sure it is tagged with the
815 correct name, and therefore show up correctly in stack traces and
818 =item B<alias_method ($method_name, $method)>
820 This will take a C<$method_name> and CODE reference to that
821 C<$method> and alias the method into the class's package.
824 Unlike C<add_method>, this will B<not> try to name the
825 C<$method> using B<Sub::Name>, it only aliases the method in
828 =item B<has_method ($method_name)>
830 This just provides a simple way to check if the class implements
831 a specific C<$method_name>. It will I<not> however, attempt to check
832 if the class inherits the method (use C<UNIVERSAL::can> for that).
834 This will correctly handle functions defined outside of the package
835 that use a fully qualified name (C<sub Package::name { ... }>).
837 This will correctly handle functions renamed with B<Sub::Name> and
838 installed using the symbol tables. However, if you are naming the
839 subroutine outside of the package scope, you must use the fully
840 qualified name, including the package name, for C<has_method> to
841 correctly identify it.
843 This will attempt to correctly ignore functions imported from other
844 packages using B<Exporter>. It breaks down if the function imported
845 is an C<__ANON__> sub (such as with C<use constant>), which very well
846 may be a valid method being applied to the class.
848 In short, this method cannot always be trusted to determine if the
849 C<$method_name> is actually a method. However, it will DWIM about
850 90% of the time, so it's a small trade off I think.
852 =item B<get_method ($method_name)>
854 This will return a CODE reference of the specified C<$method_name>,
855 or return undef if that method does not exist.
857 =item B<remove_method ($method_name)>
859 This will attempt to remove a given C<$method_name> from the class.
860 It will return the CODE reference that it has removed, and will
861 attempt to use B<Sub::Name> to clear the methods associated name.
863 =item B<get_method_list>
865 This will return a list of method names for all I<locally> defined
866 methods. It does B<not> provide a list of all applicable methods,
867 including any inherited ones. If you want a list of all applicable
868 methods, use the C<compute_all_applicable_methods> method.
870 =item B<compute_all_applicable_methods>
872 This will return a list of all the methods names this class will
873 respond to, taking into account inheritance. The list will be a list of
874 HASH references, each one containing the following information; method
875 name, the name of the class in which the method lives and a CODE
876 reference for the actual method.
878 =item B<find_all_methods_by_name ($method_name)>
880 This will traverse the inheritence hierarchy and locate all methods
881 with a given C<$method_name>. Similar to
882 C<compute_all_applicable_methods> it returns a list of HASH references
883 with the following information; method name (which will always be the
884 same as C<$method_name>), the name of the class in which the method
885 lives and a CODE reference for the actual method.
887 The list of methods produced is a distinct list, meaning there are no
888 duplicates in it. This is especially useful for things like object
889 initialization and destruction where you only want the method called
890 once, and in the correct order.
892 =item B<find_next_method_by_name ($method_name)>
894 This will return the first method to match a given C<$method_name> in
895 the superclasses, this is basically equivalent to calling
896 C<SUPER::$method_name>, but it can be dispatched at runtime.
900 =head2 Method Modifiers
902 Method modifiers are a concept borrowed from CLOS, in which a method
903 can be wrapped with I<before>, I<after> and I<around> method modifiers
904 that will be called everytime the method is called.
906 =head3 How method modifiers work?
908 Method modifiers work by wrapping the original method and then replacing
909 it in the classes symbol table. The wrappers will handle calling all the
910 modifiers in the appropariate orders and preserving the calling context
911 for the original method.
913 Each method modifier serves a particular purpose, which may not be
914 obvious to users of other method wrapping modules. To start with, the
915 return values of I<before> and I<after> modifiers are ignored. This is
916 because thier purpose is B<not> to filter the input and output of the
917 primary method (this is done with an I<around> modifier). This may seem
918 like an odd restriction to some, but doing this allows for simple code
919 to be added at the begining or end of a method call without jeapordizing
920 the normal functioning of the primary method or placing any extra
921 responsibility on the code of the modifier. Of course if you have more
922 complex needs, then use the I<around> modifier, which uses a variation
923 of continutation passing style to allow for a high degree of flexibility.
925 Before and around modifiers are called in last-defined-first-called order,
926 while after modifiers are called in first-defined-first-called order. So
927 the call tree might looks something like this:
937 To see examples of using method modifiers, see the following examples
938 included in the distribution; F<InstanceCountingClass>, F<Perl6Attribute>,
939 F<AttributesWithHistory> and F<C3MethodDispatchOrder>. There is also a
940 classic CLOS usage example in the test F<017_add_method_modifier.t>.
942 =head3 What is the performance impact?
944 Of course there is a performance cost associated with method modifiers,
945 but we have made every effort to make that cost be directly proportional
946 to the amount of modifier features you utilize.
948 The wrapping method does it's best to B<only> do as much work as it
949 absolutely needs to. In order to do this we have moved some of the
950 performance costs to set-up time, where they are easier to amortize.
952 All this said, my benchmarks have indicated the following:
954 simple wrapper with no modifiers 100% slower
955 simple wrapper with simple before modifier 400% slower
956 simple wrapper with simple after modifier 450% slower
957 simple wrapper with simple around modifier 500-550% slower
958 simple wrapper with all 3 modifiers 1100% slower
960 These numbers may seem daunting, but you must remember, every feature
961 comes with some cost. To put things in perspective, just doing a simple
962 C<AUTOLOAD> which does nothing but extract the name of the method called
963 and return it costs about 400% over a normal method call.
967 =item B<add_before_method_modifier ($method_name, $code)>
969 This will wrap the method at C<$method_name> and the supplied C<$code>
970 will be passed the C<@_> arguments, and called before the original
971 method is called. As specified above, the return value of the I<before>
972 method modifiers is ignored, and it's ability to modify C<@_> is
973 fairly limited. If you need to do either of these things, use an
974 C<around> method modifier.
976 =item B<add_after_method_modifier ($method_name, $code)>
978 This will wrap the method at C<$method_name> so that the original
979 method will be called, it's return values stashed, and then the
980 supplied C<$code> will be passed the C<@_> arguments, and called.
981 As specified above, the return value of the I<after> method
982 modifiers is ignored, and it cannot modify the return values of
983 the original method. If you need to do either of these things, use an
984 C<around> method modifier.
986 =item B<add_around_method_modifier ($method_name, $code)>
988 This will wrap the method at C<$method_name> so that C<$code>
989 will be called and passed the original method as an extra argument
990 at the begining of the C<@_> argument list. This is a variation of
991 continuation passing style, where the function prepended to C<@_>
992 can be considered a continuation. It is up to C<$code> if it calls
993 the original method or not, there is no restriction on what the
994 C<$code> can or cannot do.
1000 It should be noted that since there is no one consistent way to define
1001 the attributes of a class in Perl 5. These methods can only work with
1002 the information given, and can not easily discover information on
1003 their own. See L<Class::MOP::Attribute> for more details.
1007 =item B<attribute_metaclass>
1009 =item B<get_attribute_map>
1011 =item B<add_attribute ($attribute_name, $attribute_meta_object)>
1013 This stores a C<$attribute_meta_object> in the B<Class::MOP::Class>
1014 instance associated with the given class, and associates it with
1015 the C<$attribute_name>. Unlike methods, attributes within the MOP
1016 are stored as meta-information only. They will be used later to
1017 construct instances from (see C<construct_instance> above).
1018 More details about the attribute meta-objects can be found in the
1019 L<Class::MOP::Attribute> or the L<Class::MOP/The Attribute protocol>
1022 It should be noted that any accessor, reader/writer or predicate
1023 methods which the C<$attribute_meta_object> has will be installed
1024 into the class at this time.
1026 =item B<has_attribute ($attribute_name)>
1028 Checks to see if this class has an attribute by the name of
1029 C<$attribute_name> and returns a boolean.
1031 =item B<get_attribute ($attribute_name)>
1033 Returns the attribute meta-object associated with C<$attribute_name>,
1034 if none is found, it will return undef.
1036 =item B<remove_attribute ($attribute_name)>
1038 This will remove the attribute meta-object stored at
1039 C<$attribute_name>, then return the removed attribute meta-object.
1042 Removing an attribute will only affect future instances of
1043 the class, it will not make any attempt to remove the attribute from
1044 any existing instances of the class.
1046 It should be noted that any accessor, reader/writer or predicate
1047 methods which the attribute meta-object stored at C<$attribute_name>
1048 has will be removed from the class at this time. This B<will> make
1049 these attributes somewhat inaccessable in previously created
1050 instances. But if you are crazy enough to do this at runtime, then
1051 you are crazy enough to deal with something like this :).
1053 =item B<get_attribute_list>
1055 This returns a list of attribute names which are defined in the local
1056 class. If you want a list of all applicable attributes for a class,
1057 use the C<compute_all_applicable_attributes> method.
1059 =item B<compute_all_applicable_attributes>
1061 This will traverse the inheritance heirachy and return a list of all
1062 the applicable attributes for this class. It does not construct a
1063 HASH reference like C<compute_all_applicable_methods> because all
1064 that same information is discoverable through the attribute
1069 =head2 Package Variables
1071 Since Perl's classes are built atop the Perl package system, it is
1072 fairly common to use package scoped variables for things like static
1073 class variables. The following methods are convience methods for
1074 the creation and inspection of package scoped variables.
1078 =item B<add_package_variable ($variable_name, ?$initial_value)>
1080 Given a C<$variable_name>, which must contain a leading sigil, this
1081 method will create that variable within the package which houses the
1082 class. It also takes an optional C<$initial_value>, which must be a
1083 reference of the same type as the sigil of the C<$variable_name>
1086 =item B<get_package_variable ($variable_name)>
1088 This will return a reference to the package variable in
1091 =item B<has_package_variable ($variable_name)>
1093 Returns true (C<1>) if there is a package variable defined for
1094 C<$variable_name>, and false (C<0>) otherwise.
1096 =item B<remove_package_variable ($variable_name)>
1098 This will attempt to remove the package variable at C<$variable_name>.
1104 Stevan Little E<lt>stevan@iinteractive.comE<gt>
1106 =head1 COPYRIGHT AND LICENSE
1108 Copyright 2006 by Infinity Interactive, Inc.
1110 L<http://www.iinteractive.com>
1112 This library is free software; you can redistribute it and/or modify
1113 it under the same terms as Perl itself.