2 package Class::MOP::Class;
7 use Class::MOP::Immutable;
8 use Class::MOP::Instance;
9 use Class::MOP::Method::Wrapped;
12 use Scalar::Util 'blessed', 'reftype', 'weaken';
13 use Sub::Name 'subname';
14 use B 'svref_2object';
16 our $VERSION = '0.24';
17 our $AUTHORITY = 'cpan:STEVAN';
19 use base 'Class::MOP::Module';
23 sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) }
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 if (defined(my $meta = Class::MOP::get_metaclass_by_name($package_name))) {
35 $class->construct_class_instance('package' => $package_name, @_);
40 my $package_name = shift;
41 (defined $package_name && $package_name && !blessed($package_name))
42 || confess "You must pass a package name and it cannot be blessed";
43 Class::MOP::remove_metaclass_by_name($package_name);
44 $class->construct_class_instance('package' => $package_name, @_);
47 # NOTE: (meta-circularity)
48 # this is a special form of &construct_instance
49 # (see below), which is used to construct class
50 # meta-object instances for any Class::MOP::*
51 # class. All other classes will use the more
52 # normal &construct_instance.
53 sub construct_class_instance {
56 my $package_name = $options{'package'};
57 (defined $package_name && $package_name)
58 || confess "You must pass a package name";
60 # return the metaclass if we have it cached,
61 # and it is still defined (it has not been
62 # reaped by DESTROY yet, which can happen
63 # annoyingly enough during global destruction)
65 if (defined(my $meta = Class::MOP::get_metaclass_by_name($package_name))) {
70 # we need to deal with the possibility
71 # of class immutability here, and then
72 # get the name of the class appropriately
73 $class = (blessed($class)
74 ? ($class->is_immutable
75 ? $class->get_mutable_metaclass_name()
79 # now create the metaclass
81 if ($class eq 'Class::MOP::Class') {
84 # inherited from Class::MOP::Package
85 '$!package' => $package_name,
88 # since the following attributes will
89 # actually be loaded from the symbol
90 # table, and actually bypass the instance
91 # entirely, we can just leave these things
92 # listed here for reference, because they
93 # should not actually have a value associated
95 '%!namespace' => \undef,
96 # inherited from Class::MOP::Module
97 '$!version' => \undef,
98 '$!authority' => \undef,
99 # defined in Class::MOP::Class
100 '@!superclasses' => \undef,
103 '%!attributes' => {},
104 '$!attribute_metaclass' => $options{'attribute_metaclass'} || 'Class::MOP::Attribute',
105 '$!method_metaclass' => $options{'method_metaclass'} || 'Class::MOP::Method',
106 '$!instance_metaclass' => $options{'instance_metaclass'} || 'Class::MOP::Instance',
111 # it is safe to use meta here because
112 # class will always be a subclass of
113 # Class::MOP::Class, which defines meta
114 $meta = $class->meta->construct_instance(%options)
117 # and check the metaclass compatibility
118 $meta->check_metaclass_compatability();
120 Class::MOP::store_metaclass_by_name($package_name, $meta);
123 # we need to weaken any anon classes
124 # so that they can call DESTROY properly
125 Class::MOP::weaken_metaclass($package_name) if $meta->is_anon_class;
130 sub check_metaclass_compatability {
133 # this is always okay ...
134 return if blessed($self) eq 'Class::MOP::Class' &&
135 $self->instance_metaclass eq 'Class::MOP::Instance';
137 my @class_list = $self->linearized_isa;
138 shift @class_list; # shift off $self->name
140 foreach my $class_name (@class_list) {
141 my $meta = Class::MOP::get_metaclass_by_name($class_name) || next;
144 # we need to deal with the possibility
145 # of class immutability here, and then
146 # get the name of the class appropriately
147 my $meta_type = ($meta->is_immutable
148 ? $meta->get_mutable_metaclass_name()
151 ($self->isa($meta_type))
152 || confess $self->name . "->meta => (" . (blessed($self)) . ")" .
153 " is not compatible with the " .
154 $class_name . "->meta => (" . ($meta_type) . ")";
156 # we also need to check that instance metaclasses
157 # are compatabile in the same the class.
158 ($self->instance_metaclass->isa($meta->instance_metaclass))
159 || confess $self->name . "->meta => (" . ($self->instance_metaclass) . ")" .
160 " is not compatible with the " .
161 $class_name . "->meta => (" . ($meta->instance_metaclass) . ")";
169 # this should be sufficient, if you have a
170 # use case where it is not, write a test and
172 my $ANON_CLASS_SERIAL = 0;
175 # we need a sufficiently annoying prefix
176 # this should suffice for now, this is
177 # used in a couple of places below, so
178 # need to put it up here for now.
179 my $ANON_CLASS_PREFIX = 'Class::MOP::Class::__ANON__::SERIAL::';
183 no warnings 'uninitialized';
184 $self->name =~ /^$ANON_CLASS_PREFIX/ ? 1 : 0;
187 sub create_anon_class {
188 my ($class, %options) = @_;
189 my $package_name = $ANON_CLASS_PREFIX . ++$ANON_CLASS_SERIAL;
190 return $class->create($package_name, %options);
194 # this will only get called for
195 # anon-classes, all other calls
196 # are assumed to occur during
197 # global destruction and so don't
198 # really need to be handled explicitly
201 no warnings 'uninitialized';
202 return unless $self->name =~ /^$ANON_CLASS_PREFIX/;
203 my ($serial_id) = ($self->name =~ /^$ANON_CLASS_PREFIX(\d+)/);
205 foreach my $key (keys %{$ANON_CLASS_PREFIX . $serial_id}) {
206 delete ${$ANON_CLASS_PREFIX . $serial_id}{$key};
208 delete ${'main::' . $ANON_CLASS_PREFIX}{$serial_id . '::'};
213 # creating classes with MOP ...
217 my $package_name = shift;
219 (defined $package_name && $package_name)
220 || confess "You must pass a package name";
223 || confess "You much pass all parameters as name => value pairs " .
224 "(I found an uneven number of params in \@_)";
228 my $code = "package $package_name;";
229 $code .= "\$$package_name\:\:VERSION = '" . $options{version} . "';"
230 if exists $options{version};
231 $code .= "\$$package_name\:\:AUTHORITY = '" . $options{authority} . "';"
232 if exists $options{authority};
235 confess "creation of $package_name failed : $@" if $@;
237 my $meta = $class->initialize($package_name);
239 $meta->add_method('meta' => sub {
240 $class->initialize(blessed($_[0]) || $_[0]);
243 $meta->superclasses(@{$options{superclasses}})
244 if exists $options{superclasses};
246 # process attributes first, so that they can
247 # install accessors, but locally defined methods
248 # can then overwrite them. It is maybe a little odd, but
249 # I think this should be the order of things.
250 if (exists $options{attributes}) {
251 foreach my $attr (@{$options{attributes}}) {
252 $meta->add_attribute($attr);
255 if (exists $options{methods}) {
256 foreach my $method_name (keys %{$options{methods}}) {
257 $meta->add_method($method_name, $options{methods}->{$method_name});
266 # all these attribute readers will be bootstrapped
267 # away in the Class::MOP bootstrap section
269 sub get_attribute_map { $_[0]->{'%!attributes'} }
270 sub attribute_metaclass { $_[0]->{'$!attribute_metaclass'} }
271 sub method_metaclass { $_[0]->{'$!method_metaclass'} }
272 sub instance_metaclass { $_[0]->{'$!instance_metaclass'} }
275 # this is a prime canidate for conversion to XS
278 my $map = $self->{'%!methods'};
280 my $class_name = $self->name;
281 my $method_metaclass = $self->method_metaclass;
283 foreach my $symbol ($self->list_all_package_symbols('CODE')) {
284 my $code = $self->get_package_symbol('&' . $symbol);
286 next if exists $map->{$symbol} &&
287 defined $map->{$symbol} &&
288 $map->{$symbol}->body == $code;
290 my $gv = svref_2object($code)->GV;
291 next if ($gv->STASH->NAME || '') ne $class_name &&
292 ($gv->NAME || '') ne '__ANON__';
294 $map->{$symbol} = $method_metaclass->wrap($code);
300 # Instance Construction & Cloning
305 # we need to protect the integrity of the
306 # Class::MOP::Class singletons here, so we
307 # delegate this to &construct_class_instance
308 # which will deal with the singletons
309 return $class->construct_class_instance(@_)
310 if $class->name->isa('Class::MOP::Class');
311 return $class->construct_instance(@_);
314 sub construct_instance {
315 my ($class, %params) = @_;
316 my $meta_instance = $class->get_meta_instance();
317 my $instance = $meta_instance->create_instance();
318 foreach my $attr ($class->compute_all_applicable_attributes()) {
319 $attr->initialize_instance_slot($meta_instance, $instance, \%params);
322 # this will only work for a HASH instance type
323 if ($class->is_anon_class) {
324 (reftype($instance) eq 'HASH')
325 || confess "Currently only HASH based instances are supported with instance of anon-classes";
327 # At some point we should make this official
328 # as a reserved slot name, but right now I am
329 # going to keep it here.
330 # my $RESERVED_MOP_SLOT = '__MOP__';
331 $instance->{'__MOP__'} = $class;
336 sub get_meta_instance {
338 return $class->instance_metaclass->new(
340 $class->compute_all_applicable_attributes()
346 my $instance = shift;
347 (blessed($instance) && $instance->isa($class->name))
348 || confess "You must pass an instance ($instance) of the metaclass (" . $class->name . ")";
350 # we need to protect the integrity of the
351 # Class::MOP::Class singletons here, they
352 # should not be cloned.
353 return $instance if $instance->isa('Class::MOP::Class');
354 $class->clone_instance($instance, @_);
358 my ($class, $instance, %params) = @_;
360 || confess "You can only clone instances, \$self is not a blessed instance";
361 my $meta_instance = $class->get_meta_instance();
362 my $clone = $meta_instance->clone_instance($instance);
363 foreach my $attr ($class->compute_all_applicable_attributes()) {
364 if (exists $params{$attr->init_arg}) {
365 $meta_instance->set_slot_value($clone, $attr->name, $params{$attr->init_arg});
377 @{$self->get_package_symbol('@ISA')} = @supers;
379 # we need to check the metaclass
380 # compatibility here so that we can
381 # be sure that the superclass is
382 # not potentially creating an issues
383 # we don't know about
384 $self->check_metaclass_compatability();
386 @{$self->get_package_symbol('@ISA')};
391 grep { !($seen{$_}++) } (shift)->class_precedence_list
394 sub class_precedence_list {
397 # We need to check for circular inheritance here.
398 # This will do nothing if all is well, and blow
399 # up otherwise. Yes, it's an ugly hack, better
400 # suggestions are welcome.
401 { ($self->name || return)->isa('This is a test for circular inheritance') }
406 $self->initialize($_)->class_precedence_list()
407 } $self->superclasses()
414 my ($self, $method_name, $method) = @_;
415 (defined $method_name && $method_name)
416 || confess "You must define a method name";
419 if (blessed($method)) {
420 $body = $method->body;
424 ('CODE' eq (reftype($body) || ''))
425 || confess "Your code block must be a CODE reference";
426 $method = $self->method_metaclass->wrap($body);
428 $self->get_method_map->{$method_name} = $method;
430 my $full_method_name = ($self->name . '::' . $method_name);
431 $self->add_package_symbol("&${method_name}" => subname $full_method_name => $body);
435 my $fetch_and_prepare_method = sub {
436 my ($self, $method_name) = @_;
438 my $method = $self->get_method($method_name);
439 # if we dont have local ...
441 # try to find the next method
442 $method = $self->find_next_method_by_name($method_name);
443 # die if it does not exist
445 || confess "The method '$method_name' is not found in the inheritance hierarchy for class " . $self->name;
446 # and now make sure to wrap it
447 # even if it is already wrapped
448 # because we need a new sub ref
449 $method = Class::MOP::Method::Wrapped->wrap($method);
452 # now make sure we wrap it properly
453 $method = Class::MOP::Method::Wrapped->wrap($method)
454 unless $method->isa('Class::MOP::Method::Wrapped');
456 $self->add_method($method_name => $method);
460 sub add_before_method_modifier {
461 my ($self, $method_name, $method_modifier) = @_;
462 (defined $method_name && $method_name)
463 || confess "You must pass in a method name";
464 my $method = $fetch_and_prepare_method->($self, $method_name);
465 $method->add_before_modifier(subname ':before' => $method_modifier);
468 sub add_after_method_modifier {
469 my ($self, $method_name, $method_modifier) = @_;
470 (defined $method_name && $method_name)
471 || confess "You must pass in a method name";
472 my $method = $fetch_and_prepare_method->($self, $method_name);
473 $method->add_after_modifier(subname ':after' => $method_modifier);
476 sub add_around_method_modifier {
477 my ($self, $method_name, $method_modifier) = @_;
478 (defined $method_name && $method_name)
479 || confess "You must pass in a method name";
480 my $method = $fetch_and_prepare_method->($self, $method_name);
481 $method->add_around_modifier(subname ':around' => $method_modifier);
485 # the methods above used to be named like this:
486 # ${pkg}::${method}:(before|after|around)
487 # but this proved problematic when using one modifier
488 # to wrap multiple methods (something which is likely
489 # to happen pretty regularly IMO). So instead of naming
490 # it like this, I have chosen to just name them purely
491 # with their modifier names, like so:
492 # :(before|after|around)
493 # The fact is that in a stack trace, it will be fairly
494 # evident from the context what method they are attached
495 # to, and so don't need the fully qualified name.
499 my ($self, $method_name, $method) = @_;
500 (defined $method_name && $method_name)
501 || confess "You must define a method name";
503 my $body = (blessed($method) ? $method->body : $method);
504 ('CODE' eq (reftype($body) || ''))
505 || confess "Your code block must be a CODE reference";
507 $self->add_package_symbol("&${method_name}" => $body);
511 my ($self, $method_name) = @_;
512 (defined $method_name && $method_name)
513 || confess "You must define a method name";
515 return 0 unless exists $self->get_method_map->{$method_name};
520 my ($self, $method_name) = @_;
521 (defined $method_name && $method_name)
522 || confess "You must define a method name";
525 # I don't really need this here, because
526 # if the method_map is missing a key it
527 # will just return undef for me now
528 # return unless $self->has_method($method_name);
530 return $self->get_method_map->{$method_name};
534 my ($self, $method_name) = @_;
535 (defined $method_name && $method_name)
536 || confess "You must define a method name";
538 my $removed_method = $self->get_method($method_name);
541 $self->remove_package_symbol("&${method_name}");
542 delete $self->get_method_map->{$method_name};
543 } if defined $removed_method;
545 return $removed_method;
548 sub get_method_list {
550 keys %{$self->get_method_map};
553 sub find_method_by_name {
554 my ($self, $method_name) = @_;
555 (defined $method_name && $method_name)
556 || confess "You must define a method name to find";
557 foreach my $class ($self->linearized_isa) {
558 # fetch the meta-class ...
559 my $meta = $self->initialize($class);
560 return $meta->get_method($method_name)
561 if $meta->has_method($method_name);
566 sub compute_all_applicable_methods {
568 my (@methods, %seen_method);
569 foreach my $class ($self->linearized_isa) {
570 # fetch the meta-class ...
571 my $meta = $self->initialize($class);
572 foreach my $method_name ($meta->get_method_list()) {
573 next if exists $seen_method{$method_name};
574 $seen_method{$method_name}++;
576 name => $method_name,
578 code => $meta->get_method($method_name)
585 sub find_all_methods_by_name {
586 my ($self, $method_name) = @_;
587 (defined $method_name && $method_name)
588 || confess "You must define a method name to find";
590 foreach my $class ($self->linearized_isa) {
591 # fetch the meta-class ...
592 my $meta = $self->initialize($class);
594 name => $method_name,
596 code => $meta->get_method($method_name)
597 } if $meta->has_method($method_name);
602 sub find_next_method_by_name {
603 my ($self, $method_name) = @_;
604 (defined $method_name && $method_name)
605 || confess "You must define a method name to find";
606 my @cpl = $self->linearized_isa;
607 shift @cpl; # discard ourselves
608 foreach my $class (@cpl) {
609 # fetch the meta-class ...
610 my $meta = $self->initialize($class);
611 return $meta->get_method($method_name)
612 if $meta->has_method($method_name);
621 # either we have an attribute object already
622 # or we need to create one from the args provided
623 my $attribute = blessed($_[0]) ? $_[0] : $self->attribute_metaclass->new(@_);
624 # make sure it is derived from the correct type though
625 ($attribute->isa('Class::MOP::Attribute'))
626 || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";
628 # first we attach our new attribute
629 # because it might need certain information
630 # about the class which it is attached to
631 $attribute->attach_to_class($self);
633 # then we remove attributes of a conflicting
634 # name here so that we can properly detach
635 # the old attr object, and remove any
636 # accessors it would have generated
637 $self->remove_attribute($attribute->name)
638 if $self->has_attribute($attribute->name);
640 # then onto installing the new accessors
641 $attribute->install_accessors();
642 $self->get_attribute_map->{$attribute->name} = $attribute;
646 my ($self, $attribute_name) = @_;
647 (defined $attribute_name && $attribute_name)
648 || confess "You must define an attribute name";
649 exists $self->get_attribute_map->{$attribute_name} ? 1 : 0;
653 my ($self, $attribute_name) = @_;
654 (defined $attribute_name && $attribute_name)
655 || confess "You must define an attribute name";
656 return $self->get_attribute_map->{$attribute_name}
658 # this will return undef anyway, so no need ...
659 # if $self->has_attribute($attribute_name);
663 sub remove_attribute {
664 my ($self, $attribute_name) = @_;
665 (defined $attribute_name && $attribute_name)
666 || confess "You must define an attribute name";
667 my $removed_attribute = $self->get_attribute_map->{$attribute_name};
668 return unless defined $removed_attribute;
669 delete $self->get_attribute_map->{$attribute_name};
670 $removed_attribute->remove_accessors();
671 $removed_attribute->detach_from_class();
672 return $removed_attribute;
675 sub get_attribute_list {
677 keys %{$self->get_attribute_map};
680 sub compute_all_applicable_attributes {
682 my (@attrs, %seen_attr);
683 foreach my $class ($self->linearized_isa) {
684 # fetch the meta-class ...
685 my $meta = $self->initialize($class);
686 foreach my $attr_name ($meta->get_attribute_list()) {
687 next if exists $seen_attr{$attr_name};
688 $seen_attr{$attr_name}++;
689 push @attrs => $meta->get_attribute($attr_name);
695 sub find_attribute_by_name {
696 my ($self, $attr_name) = @_;
697 foreach my $class ($self->linearized_isa) {
698 # fetch the meta-class ...
699 my $meta = $self->initialize($class);
700 return $meta->get_attribute($attr_name)
701 if $meta->has_attribute($attr_name);
709 sub is_immutable { 0 }
712 # Why I changed this (groditi)
713 # - One Metaclass may have many Classes through many Metaclass instances
714 # - One Metaclass should only have one Immutable Transformer instance
715 # - Each Class may have different Immutabilizing options
716 # - Therefore each Metaclass instance may have different Immutabilizing options
717 # - We need to store one Immutable Transformer instance per Metaclass
718 # - We need to store one set of Immutable Transformer options per Class
719 # - Upon make_mutable we may delete the Immutabilizing options
720 # - We could clean the immutable Transformer instance when there is no more
721 # immutable Classes of that type, but we can also keep it in case
722 # another class with this same Metaclass becomes immutable. It is a case
723 # of trading of storing an instance to avoid unnecessary instantiations of
724 # Immutable Transformers. You may view this as a memory leak, however
725 # Because we have few Metaclasses, in practice it seems acceptable
726 # - To allow Immutable Transformers instances to be cleaned up we could weaken
727 # the reference stored in $IMMUTABLE_TRANSFORMERS{$class} and ||= should DWIM
730 my %IMMUTABLE_TRANSFORMERS;
731 my %IMMUTABLE_OPTIONS;
735 my $class = blessed $self || $self;
737 $IMMUTABLE_TRANSFORMERS{$class} ||= $self->create_immutable_transformer;
738 my $transformer = $IMMUTABLE_TRANSFORMERS{$class};
740 $transformer->make_metaclass_immutable($self, %options);
741 $IMMUTABLE_OPTIONS{$self->name} =
742 { %options, IMMUTABLE_TRANSFORMER => $transformer };
744 if( exists $options{debug} && $options{debug} ){
745 print STDERR "# of Metaclass options: ", keys %IMMUTABLE_OPTIONS;
746 print STDERR "# of Immutable transformers: ", keys %IMMUTABLE_TRANSFORMERS;
752 return if $self->is_mutable;
753 my $options = delete $IMMUTABLE_OPTIONS{$self->name};
754 confess "unable to find immutabilizing options" unless ref $options;
755 my $transformer = delete $options->{IMMUTABLE_TRANSFORMER};
756 $transformer->make_metaclass_mutable($self, %$options);
760 sub create_immutable_transformer {
762 my $class = Class::MOP::Immutable->new($self, {
763 read_only => [qw/superclasses/],
771 remove_package_symbol
774 class_precedence_list => 'ARRAY',
775 linearized_isa => 'ARRAY',
776 compute_all_applicable_attributes => 'ARRAY',
777 get_meta_instance => 'SCALAR',
778 get_method_map => 'SCALAR',
792 Class::MOP::Class - Class Meta Object
796 # assuming that class Foo
797 # has been defined, you can
799 # use this for introspection ...
801 # add a method to Foo ...
802 Foo->meta->add_method('bar' => sub { ... })
804 # get a list of all the classes searched
805 # the method dispatcher in the correct order
806 Foo->meta->class_precedence_list()
808 # remove a method from Foo
809 Foo->meta->remove_method('bar');
811 # or use this to actually create classes ...
813 Class::MOP::Class->create('Bar' => (
815 superclasses => [ 'Foo' ],
817 Class::MOP:::Attribute->new('$bar'),
818 Class::MOP:::Attribute->new('$baz'),
821 calculate_bar => sub { ... },
822 construct_baz => sub { ... }
828 This is the largest and currently most complex part of the Perl 5
829 meta-object protocol. It controls the introspection and
830 manipulation of Perl 5 classes (and it can create them too). The
831 best way to understand what this module can do, is to read the
832 documentation for each of it's methods.
836 =head2 Self Introspection
842 This will return a B<Class::MOP::Class> instance which is related
843 to this class. Thereby allowing B<Class::MOP::Class> to actually
846 As with B<Class::MOP::Attribute>, B<Class::MOP> will actually
847 bootstrap this module by installing a number of attribute meta-objects
848 into it's metaclass. This will allow this class to reap all the benifits
849 of the MOP when subclassing it.
853 =head2 Class construction
855 These methods will handle creating B<Class::MOP::Class> objects,
856 which can be used to both create new classes, and analyze
857 pre-existing classes.
859 This module will internally store references to all the instances
860 you create with these methods, so that they do not need to be
861 created any more than nessecary. Basically, they are singletons.
865 =item B<create ($package_name,
866 version =E<gt> ?$version,
867 authority =E<gt> ?$authority,
868 superclasses =E<gt> ?@superclasses,
869 methods =E<gt> ?%methods,
870 attributes =E<gt> ?%attributes)>
872 This returns a B<Class::MOP::Class> object, bringing the specified
873 C<$package_name> into existence and adding any of the C<$version>,
874 C<$authority>, C<@superclasses>, C<%methods> and C<%attributes> to
877 =item B<create_anon_class (superclasses =E<gt> ?@superclasses,
878 methods =E<gt> ?%methods,
879 attributes =E<gt> ?%attributes)>
881 This will create an anonymous class, it works much like C<create> but
882 it does not need a C<$package_name>. Instead it will create a suitably
883 unique package name for you to stash things into.
885 On very important distinction is that anon classes are destroyed once
886 the metaclass they are attached to goes out of scope. In the DESTROY
887 method, the created package will be removed from the symbol table.
889 It is also worth noting that any instances created with an anon-class
890 will keep a special reference to the anon-meta which will prevent the
891 anon-class from going out of scope until all instances of it have also
892 been destroyed. This however only works for HASH based instance types,
893 as we use a special reserved slot (C<__MOP__>) to store this.
895 =item B<initialize ($package_name, %options)>
897 This initializes and returns returns a B<Class::MOP::Class> object
898 for a given a C<$package_name>.
900 =item B<reinitialize ($package_name, %options)>
902 This removes the old metaclass, and creates a new one in it's place.
903 Do B<not> use this unless you really know what you are doing, it could
904 very easily make a very large mess of your program.
906 =item B<construct_class_instance (%options)>
908 This will construct an instance of B<Class::MOP::Class>, it is
909 here so that we can actually "tie the knot" for B<Class::MOP::Class>
910 to use C<construct_instance> once all the bootstrapping is done. This
911 method is used internally by C<initialize> and should never be called
912 from outside of that method really.
914 =item B<check_metaclass_compatability>
916 This method is called as the very last thing in the
917 C<construct_class_instance> method. This will check that the
918 metaclass you are creating is compatible with the metaclasses of all
919 your ancestors. For more inforamtion about metaclass compatibility
920 see the C<About Metaclass compatibility> section in L<Class::MOP>.
924 =head2 Object instance construction and cloning
926 These methods are B<entirely optional>, it is up to you whether you want
931 =item B<instance_metaclass>
933 =item B<get_meta_instance>
935 =item B<new_object (%params)>
937 This is a convience method for creating a new object of the class, and
938 blessing it into the appropriate package as well. Ideally your class
939 would call a C<new> this method like so:
942 my ($class, %param) = @_;
943 $class->meta->new_object(%params);
946 Of course the ideal place for this would actually be in C<UNIVERSAL::>
947 but that is considered bad style, so we do not do that.
949 =item B<construct_instance (%params)>
951 This method is used to construct an instace structure suitable for
952 C<bless>-ing into your package of choice. It works in conjunction
953 with the Attribute protocol to collect all applicable attributes.
955 This will construct and instance using a HASH ref as storage
956 (currently only HASH references are supported). This will collect all
957 the applicable attributes and layout out the fields in the HASH ref,
958 it will then initialize them using either use the corresponding key
959 in C<%params> or any default value or initializer found in the
960 attribute meta-object.
962 =item B<clone_object ($instance, %params)>
964 This is a convience method for cloning an object instance, then
965 blessing it into the appropriate package. This method will call
966 C<clone_instance>, which performs a shallow copy of the object,
967 see that methods documentation for more details. Ideally your
968 class would call a C<clone> this method like so:
971 my ($self, %param) = @_;
972 $self->meta->clone_object($self, %params);
975 Of course the ideal place for this would actually be in C<UNIVERSAL::>
976 but that is considered bad style, so we do not do that.
978 =item B<clone_instance($instance, %params)>
980 This method is a compliment of C<construct_instance> (which means if
981 you override C<construct_instance>, you need to override this one too),
982 and clones the instance shallowly.
984 The cloned structure returned is (like with C<construct_instance>) an
985 unC<bless>ed HASH reference, it is your responsibility to then bless
986 this cloned structure into the right class (which C<clone_object> will
989 As of 0.11, this method will clone the C<$instance> structure shallowly,
990 as opposed to the deep cloning implemented in prior versions. After much
991 thought, research and discussion, I have decided that anything but basic
992 shallow cloning is outside the scope of the meta-object protocol. I
993 think Yuval "nothingmuch" Kogman put it best when he said that cloning
994 is too I<context-specific> to be part of the MOP.
1000 These are a few predicate methods for asking information about the class.
1004 =item B<is_anon_class>
1006 This returns true if the class is a C<Class::MOP::Class> created anon class.
1010 This returns true if the class is still mutable.
1012 =item B<is_immutable>
1014 This returns true if the class has been made immutable.
1018 =head2 Inheritance Relationships
1022 =item B<superclasses (?@superclasses)>
1024 This is a read-write attribute which represents the superclass
1025 relationships of the class the B<Class::MOP::Class> instance is
1026 associated with. Basically, it can get and set the C<@ISA> for you.
1029 Perl will occasionally perform some C<@ISA> and method caching, if
1030 you decide to change your superclass relationship at runtime (which
1031 is quite insane and very much not recommened), then you should be
1032 aware of this and the fact that this module does not make any
1033 attempt to address this issue.
1035 =item B<class_precedence_list>
1037 This computes the a list of all the class's ancestors in the same order
1038 in which method dispatch will be done. This is similair to
1039 what B<Class::ISA::super_path> does, but we don't remove duplicate names.
1041 =item B<linearized_isa>
1043 This returns a list based on C<class_precedence_list> but with all
1052 =item B<get_method_map>
1054 =item B<method_metaclass>
1056 =item B<add_method ($method_name, $method)>
1058 This will take a C<$method_name> and CODE reference to that
1059 C<$method> and install it into the class's package.
1062 This does absolutely nothing special to C<$method>
1063 other than use B<Sub::Name> to make sure it is tagged with the
1064 correct name, and therefore show up correctly in stack traces and
1067 =item B<alias_method ($method_name, $method)>
1069 This will take a C<$method_name> and CODE reference to that
1070 C<$method> and alias the method into the class's package.
1073 Unlike C<add_method>, this will B<not> try to name the
1074 C<$method> using B<Sub::Name>, it only aliases the method in
1075 the class's package.
1077 =item B<has_method ($method_name)>
1079 This just provides a simple way to check if the class implements
1080 a specific C<$method_name>. It will I<not> however, attempt to check
1081 if the class inherits the method (use C<UNIVERSAL::can> for that).
1083 This will correctly handle functions defined outside of the package
1084 that use a fully qualified name (C<sub Package::name { ... }>).
1086 This will correctly handle functions renamed with B<Sub::Name> and
1087 installed using the symbol tables. However, if you are naming the
1088 subroutine outside of the package scope, you must use the fully
1089 qualified name, including the package name, for C<has_method> to
1090 correctly identify it.
1092 This will attempt to correctly ignore functions imported from other
1093 packages using B<Exporter>. It breaks down if the function imported
1094 is an C<__ANON__> sub (such as with C<use constant>), which very well
1095 may be a valid method being applied to the class.
1097 In short, this method cannot always be trusted to determine if the
1098 C<$method_name> is actually a method. However, it will DWIM about
1099 90% of the time, so it's a small trade off I think.
1101 =item B<get_method ($method_name)>
1103 This will return a Class::MOP::Method instance related to the specified
1104 C<$method_name>, or return undef if that method does not exist.
1106 The Class::MOP::Method is codifiable, so you can use it like a normal
1107 CODE reference, see L<Class::MOP::Method> for more information.
1109 =item B<find_method_by_name ($method_name>
1111 This will return a CODE reference of the specified C<$method_name>,
1112 or return undef if that method does not exist.
1114 Unlike C<get_method> this will also look in the superclasses.
1116 =item B<remove_method ($method_name)>
1118 This will attempt to remove a given C<$method_name> from the class.
1119 It will return the CODE reference that it has removed, and will
1120 attempt to use B<Sub::Name> to clear the methods associated name.
1122 =item B<get_method_list>
1124 This will return a list of method names for all I<locally> defined
1125 methods. It does B<not> provide a list of all applicable methods,
1126 including any inherited ones. If you want a list of all applicable
1127 methods, use the C<compute_all_applicable_methods> method.
1129 =item B<compute_all_applicable_methods>
1131 This will return a list of all the methods names this class will
1132 respond to, taking into account inheritance. The list will be a list of
1133 HASH references, each one containing the following information; method
1134 name, the name of the class in which the method lives and a CODE
1135 reference for the actual method.
1137 =item B<find_all_methods_by_name ($method_name)>
1139 This will traverse the inheritence hierarchy and locate all methods
1140 with a given C<$method_name>. Similar to
1141 C<compute_all_applicable_methods> it returns a list of HASH references
1142 with the following information; method name (which will always be the
1143 same as C<$method_name>), the name of the class in which the method
1144 lives and a CODE reference for the actual method.
1146 The list of methods produced is a distinct list, meaning there are no
1147 duplicates in it. This is especially useful for things like object
1148 initialization and destruction where you only want the method called
1149 once, and in the correct order.
1151 =item B<find_next_method_by_name ($method_name)>
1153 This will return the first method to match a given C<$method_name> in
1154 the superclasses, this is basically equivalent to calling
1155 C<SUPER::$method_name>, but it can be dispatched at runtime.
1159 =head2 Method Modifiers
1161 Method modifiers are a concept borrowed from CLOS, in which a method
1162 can be wrapped with I<before>, I<after> and I<around> method modifiers
1163 that will be called everytime the method is called.
1165 =head3 How method modifiers work?
1167 Method modifiers work by wrapping the original method and then replacing
1168 it in the classes symbol table. The wrappers will handle calling all the
1169 modifiers in the appropariate orders and preserving the calling context
1170 for the original method.
1172 Each method modifier serves a particular purpose, which may not be
1173 obvious to users of other method wrapping modules. To start with, the
1174 return values of I<before> and I<after> modifiers are ignored. This is
1175 because thier purpose is B<not> to filter the input and output of the
1176 primary method (this is done with an I<around> modifier). This may seem
1177 like an odd restriction to some, but doing this allows for simple code
1178 to be added at the begining or end of a method call without jeapordizing
1179 the normal functioning of the primary method or placing any extra
1180 responsibility on the code of the modifier. Of course if you have more
1181 complex needs, then use the I<around> modifier, which uses a variation
1182 of continutation passing style to allow for a high degree of flexibility.
1184 Before and around modifiers are called in last-defined-first-called order,
1185 while after modifiers are called in first-defined-first-called order. So
1186 the call tree might looks something like this:
1196 To see examples of using method modifiers, see the following examples
1197 included in the distribution; F<InstanceCountingClass>, F<Perl6Attribute>,
1198 F<AttributesWithHistory> and F<C3MethodDispatchOrder>. There is also a
1199 classic CLOS usage example in the test F<017_add_method_modifier.t>.
1201 =head3 What is the performance impact?
1203 Of course there is a performance cost associated with method modifiers,
1204 but we have made every effort to make that cost be directly proportional
1205 to the amount of modifier features you utilize.
1207 The wrapping method does it's best to B<only> do as much work as it
1208 absolutely needs to. In order to do this we have moved some of the
1209 performance costs to set-up time, where they are easier to amortize.
1211 All this said, my benchmarks have indicated the following:
1213 simple wrapper with no modifiers 100% slower
1214 simple wrapper with simple before modifier 400% slower
1215 simple wrapper with simple after modifier 450% slower
1216 simple wrapper with simple around modifier 500-550% slower
1217 simple wrapper with all 3 modifiers 1100% slower
1219 These numbers may seem daunting, but you must remember, every feature
1220 comes with some cost. To put things in perspective, just doing a simple
1221 C<AUTOLOAD> which does nothing but extract the name of the method called
1222 and return it costs about 400% over a normal method call.
1226 =item B<add_before_method_modifier ($method_name, $code)>
1228 This will wrap the method at C<$method_name> and the supplied C<$code>
1229 will be passed the C<@_> arguments, and called before the original
1230 method is called. As specified above, the return value of the I<before>
1231 method modifiers is ignored, and it's ability to modify C<@_> is
1232 fairly limited. If you need to do either of these things, use an
1233 C<around> method modifier.
1235 =item B<add_after_method_modifier ($method_name, $code)>
1237 This will wrap the method at C<$method_name> so that the original
1238 method will be called, it's return values stashed, and then the
1239 supplied C<$code> will be passed the C<@_> arguments, and called.
1240 As specified above, the return value of the I<after> method
1241 modifiers is ignored, and it cannot modify the return values of
1242 the original method. If you need to do either of these things, use an
1243 C<around> method modifier.
1245 =item B<add_around_method_modifier ($method_name, $code)>
1247 This will wrap the method at C<$method_name> so that C<$code>
1248 will be called and passed the original method as an extra argument
1249 at the begining of the C<@_> argument list. This is a variation of
1250 continuation passing style, where the function prepended to C<@_>
1251 can be considered a continuation. It is up to C<$code> if it calls
1252 the original method or not, there is no restriction on what the
1253 C<$code> can or cannot do.
1259 It should be noted that since there is no one consistent way to define
1260 the attributes of a class in Perl 5. These methods can only work with
1261 the information given, and can not easily discover information on
1262 their own. See L<Class::MOP::Attribute> for more details.
1266 =item B<attribute_metaclass>
1268 =item B<get_attribute_map>
1270 =item B<add_attribute ($attribute_meta_object | $attribute_name, %attribute_spec)>
1272 This stores the C<$attribute_meta_object> (or creates one from the
1273 C<$attribute_name> and C<%attribute_spec>) in the B<Class::MOP::Class>
1274 instance associated with the given class. Unlike methods, attributes
1275 within the MOP are stored as meta-information only. They will be used
1276 later to construct instances from (see C<construct_instance> above).
1277 More details about the attribute meta-objects can be found in the
1278 L<Class::MOP::Attribute> or the L<Class::MOP/The Attribute protocol>
1281 It should be noted that any accessor, reader/writer or predicate
1282 methods which the C<$attribute_meta_object> has will be installed
1283 into the class at this time.
1286 If an attribute already exists for C<$attribute_name>, the old one
1287 will be removed (as well as removing all it's accessors), and then
1290 =item B<has_attribute ($attribute_name)>
1292 Checks to see if this class has an attribute by the name of
1293 C<$attribute_name> and returns a boolean.
1295 =item B<get_attribute ($attribute_name)>
1297 Returns the attribute meta-object associated with C<$attribute_name>,
1298 if none is found, it will return undef.
1300 =item B<remove_attribute ($attribute_name)>
1302 This will remove the attribute meta-object stored at
1303 C<$attribute_name>, then return the removed attribute meta-object.
1306 Removing an attribute will only affect future instances of
1307 the class, it will not make any attempt to remove the attribute from
1308 any existing instances of the class.
1310 It should be noted that any accessor, reader/writer or predicate
1311 methods which the attribute meta-object stored at C<$attribute_name>
1312 has will be removed from the class at this time. This B<will> make
1313 these attributes somewhat inaccessable in previously created
1314 instances. But if you are crazy enough to do this at runtime, then
1315 you are crazy enough to deal with something like this :).
1317 =item B<get_attribute_list>
1319 This returns a list of attribute names which are defined in the local
1320 class. If you want a list of all applicable attributes for a class,
1321 use the C<compute_all_applicable_attributes> method.
1323 =item B<compute_all_applicable_attributes>
1325 This will traverse the inheritance heirachy and return a list of all
1326 the applicable attributes for this class. It does not construct a
1327 HASH reference like C<compute_all_applicable_methods> because all
1328 that same information is discoverable through the attribute
1331 =item B<find_attribute_by_name ($attr_name)>
1333 This method will traverse the inheritance heirachy and find the
1334 first attribute whose name matches C<$attr_name>, then return it.
1335 It will return undef if nothing is found.
1339 =head2 Class Immutability
1343 =item B<make_immutable (%options)>
1345 This method will invoke a tranforamtion upon the class which will
1346 make it immutable. Details of this transformation can be found in
1347 the L<Class::MOP::Immutable> documentation.
1349 =item B<make_mutable>
1351 This method will reverse tranforamtion upon the class which
1354 =item B<create_immutable_transformer>
1356 Create a transformer suitable for making this class immutable
1362 Stevan Little E<lt>stevan@iinteractive.comE<gt>
1364 =head1 COPYRIGHT AND LICENSE
1366 Copyright 2006, 2007 by Infinity Interactive, Inc.
1368 L<http://www.iinteractive.com>
1370 This library is free software; you can redistribute it and/or modify
1371 it under the same terms as Perl itself.