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.19';
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,
82 # since the following attributes will
83 # actually be loaded from the symbol
84 # table, and actually bypass the instance
85 # entirely, we can just leave these things
86 # listed here for reference, because they
87 # should not actually have a value associated
89 '%:namespace' => \undef,
90 # inherited from Class::MOP::Module
91 '$:version' => \undef,
92 '$:authority' => \undef,
93 # defined in Class::MOP::Class
97 '$:attribute_metaclass' => $options{':attribute_metaclass'} || 'Class::MOP::Attribute',
98 '$:method_metaclass' => $options{':method_metaclass'} || 'Class::MOP::Method',
99 '$:instance_metaclass' => $options{':instance_metaclass'} || 'Class::MOP::Instance',
104 # it is safe to use meta here because
105 # class will always be a subclass of
106 # Class::MOP::Class, which defines meta
107 $meta = $class->meta->construct_instance(%options)
110 # and check the metaclass compatibility
111 $meta->check_metaclass_compatability();
113 Class::MOP::store_metaclass_by_name($package_name, $meta);
116 # we need to weaken any anon classes
117 # so that they can call DESTROY properly
118 Class::MOP::weaken_metaclass($package_name) if $meta->is_anon_class;
123 sub check_metaclass_compatability {
126 # this is always okay ...
127 return if blessed($self) eq 'Class::MOP::Class' &&
128 $self->instance_metaclass eq 'Class::MOP::Instance';
130 my @class_list = $self->class_precedence_list;
131 shift @class_list; # shift off $self->name
133 foreach my $class_name (@class_list) {
134 my $meta = Class::MOP::get_metaclass_by_name($class_name) || next;
137 # we need to deal with the possibility
138 # of class immutability here, and then
139 # get the name of the class appropriately
140 my $meta_type = ($meta->is_immutable
141 ? $meta->get_mutable_metaclass_name()
144 ($self->isa($meta_type))
145 || confess $self->name . "->meta => (" . (blessed($self)) . ")" .
146 " is not compatible with the " .
147 $class_name . "->meta => (" . ($meta_type) . ")";
149 # we also need to check that instance metaclasses
150 # are compatabile in the same the class.
151 ($self->instance_metaclass->isa($meta->instance_metaclass))
152 || confess $self->name . "->meta => (" . ($self->instance_metaclass) . ")" .
153 " is not compatible with the " .
154 $class_name . "->meta => (" . ($meta->instance_metaclass) . ")";
162 # this should be sufficient, if you have a
163 # use case where it is not, write a test and
165 my $ANON_CLASS_SERIAL = 0;
168 # we need a sufficiently annoying prefix
169 # this should suffice for now, this is
170 # used in a couple of places below, so
171 # need to put it up here for now.
172 my $ANON_CLASS_PREFIX = 'Class::MOP::Class::__ANON__::SERIAL::';
176 $self->name =~ /^$ANON_CLASS_PREFIX/ ? 1 : 0;
179 sub create_anon_class {
180 my ($class, %options) = @_;
181 my $package_name = $ANON_CLASS_PREFIX . ++$ANON_CLASS_SERIAL;
182 return $class->create($package_name, %options);
186 # this will only get called for
187 # anon-classes, all other calls
188 # are assumed to occur during
189 # global destruction and so don't
190 # really need to be handled explicitly
193 return unless $self->name =~ /^$ANON_CLASS_PREFIX/;
194 my ($serial_id) = ($self->name =~ /^$ANON_CLASS_PREFIX(\d+)/);
196 foreach my $key (keys %{$ANON_CLASS_PREFIX . $serial_id}) {
197 delete ${$ANON_CLASS_PREFIX . $serial_id}{$key};
199 delete ${'main::' . $ANON_CLASS_PREFIX}{$serial_id . '::'};
204 # creating classes with MOP ...
208 my $package_name = shift;
210 (defined $package_name && $package_name)
211 || confess "You must pass a package name";
214 || confess "You much pass all parameters as name => value pairs " .
215 "(I found an uneven number of params in \@_)";
219 my $code = "package $package_name;";
220 $code .= "\$$package_name\:\:VERSION = '" . $options{version} . "';"
221 if exists $options{version};
222 $code .= "\$$package_name\:\:AUTHORITY = '" . $options{authority} . "';"
223 if exists $options{authority};
226 confess "creation of $package_name failed : $@" if $@;
228 my $meta = $class->initialize($package_name);
230 $meta->add_method('meta' => sub {
231 $class->initialize(blessed($_[0]) || $_[0]);
234 $meta->superclasses(@{$options{superclasses}})
235 if exists $options{superclasses};
237 # process attributes first, so that they can
238 # install accessors, but locally defined methods
239 # can then overwrite them. It is maybe a little odd, but
240 # I think this should be the order of things.
241 if (exists $options{attributes}) {
242 foreach my $attr (@{$options{attributes}}) {
243 $meta->add_attribute($attr);
246 if (exists $options{methods}) {
247 foreach my $method_name (keys %{$options{methods}}) {
248 $meta->add_method($method_name, $options{methods}->{$method_name});
257 # all these attribute readers will be bootstrapped
258 # away in the Class::MOP bootstrap section
260 sub get_attribute_map { $_[0]->{'%:attributes'} }
261 sub attribute_metaclass { $_[0]->{'$:attribute_metaclass'} }
262 sub method_metaclass { $_[0]->{'$:method_metaclass'} }
263 sub instance_metaclass { $_[0]->{'$:instance_metaclass'} }
267 my $map = $self->{'%:methods'};
269 foreach my $symbol (grep { $self->has_package_symbol('&' . $_) } $self->list_all_package_symbols) {
270 next if exists $map->{$symbol} &&
271 $map->{$symbol}->body == $self->get_package_symbol('&' . $symbol);
273 $map->{$symbol} = $self->method_metaclass->wrap(
274 $self->get_package_symbol('&' . $symbol)
281 # Instance Construction & Cloning
286 # we need to protect the integrity of the
287 # Class::MOP::Class singletons here, so we
288 # delegate this to &construct_class_instance
289 # which will deal with the singletons
290 return $class->construct_class_instance(@_)
291 if $class->name->isa('Class::MOP::Class');
292 return $class->construct_instance(@_);
295 sub construct_instance {
296 my ($class, %params) = @_;
297 my $meta_instance = $class->get_meta_instance();
298 my $instance = $meta_instance->create_instance();
299 foreach my $attr ($class->compute_all_applicable_attributes()) {
300 $attr->initialize_instance_slot($meta_instance, $instance, \%params);
305 sub get_meta_instance {
307 return $class->instance_metaclass->new(
309 $class->compute_all_applicable_attributes()
315 my $instance = shift;
316 (blessed($instance) && $instance->isa($class->name))
317 || confess "You must pass an instance ($instance) of the metaclass (" . $class->name . ")";
319 # we need to protect the integrity of the
320 # Class::MOP::Class singletons here, they
321 # should not be cloned.
322 return $instance if $instance->isa('Class::MOP::Class');
323 $class->clone_instance($instance, @_);
327 my ($class, $instance, %params) = @_;
329 || confess "You can only clone instances, \$self is not a blessed instance";
330 my $meta_instance = $class->get_meta_instance();
331 my $clone = $meta_instance->clone_instance($instance);
332 foreach my $key (keys %params) {
333 next unless $meta_instance->is_valid_slot($key);
334 $meta_instance->set_slot_value($clone, $key, $params{$key});
345 @{$self->get_package_symbol('@ISA')} = @supers;
347 # we need to check the metaclass
348 # compatability here so that we can
349 # be sure that the superclass is
350 # not potentially creating an issues
351 # we don't know about
352 $self->check_metaclass_compatability();
354 @{$self->get_package_symbol('@ISA')};
357 sub class_precedence_list {
360 # We need to check for ciruclar inheirtance here.
361 # This will do nothing if all is well, and blow
362 # up otherwise. Yes, it's an ugly hack, better
363 # suggestions are welcome.
364 { ($self->name || return)->isa('This is a test for circular inheritance') }
365 # ... and now back to our regularly scheduled program
369 $self->initialize($_)->class_precedence_list()
370 } $self->superclasses()
377 my ($self, $method_name, $method) = @_;
378 (defined $method_name && $method_name)
379 || confess "You must define a method name";
380 # use reftype here to allow for blessed subs ...
384 if (blessed($method)) {
386 $body = $method->body;
388 ('CODE' eq (reftype($body) || ''))
389 || confess "Your code block must be a CODE reference";
391 $self->get_method_map->{$method_name} = $method;
397 ('CODE' eq (reftype($body) || ''))
398 || confess "Your code block must be a CODE reference";
400 $self->get_method_map->{$method_name} = $self->method_metaclass->wrap($body);
404 my $full_method_name = ($self->name . '::' . $method_name);
405 $self->add_package_symbol("&${method_name}" => subname $full_method_name => $body);
409 my $fetch_and_prepare_method = sub {
410 my ($self, $method_name) = @_;
412 my $method = $self->get_method($method_name);
413 # if we dont have local ...
415 # try to find the next method
416 $method = $self->find_next_method_by_name($method_name);
417 # die if it does not exist
419 || confess "The method '$method_name' is not found in the inherience hierarchy for this class";
420 # and now make sure to wrap it
421 # even if it is already wrapped
422 # because we need a new sub ref
423 $method = Class::MOP::Method::Wrapped->wrap($method);
426 # now make sure we wrap it properly
427 $method = Class::MOP::Method::Wrapped->wrap($method)
428 unless $method->isa('Class::MOP::Method::Wrapped');
430 $self->add_method($method_name => $method);
434 sub add_before_method_modifier {
435 my ($self, $method_name, $method_modifier) = @_;
436 (defined $method_name && $method_name)
437 || confess "You must pass in a method name";
438 my $method = $fetch_and_prepare_method->($self, $method_name);
439 $method->add_before_modifier(subname ':before' => $method_modifier);
442 sub add_after_method_modifier {
443 my ($self, $method_name, $method_modifier) = @_;
444 (defined $method_name && $method_name)
445 || confess "You must pass in a method name";
446 my $method = $fetch_and_prepare_method->($self, $method_name);
447 $method->add_after_modifier(subname ':after' => $method_modifier);
450 sub add_around_method_modifier {
451 my ($self, $method_name, $method_modifier) = @_;
452 (defined $method_name && $method_name)
453 || confess "You must pass in a method name";
454 my $method = $fetch_and_prepare_method->($self, $method_name);
455 $method->add_around_modifier(subname ':around' => $method_modifier);
459 # the methods above used to be named like this:
460 # ${pkg}::${method}:(before|after|around)
461 # but this proved problematic when using one modifier
462 # to wrap multiple methods (something which is likely
463 # to happen pretty regularly IMO). So instead of naming
464 # it like this, I have chosen to just name them purely
465 # with their modifier names, like so:
466 # :(before|after|around)
467 # The fact is that in a stack trace, it will be fairly
468 # evident from the context what method they are attached
469 # to, and so don't need the fully qualified name.
473 my ($self, $method_name, $method) = @_;
474 (defined $method_name && $method_name)
475 || confess "You must define a method name";
479 if (blessed($method)) {
481 $body = $method->body;
483 ('CODE' eq (reftype($body) || ''))
484 || confess "Your code block must be a CODE reference";
486 $self->get_method_map->{$method_name} = $method;
492 ('CODE' eq (reftype($body) || ''))
493 || confess "Your code block must be a CODE reference";
495 $self->get_method_map->{$method_name} = $self->method_metaclass->wrap($body);
499 $self->add_package_symbol("&${method_name}" => $body);
503 my ($self, $method_name) = @_;
504 (defined $method_name && $method_name)
505 || confess "You must define a method name";
507 my $method_map = $self->get_method_map;
509 return 0 unless exists $self->get_method_map->{$method_name};
511 my $method = $method_map->{$method_name};
512 return 0 if ($method->package_name || '') ne $self->name &&
513 ($method->name || '') ne '__ANON__';
519 my ($self, $method_name) = @_;
520 (defined $method_name && $method_name)
521 || confess "You must define a method name";
523 return unless $self->has_method($method_name);
525 return $self->get_method_map->{$method_name};
529 my ($self, $method_name) = @_;
530 (defined $method_name && $method_name)
531 || confess "You must define a method name";
533 my $removed_method = $self->get_method($method_name);
535 $self->remove_package_symbol("&${method_name}")
536 if defined $removed_method;
538 delete $self->get_method_map->{$method_name}
539 if exists $self->get_method_map->{$method_name};
541 return $removed_method;
544 sub get_method_list {
546 return grep { $self->has_method($_) } keys %{$self->get_method_map};
549 sub find_method_by_name {
550 my ($self, $method_name) = @_;
552 return $self->name->can($method_name);
555 sub compute_all_applicable_methods {
558 # keep a record of what we have seen
559 # here, this will handle all the
560 # inheritence issues because we are
561 # using the &class_precedence_list
562 my (%seen_class, %seen_method);
563 foreach my $class ($self->class_precedence_list()) {
564 next if $seen_class{$class};
565 $seen_class{$class}++;
566 # fetch the meta-class ...
567 my $meta = $self->initialize($class);
568 foreach my $method_name ($meta->get_method_list()) {
569 next if exists $seen_method{$method_name};
570 $seen_method{$method_name}++;
572 name => $method_name,
574 code => $meta->get_method($method_name)
581 sub find_all_methods_by_name {
582 my ($self, $method_name) = @_;
583 (defined $method_name && $method_name)
584 || confess "You must define a method name to find";
586 # keep a record of what we have seen
587 # here, this will handle all the
588 # inheritence issues because we are
589 # using the &class_precedence_list
591 foreach my $class ($self->class_precedence_list()) {
592 next if $seen_class{$class};
593 $seen_class{$class}++;
594 # fetch the meta-class ...
595 my $meta = $self->initialize($class);
597 name => $method_name,
599 code => $meta->get_method($method_name)
600 } if $meta->has_method($method_name);
605 sub find_next_method_by_name {
606 my ($self, $method_name) = @_;
607 (defined $method_name && $method_name)
608 || confess "You must define a method name to find";
609 # keep a record of what we have seen
610 # here, this will handle all the
611 # inheritence issues because we are
612 # using the &class_precedence_list
614 my @cpl = $self->class_precedence_list();
615 shift @cpl; # discard ourselves
616 foreach my $class (@cpl) {
617 next if $seen_class{$class};
618 $seen_class{$class}++;
619 # fetch the meta-class ...
620 my $meta = $self->initialize($class);
621 return $meta->get_method($method_name)
622 if $meta->has_method($method_name);
631 # either we have an attribute object already
632 # or we need to create one from the args provided
633 my $attribute = blessed($_[0]) ? $_[0] : $self->attribute_metaclass->new(@_);
634 # make sure it is derived from the correct type though
635 ($attribute->isa('Class::MOP::Attribute'))
636 || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";
637 $attribute->attach_to_class($self);
638 $attribute->install_accessors();
639 $self->get_attribute_map->{$attribute->name} = $attribute;
643 my ($self, $attribute_name) = @_;
644 (defined $attribute_name && $attribute_name)
645 || confess "You must define an attribute name";
646 exists $self->get_attribute_map->{$attribute_name} ? 1 : 0;
650 my ($self, $attribute_name) = @_;
651 (defined $attribute_name && $attribute_name)
652 || confess "You must define an attribute name";
653 return $self->get_attribute_map->{$attribute_name}
654 if $self->has_attribute($attribute_name);
658 sub remove_attribute {
659 my ($self, $attribute_name) = @_;
660 (defined $attribute_name && $attribute_name)
661 || confess "You must define an attribute name";
662 my $removed_attribute = $self->get_attribute_map->{$attribute_name};
663 return unless defined $removed_attribute;
664 delete $self->get_attribute_map->{$attribute_name};
665 $removed_attribute->remove_accessors();
666 $removed_attribute->detach_from_class();
667 return $removed_attribute;
670 sub get_attribute_list {
672 keys %{$self->get_attribute_map};
675 sub compute_all_applicable_attributes {
678 # keep a record of what we have seen
679 # here, this will handle all the
680 # inheritence issues because we are
681 # using the &class_precedence_list
682 my (%seen_class, %seen_attr);
683 foreach my $class ($self->class_precedence_list()) {
684 next if $seen_class{$class};
685 $seen_class{$class}++;
686 # fetch the meta-class ...
687 my $meta = $self->initialize($class);
688 foreach my $attr_name ($meta->get_attribute_list()) {
689 next if exists $seen_attr{$attr_name};
690 $seen_attr{$attr_name}++;
691 push @attrs => $meta->get_attribute($attr_name);
697 sub find_attribute_by_name {
698 my ($self, $attr_name) = @_;
699 # keep a record of what we have seen
700 # here, this will handle all the
701 # inheritence issues because we are
702 # using the &class_precedence_list
704 foreach my $class ($self->class_precedence_list()) {
705 next if $seen_class{$class};
706 $seen_class{$class}++;
707 # fetch the meta-class ...
708 my $meta = $self->initialize($class);
709 return $meta->get_attribute($attr_name)
710 if $meta->has_attribute($attr_name);
718 sub is_immutable { 0 }
721 return Class::MOP::Class::Immutable->make_metaclass_immutable(@_);
732 Class::MOP::Class - Class Meta Object
736 # assuming that class Foo
737 # has been defined, you can
739 # use this for introspection ...
741 # add a method to Foo ...
742 Foo->meta->add_method('bar' => sub { ... })
744 # get a list of all the classes searched
745 # the method dispatcher in the correct order
746 Foo->meta->class_precedence_list()
748 # remove a method from Foo
749 Foo->meta->remove_method('bar');
751 # or use this to actually create classes ...
753 Class::MOP::Class->create('Bar' => (
755 superclasses => [ 'Foo' ],
757 Class::MOP:::Attribute->new('$bar'),
758 Class::MOP:::Attribute->new('$baz'),
761 calculate_bar => sub { ... },
762 construct_baz => sub { ... }
768 This is the largest and currently most complex part of the Perl 5
769 meta-object protocol. It controls the introspection and
770 manipulation of Perl 5 classes (and it can create them too). The
771 best way to understand what this module can do, is to read the
772 documentation for each of it's methods.
776 =head2 Self Introspection
782 This will return a B<Class::MOP::Class> instance which is related
783 to this class. Thereby allowing B<Class::MOP::Class> to actually
786 As with B<Class::MOP::Attribute>, B<Class::MOP> will actually
787 bootstrap this module by installing a number of attribute meta-objects
788 into it's metaclass. This will allow this class to reap all the benifits
789 of the MOP when subclassing it.
793 =head2 Class construction
795 These methods will handle creating B<Class::MOP::Class> objects,
796 which can be used to both create new classes, and analyze
797 pre-existing classes.
799 This module will internally store references to all the instances
800 you create with these methods, so that they do not need to be
801 created any more than nessecary. Basically, they are singletons.
805 =item B<create ($package_name,
806 version =E<gt> ?$version,
807 authority =E<gt> ?$authority,
808 superclasses =E<gt> ?@superclasses,
809 methods =E<gt> ?%methods,
810 attributes =E<gt> ?%attributes)>
812 This returns a B<Class::MOP::Class> object, bringing the specified
813 C<$package_name> into existence and adding any of the C<$version>,
814 C<$authority>, C<@superclasses>, C<%methods> and C<%attributes> to
817 =item B<create_anon_class (superclasses =E<gt> ?@superclasses,
818 methods =E<gt> ?%methods,
819 attributes =E<gt> ?%attributes)>
821 This will create an anonymous class, it works much like C<create> but
822 it does not need a C<$package_name>. Instead it will create a suitably
823 unique package name for you to stash things into.
825 =item B<initialize ($package_name, %options)>
827 This initializes and returns returns a B<Class::MOP::Class> object
828 for a given a C<$package_name>.
830 =item B<reinitialize ($package_name, %options)>
832 This removes the old metaclass, and creates a new one in it's place.
833 Do B<not> use this unless you really know what you are doing, it could
834 very easily make a very large mess of your program.
836 =item B<construct_class_instance (%options)>
838 This will construct an instance of B<Class::MOP::Class>, it is
839 here so that we can actually "tie the knot" for B<Class::MOP::Class>
840 to use C<construct_instance> once all the bootstrapping is done. This
841 method is used internally by C<initialize> and should never be called
842 from outside of that method really.
844 =item B<check_metaclass_compatability>
846 This method is called as the very last thing in the
847 C<construct_class_instance> method. This will check that the
848 metaclass you are creating is compatible with the metaclasses of all
849 your ancestors. For more inforamtion about metaclass compatibility
850 see the C<About Metaclass compatibility> section in L<Class::MOP>.
854 =head2 Object instance construction and cloning
856 These methods are B<entirely optional>, it is up to you whether you want
861 =item B<instance_metaclass>
863 =item B<get_meta_instance>
865 =item B<new_object (%params)>
867 This is a convience method for creating a new object of the class, and
868 blessing it into the appropriate package as well. Ideally your class
869 would call a C<new> this method like so:
872 my ($class, %param) = @_;
873 $class->meta->new_object(%params);
876 Of course the ideal place for this would actually be in C<UNIVERSAL::>
877 but that is considered bad style, so we do not do that.
879 =item B<construct_instance (%params)>
881 This method is used to construct an instace structure suitable for
882 C<bless>-ing into your package of choice. It works in conjunction
883 with the Attribute protocol to collect all applicable attributes.
885 This will construct and instance using a HASH ref as storage
886 (currently only HASH references are supported). This will collect all
887 the applicable attributes and layout out the fields in the HASH ref,
888 it will then initialize them using either use the corresponding key
889 in C<%params> or any default value or initializer found in the
890 attribute meta-object.
892 =item B<clone_object ($instance, %params)>
894 This is a convience method for cloning an object instance, then
895 blessing it into the appropriate package. This method will call
896 C<clone_instance>, which performs a shallow copy of the object,
897 see that methods documentation for more details. Ideally your
898 class would call a C<clone> this method like so:
901 my ($self, %param) = @_;
902 $self->meta->clone_object($self, %params);
905 Of course the ideal place for this would actually be in C<UNIVERSAL::>
906 but that is considered bad style, so we do not do that.
908 =item B<clone_instance($instance, %params)>
910 This method is a compliment of C<construct_instance> (which means if
911 you override C<construct_instance>, you need to override this one too),
912 and clones the instance shallowly.
914 The cloned structure returned is (like with C<construct_instance>) an
915 unC<bless>ed HASH reference, it is your responsibility to then bless
916 this cloned structure into the right class (which C<clone_object> will
919 As of 0.11, this method will clone the C<$instance> structure shallowly,
920 as opposed to the deep cloning implemented in prior versions. After much
921 thought, research and discussion, I have decided that anything but basic
922 shallow cloning is outside the scope of the meta-object protocol. I
923 think Yuval "nothingmuch" Kogman put it best when he said that cloning
924 is too I<context-specific> to be part of the MOP.
930 These are a few predicate methods for asking information about the class.
934 =item B<is_anon_class>
938 =item B<is_immutable>
942 =head2 Inheritance Relationships
946 =item B<superclasses (?@superclasses)>
948 This is a read-write attribute which represents the superclass
949 relationships of the class the B<Class::MOP::Class> instance is
950 associated with. Basically, it can get and set the C<@ISA> for you.
953 Perl will occasionally perform some C<@ISA> and method caching, if
954 you decide to change your superclass relationship at runtime (which
955 is quite insane and very much not recommened), then you should be
956 aware of this and the fact that this module does not make any
957 attempt to address this issue.
959 =item B<class_precedence_list>
961 This computes the a list of all the class's ancestors in the same order
962 in which method dispatch will be done. This is similair to
963 what B<Class::ISA::super_path> does, but we don't remove duplicate names.
971 =item B<get_method_map>
973 =item B<method_metaclass>
975 =item B<add_method ($method_name, $method)>
977 This will take a C<$method_name> and CODE reference to that
978 C<$method> and install it into the class's package.
981 This does absolutely nothing special to C<$method>
982 other than use B<Sub::Name> to make sure it is tagged with the
983 correct name, and therefore show up correctly in stack traces and
986 =item B<alias_method ($method_name, $method)>
988 This will take a C<$method_name> and CODE reference to that
989 C<$method> and alias the method into the class's package.
992 Unlike C<add_method>, this will B<not> try to name the
993 C<$method> using B<Sub::Name>, it only aliases the method in
996 =item B<has_method ($method_name)>
998 This just provides a simple way to check if the class implements
999 a specific C<$method_name>. It will I<not> however, attempt to check
1000 if the class inherits the method (use C<UNIVERSAL::can> for that).
1002 This will correctly handle functions defined outside of the package
1003 that use a fully qualified name (C<sub Package::name { ... }>).
1005 This will correctly handle functions renamed with B<Sub::Name> and
1006 installed using the symbol tables. However, if you are naming the
1007 subroutine outside of the package scope, you must use the fully
1008 qualified name, including the package name, for C<has_method> to
1009 correctly identify it.
1011 This will attempt to correctly ignore functions imported from other
1012 packages using B<Exporter>. It breaks down if the function imported
1013 is an C<__ANON__> sub (such as with C<use constant>), which very well
1014 may be a valid method being applied to the class.
1016 In short, this method cannot always be trusted to determine if the
1017 C<$method_name> is actually a method. However, it will DWIM about
1018 90% of the time, so it's a small trade off I think.
1020 =item B<get_method ($method_name)>
1022 This will return a CODE reference of the specified C<$method_name>,
1023 or return undef if that method does not exist.
1025 =item B<find_method_by_name ($method_name>
1027 This will return a CODE reference of the specified C<$method_name>,
1028 or return undef if that method does not exist.
1030 Unlike C<get_method> this will also look in the superclasses.
1032 =item B<remove_method ($method_name)>
1034 This will attempt to remove a given C<$method_name> from the class.
1035 It will return the CODE reference that it has removed, and will
1036 attempt to use B<Sub::Name> to clear the methods associated name.
1038 =item B<get_method_list>
1040 This will return a list of method names for all I<locally> defined
1041 methods. It does B<not> provide a list of all applicable methods,
1042 including any inherited ones. If you want a list of all applicable
1043 methods, use the C<compute_all_applicable_methods> method.
1045 =item B<compute_all_applicable_methods>
1047 This will return a list of all the methods names this class will
1048 respond to, taking into account inheritance. The list will be a list of
1049 HASH references, each one containing the following information; method
1050 name, the name of the class in which the method lives and a CODE
1051 reference for the actual method.
1053 =item B<find_all_methods_by_name ($method_name)>
1055 This will traverse the inheritence hierarchy and locate all methods
1056 with a given C<$method_name>. Similar to
1057 C<compute_all_applicable_methods> it returns a list of HASH references
1058 with the following information; method name (which will always be the
1059 same as C<$method_name>), the name of the class in which the method
1060 lives and a CODE reference for the actual method.
1062 The list of methods produced is a distinct list, meaning there are no
1063 duplicates in it. This is especially useful for things like object
1064 initialization and destruction where you only want the method called
1065 once, and in the correct order.
1067 =item B<find_next_method_by_name ($method_name)>
1069 This will return the first method to match a given C<$method_name> in
1070 the superclasses, this is basically equivalent to calling
1071 C<SUPER::$method_name>, but it can be dispatched at runtime.
1075 =head2 Method Modifiers
1077 Method modifiers are a concept borrowed from CLOS, in which a method
1078 can be wrapped with I<before>, I<after> and I<around> method modifiers
1079 that will be called everytime the method is called.
1081 =head3 How method modifiers work?
1083 Method modifiers work by wrapping the original method and then replacing
1084 it in the classes symbol table. The wrappers will handle calling all the
1085 modifiers in the appropariate orders and preserving the calling context
1086 for the original method.
1088 Each method modifier serves a particular purpose, which may not be
1089 obvious to users of other method wrapping modules. To start with, the
1090 return values of I<before> and I<after> modifiers are ignored. This is
1091 because thier purpose is B<not> to filter the input and output of the
1092 primary method (this is done with an I<around> modifier). This may seem
1093 like an odd restriction to some, but doing this allows for simple code
1094 to be added at the begining or end of a method call without jeapordizing
1095 the normal functioning of the primary method or placing any extra
1096 responsibility on the code of the modifier. Of course if you have more
1097 complex needs, then use the I<around> modifier, which uses a variation
1098 of continutation passing style to allow for a high degree of flexibility.
1100 Before and around modifiers are called in last-defined-first-called order,
1101 while after modifiers are called in first-defined-first-called order. So
1102 the call tree might looks something like this:
1112 To see examples of using method modifiers, see the following examples
1113 included in the distribution; F<InstanceCountingClass>, F<Perl6Attribute>,
1114 F<AttributesWithHistory> and F<C3MethodDispatchOrder>. There is also a
1115 classic CLOS usage example in the test F<017_add_method_modifier.t>.
1117 =head3 What is the performance impact?
1119 Of course there is a performance cost associated with method modifiers,
1120 but we have made every effort to make that cost be directly proportional
1121 to the amount of modifier features you utilize.
1123 The wrapping method does it's best to B<only> do as much work as it
1124 absolutely needs to. In order to do this we have moved some of the
1125 performance costs to set-up time, where they are easier to amortize.
1127 All this said, my benchmarks have indicated the following:
1129 simple wrapper with no modifiers 100% slower
1130 simple wrapper with simple before modifier 400% slower
1131 simple wrapper with simple after modifier 450% slower
1132 simple wrapper with simple around modifier 500-550% slower
1133 simple wrapper with all 3 modifiers 1100% slower
1135 These numbers may seem daunting, but you must remember, every feature
1136 comes with some cost. To put things in perspective, just doing a simple
1137 C<AUTOLOAD> which does nothing but extract the name of the method called
1138 and return it costs about 400% over a normal method call.
1142 =item B<add_before_method_modifier ($method_name, $code)>
1144 This will wrap the method at C<$method_name> and the supplied C<$code>
1145 will be passed the C<@_> arguments, and called before the original
1146 method is called. As specified above, the return value of the I<before>
1147 method modifiers is ignored, and it's ability to modify C<@_> is
1148 fairly limited. If you need to do either of these things, use an
1149 C<around> method modifier.
1151 =item B<add_after_method_modifier ($method_name, $code)>
1153 This will wrap the method at C<$method_name> so that the original
1154 method will be called, it's return values stashed, and then the
1155 supplied C<$code> will be passed the C<@_> arguments, and called.
1156 As specified above, the return value of the I<after> method
1157 modifiers is ignored, and it cannot modify the return values of
1158 the original method. If you need to do either of these things, use an
1159 C<around> method modifier.
1161 =item B<add_around_method_modifier ($method_name, $code)>
1163 This will wrap the method at C<$method_name> so that C<$code>
1164 will be called and passed the original method as an extra argument
1165 at the begining of the C<@_> argument list. This is a variation of
1166 continuation passing style, where the function prepended to C<@_>
1167 can be considered a continuation. It is up to C<$code> if it calls
1168 the original method or not, there is no restriction on what the
1169 C<$code> can or cannot do.
1175 It should be noted that since there is no one consistent way to define
1176 the attributes of a class in Perl 5. These methods can only work with
1177 the information given, and can not easily discover information on
1178 their own. See L<Class::MOP::Attribute> for more details.
1182 =item B<attribute_metaclass>
1184 =item B<get_attribute_map>
1186 =item B<add_attribute ($attribute_name, $attribute_meta_object)>
1188 This stores a C<$attribute_meta_object> in the B<Class::MOP::Class>
1189 instance associated with the given class, and associates it with
1190 the C<$attribute_name>. Unlike methods, attributes within the MOP
1191 are stored as meta-information only. They will be used later to
1192 construct instances from (see C<construct_instance> above).
1193 More details about the attribute meta-objects can be found in the
1194 L<Class::MOP::Attribute> or the L<Class::MOP/The Attribute protocol>
1197 It should be noted that any accessor, reader/writer or predicate
1198 methods which the C<$attribute_meta_object> has will be installed
1199 into the class at this time.
1201 =item B<has_attribute ($attribute_name)>
1203 Checks to see if this class has an attribute by the name of
1204 C<$attribute_name> and returns a boolean.
1206 =item B<get_attribute ($attribute_name)>
1208 Returns the attribute meta-object associated with C<$attribute_name>,
1209 if none is found, it will return undef.
1211 =item B<remove_attribute ($attribute_name)>
1213 This will remove the attribute meta-object stored at
1214 C<$attribute_name>, then return the removed attribute meta-object.
1217 Removing an attribute will only affect future instances of
1218 the class, it will not make any attempt to remove the attribute from
1219 any existing instances of the class.
1221 It should be noted that any accessor, reader/writer or predicate
1222 methods which the attribute meta-object stored at C<$attribute_name>
1223 has will be removed from the class at this time. This B<will> make
1224 these attributes somewhat inaccessable in previously created
1225 instances. But if you are crazy enough to do this at runtime, then
1226 you are crazy enough to deal with something like this :).
1228 =item B<get_attribute_list>
1230 This returns a list of attribute names which are defined in the local
1231 class. If you want a list of all applicable attributes for a class,
1232 use the C<compute_all_applicable_attributes> method.
1234 =item B<compute_all_applicable_attributes>
1236 This will traverse the inheritance heirachy and return a list of all
1237 the applicable attributes for this class. It does not construct a
1238 HASH reference like C<compute_all_applicable_methods> because all
1239 that same information is discoverable through the attribute
1242 =item B<find_attribute_by_name ($attr_name)>
1244 This method will traverse the inheritance heirachy and find the
1245 first attribute whose name matches C<$attr_name>, then return it.
1246 It will return undef if nothing is found.
1250 =head2 Class closing
1254 =item B<make_immutable>
1260 Stevan Little E<lt>stevan@iinteractive.comE<gt>
1262 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
1264 =head1 COPYRIGHT AND LICENSE
1266 Copyright 2006 by Infinity Interactive, Inc.
1268 L<http://www.iinteractive.com>
1270 This library is free software; you can redistribute it and/or modify
1271 it under the same terms as Perl itself.