2 package Class::MOP::Class;
8 use Scalar::Util 'blessed', 'reftype', 'weaken';
9 use Sub::Name 'subname';
10 use B 'svref_2object';
12 our $VERSION = '0.18';
13 our $AUTHORITY = 'cpan:STEVAN';
15 use base 'Class::MOP::Module';
17 use Class::MOP::Instance;
21 sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) }
27 my $package_name = shift;
28 (defined $package_name && $package_name && !blessed($package_name))
29 || confess "You must pass a package name and it cannot be blessed";
30 $class->construct_class_instance(':package' => $package_name, @_);
35 my $package_name = shift;
36 (defined $package_name && $package_name && !blessed($package_name))
37 || confess "You must pass a package name and it cannot be blessed";
38 Class::MOP::remove_metaclass_by_name($package_name);
39 $class->construct_class_instance(':package' => $package_name, @_);
42 # NOTE: (meta-circularity)
43 # this is a special form of &construct_instance
44 # (see below), which is used to construct class
45 # meta-object instances for any Class::MOP::*
46 # class. All other classes will use the more
47 # normal &construct_instance.
48 sub construct_class_instance {
51 my $package_name = $options{':package'};
52 (defined $package_name && $package_name)
53 || confess "You must pass a package name";
55 # return the metaclass if we have it cached,
56 # and it is still defined (it has not been
57 # reaped by DESTROY yet, which can happen
58 # annoyingly enough during global destruction)
59 return Class::MOP::get_metaclass_by_name($package_name)
60 if Class::MOP::does_metaclass_exist($package_name);
63 # we need to deal with the possibility
64 # of class immutability here, and then
65 # get the name of the class appropriately
66 $class = (blessed($class)
67 ? ($class->is_immutable
68 ? $class->get_mutable_metaclass_name()
72 $class = blessed($class) || $class;
73 # now create the metaclass
75 if ($class =~ /^Class::MOP::Class$/) {
78 # inherited from Class::MOP::Package
79 '$:package' => $package_name,
80 '%:namespace' => \%{$package_name . '::'},
81 # inherited from Class::MOP::Module
82 '$:version' => (exists ${$package_name . '::'}{'VERSION'} ? ${$package_name . '::VERSION'} : undef),
83 '$:authority' => (exists ${$package_name . '::'}{'AUTHORITY'} ? ${$package_name . '::AUTHORITY'} : undef),
86 '$:attribute_metaclass' => $options{':attribute_metaclass'} || 'Class::MOP::Attribute',
87 '$:method_metaclass' => $options{':method_metaclass'} || 'Class::MOP::Method',
88 '$:instance_metaclass' => $options{':instance_metaclass'} || 'Class::MOP::Instance',
93 # it is safe to use meta here because
94 # class will always be a subclass of
95 # Class::MOP::Class, which defines meta
96 $meta = $class->meta->construct_instance(%options)
99 # and check the metaclass compatibility
100 $meta->check_metaclass_compatability();
102 Class::MOP::store_metaclass_by_name($package_name, $meta);
105 # we need to weaken any anon classes
106 # so that they can call DESTROY properly
107 Class::MOP::weaken_metaclass($package_name) if $meta->is_anon_class;
112 sub check_metaclass_compatability {
115 # this is always okay ...
116 return if blessed($self) eq 'Class::MOP::Class' &&
117 $self->instance_metaclass eq 'Class::MOP::Instance';
119 my @class_list = $self->class_precedence_list;
120 shift @class_list; # shift off $self->name
122 foreach my $class_name (@class_list) {
123 my $meta = Class::MOP::get_metaclass_by_name($class_name) || next;
126 # we need to deal with the possibility
127 # of class immutability here, and then
128 # get the name of the class appropriately
129 my $meta_type = ($meta->is_immutable
130 ? $meta->get_mutable_metaclass_name()
133 ($self->isa($meta_type))
134 || confess $self->name . "->meta => (" . (blessed($self)) . ")" .
135 " is not compatible with the " .
136 $class_name . "->meta => (" . ($meta_type) . ")";
138 # we also need to check that instance metaclasses
139 # are compatabile in the same the class.
140 ($self->instance_metaclass->isa($meta->instance_metaclass))
141 || confess $self->name . "->meta => (" . ($self->instance_metaclass) . ")" .
142 " is not compatible with the " .
143 $class_name . "->meta => (" . ($meta->instance_metaclass) . ")";
151 # this should be sufficient, if you have a
152 # use case where it is not, write a test and
154 my $ANON_CLASS_SERIAL = 0;
157 # we need a sufficiently annoying prefix
158 # this should suffice for now, this is
159 # used in a couple of places below, so
160 # need to put it up here for now.
161 my $ANON_CLASS_PREFIX = 'Class::MOP::Class::__ANON__::SERIAL::';
165 $self->name =~ /^$ANON_CLASS_PREFIX/ ? 1 : 0;
168 sub create_anon_class {
169 my ($class, %options) = @_;
170 my $package_name = $ANON_CLASS_PREFIX . ++$ANON_CLASS_SERIAL;
171 return $class->create($package_name, '0.00', %options);
175 # this will only get called for
176 # anon-classes, all other calls
177 # are assumed to occur during
178 # global destruction and so don't
179 # really need to be handled explicitly
182 return unless $self->name =~ /^$ANON_CLASS_PREFIX/;
183 my ($serial_id) = ($self->name =~ /^$ANON_CLASS_PREFIX(\d+)/);
185 foreach my $key (keys %{$ANON_CLASS_PREFIX . $serial_id}) {
186 delete ${$ANON_CLASS_PREFIX . $serial_id}{$key};
188 delete ${'main::' . $ANON_CLASS_PREFIX}{$serial_id . '::'};
193 # creating classes with MOP ...
196 my ($class, $package_name, $package_version, %options) = @_;
197 (defined $package_name && $package_name)
198 || confess "You must pass a package name";
199 my $code = "package $package_name;";
200 $code .= "\$$package_name\:\:VERSION = '$package_version';"
201 if defined $package_version;
203 confess "creation of $package_name failed : $@" if $@;
204 my $meta = $class->initialize($package_name);
206 $meta->add_method('meta' => sub {
207 $class->initialize(blessed($_[0]) || $_[0]);
210 $meta->superclasses(@{$options{superclasses}})
211 if exists $options{superclasses};
213 # process attributes first, so that they can
214 # install accessors, but locally defined methods
215 # can then overwrite them. It is maybe a little odd, but
216 # I think this should be the order of things.
217 if (exists $options{attributes}) {
218 foreach my $attr (@{$options{attributes}}) {
219 $meta->add_attribute($attr);
222 if (exists $options{methods}) {
223 foreach my $method_name (keys %{$options{methods}}) {
224 $meta->add_method($method_name, $options{methods}->{$method_name});
233 # all these attribute readers will be bootstrapped
234 # away in the Class::MOP bootstrap section
236 sub get_attribute_map { $_[0]->{'%:attributes'} }
237 sub attribute_metaclass { $_[0]->{'$:attribute_metaclass'} }
238 sub method_metaclass { $_[0]->{'$:method_metaclass'} }
239 sub instance_metaclass { $_[0]->{'$:instance_metaclass'} }
241 # Instance Construction & Cloning
246 # we need to protect the integrity of the
247 # Class::MOP::Class singletons here, so we
248 # delegate this to &construct_class_instance
249 # which will deal with the singletons
250 return $class->construct_class_instance(@_)
251 if $class->name->isa('Class::MOP::Class');
252 return $class->construct_instance(@_);
255 sub construct_instance {
256 my ($class, %params) = @_;
257 my $meta_instance = $class->get_meta_instance();
258 my $instance = $meta_instance->create_instance();
259 foreach my $attr ($class->compute_all_applicable_attributes()) {
260 $attr->initialize_instance_slot($meta_instance, $instance, \%params);
265 sub get_meta_instance {
267 return $class->instance_metaclass->new(
269 $class->compute_all_applicable_attributes()
275 my $instance = shift;
276 (blessed($instance) && $instance->isa($class->name))
277 || confess "You must pass an instance ($instance) of the metaclass (" . $class->name . ")";
279 # we need to protect the integrity of the
280 # Class::MOP::Class singletons here, they
281 # should not be cloned.
282 return $instance if $instance->isa('Class::MOP::Class');
283 $class->clone_instance($instance, @_);
287 my ($class, $instance, %params) = @_;
289 || confess "You can only clone instances, \$self is not a blessed instance";
290 my $meta_instance = $class->get_meta_instance();
291 my $clone = $meta_instance->clone_instance($instance);
292 foreach my $key (keys %params) {
293 next unless $meta_instance->is_valid_slot($key);
294 $meta_instance->set_slot_value($clone, $key, $params{$key});
305 @{$self->get_package_symbol('@ISA')} = @supers;
307 # we need to check the metaclass
308 # compatability here so that we can
309 # be sure that the superclass is
310 # not potentially creating an issues
311 # we don't know about
312 $self->check_metaclass_compatability();
314 @{$self->get_package_symbol('@ISA')};
317 sub class_precedence_list {
320 # We need to check for ciruclar inheirtance here.
321 # This will do nothing if all is well, and blow
322 # up otherwise. Yes, it's an ugly hack, better
323 # suggestions are welcome.
324 { ($self->name || return)->isa('This is a test for circular inheritance') }
325 # ... and now back to our regularly scheduled program
329 $self->initialize($_)->class_precedence_list()
330 } $self->superclasses()
337 my ($self, $method_name, $method) = @_;
338 (defined $method_name && $method_name)
339 || confess "You must define a method name";
340 # use reftype here to allow for blessed subs ...
341 ('CODE' eq (reftype($method) || ''))
342 || confess "Your code block must be a CODE reference";
343 my $full_method_name = ($self->name . '::' . $method_name);
346 # dont bless subs, its bad mkay
347 $method = $self->method_metaclass->wrap($method) unless blessed($method);
349 $self->add_package_symbol("&${method_name}" => subname $full_method_name => $method);
353 my $fetch_and_prepare_method = sub {
354 my ($self, $method_name) = @_;
356 my $method = $self->get_method($method_name);
357 # if we dont have local ...
359 # try to find the next method
360 $method = $self->find_next_method_by_name($method_name);
361 # die if it does not exist
363 || confess "The method '$method_name' is not found in the inherience hierarchy for this class";
364 # and now make sure to wrap it
365 # even if it is already wrapped
366 # because we need a new sub ref
367 $method = Class::MOP::Method::Wrapped->wrap($method);
370 # now make sure we wrap it properly
371 $method = Class::MOP::Method::Wrapped->wrap($method)
372 unless $method->isa('Class::MOP::Method::Wrapped');
374 $self->add_method($method_name => $method);
378 sub add_before_method_modifier {
379 my ($self, $method_name, $method_modifier) = @_;
380 (defined $method_name && $method_name)
381 || confess "You must pass in a method name";
382 my $method = $fetch_and_prepare_method->($self, $method_name);
383 $method->add_before_modifier(subname ':before' => $method_modifier);
386 sub add_after_method_modifier {
387 my ($self, $method_name, $method_modifier) = @_;
388 (defined $method_name && $method_name)
389 || confess "You must pass in a method name";
390 my $method = $fetch_and_prepare_method->($self, $method_name);
391 $method->add_after_modifier(subname ':after' => $method_modifier);
394 sub add_around_method_modifier {
395 my ($self, $method_name, $method_modifier) = @_;
396 (defined $method_name && $method_name)
397 || confess "You must pass in a method name";
398 my $method = $fetch_and_prepare_method->($self, $method_name);
399 $method->add_around_modifier(subname ':around' => $method_modifier);
403 # the methods above used to be named like this:
404 # ${pkg}::${method}:(before|after|around)
405 # but this proved problematic when using one modifier
406 # to wrap multiple methods (something which is likely
407 # to happen pretty regularly IMO). So instead of naming
408 # it like this, I have chosen to just name them purely
409 # with their modifier names, like so:
410 # :(before|after|around)
411 # The fact is that in a stack trace, it will be fairly
412 # evident from the context what method they are attached
413 # to, and so don't need the fully qualified name.
417 my ($self, $method_name, $method) = @_;
418 (defined $method_name && $method_name)
419 || confess "You must define a method name";
420 # use reftype here to allow for blessed subs ...
421 ('CODE' eq (reftype($method) || ''))
422 || confess "Your code block must be a CODE reference";
425 # dont bless subs, its bad mkay
426 $method = $self->method_metaclass->wrap($method) unless blessed($method);
428 $self->add_package_symbol("&${method_name}" => $method);
431 sub find_method_by_name {
432 my ($self, $method_name) = @_;
433 return $self->name->can($method_name);
437 my ($self, $method_name) = @_;
438 (defined $method_name && $method_name)
439 || confess "You must define a method name";
441 return 0 if !$self->has_package_symbol("&${method_name}");
442 my $method = $self->get_package_symbol("&${method_name}");
443 return 0 if (svref_2object($method)->GV->STASH->NAME || '') ne $self->name &&
444 (svref_2object($method)->GV->NAME || '') ne '__ANON__';
447 # dont bless subs, its bad mkay
448 $self->method_metaclass->wrap($method) unless blessed($method);
454 my ($self, $method_name) = @_;
455 (defined $method_name && $method_name)
456 || confess "You must define a method name";
458 return unless $self->has_method($method_name);
460 return $self->get_package_symbol("&${method_name}");
464 my ($self, $method_name) = @_;
465 (defined $method_name && $method_name)
466 || confess "You must define a method name";
468 my $removed_method = $self->get_method($method_name);
470 $self->remove_package_symbol("&${method_name}")
471 if defined $removed_method;
473 return $removed_method;
476 sub get_method_list {
478 grep { $self->has_method($_) } $self->list_all_package_symbols;
481 sub compute_all_applicable_methods {
484 # keep a record of what we have seen
485 # here, this will handle all the
486 # inheritence issues because we are
487 # using the &class_precedence_list
488 my (%seen_class, %seen_method);
489 foreach my $class ($self->class_precedence_list()) {
490 next if $seen_class{$class};
491 $seen_class{$class}++;
492 # fetch the meta-class ...
493 my $meta = $self->initialize($class);
494 foreach my $method_name ($meta->get_method_list()) {
495 next if exists $seen_method{$method_name};
496 $seen_method{$method_name}++;
498 name => $method_name,
500 code => $meta->get_method($method_name)
507 sub find_all_methods_by_name {
508 my ($self, $method_name) = @_;
509 (defined $method_name && $method_name)
510 || confess "You must define a method name to find";
512 # keep a record of what we have seen
513 # here, this will handle all the
514 # inheritence issues because we are
515 # using the &class_precedence_list
517 foreach my $class ($self->class_precedence_list()) {
518 next if $seen_class{$class};
519 $seen_class{$class}++;
520 # fetch the meta-class ...
521 my $meta = $self->initialize($class);
523 name => $method_name,
525 code => $meta->get_method($method_name)
526 } if $meta->has_method($method_name);
531 sub find_next_method_by_name {
532 my ($self, $method_name) = @_;
533 (defined $method_name && $method_name)
534 || confess "You must define a method name to find";
535 # keep a record of what we have seen
536 # here, this will handle all the
537 # inheritence issues because we are
538 # using the &class_precedence_list
540 my @cpl = $self->class_precedence_list();
541 shift @cpl; # discard ourselves
542 foreach my $class (@cpl) {
543 next if $seen_class{$class};
544 $seen_class{$class}++;
545 # fetch the meta-class ...
546 my $meta = $self->initialize($class);
547 return $meta->get_method($method_name)
548 if $meta->has_method($method_name);
557 # either we have an attribute object already
558 # or we need to create one from the args provided
559 my $attribute = blessed($_[0]) ? $_[0] : $self->attribute_metaclass->new(@_);
560 # make sure it is derived from the correct type though
561 ($attribute->isa('Class::MOP::Attribute'))
562 || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";
563 $attribute->attach_to_class($self);
564 $attribute->install_accessors();
565 $self->get_attribute_map->{$attribute->name} = $attribute;
569 my ($self, $attribute_name) = @_;
570 (defined $attribute_name && $attribute_name)
571 || confess "You must define an attribute name";
572 exists $self->get_attribute_map->{$attribute_name} ? 1 : 0;
576 my ($self, $attribute_name) = @_;
577 (defined $attribute_name && $attribute_name)
578 || confess "You must define an attribute name";
579 return $self->get_attribute_map->{$attribute_name}
580 if $self->has_attribute($attribute_name);
584 sub remove_attribute {
585 my ($self, $attribute_name) = @_;
586 (defined $attribute_name && $attribute_name)
587 || confess "You must define an attribute name";
588 my $removed_attribute = $self->get_attribute_map->{$attribute_name};
589 return unless defined $removed_attribute;
590 delete $self->get_attribute_map->{$attribute_name};
591 $removed_attribute->remove_accessors();
592 $removed_attribute->detach_from_class();
593 return $removed_attribute;
596 sub get_attribute_list {
598 keys %{$self->get_attribute_map};
601 sub compute_all_applicable_attributes {
604 # keep a record of what we have seen
605 # here, this will handle all the
606 # inheritence issues because we are
607 # using the &class_precedence_list
608 my (%seen_class, %seen_attr);
609 foreach my $class ($self->class_precedence_list()) {
610 next if $seen_class{$class};
611 $seen_class{$class}++;
612 # fetch the meta-class ...
613 my $meta = $self->initialize($class);
614 foreach my $attr_name ($meta->get_attribute_list()) {
615 next if exists $seen_attr{$attr_name};
616 $seen_attr{$attr_name}++;
617 push @attrs => $meta->get_attribute($attr_name);
623 sub find_attribute_by_name {
624 my ($self, $attr_name) = @_;
625 # keep a record of what we have seen
626 # here, this will handle all the
627 # inheritence issues because we are
628 # using the &class_precedence_list
630 foreach my $class ($self->class_precedence_list()) {
631 next if $seen_class{$class};
632 $seen_class{$class}++;
633 # fetch the meta-class ...
634 my $meta = $self->initialize($class);
635 return $meta->get_attribute($attr_name)
636 if $meta->has_attribute($attr_name);
644 sub is_immutable { 0 }
647 return Class::MOP::Class::Immutable->make_metaclass_immutable(@_);
658 Class::MOP::Class - Class Meta Object
662 # assuming that class Foo
663 # has been defined, you can
665 # use this for introspection ...
667 # add a method to Foo ...
668 Foo->meta->add_method('bar' => sub { ... })
670 # get a list of all the classes searched
671 # the method dispatcher in the correct order
672 Foo->meta->class_precedence_list()
674 # remove a method from Foo
675 Foo->meta->remove_method('bar');
677 # or use this to actually create classes ...
679 Class::MOP::Class->create('Bar' => '0.01' => (
680 superclasses => [ 'Foo' ],
682 Class::MOP:::Attribute->new('$bar'),
683 Class::MOP:::Attribute->new('$baz'),
686 calculate_bar => sub { ... },
687 construct_baz => sub { ... }
693 This is the largest and currently most complex part of the Perl 5
694 meta-object protocol. It controls the introspection and
695 manipulation of Perl 5 classes (and it can create them too). The
696 best way to understand what this module can do, is to read the
697 documentation for each of it's methods.
701 =head2 Self Introspection
707 This will return a B<Class::MOP::Class> instance which is related
708 to this class. Thereby allowing B<Class::MOP::Class> to actually
711 As with B<Class::MOP::Attribute>, B<Class::MOP> will actually
712 bootstrap this module by installing a number of attribute meta-objects
713 into it's metaclass. This will allow this class to reap all the benifits
714 of the MOP when subclassing it.
718 =head2 Class construction
720 These methods will handle creating B<Class::MOP::Class> objects,
721 which can be used to both create new classes, and analyze
722 pre-existing classes.
724 This module will internally store references to all the instances
725 you create with these methods, so that they do not need to be
726 created any more than nessecary. Basically, they are singletons.
730 =item B<create ($package_name, ?$package_version,
731 superclasses =E<gt> ?@superclasses,
732 methods =E<gt> ?%methods,
733 attributes =E<gt> ?%attributes)>
735 This returns a B<Class::MOP::Class> object, bringing the specified
736 C<$package_name> into existence and adding any of the
737 C<$package_version>, C<@superclasses>, C<%methods> and C<%attributes>
740 =item B<create_anon_class (superclasses =E<gt> ?@superclasses,
741 methods =E<gt> ?%methods,
742 attributes =E<gt> ?%attributes)>
744 This will create an anonymous class, it works much like C<create> but
745 it does not need a C<$package_name>. Instead it will create a suitably
746 unique package name for you to stash things into.
748 =item B<initialize ($package_name, %options)>
750 This initializes and returns returns a B<Class::MOP::Class> object
751 for a given a C<$package_name>.
753 =item B<reinitialize ($package_name, %options)>
755 This removes the old metaclass, and creates a new one in it's place.
756 Do B<not> use this unless you really know what you are doing, it could
757 very easily make a very large mess of your program.
759 =item B<construct_class_instance (%options)>
761 This will construct an instance of B<Class::MOP::Class>, it is
762 here so that we can actually "tie the knot" for B<Class::MOP::Class>
763 to use C<construct_instance> once all the bootstrapping is done. This
764 method is used internally by C<initialize> and should never be called
765 from outside of that method really.
767 =item B<check_metaclass_compatability>
769 This method is called as the very last thing in the
770 C<construct_class_instance> method. This will check that the
771 metaclass you are creating is compatible with the metaclasses of all
772 your ancestors. For more inforamtion about metaclass compatibility
773 see the C<About Metaclass compatibility> section in L<Class::MOP>.
777 =head2 Object instance construction and cloning
779 These methods are B<entirely optional>, it is up to you whether you want
784 =item B<instance_metaclass>
786 =item B<get_meta_instance>
788 =item B<new_object (%params)>
790 This is a convience method for creating a new object of the class, and
791 blessing it into the appropriate package as well. Ideally your class
792 would call a C<new> this method like so:
795 my ($class, %param) = @_;
796 $class->meta->new_object(%params);
799 Of course the ideal place for this would actually be in C<UNIVERSAL::>
800 but that is considered bad style, so we do not do that.
802 =item B<construct_instance (%params)>
804 This method is used to construct an instace structure suitable for
805 C<bless>-ing into your package of choice. It works in conjunction
806 with the Attribute protocol to collect all applicable attributes.
808 This will construct and instance using a HASH ref as storage
809 (currently only HASH references are supported). This will collect all
810 the applicable attributes and layout out the fields in the HASH ref,
811 it will then initialize them using either use the corresponding key
812 in C<%params> or any default value or initializer found in the
813 attribute meta-object.
815 =item B<clone_object ($instance, %params)>
817 This is a convience method for cloning an object instance, then
818 blessing it into the appropriate package. This method will call
819 C<clone_instance>, which performs a shallow copy of the object,
820 see that methods documentation for more details. Ideally your
821 class would call a C<clone> this method like so:
824 my ($self, %param) = @_;
825 $self->meta->clone_object($self, %params);
828 Of course the ideal place for this would actually be in C<UNIVERSAL::>
829 but that is considered bad style, so we do not do that.
831 =item B<clone_instance($instance, %params)>
833 This method is a compliment of C<construct_instance> (which means if
834 you override C<construct_instance>, you need to override this one too),
835 and clones the instance shallowly.
837 The cloned structure returned is (like with C<construct_instance>) an
838 unC<bless>ed HASH reference, it is your responsibility to then bless
839 this cloned structure into the right class (which C<clone_object> will
842 As of 0.11, this method will clone the C<$instance> structure shallowly,
843 as opposed to the deep cloning implemented in prior versions. After much
844 thought, research and discussion, I have decided that anything but basic
845 shallow cloning is outside the scope of the meta-object protocol. I
846 think Yuval "nothingmuch" Kogman put it best when he said that cloning
847 is too I<context-specific> to be part of the MOP.
853 These are a few predicate methods for asking information about the class.
857 =item B<is_anon_class>
861 =item B<is_immutable>
865 =head2 Inheritance Relationships
869 =item B<superclasses (?@superclasses)>
871 This is a read-write attribute which represents the superclass
872 relationships of the class the B<Class::MOP::Class> instance is
873 associated with. Basically, it can get and set the C<@ISA> for you.
876 Perl will occasionally perform some C<@ISA> and method caching, if
877 you decide to change your superclass relationship at runtime (which
878 is quite insane and very much not recommened), then you should be
879 aware of this and the fact that this module does not make any
880 attempt to address this issue.
882 =item B<class_precedence_list>
884 This computes the a list of all the class's ancestors in the same order
885 in which method dispatch will be done. This is similair to
886 what B<Class::ISA::super_path> does, but we don't remove duplicate names.
894 =item B<method_metaclass>
896 =item B<add_method ($method_name, $method)>
898 This will take a C<$method_name> and CODE reference to that
899 C<$method> and install it into the class's package.
902 This does absolutely nothing special to C<$method>
903 other than use B<Sub::Name> to make sure it is tagged with the
904 correct name, and therefore show up correctly in stack traces and
907 =item B<alias_method ($method_name, $method)>
909 This will take a C<$method_name> and CODE reference to that
910 C<$method> and alias the method into the class's package.
913 Unlike C<add_method>, this will B<not> try to name the
914 C<$method> using B<Sub::Name>, it only aliases the method in
917 =item B<has_method ($method_name)>
919 This just provides a simple way to check if the class implements
920 a specific C<$method_name>. It will I<not> however, attempt to check
921 if the class inherits the method (use C<UNIVERSAL::can> for that).
923 This will correctly handle functions defined outside of the package
924 that use a fully qualified name (C<sub Package::name { ... }>).
926 This will correctly handle functions renamed with B<Sub::Name> and
927 installed using the symbol tables. However, if you are naming the
928 subroutine outside of the package scope, you must use the fully
929 qualified name, including the package name, for C<has_method> to
930 correctly identify it.
932 This will attempt to correctly ignore functions imported from other
933 packages using B<Exporter>. It breaks down if the function imported
934 is an C<__ANON__> sub (such as with C<use constant>), which very well
935 may be a valid method being applied to the class.
937 In short, this method cannot always be trusted to determine if the
938 C<$method_name> is actually a method. However, it will DWIM about
939 90% of the time, so it's a small trade off I think.
941 =item B<get_method ($method_name)>
943 This will return a CODE reference of the specified C<$method_name>,
944 or return undef if that method does not exist.
946 =item B<find_method_by_name ($method_name>
948 This will return a CODE reference of the specified C<$method_name>,
949 or return undef if that method does not exist.
951 Unlike C<get_method> this will also look in the superclasses.
953 =item B<remove_method ($method_name)>
955 This will attempt to remove a given C<$method_name> from the class.
956 It will return the CODE reference that it has removed, and will
957 attempt to use B<Sub::Name> to clear the methods associated name.
959 =item B<get_method_list>
961 This will return a list of method names for all I<locally> defined
962 methods. It does B<not> provide a list of all applicable methods,
963 including any inherited ones. If you want a list of all applicable
964 methods, use the C<compute_all_applicable_methods> method.
966 =item B<compute_all_applicable_methods>
968 This will return a list of all the methods names this class will
969 respond to, taking into account inheritance. The list will be a list of
970 HASH references, each one containing the following information; method
971 name, the name of the class in which the method lives and a CODE
972 reference for the actual method.
974 =item B<find_all_methods_by_name ($method_name)>
976 This will traverse the inheritence hierarchy and locate all methods
977 with a given C<$method_name>. Similar to
978 C<compute_all_applicable_methods> it returns a list of HASH references
979 with the following information; method name (which will always be the
980 same as C<$method_name>), the name of the class in which the method
981 lives and a CODE reference for the actual method.
983 The list of methods produced is a distinct list, meaning there are no
984 duplicates in it. This is especially useful for things like object
985 initialization and destruction where you only want the method called
986 once, and in the correct order.
988 =item B<find_next_method_by_name ($method_name)>
990 This will return the first method to match a given C<$method_name> in
991 the superclasses, this is basically equivalent to calling
992 C<SUPER::$method_name>, but it can be dispatched at runtime.
996 =head2 Method Modifiers
998 Method modifiers are a concept borrowed from CLOS, in which a method
999 can be wrapped with I<before>, I<after> and I<around> method modifiers
1000 that will be called everytime the method is called.
1002 =head3 How method modifiers work?
1004 Method modifiers work by wrapping the original method and then replacing
1005 it in the classes symbol table. The wrappers will handle calling all the
1006 modifiers in the appropariate orders and preserving the calling context
1007 for the original method.
1009 Each method modifier serves a particular purpose, which may not be
1010 obvious to users of other method wrapping modules. To start with, the
1011 return values of I<before> and I<after> modifiers are ignored. This is
1012 because thier purpose is B<not> to filter the input and output of the
1013 primary method (this is done with an I<around> modifier). This may seem
1014 like an odd restriction to some, but doing this allows for simple code
1015 to be added at the begining or end of a method call without jeapordizing
1016 the normal functioning of the primary method or placing any extra
1017 responsibility on the code of the modifier. Of course if you have more
1018 complex needs, then use the I<around> modifier, which uses a variation
1019 of continutation passing style to allow for a high degree of flexibility.
1021 Before and around modifiers are called in last-defined-first-called order,
1022 while after modifiers are called in first-defined-first-called order. So
1023 the call tree might looks something like this:
1033 To see examples of using method modifiers, see the following examples
1034 included in the distribution; F<InstanceCountingClass>, F<Perl6Attribute>,
1035 F<AttributesWithHistory> and F<C3MethodDispatchOrder>. There is also a
1036 classic CLOS usage example in the test F<017_add_method_modifier.t>.
1038 =head3 What is the performance impact?
1040 Of course there is a performance cost associated with method modifiers,
1041 but we have made every effort to make that cost be directly proportional
1042 to the amount of modifier features you utilize.
1044 The wrapping method does it's best to B<only> do as much work as it
1045 absolutely needs to. In order to do this we have moved some of the
1046 performance costs to set-up time, where they are easier to amortize.
1048 All this said, my benchmarks have indicated the following:
1050 simple wrapper with no modifiers 100% slower
1051 simple wrapper with simple before modifier 400% slower
1052 simple wrapper with simple after modifier 450% slower
1053 simple wrapper with simple around modifier 500-550% slower
1054 simple wrapper with all 3 modifiers 1100% slower
1056 These numbers may seem daunting, but you must remember, every feature
1057 comes with some cost. To put things in perspective, just doing a simple
1058 C<AUTOLOAD> which does nothing but extract the name of the method called
1059 and return it costs about 400% over a normal method call.
1063 =item B<add_before_method_modifier ($method_name, $code)>
1065 This will wrap the method at C<$method_name> and the supplied C<$code>
1066 will be passed the C<@_> arguments, and called before the original
1067 method is called. As specified above, the return value of the I<before>
1068 method modifiers is ignored, and it's ability to modify C<@_> is
1069 fairly limited. If you need to do either of these things, use an
1070 C<around> method modifier.
1072 =item B<add_after_method_modifier ($method_name, $code)>
1074 This will wrap the method at C<$method_name> so that the original
1075 method will be called, it's return values stashed, and then the
1076 supplied C<$code> will be passed the C<@_> arguments, and called.
1077 As specified above, the return value of the I<after> method
1078 modifiers is ignored, and it cannot modify the return values of
1079 the original method. If you need to do either of these things, use an
1080 C<around> method modifier.
1082 =item B<add_around_method_modifier ($method_name, $code)>
1084 This will wrap the method at C<$method_name> so that C<$code>
1085 will be called and passed the original method as an extra argument
1086 at the begining of the C<@_> argument list. This is a variation of
1087 continuation passing style, where the function prepended to C<@_>
1088 can be considered a continuation. It is up to C<$code> if it calls
1089 the original method or not, there is no restriction on what the
1090 C<$code> can or cannot do.
1096 It should be noted that since there is no one consistent way to define
1097 the attributes of a class in Perl 5. These methods can only work with
1098 the information given, and can not easily discover information on
1099 their own. See L<Class::MOP::Attribute> for more details.
1103 =item B<attribute_metaclass>
1105 =item B<get_attribute_map>
1107 =item B<add_attribute ($attribute_name, $attribute_meta_object)>
1109 This stores a C<$attribute_meta_object> in the B<Class::MOP::Class>
1110 instance associated with the given class, and associates it with
1111 the C<$attribute_name>. Unlike methods, attributes within the MOP
1112 are stored as meta-information only. They will be used later to
1113 construct instances from (see C<construct_instance> above).
1114 More details about the attribute meta-objects can be found in the
1115 L<Class::MOP::Attribute> or the L<Class::MOP/The Attribute protocol>
1118 It should be noted that any accessor, reader/writer or predicate
1119 methods which the C<$attribute_meta_object> has will be installed
1120 into the class at this time.
1122 =item B<has_attribute ($attribute_name)>
1124 Checks to see if this class has an attribute by the name of
1125 C<$attribute_name> and returns a boolean.
1127 =item B<get_attribute ($attribute_name)>
1129 Returns the attribute meta-object associated with C<$attribute_name>,
1130 if none is found, it will return undef.
1132 =item B<remove_attribute ($attribute_name)>
1134 This will remove the attribute meta-object stored at
1135 C<$attribute_name>, then return the removed attribute meta-object.
1138 Removing an attribute will only affect future instances of
1139 the class, it will not make any attempt to remove the attribute from
1140 any existing instances of the class.
1142 It should be noted that any accessor, reader/writer or predicate
1143 methods which the attribute meta-object stored at C<$attribute_name>
1144 has will be removed from the class at this time. This B<will> make
1145 these attributes somewhat inaccessable in previously created
1146 instances. But if you are crazy enough to do this at runtime, then
1147 you are crazy enough to deal with something like this :).
1149 =item B<get_attribute_list>
1151 This returns a list of attribute names which are defined in the local
1152 class. If you want a list of all applicable attributes for a class,
1153 use the C<compute_all_applicable_attributes> method.
1155 =item B<compute_all_applicable_attributes>
1157 This will traverse the inheritance heirachy and return a list of all
1158 the applicable attributes for this class. It does not construct a
1159 HASH reference like C<compute_all_applicable_methods> because all
1160 that same information is discoverable through the attribute
1163 =item B<find_attribute_by_name ($attr_name)>
1165 This method will traverse the inheritance heirachy and find the
1166 first attribute whose name matches C<$attr_name>, then return it.
1167 It will return undef if nothing is found.
1171 =head2 Class closing
1175 =item B<make_immutable>
1181 Stevan Little E<lt>stevan@iinteractive.comE<gt>
1183 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
1185 =head1 COPYRIGHT AND LICENSE
1187 Copyright 2006 by Infinity Interactive, Inc.
1189 L<http://www.iinteractive.com>
1191 This library is free software; you can redistribute it and/or modify
1192 it under the same terms as Perl itself.