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';
15 our $VERSION = '0.26';
16 our $AUTHORITY = 'cpan:STEVAN';
18 use base 'Class::MOP::Module';
22 sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) }
28 my $package_name = shift;
29 (defined $package_name && $package_name && !blessed($package_name))
30 || confess "You must pass a package name and it cannot be blessed";
31 if (defined(my $meta = Class::MOP::get_metaclass_by_name($package_name))) {
34 $class->construct_class_instance('package' => $package_name, @_);
39 my $package_name = shift;
40 (defined $package_name && $package_name && !blessed($package_name))
41 || confess "You must pass a package name and it cannot be blessed";
42 Class::MOP::remove_metaclass_by_name($package_name);
43 $class->construct_class_instance('package' => $package_name, @_);
46 # NOTE: (meta-circularity)
47 # this is a special form of &construct_instance
48 # (see below), which is used to construct class
49 # meta-object instances for any Class::MOP::*
50 # class. All other classes will use the more
51 # normal &construct_instance.
52 sub construct_class_instance {
55 my $package_name = $options{'package'};
56 (defined $package_name && $package_name)
57 || confess "You must pass a package name";
59 # return the metaclass if we have it cached,
60 # and it is still defined (it has not been
61 # reaped by DESTROY yet, which can happen
62 # annoyingly enough during global destruction)
64 if (defined(my $meta = Class::MOP::get_metaclass_by_name($package_name))) {
69 # we need to deal with the possibility
70 # of class immutability here, and then
71 # get the name of the class appropriately
72 $class = (blessed($class)
73 ? ($class->is_immutable
74 ? $class->get_mutable_metaclass_name()
78 # now create the metaclass
80 if ($class eq 'Class::MOP::Class') {
83 # inherited from Class::MOP::Package
84 '$!package' => $package_name,
87 # since the following attributes will
88 # actually be loaded from the symbol
89 # table, and actually bypass the instance
90 # entirely, we can just leave these things
91 # listed here for reference, because they
92 # should not actually have a value associated
94 '%!namespace' => \undef,
95 # inherited from Class::MOP::Module
96 '$!version' => \undef,
97 '$!authority' => \undef,
98 # defined in Class::MOP::Class
99 '@!superclasses' => \undef,
102 '%!attributes' => {},
103 '$!attribute_metaclass' => $options{'attribute_metaclass'} || 'Class::MOP::Attribute',
104 '$!method_metaclass' => $options{'method_metaclass'} || 'Class::MOP::Method',
105 '$!instance_metaclass' => $options{'instance_metaclass'} || 'Class::MOP::Instance',
107 ## uber-private variables
109 # this starts out as undef so that
110 # we can tell the first time the
111 # methods are fetched
113 '$!_package_cache_flag' => undef,
118 # it is safe to use meta here because
119 # class will always be a subclass of
120 # Class::MOP::Class, which defines meta
121 $meta = $class->meta->construct_instance(%options)
124 # and check the metaclass compatibility
125 $meta->check_metaclass_compatability();
127 Class::MOP::store_metaclass_by_name($package_name, $meta);
130 # we need to weaken any anon classes
131 # so that they can call DESTROY properly
132 Class::MOP::weaken_metaclass($package_name) if $meta->is_anon_class;
137 sub reset_package_cache_flag { (shift)->{'$!_package_cache_flag'} = undef }
138 sub update_package_cache_flag {
141 # we can manually update the cache number
142 # since we are actually adding the method
143 # to our cache as well. This avoids us
144 # having to regenerate the method_map.
146 $self->{'$!_package_cache_flag'} = Class::MOP::check_package_cache_flag($self->name);
149 sub check_metaclass_compatability {
152 # this is always okay ...
153 return if blessed($self) eq 'Class::MOP::Class' &&
154 $self->instance_metaclass eq 'Class::MOP::Instance';
156 my @class_list = $self->linearized_isa;
157 shift @class_list; # shift off $self->name
159 foreach my $class_name (@class_list) {
160 my $meta = Class::MOP::get_metaclass_by_name($class_name) || next;
163 # we need to deal with the possibility
164 # of class immutability here, and then
165 # get the name of the class appropriately
166 my $meta_type = ($meta->is_immutable
167 ? $meta->get_mutable_metaclass_name()
170 ($self->isa($meta_type))
171 || confess $self->name . "->meta => (" . (blessed($self)) . ")" .
172 " is not compatible with the " .
173 $class_name . "->meta => (" . ($meta_type) . ")";
175 # we also need to check that instance metaclasses
176 # are compatabile in the same the class.
177 ($self->instance_metaclass->isa($meta->instance_metaclass))
178 || confess $self->name . "->meta => (" . ($self->instance_metaclass) . ")" .
179 " is not compatible with the " .
180 $class_name . "->meta => (" . ($meta->instance_metaclass) . ")";
188 # this should be sufficient, if you have a
189 # use case where it is not, write a test and
191 my $ANON_CLASS_SERIAL = 0;
194 # we need a sufficiently annoying prefix
195 # this should suffice for now, this is
196 # used in a couple of places below, so
197 # need to put it up here for now.
198 my $ANON_CLASS_PREFIX = 'Class::MOP::Class::__ANON__::SERIAL::';
202 no warnings 'uninitialized';
203 $self->name =~ /^$ANON_CLASS_PREFIX/ ? 1 : 0;
206 sub create_anon_class {
207 my ($class, %options) = @_;
208 my $package_name = $ANON_CLASS_PREFIX . ++$ANON_CLASS_SERIAL;
209 return $class->create($package_name, %options);
213 # this will only get called for
214 # anon-classes, all other calls
215 # are assumed to occur during
216 # global destruction and so don't
217 # really need to be handled explicitly
220 no warnings 'uninitialized';
221 return unless $self->name =~ /^$ANON_CLASS_PREFIX/;
222 my ($serial_id) = ($self->name =~ /^$ANON_CLASS_PREFIX(\d+)/);
224 foreach my $key (keys %{$ANON_CLASS_PREFIX . $serial_id}) {
225 delete ${$ANON_CLASS_PREFIX . $serial_id}{$key};
227 delete ${'main::' . $ANON_CLASS_PREFIX}{$serial_id . '::'};
232 # creating classes with MOP ...
236 my $package_name = shift;
238 (defined $package_name && $package_name)
239 || confess "You must pass a package name";
242 || confess "You much pass all parameters as name => value pairs " .
243 "(I found an uneven number of params in \@_)";
247 my $code = "package $package_name;";
248 $code .= "\$$package_name\:\:VERSION = '" . $options{version} . "';"
249 if exists $options{version};
250 $code .= "\$$package_name\:\:AUTHORITY = '" . $options{authority} . "';"
251 if exists $options{authority};
254 confess "creation of $package_name failed : $@" if $@;
256 my $meta = $class->initialize($package_name);
258 $meta->add_method('meta' => sub {
259 $class->initialize(blessed($_[0]) || $_[0]);
262 $meta->superclasses(@{$options{superclasses}})
263 if exists $options{superclasses};
265 # process attributes first, so that they can
266 # install accessors, but locally defined methods
267 # can then overwrite them. It is maybe a little odd, but
268 # I think this should be the order of things.
269 if (exists $options{attributes}) {
270 foreach my $attr (@{$options{attributes}}) {
271 $meta->add_attribute($attr);
274 if (exists $options{methods}) {
275 foreach my $method_name (keys %{$options{methods}}) {
276 $meta->add_method($method_name, $options{methods}->{$method_name});
285 # all these attribute readers will be bootstrapped
286 # away in the Class::MOP bootstrap section
288 sub get_attribute_map { $_[0]->{'%!attributes'} }
289 sub attribute_metaclass { $_[0]->{'$!attribute_metaclass'} }
290 sub method_metaclass { $_[0]->{'$!method_metaclass'} }
291 sub instance_metaclass { $_[0]->{'$!instance_metaclass'} }
294 # this is a prime canidate for conversion to XS
298 if (defined $self->{'$!_package_cache_flag'} &&
299 $self->{'$!_package_cache_flag'} == Class::MOP::check_package_cache_flag($self->name)) {
300 return $self->{'%!methods'};
303 my $map = $self->{'%!methods'};
305 my $class_name = $self->name;
306 my $method_metaclass = $self->method_metaclass;
308 foreach my $symbol ($self->list_all_package_symbols('CODE')) {
309 my $code = $self->get_package_symbol('&' . $symbol);
311 next if exists $map->{$symbol} &&
312 defined $map->{$symbol} &&
313 $map->{$symbol}->body == $code;
315 my ($pkg, $name) = Class::MOP::get_code_info($code);
316 next if ($pkg || '') ne $class_name &&
317 ($name || '') ne '__ANON__';
319 $map->{$symbol} = $method_metaclass->wrap($code);
325 # Instance Construction & Cloning
330 # we need to protect the integrity of the
331 # Class::MOP::Class singletons here, so we
332 # delegate this to &construct_class_instance
333 # which will deal with the singletons
334 return $class->construct_class_instance(@_)
335 if $class->name->isa('Class::MOP::Class');
336 return $class->construct_instance(@_);
339 sub construct_instance {
340 my ($class, %params) = @_;
341 my $meta_instance = $class->get_meta_instance();
342 my $instance = $meta_instance->create_instance();
343 foreach my $attr ($class->compute_all_applicable_attributes()) {
344 $attr->initialize_instance_slot($meta_instance, $instance, \%params);
347 # this will only work for a HASH instance type
348 if ($class->is_anon_class) {
349 (reftype($instance) eq 'HASH')
350 || confess "Currently only HASH based instances are supported with instance of anon-classes";
352 # At some point we should make this official
353 # as a reserved slot name, but right now I am
354 # going to keep it here.
355 # my $RESERVED_MOP_SLOT = '__MOP__';
356 $instance->{'__MOP__'} = $class;
361 sub get_meta_instance {
363 return $class->instance_metaclass->new(
365 $class->compute_all_applicable_attributes()
371 my $instance = shift;
372 (blessed($instance) && $instance->isa($class->name))
373 || confess "You must pass an instance ($instance) of the metaclass (" . $class->name . ")";
375 # we need to protect the integrity of the
376 # Class::MOP::Class singletons here, they
377 # should not be cloned.
378 return $instance if $instance->isa('Class::MOP::Class');
379 $class->clone_instance($instance, @_);
383 my ($class, $instance, %params) = @_;
385 || confess "You can only clone instances, \$self is not a blessed instance";
386 my $meta_instance = $class->get_meta_instance();
387 my $clone = $meta_instance->clone_instance($instance);
388 foreach my $attr ($class->compute_all_applicable_attributes()) {
389 if (exists $params{$attr->init_arg}) {
390 $meta_instance->set_slot_value($clone, $attr->name, $params{$attr->init_arg});
396 sub rebless_instance {
397 my ($self, $instance, $new_metaclass) = @_;
399 # it's okay (expected, even) to pass in a package name
400 unless (blessed $new_metaclass) {
401 $new_metaclass = $self->initialize($new_metaclass);
404 my $meta_instance = $self->get_meta_instance();
405 return $meta_instance->rebless_instance_structure($instance, $new_metaclass);
414 @{$self->get_package_symbol('@ISA')} = @supers;
416 # we need to check the metaclass
417 # compatibility here so that we can
418 # be sure that the superclass is
419 # not potentially creating an issues
420 # we don't know about
421 $self->check_metaclass_compatability();
423 @{$self->get_package_symbol('@ISA')};
429 my $super_class = $self->name;
432 my $find_derived_classes;
433 $find_derived_classes = sub {
434 my ($outer_class) = @_;
436 my $symbol_table_hashref = do { no strict 'refs'; \%{"${outer_class}::"} };
439 for my $symbol ( keys %$symbol_table_hashref ) {
440 next SYMBOL if $symbol !~ /\A (\w+):: \z/x;
441 my $inner_class = $1;
443 next SYMBOL if $inner_class eq 'SUPER'; # skip '*::SUPER'
447 ? "${outer_class}::$inner_class"
450 if ( $class->isa($super_class) and $class ne $super_class ) {
451 push @derived_classes, $class;
454 next SYMBOL if $class eq 'main'; # skip 'main::*'
456 $find_derived_classes->($class);
460 my $root_class = q{};
461 $find_derived_classes->($root_class);
463 undef $find_derived_classes;
465 @derived_classes = sort { $a->isa($b) ? 1 : $b->isa($a) ? -1 : 0 } @derived_classes;
467 return @derived_classes;
472 if (Class::MOP::IS_RUNNING_ON_5_10()) {
473 return @{ mro::get_linear_isa( (shift)->name ) };
477 return grep { !($seen{$_}++) } (shift)->class_precedence_list;
481 sub class_precedence_list {
484 unless (Class::MOP::IS_RUNNING_ON_5_10()) {
486 # We need to check for circular inheritance here
487 # if we are are not on 5.10, cause 5.8 detects it
488 # late. This will do nothing if all is well, and
489 # blow up otherwise. Yes, it's an ugly hack, better
490 # suggestions are welcome.
492 ($self->name || return)->isa('This is a test for circular inheritance')
498 $self->initialize($_)->class_precedence_list()
499 } $self->superclasses()
506 my ($self, $method_name, $method) = @_;
507 (defined $method_name && $method_name)
508 || confess "You must define a method name";
511 if (blessed($method)) {
512 $body = $method->body;
516 ('CODE' eq (reftype($body) || ''))
517 || confess "Your code block must be a CODE reference";
518 $method = $self->method_metaclass->wrap($body);
520 $self->get_method_map->{$method_name} = $method;
522 my $full_method_name = ($self->name . '::' . $method_name);
523 $self->add_package_symbol("&${method_name}" => subname $full_method_name => $body);
524 $self->update_package_cache_flag;
528 my $fetch_and_prepare_method = sub {
529 my ($self, $method_name) = @_;
531 my $method = $self->get_method($method_name);
532 # if we dont have local ...
534 # try to find the next method
535 $method = $self->find_next_method_by_name($method_name);
536 # die if it does not exist
538 || confess "The method '$method_name' is not found in the inheritance hierarchy for class " . $self->name;
539 # and now make sure to wrap it
540 # even if it is already wrapped
541 # because we need a new sub ref
542 $method = Class::MOP::Method::Wrapped->wrap($method);
545 # now make sure we wrap it properly
546 $method = Class::MOP::Method::Wrapped->wrap($method)
547 unless $method->isa('Class::MOP::Method::Wrapped');
549 $self->add_method($method_name => $method);
553 sub add_before_method_modifier {
554 my ($self, $method_name, $method_modifier) = @_;
555 (defined $method_name && $method_name)
556 || confess "You must pass in a method name";
557 my $method = $fetch_and_prepare_method->($self, $method_name);
558 $method->add_before_modifier(subname ':before' => $method_modifier);
561 sub add_after_method_modifier {
562 my ($self, $method_name, $method_modifier) = @_;
563 (defined $method_name && $method_name)
564 || confess "You must pass in a method name";
565 my $method = $fetch_and_prepare_method->($self, $method_name);
566 $method->add_after_modifier(subname ':after' => $method_modifier);
569 sub add_around_method_modifier {
570 my ($self, $method_name, $method_modifier) = @_;
571 (defined $method_name && $method_name)
572 || confess "You must pass in a method name";
573 my $method = $fetch_and_prepare_method->($self, $method_name);
574 $method->add_around_modifier(subname ':around' => $method_modifier);
578 # the methods above used to be named like this:
579 # ${pkg}::${method}:(before|after|around)
580 # but this proved problematic when using one modifier
581 # to wrap multiple methods (something which is likely
582 # to happen pretty regularly IMO). So instead of naming
583 # it like this, I have chosen to just name them purely
584 # with their modifier names, like so:
585 # :(before|after|around)
586 # The fact is that in a stack trace, it will be fairly
587 # evident from the context what method they are attached
588 # to, and so don't need the fully qualified name.
592 my ($self, $method_name, $method) = @_;
593 (defined $method_name && $method_name)
594 || confess "You must define a method name";
596 my $body = (blessed($method) ? $method->body : $method);
597 ('CODE' eq (reftype($body) || ''))
598 || confess "Your code block must be a CODE reference";
600 $self->add_package_symbol("&${method_name}" => $body);
601 $self->update_package_cache_flag;
605 my ($self, $method_name) = @_;
606 (defined $method_name && $method_name)
607 || confess "You must define a method name";
609 return 0 unless exists $self->get_method_map->{$method_name};
614 my ($self, $method_name) = @_;
615 (defined $method_name && $method_name)
616 || confess "You must define a method name";
619 # I don't really need this here, because
620 # if the method_map is missing a key it
621 # will just return undef for me now
622 # return unless $self->has_method($method_name);
624 return $self->get_method_map->{$method_name};
628 my ($self, $method_name) = @_;
629 (defined $method_name && $method_name)
630 || confess "You must define a method name";
632 my $removed_method = delete $self->get_method_map->{$method_name};
634 $self->remove_package_symbol("&${method_name}");
636 $self->update_package_cache_flag;
638 return $removed_method;
641 sub get_method_list {
643 keys %{$self->get_method_map};
646 sub find_method_by_name {
647 my ($self, $method_name) = @_;
648 (defined $method_name && $method_name)
649 || confess "You must define a method name to find";
650 foreach my $class ($self->linearized_isa) {
651 # fetch the meta-class ...
652 my $meta = $self->initialize($class);
653 return $meta->get_method($method_name)
654 if $meta->has_method($method_name);
659 sub compute_all_applicable_methods {
661 my (@methods, %seen_method);
662 foreach my $class ($self->linearized_isa) {
663 # fetch the meta-class ...
664 my $meta = $self->initialize($class);
665 foreach my $method_name ($meta->get_method_list()) {
666 next if exists $seen_method{$method_name};
667 $seen_method{$method_name}++;
669 name => $method_name,
671 code => $meta->get_method($method_name)
678 sub find_all_methods_by_name {
679 my ($self, $method_name) = @_;
680 (defined $method_name && $method_name)
681 || confess "You must define a method name to find";
683 foreach my $class ($self->linearized_isa) {
684 # fetch the meta-class ...
685 my $meta = $self->initialize($class);
687 name => $method_name,
689 code => $meta->get_method($method_name)
690 } if $meta->has_method($method_name);
695 sub find_next_method_by_name {
696 my ($self, $method_name) = @_;
697 (defined $method_name && $method_name)
698 || confess "You must define a method name to find";
699 my @cpl = $self->linearized_isa;
700 shift @cpl; # discard ourselves
701 foreach my $class (@cpl) {
702 # fetch the meta-class ...
703 my $meta = $self->initialize($class);
704 return $meta->get_method($method_name)
705 if $meta->has_method($method_name);
714 # either we have an attribute object already
715 # or we need to create one from the args provided
716 my $attribute = blessed($_[0]) ? $_[0] : $self->attribute_metaclass->new(@_);
717 # make sure it is derived from the correct type though
718 ($attribute->isa('Class::MOP::Attribute'))
719 || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";
721 # first we attach our new attribute
722 # because it might need certain information
723 # about the class which it is attached to
724 $attribute->attach_to_class($self);
726 # then we remove attributes of a conflicting
727 # name here so that we can properly detach
728 # the old attr object, and remove any
729 # accessors it would have generated
730 $self->remove_attribute($attribute->name)
731 if $self->has_attribute($attribute->name);
733 # then onto installing the new accessors
734 $attribute->install_accessors();
735 $self->get_attribute_map->{$attribute->name} = $attribute;
739 my ($self, $attribute_name) = @_;
740 (defined $attribute_name && $attribute_name)
741 || confess "You must define an attribute name";
742 exists $self->get_attribute_map->{$attribute_name} ? 1 : 0;
746 my ($self, $attribute_name) = @_;
747 (defined $attribute_name && $attribute_name)
748 || confess "You must define an attribute name";
749 return $self->get_attribute_map->{$attribute_name}
751 # this will return undef anyway, so no need ...
752 # if $self->has_attribute($attribute_name);
756 sub remove_attribute {
757 my ($self, $attribute_name) = @_;
758 (defined $attribute_name && $attribute_name)
759 || confess "You must define an attribute name";
760 my $removed_attribute = $self->get_attribute_map->{$attribute_name};
761 return unless defined $removed_attribute;
762 delete $self->get_attribute_map->{$attribute_name};
763 $removed_attribute->remove_accessors();
764 $removed_attribute->detach_from_class();
765 return $removed_attribute;
768 sub get_attribute_list {
770 keys %{$self->get_attribute_map};
773 sub compute_all_applicable_attributes {
775 my (@attrs, %seen_attr);
776 foreach my $class ($self->linearized_isa) {
777 # fetch the meta-class ...
778 my $meta = $self->initialize($class);
779 foreach my $attr_name ($meta->get_attribute_list()) {
780 next if exists $seen_attr{$attr_name};
781 $seen_attr{$attr_name}++;
782 push @attrs => $meta->get_attribute($attr_name);
788 sub find_attribute_by_name {
789 my ($self, $attr_name) = @_;
790 foreach my $class ($self->linearized_isa) {
791 # fetch the meta-class ...
792 my $meta = $self->initialize($class);
793 return $meta->get_attribute($attr_name)
794 if $meta->has_attribute($attr_name);
802 sub is_immutable { 0 }
805 # Why I changed this (groditi)
806 # - One Metaclass may have many Classes through many Metaclass instances
807 # - One Metaclass should only have one Immutable Transformer instance
808 # - Each Class may have different Immutabilizing options
809 # - Therefore each Metaclass instance may have different Immutabilizing options
810 # - We need to store one Immutable Transformer instance per Metaclass
811 # - We need to store one set of Immutable Transformer options per Class
812 # - Upon make_mutable we may delete the Immutabilizing options
813 # - We could clean the immutable Transformer instance when there is no more
814 # immutable Classes of that type, but we can also keep it in case
815 # another class with this same Metaclass becomes immutable. It is a case
816 # of trading of storing an instance to avoid unnecessary instantiations of
817 # Immutable Transformers. You may view this as a memory leak, however
818 # Because we have few Metaclasses, in practice it seems acceptable
819 # - To allow Immutable Transformers instances to be cleaned up we could weaken
820 # the reference stored in $IMMUTABLE_TRANSFORMERS{$class} and ||= should DWIM
823 my %IMMUTABLE_TRANSFORMERS;
824 my %IMMUTABLE_OPTIONS;
828 my $class = blessed $self || $self;
830 $IMMUTABLE_TRANSFORMERS{$class} ||= $self->create_immutable_transformer;
831 my $transformer = $IMMUTABLE_TRANSFORMERS{$class};
833 $transformer->make_metaclass_immutable($self, \%options);
834 $IMMUTABLE_OPTIONS{$self->name} =
835 { %options, IMMUTABLE_TRANSFORMER => $transformer };
837 if( exists $options{debug} && $options{debug} ){
838 print STDERR "# of Metaclass options: ", keys %IMMUTABLE_OPTIONS;
839 print STDERR "# of Immutable transformers: ", keys %IMMUTABLE_TRANSFORMERS;
845 return if $self->is_mutable;
846 my $options = delete $IMMUTABLE_OPTIONS{$self->name};
847 confess "unable to find immutabilizing options" unless ref $options;
848 my $transformer = delete $options->{IMMUTABLE_TRANSFORMER};
849 $transformer->make_metaclass_mutable($self, $options);
853 sub create_immutable_transformer {
855 my $class = Class::MOP::Immutable->new($self, {
856 read_only => [qw/superclasses/],
864 remove_package_symbol
867 class_precedence_list => 'ARRAY',
868 linearized_isa => 'ARRAY',
869 compute_all_applicable_attributes => 'ARRAY',
870 get_meta_instance => 'SCALAR',
871 get_method_map => 'SCALAR',
885 Class::MOP::Class - Class Meta Object
889 # assuming that class Foo
890 # has been defined, you can
892 # use this for introspection ...
894 # add a method to Foo ...
895 Foo->meta->add_method('bar' => sub { ... })
897 # get a list of all the classes searched
898 # the method dispatcher in the correct order
899 Foo->meta->class_precedence_list()
901 # remove a method from Foo
902 Foo->meta->remove_method('bar');
904 # or use this to actually create classes ...
906 Class::MOP::Class->create('Bar' => (
908 superclasses => [ 'Foo' ],
910 Class::MOP:::Attribute->new('$bar'),
911 Class::MOP:::Attribute->new('$baz'),
914 calculate_bar => sub { ... },
915 construct_baz => sub { ... }
921 This is the largest and currently most complex part of the Perl 5
922 meta-object protocol. It controls the introspection and
923 manipulation of Perl 5 classes (and it can create them too). The
924 best way to understand what this module can do, is to read the
925 documentation for each of it's methods.
929 =head2 Self Introspection
935 This will return a B<Class::MOP::Class> instance which is related
936 to this class. Thereby allowing B<Class::MOP::Class> to actually
939 As with B<Class::MOP::Attribute>, B<Class::MOP> will actually
940 bootstrap this module by installing a number of attribute meta-objects
941 into it's metaclass. This will allow this class to reap all the benifits
942 of the MOP when subclassing it.
946 =head2 Class construction
948 These methods will handle creating B<Class::MOP::Class> objects,
949 which can be used to both create new classes, and analyze
950 pre-existing classes.
952 This module will internally store references to all the instances
953 you create with these methods, so that they do not need to be
954 created any more than nessecary. Basically, they are singletons.
958 =item B<create ($package_name,
959 version =E<gt> ?$version,
960 authority =E<gt> ?$authority,
961 superclasses =E<gt> ?@superclasses,
962 methods =E<gt> ?%methods,
963 attributes =E<gt> ?%attributes)>
965 This returns a B<Class::MOP::Class> object, bringing the specified
966 C<$package_name> into existence and adding any of the C<$version>,
967 C<$authority>, C<@superclasses>, C<%methods> and C<%attributes> to
970 =item B<create_anon_class (superclasses =E<gt> ?@superclasses,
971 methods =E<gt> ?%methods,
972 attributes =E<gt> ?%attributes)>
974 This will create an anonymous class, it works much like C<create> but
975 it does not need a C<$package_name>. Instead it will create a suitably
976 unique package name for you to stash things into.
978 On very important distinction is that anon classes are destroyed once
979 the metaclass they are attached to goes out of scope. In the DESTROY
980 method, the created package will be removed from the symbol table.
982 It is also worth noting that any instances created with an anon-class
983 will keep a special reference to the anon-meta which will prevent the
984 anon-class from going out of scope until all instances of it have also
985 been destroyed. This however only works for HASH based instance types,
986 as we use a special reserved slot (C<__MOP__>) to store this.
988 =item B<initialize ($package_name, %options)>
990 This initializes and returns returns a B<Class::MOP::Class> object
991 for a given a C<$package_name>.
993 =item B<reinitialize ($package_name, %options)>
995 This removes the old metaclass, and creates a new one in it's place.
996 Do B<not> use this unless you really know what you are doing, it could
997 very easily make a very large mess of your program.
999 =item B<construct_class_instance (%options)>
1001 This will construct an instance of B<Class::MOP::Class>, it is
1002 here so that we can actually "tie the knot" for B<Class::MOP::Class>
1003 to use C<construct_instance> once all the bootstrapping is done. This
1004 method is used internally by C<initialize> and should never be called
1005 from outside of that method really.
1007 =item B<check_metaclass_compatability>
1009 This method is called as the very last thing in the
1010 C<construct_class_instance> method. This will check that the
1011 metaclass you are creating is compatible with the metaclasses of all
1012 your ancestors. For more inforamtion about metaclass compatibility
1013 see the C<About Metaclass compatibility> section in L<Class::MOP>.
1015 =item B<update_package_cache_flag>
1017 This will reset the package cache flag for this particular metaclass
1018 it is basically the value of the C<Class::MOP::get_package_cache_flag>
1019 function. This is very rarely needed from outside of C<Class::MOP::Class>
1020 but in some cases you might want to use it, so it is here.
1022 =item B<reset_package_cache_flag>
1024 Clear this flag, used in Moose.
1028 =head2 Object instance construction and cloning
1030 These methods are B<entirely optional>, it is up to you whether you want
1035 =item B<instance_metaclass>
1037 =item B<get_meta_instance>
1039 =item B<new_object (%params)>
1041 This is a convience method for creating a new object of the class, and
1042 blessing it into the appropriate package as well. Ideally your class
1043 would call a C<new> this method like so:
1046 my ($class, %param) = @_;
1047 $class->meta->new_object(%params);
1050 Of course the ideal place for this would actually be in C<UNIVERSAL::>
1051 but that is considered bad style, so we do not do that.
1053 =item B<construct_instance (%params)>
1055 This method is used to construct an instace structure suitable for
1056 C<bless>-ing into your package of choice. It works in conjunction
1057 with the Attribute protocol to collect all applicable attributes.
1059 This will construct and instance using a HASH ref as storage
1060 (currently only HASH references are supported). This will collect all
1061 the applicable attributes and layout out the fields in the HASH ref,
1062 it will then initialize them using either use the corresponding key
1063 in C<%params> or any default value or initializer found in the
1064 attribute meta-object.
1066 =item B<clone_object ($instance, %params)>
1068 This is a convience method for cloning an object instance, then
1069 blessing it into the appropriate package. This method will call
1070 C<clone_instance>, which performs a shallow copy of the object,
1071 see that methods documentation for more details. Ideally your
1072 class would call a C<clone> this method like so:
1074 sub MyClass::clone {
1075 my ($self, %param) = @_;
1076 $self->meta->clone_object($self, %params);
1079 Of course the ideal place for this would actually be in C<UNIVERSAL::>
1080 but that is considered bad style, so we do not do that.
1082 =item B<clone_instance($instance, %params)>
1084 This method is a compliment of C<construct_instance> (which means if
1085 you override C<construct_instance>, you need to override this one too),
1086 and clones the instance shallowly.
1088 The cloned structure returned is (like with C<construct_instance>) an
1089 unC<bless>ed HASH reference, it is your responsibility to then bless
1090 this cloned structure into the right class (which C<clone_object> will
1093 As of 0.11, this method will clone the C<$instance> structure shallowly,
1094 as opposed to the deep cloning implemented in prior versions. After much
1095 thought, research and discussion, I have decided that anything but basic
1096 shallow cloning is outside the scope of the meta-object protocol. I
1097 think Yuval "nothingmuch" Kogman put it best when he said that cloning
1098 is too I<context-specific> to be part of the MOP.
1102 =head2 Informational
1104 These are a few predicate methods for asking information about the class.
1108 =item B<is_anon_class>
1110 This returns true if the class is a C<Class::MOP::Class> created anon class.
1114 This returns true if the class is still mutable.
1116 =item B<is_immutable>
1118 This returns true if the class has been made immutable.
1122 =head2 Inheritance Relationships
1126 =item B<superclasses (?@superclasses)>
1128 This is a read-write attribute which represents the superclass
1129 relationships of the class the B<Class::MOP::Class> instance is
1130 associated with. Basically, it can get and set the C<@ISA> for you.
1133 Perl will occasionally perform some C<@ISA> and method caching, if
1134 you decide to change your superclass relationship at runtime (which
1135 is quite insane and very much not recommened), then you should be
1136 aware of this and the fact that this module does not make any
1137 attempt to address this issue.
1139 =item B<class_precedence_list>
1141 This computes the a list of all the class's ancestors in the same order
1142 in which method dispatch will be done. This is similair to
1143 what B<Class::ISA::super_path> does, but we don't remove duplicate names.
1145 =item B<linearized_isa>
1147 This returns a list based on C<class_precedence_list> but with all
1152 This returns a list of subclasses for this class.
1160 =item B<get_method_map>
1162 =item B<method_metaclass>
1164 =item B<add_method ($method_name, $method)>
1166 This will take a C<$method_name> and CODE reference to that
1167 C<$method> and install it into the class's package.
1170 This does absolutely nothing special to C<$method>
1171 other than use B<Sub::Name> to make sure it is tagged with the
1172 correct name, and therefore show up correctly in stack traces and
1175 =item B<alias_method ($method_name, $method)>
1177 This will take a C<$method_name> and CODE reference to that
1178 C<$method> and alias the method into the class's package.
1181 Unlike C<add_method>, this will B<not> try to name the
1182 C<$method> using B<Sub::Name>, it only aliases the method in
1183 the class's package.
1185 =item B<has_method ($method_name)>
1187 This just provides a simple way to check if the class implements
1188 a specific C<$method_name>. It will I<not> however, attempt to check
1189 if the class inherits the method (use C<UNIVERSAL::can> for that).
1191 This will correctly handle functions defined outside of the package
1192 that use a fully qualified name (C<sub Package::name { ... }>).
1194 This will correctly handle functions renamed with B<Sub::Name> and
1195 installed using the symbol tables. However, if you are naming the
1196 subroutine outside of the package scope, you must use the fully
1197 qualified name, including the package name, for C<has_method> to
1198 correctly identify it.
1200 This will attempt to correctly ignore functions imported from other
1201 packages using B<Exporter>. It breaks down if the function imported
1202 is an C<__ANON__> sub (such as with C<use constant>), which very well
1203 may be a valid method being applied to the class.
1205 In short, this method cannot always be trusted to determine if the
1206 C<$method_name> is actually a method. However, it will DWIM about
1207 90% of the time, so it's a small trade off I think.
1209 =item B<get_method ($method_name)>
1211 This will return a Class::MOP::Method instance related to the specified
1212 C<$method_name>, or return undef if that method does not exist.
1214 The Class::MOP::Method is codifiable, so you can use it like a normal
1215 CODE reference, see L<Class::MOP::Method> for more information.
1217 =item B<find_method_by_name ($method_name>
1219 This will return a CODE reference of the specified C<$method_name>,
1220 or return undef if that method does not exist.
1222 Unlike C<get_method> this will also look in the superclasses.
1224 =item B<remove_method ($method_name)>
1226 This will attempt to remove a given C<$method_name> from the class.
1227 It will return the CODE reference that it has removed, and will
1228 attempt to use B<Sub::Name> to clear the methods associated name.
1230 =item B<get_method_list>
1232 This will return a list of method names for all I<locally> defined
1233 methods. It does B<not> provide a list of all applicable methods,
1234 including any inherited ones. If you want a list of all applicable
1235 methods, use the C<compute_all_applicable_methods> method.
1237 =item B<compute_all_applicable_methods>
1239 This will return a list of all the methods names this class will
1240 respond to, taking into account inheritance. The list will be a list of
1241 HASH references, each one containing the following information; method
1242 name, the name of the class in which the method lives and a CODE
1243 reference for the actual method.
1245 =item B<find_all_methods_by_name ($method_name)>
1247 This will traverse the inheritence hierarchy and locate all methods
1248 with a given C<$method_name>. Similar to
1249 C<compute_all_applicable_methods> it returns a list of HASH references
1250 with the following information; method name (which will always be the
1251 same as C<$method_name>), the name of the class in which the method
1252 lives and a CODE reference for the actual method.
1254 The list of methods produced is a distinct list, meaning there are no
1255 duplicates in it. This is especially useful for things like object
1256 initialization and destruction where you only want the method called
1257 once, and in the correct order.
1259 =item B<find_next_method_by_name ($method_name)>
1261 This will return the first method to match a given C<$method_name> in
1262 the superclasses, this is basically equivalent to calling
1263 C<SUPER::$method_name>, but it can be dispatched at runtime.
1267 =head2 Method Modifiers
1269 Method modifiers are a concept borrowed from CLOS, in which a method
1270 can be wrapped with I<before>, I<after> and I<around> method modifiers
1271 that will be called everytime the method is called.
1273 =head3 How method modifiers work?
1275 Method modifiers work by wrapping the original method and then replacing
1276 it in the classes symbol table. The wrappers will handle calling all the
1277 modifiers in the appropariate orders and preserving the calling context
1278 for the original method.
1280 Each method modifier serves a particular purpose, which may not be
1281 obvious to users of other method wrapping modules. To start with, the
1282 return values of I<before> and I<after> modifiers are ignored. This is
1283 because thier purpose is B<not> to filter the input and output of the
1284 primary method (this is done with an I<around> modifier). This may seem
1285 like an odd restriction to some, but doing this allows for simple code
1286 to be added at the begining or end of a method call without jeapordizing
1287 the normal functioning of the primary method or placing any extra
1288 responsibility on the code of the modifier. Of course if you have more
1289 complex needs, then use the I<around> modifier, which uses a variation
1290 of continutation passing style to allow for a high degree of flexibility.
1292 Before and around modifiers are called in last-defined-first-called order,
1293 while after modifiers are called in first-defined-first-called order. So
1294 the call tree might looks something like this:
1304 To see examples of using method modifiers, see the following examples
1305 included in the distribution; F<InstanceCountingClass>, F<Perl6Attribute>,
1306 F<AttributesWithHistory> and F<C3MethodDispatchOrder>. There is also a
1307 classic CLOS usage example in the test F<017_add_method_modifier.t>.
1309 =head3 What is the performance impact?
1311 Of course there is a performance cost associated with method modifiers,
1312 but we have made every effort to make that cost be directly proportional
1313 to the amount of modifier features you utilize.
1315 The wrapping method does it's best to B<only> do as much work as it
1316 absolutely needs to. In order to do this we have moved some of the
1317 performance costs to set-up time, where they are easier to amortize.
1319 All this said, my benchmarks have indicated the following:
1321 simple wrapper with no modifiers 100% slower
1322 simple wrapper with simple before modifier 400% slower
1323 simple wrapper with simple after modifier 450% slower
1324 simple wrapper with simple around modifier 500-550% slower
1325 simple wrapper with all 3 modifiers 1100% slower
1327 These numbers may seem daunting, but you must remember, every feature
1328 comes with some cost. To put things in perspective, just doing a simple
1329 C<AUTOLOAD> which does nothing but extract the name of the method called
1330 and return it costs about 400% over a normal method call.
1334 =item B<add_before_method_modifier ($method_name, $code)>
1336 This will wrap the method at C<$method_name> and the supplied C<$code>
1337 will be passed the C<@_> arguments, and called before the original
1338 method is called. As specified above, the return value of the I<before>
1339 method modifiers is ignored, and it's ability to modify C<@_> is
1340 fairly limited. If you need to do either of these things, use an
1341 C<around> method modifier.
1343 =item B<add_after_method_modifier ($method_name, $code)>
1345 This will wrap the method at C<$method_name> so that the original
1346 method will be called, it's return values stashed, and then the
1347 supplied C<$code> will be passed the C<@_> arguments, and called.
1348 As specified above, the return value of the I<after> method
1349 modifiers is ignored, and it cannot modify the return values of
1350 the original method. If you need to do either of these things, use an
1351 C<around> method modifier.
1353 =item B<add_around_method_modifier ($method_name, $code)>
1355 This will wrap the method at C<$method_name> so that C<$code>
1356 will be called and passed the original method as an extra argument
1357 at the begining of the C<@_> argument list. This is a variation of
1358 continuation passing style, where the function prepended to C<@_>
1359 can be considered a continuation. It is up to C<$code> if it calls
1360 the original method or not, there is no restriction on what the
1361 C<$code> can or cannot do.
1367 It should be noted that since there is no one consistent way to define
1368 the attributes of a class in Perl 5. These methods can only work with
1369 the information given, and can not easily discover information on
1370 their own. See L<Class::MOP::Attribute> for more details.
1374 =item B<attribute_metaclass>
1376 =item B<get_attribute_map>
1378 =item B<add_attribute ($attribute_meta_object | $attribute_name, %attribute_spec)>
1380 This stores the C<$attribute_meta_object> (or creates one from the
1381 C<$attribute_name> and C<%attribute_spec>) in the B<Class::MOP::Class>
1382 instance associated with the given class. Unlike methods, attributes
1383 within the MOP are stored as meta-information only. They will be used
1384 later to construct instances from (see C<construct_instance> above).
1385 More details about the attribute meta-objects can be found in the
1386 L<Class::MOP::Attribute> or the L<Class::MOP/The Attribute protocol>
1389 It should be noted that any accessor, reader/writer or predicate
1390 methods which the C<$attribute_meta_object> has will be installed
1391 into the class at this time.
1394 If an attribute already exists for C<$attribute_name>, the old one
1395 will be removed (as well as removing all it's accessors), and then
1398 =item B<has_attribute ($attribute_name)>
1400 Checks to see if this class has an attribute by the name of
1401 C<$attribute_name> and returns a boolean.
1403 =item B<get_attribute ($attribute_name)>
1405 Returns the attribute meta-object associated with C<$attribute_name>,
1406 if none is found, it will return undef.
1408 =item B<remove_attribute ($attribute_name)>
1410 This will remove the attribute meta-object stored at
1411 C<$attribute_name>, then return the removed attribute meta-object.
1414 Removing an attribute will only affect future instances of
1415 the class, it will not make any attempt to remove the attribute from
1416 any existing instances of the class.
1418 It should be noted that any accessor, reader/writer or predicate
1419 methods which the attribute meta-object stored at C<$attribute_name>
1420 has will be removed from the class at this time. This B<will> make
1421 these attributes somewhat inaccessable in previously created
1422 instances. But if you are crazy enough to do this at runtime, then
1423 you are crazy enough to deal with something like this :).
1425 =item B<get_attribute_list>
1427 This returns a list of attribute names which are defined in the local
1428 class. If you want a list of all applicable attributes for a class,
1429 use the C<compute_all_applicable_attributes> method.
1431 =item B<compute_all_applicable_attributes>
1433 This will traverse the inheritance heirachy and return a list of all
1434 the applicable attributes for this class. It does not construct a
1435 HASH reference like C<compute_all_applicable_methods> because all
1436 that same information is discoverable through the attribute
1439 =item B<find_attribute_by_name ($attr_name)>
1441 This method will traverse the inheritance heirachy and find the
1442 first attribute whose name matches C<$attr_name>, then return it.
1443 It will return undef if nothing is found.
1447 =head2 Class Immutability
1451 =item B<make_immutable (%options)>
1453 This method will invoke a tranforamtion upon the class which will
1454 make it immutable. Details of this transformation can be found in
1455 the L<Class::MOP::Immutable> documentation.
1457 =item B<make_mutable>
1459 This method will reverse tranforamtion upon the class which
1462 =item B<create_immutable_transformer>
1464 Create a transformer suitable for making this class immutable
1470 Stevan Little E<lt>stevan@iinteractive.comE<gt>
1472 =head1 COPYRIGHT AND LICENSE
1474 Copyright 2006-2008 by Infinity Interactive, Inc.
1476 L<http://www.iinteractive.com>
1478 This library is free software; you can redistribute it and/or modify
1479 it under the same terms as Perl itself.