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.07';
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;
526 eval $sigil . $self->name . '::' . $name;
527 confess "Could not create package variable ($variable) because : $@" if $@;
531 sub has_package_variable {
532 my ($self, $variable) = @_;
533 (defined $variable && $variable =~ /^[\$\@\%]/)
534 || confess "variable name does not have a sigil";
535 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
537 defined ${$self->name . '::'}{$name} ? 1 : 0;
540 sub get_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 # try to fetch it first,.. see what happens
547 my $ref = eval '\\' . $sigil . $self->name . '::' . $name;
548 confess "Could not get the package variable ($variable) because : $@" if $@;
549 # if we didn't die, then we can return it
553 sub remove_package_variable {
554 my ($self, $variable) = @_;
555 (defined $variable && $variable =~ /^[\$\@\%]/)
556 || confess "variable name does not have a sigil";
557 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
559 delete ${$self->name . '::'}{$name};
570 Class::MOP::Class - Class Meta Object
574 # use this for introspection ...
576 # add a method to Foo ...
577 Foo->meta->add_method('bar' => sub { ... })
579 # get a list of all the classes searched
580 # the method dispatcher in the correct order
581 Foo->meta->class_precedence_list()
583 # remove a method from Foo
584 Foo->meta->remove_method('bar');
586 # or use this to actually create classes ...
588 Class::MOP::Class->create('Bar' => '0.01' => (
589 superclasses => [ 'Foo' ],
591 Class::MOP:::Attribute->new('$bar'),
592 Class::MOP:::Attribute->new('$baz'),
595 calculate_bar => sub { ... },
596 construct_baz => sub { ... }
602 This is the largest and currently most complex part of the Perl 5
603 meta-object protocol. It controls the introspection and
604 manipulation of Perl 5 classes (and it can create them too). The
605 best way to understand what this module can do, is to read the
606 documentation for each of it's methods.
610 =head2 Self Introspection
616 This will return a B<Class::MOP::Class> instance which is related
617 to this class. Thereby allowing B<Class::MOP::Class> to actually
620 As with B<Class::MOP::Attribute>, B<Class::MOP> will actually
621 bootstrap this module by installing a number of attribute meta-objects
622 into it's metaclass. This will allow this class to reap all the benifits
623 of the MOP when subclassing it.
627 =head2 Class construction
629 These methods will handle creating B<Class::MOP::Class> objects,
630 which can be used to both create new classes, and analyze
631 pre-existing classes.
633 This module will internally store references to all the instances
634 you create with these methods, so that they do not need to be
635 created any more than nessecary. Basically, they are singletons.
639 =item B<create ($package_name, ?$package_version,
640 superclasses =E<gt> ?@superclasses,
641 methods =E<gt> ?%methods,
642 attributes =E<gt> ?%attributes)>
644 This returns a B<Class::MOP::Class> object, bringing the specified
645 C<$package_name> into existence and adding any of the
646 C<$package_version>, C<@superclasses>, C<%methods> and C<%attributes>
649 =item B<initialize ($package_name)>
651 This initializes and returns returns a B<Class::MOP::Class> object
652 for a given a C<$package_name>.
654 =item B<construct_class_instance (%options)>
656 This will construct an instance of B<Class::MOP::Class>, it is
657 here so that we can actually "tie the knot" for B<Class::MOP::Class>
658 to use C<construct_instance> once all the bootstrapping is done. This
659 method is used internally by C<initialize> and should never be called
660 from outside of that method really.
662 =item B<check_metaclass_compatability>
664 This method is called as the very last thing in the
665 C<construct_class_instance> method. This will check that the
666 metaclass you are creating is compatible with the metaclasses of all
667 your ancestors. For more inforamtion about metaclass compatibility
668 see the C<About Metaclass compatibility> section in L<Class::MOP>.
672 =head2 Object instance construction and cloning
674 These methods are B<entirely optional>, it is up to you whether you want
679 =item B<new_object (%params)>
681 This is a convience method for creating a new object of the class, and
682 blessing it into the appropriate package as well. Ideally your class
683 would call a C<new> this method like so:
686 my ($class, %param) = @_;
687 $class->meta->new_object(%params);
690 Of course the ideal place for this would actually be in C<UNIVERSAL::>
691 but that is considered bad style, so we do not do that.
693 =item B<construct_instance (%params)>
695 This method is used to construct an instace structure suitable for
696 C<bless>-ing into your package of choice. It works in conjunction
697 with the Attribute protocol to collect all applicable attributes.
699 This will construct and instance using a HASH ref as storage
700 (currently only HASH references are supported). This will collect all
701 the applicable attributes and layout out the fields in the HASH ref,
702 it will then initialize them using either use the corresponding key
703 in C<%params> or any default value or initializer found in the
704 attribute meta-object.
706 =item B<clone_object ($instance, %params)>
708 This is a convience method for cloning an object instance, then
709 blessing it into the appropriate package. This method will call
710 C<clone_instance>, which performs a shallow copy of the object,
711 see that methods documentation for more details. Ideally your
712 class would call a C<clone> this method like so:
715 my ($self, %param) = @_;
716 $self->meta->clone_object($self, %params);
719 Of course the ideal place for this would actually be in C<UNIVERSAL::>
720 but that is considered bad style, so we do not do that.
722 =item B<clone_instance($instance, %params)>
724 This method is a compliment of C<construct_instance> (which means if
725 you override C<construct_instance>, you need to override this one too),
726 and clones the instance shallowly.
728 The cloned structure returned is (like with C<construct_instance>) an
729 unC<bless>ed HASH reference, it is your responsibility to then bless
730 this cloned structure into the right class (which C<clone_object> will
733 As of 0.11, this method will clone the C<$instance> structure shallowly,
734 as opposed to the deep cloning implemented in prior versions. After much
735 thought, research and discussion, I have decided that anything but basic
736 shallow cloning is outside the scope of the meta-object protocol. I
737 think Yuval "nothingmuch" Kogman put it best when he said that cloning
738 is too I<context-specific> to be part of the MOP.
748 This is a read-only attribute which returns the package name for the
749 given B<Class::MOP::Class> instance.
753 This is a read-only attribute which returns the C<$VERSION> of the
754 package for the given B<Class::MOP::Class> instance.
758 =head2 Inheritance Relationships
762 =item B<superclasses (?@superclasses)>
764 This is a read-write attribute which represents the superclass
765 relationships of the class the B<Class::MOP::Class> instance is
766 associated with. Basically, it can get and set the C<@ISA> for you.
769 Perl will occasionally perform some C<@ISA> and method caching, if
770 you decide to change your superclass relationship at runtime (which
771 is quite insane and very much not recommened), then you should be
772 aware of this and the fact that this module does not make any
773 attempt to address this issue.
775 =item B<class_precedence_list>
777 This computes the a list of all the class's ancestors in the same order
778 in which method dispatch will be done. This is similair to
779 what B<Class::ISA::super_path> does, but we don't remove duplicate names.
787 =item B<method_metaclass>
789 =item B<add_method ($method_name, $method)>
791 This will take a C<$method_name> and CODE reference to that
792 C<$method> and install it into the class's package.
795 This does absolutely nothing special to C<$method>
796 other than use B<Sub::Name> to make sure it is tagged with the
797 correct name, and therefore show up correctly in stack traces and
800 =item B<alias_method ($method_name, $method)>
802 This will take a C<$method_name> and CODE reference to that
803 C<$method> and alias the method into the class's package.
806 Unlike C<add_method>, this will B<not> try to name the
807 C<$method> using B<Sub::Name>, it only aliases the method in
810 =item B<has_method ($method_name)>
812 This just provides a simple way to check if the class implements
813 a specific C<$method_name>. It will I<not> however, attempt to check
814 if the class inherits the method (use C<UNIVERSAL::can> for that).
816 This will correctly handle functions defined outside of the package
817 that use a fully qualified name (C<sub Package::name { ... }>).
819 This will correctly handle functions renamed with B<Sub::Name> and
820 installed using the symbol tables. However, if you are naming the
821 subroutine outside of the package scope, you must use the fully
822 qualified name, including the package name, for C<has_method> to
823 correctly identify it.
825 This will attempt to correctly ignore functions imported from other
826 packages using B<Exporter>. It breaks down if the function imported
827 is an C<__ANON__> sub (such as with C<use constant>), which very well
828 may be a valid method being applied to the class.
830 In short, this method cannot always be trusted to determine if the
831 C<$method_name> is actually a method. However, it will DWIM about
832 90% of the time, so it's a small trade off I think.
834 =item B<get_method ($method_name)>
836 This will return a CODE reference of the specified C<$method_name>,
837 or return undef if that method does not exist.
839 =item B<remove_method ($method_name)>
841 This will attempt to remove a given C<$method_name> from the class.
842 It will return the CODE reference that it has removed, and will
843 attempt to use B<Sub::Name> to clear the methods associated name.
845 =item B<get_method_list>
847 This will return a list of method names for all I<locally> defined
848 methods. It does B<not> provide a list of all applicable methods,
849 including any inherited ones. If you want a list of all applicable
850 methods, use the C<compute_all_applicable_methods> method.
852 =item B<compute_all_applicable_methods>
854 This will return a list of all the methods names this class will
855 respond to, taking into account inheritance. The list will be a list of
856 HASH references, each one containing the following information; method
857 name, the name of the class in which the method lives and a CODE
858 reference for the actual method.
860 =item B<find_all_methods_by_name ($method_name)>
862 This will traverse the inheritence hierarchy and locate all methods
863 with a given C<$method_name>. Similar to
864 C<compute_all_applicable_methods> it returns a list of HASH references
865 with the following information; method name (which will always be the
866 same as C<$method_name>), the name of the class in which the method
867 lives and a CODE reference for the actual method.
869 The list of methods produced is a distinct list, meaning there are no
870 duplicates in it. This is especially useful for things like object
871 initialization and destruction where you only want the method called
872 once, and in the correct order.
874 =item B<find_next_method_by_name ($method_name)>
876 This will return the first method to match a given C<$method_name> in
877 the superclasses, this is basically equivalent to calling
878 C<SUPER::$method_name>, but it can be dispatched at runtime.
882 =head2 Method Modifiers
884 Method modifiers are a concept borrowed from CLOS, in which a method
885 can be wrapped with I<before>, I<after> and I<around> method modifiers
886 that will be called everytime the method is called.
888 =head3 How method modifiers work?
890 Method modifiers work by wrapping the original method and then replacing
891 it in the classes symbol table. The wrappers will handle calling all the
892 modifiers in the appropariate orders and preserving the calling context
893 for the original method.
895 Each method modifier serves a particular purpose, which may not be
896 obvious to users of other method wrapping modules. To start with, the
897 return values of I<before> and I<after> modifiers are ignored. This is
898 because thier purpose is B<not> to filter the input and output of the
899 primary method (this is done with an I<around> modifier). This may seem
900 like an odd restriction to some, but doing this allows for simple code
901 to be added at the begining or end of a method call without jeapordizing
902 the normal functioning of the primary method or placing any extra
903 responsibility on the code of the modifier. Of course if you have more
904 complex needs, then use the I<around> modifier, which uses a variation
905 of continutation passing style to allow for a high degree of flexibility.
907 Before and around modifiers are called in last-defined-first-called order,
908 while after modifiers are called in first-defined-first-called order. So
909 the call tree might looks something like this:
919 To see examples of using method modifiers, see the following examples
920 included in the distribution; F<InstanceCountingClass>, F<Perl6Attribute>,
921 F<AttributesWithHistory> and F<C3MethodDispatchOrder>. There is also a
922 classic CLOS usage example in the test F<017_add_method_modifier.t>.
924 =head3 What is the performance impact?
926 Of course there is a performance cost associated with method modifiers,
927 but we have made every effort to make that cost be directly proportional
928 to the amount of modifier features you utilize.
930 The wrapping method does it's best to B<only> do as much work as it
931 absolutely needs to. In order to do this we have moved some of the
932 performance costs to set-up time, where they are easier to amortize.
934 All this said, my benchmarks have indicated the following:
936 simple wrapper with no modifiers 100% slower
937 simple wrapper with simple before modifier 400% slower
938 simple wrapper with simple after modifier 450% slower
939 simple wrapper with simple around modifier 500-550% slower
940 simple wrapper with all 3 modifiers 1100% slower
942 These numbers may seem daunting, but you must remember, every feature
943 comes with some cost. To put things in perspective, just doing a simple
944 C<AUTOLOAD> which does nothing but extract the name of the method called
945 and return it costs about 400% over a normal method call.
949 =item B<add_before_method_modifier ($method_name, $code)>
951 This will wrap the method at C<$method_name> and the supplied C<$code>
952 will be passed the C<@_> arguments, and called before the original
953 method is called. As specified above, the return value of the I<before>
954 method modifiers is ignored, and it's ability to modify C<@_> is
955 fairly limited. If you need to do either of these things, use an
956 C<around> method modifier.
958 =item B<add_after_method_modifier ($method_name, $code)>
960 This will wrap the method at C<$method_name> so that the original
961 method will be called, it's return values stashed, and then the
962 supplied C<$code> will be passed the C<@_> arguments, and called.
963 As specified above, the return value of the I<after> method
964 modifiers is ignored, and it cannot modify the return values of
965 the original method. If you need to do either of these things, use an
966 C<around> method modifier.
968 =item B<add_around_method_modifier ($method_name, $code)>
970 This will wrap the method at C<$method_name> so that C<$code>
971 will be called and passed the original method as an extra argument
972 at the begining of the C<@_> argument list. This is a variation of
973 continuation passing style, where the function prepended to C<@_>
974 can be considered a continuation. It is up to C<$code> if it calls
975 the original method or not, there is no restriction on what the
976 C<$code> can or cannot do.
982 It should be noted that since there is no one consistent way to define
983 the attributes of a class in Perl 5. These methods can only work with
984 the information given, and can not easily discover information on
985 their own. See L<Class::MOP::Attribute> for more details.
989 =item B<attribute_metaclass>
991 =item B<get_attribute_map>
993 =item B<add_attribute ($attribute_name, $attribute_meta_object)>
995 This stores a C<$attribute_meta_object> in the B<Class::MOP::Class>
996 instance associated with the given class, and associates it with
997 the C<$attribute_name>. Unlike methods, attributes within the MOP
998 are stored as meta-information only. They will be used later to
999 construct instances from (see C<construct_instance> above).
1000 More details about the attribute meta-objects can be found in the
1001 L<Class::MOP::Attribute> or the L<Class::MOP/The Attribute protocol>
1004 It should be noted that any accessor, reader/writer or predicate
1005 methods which the C<$attribute_meta_object> has will be installed
1006 into the class at this time.
1008 =item B<has_attribute ($attribute_name)>
1010 Checks to see if this class has an attribute by the name of
1011 C<$attribute_name> and returns a boolean.
1013 =item B<get_attribute ($attribute_name)>
1015 Returns the attribute meta-object associated with C<$attribute_name>,
1016 if none is found, it will return undef.
1018 =item B<remove_attribute ($attribute_name)>
1020 This will remove the attribute meta-object stored at
1021 C<$attribute_name>, then return the removed attribute meta-object.
1024 Removing an attribute will only affect future instances of
1025 the class, it will not make any attempt to remove the attribute from
1026 any existing instances of the class.
1028 It should be noted that any accessor, reader/writer or predicate
1029 methods which the attribute meta-object stored at C<$attribute_name>
1030 has will be removed from the class at this time. This B<will> make
1031 these attributes somewhat inaccessable in previously created
1032 instances. But if you are crazy enough to do this at runtime, then
1033 you are crazy enough to deal with something like this :).
1035 =item B<get_attribute_list>
1037 This returns a list of attribute names which are defined in the local
1038 class. If you want a list of all applicable attributes for a class,
1039 use the C<compute_all_applicable_attributes> method.
1041 =item B<compute_all_applicable_attributes>
1043 This will traverse the inheritance heirachy and return a list of all
1044 the applicable attributes for this class. It does not construct a
1045 HASH reference like C<compute_all_applicable_methods> because all
1046 that same information is discoverable through the attribute
1051 =head2 Package Variables
1053 Since Perl's classes are built atop the Perl package system, it is
1054 fairly common to use package scoped variables for things like static
1055 class variables. The following methods are convience methods for
1056 the creation and inspection of package scoped variables.
1060 =item B<add_package_variable ($variable_name, ?$initial_value)>
1062 Given a C<$variable_name>, which must contain a leading sigil, this
1063 method will create that variable within the package which houses the
1064 class. It also takes an optional C<$initial_value>, which must be a
1065 reference of the same type as the sigil of the C<$variable_name>
1068 =item B<get_package_variable ($variable_name)>
1070 This will return a reference to the package variable in
1073 =item B<has_package_variable ($variable_name)>
1075 Returns true (C<1>) if there is a package variable defined for
1076 C<$variable_name>, and false (C<0>) otherwise.
1078 =item B<remove_package_variable ($variable_name)>
1080 This will attempt to remove the package variable at C<$variable_name>.
1086 Stevan Little E<lt>stevan@iinteractive.comE<gt>
1088 =head1 COPYRIGHT AND LICENSE
1090 Copyright 2006 by Infinity Interactive, Inc.
1092 L<http://www.iinteractive.com>
1094 This library is free software; you can redistribute it and/or modify
1095 it under the same terms as Perl itself.