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')};
392 my $super_class = $self->name;
395 my $find_derived_classes;
396 $find_derived_classes = sub {
397 my ($outer_class) = @_;
399 my $symbol_table_hashref = do { no strict 'refs'; \%{"${outer_class}::"} };
402 for my $symbol ( keys %$symbol_table_hashref ) {
403 next SYMBOL if $symbol !~ /\A (\w+):: \z/x;
404 my $inner_class = $1;
406 next SYMBOL if $inner_class eq 'SUPER'; # skip '*::SUPER'
410 ? "${outer_class}::$inner_class"
413 if ( $class->isa($super_class) and $class ne $super_class ) {
414 push @derived_classes, $class;
417 next SYMBOL if $class eq 'main'; # skip 'main::*'
419 $find_derived_classes->($class);
423 my $root_class = q{};
424 $find_derived_classes->($root_class);
426 undef $find_derived_classes;
428 @derived_classes = sort { $a->isa($b) ? 1 : $b->isa($a) ? -1 : 0 } @derived_classes;
430 return @derived_classes;
436 grep { !($seen{$_}++) } (shift)->class_precedence_list
439 sub class_precedence_list {
442 # We need to check for circular inheritance here.
443 # This will do nothing if all is well, and blow
444 # up otherwise. Yes, it's an ugly hack, better
445 # suggestions are welcome.
446 { ($self->name || return)->isa('This is a test for circular inheritance') }
451 $self->initialize($_)->class_precedence_list()
452 } $self->superclasses()
459 my ($self, $method_name, $method) = @_;
460 (defined $method_name && $method_name)
461 || confess "You must define a method name";
464 if (blessed($method)) {
465 $body = $method->body;
469 ('CODE' eq (reftype($body) || ''))
470 || confess "Your code block must be a CODE reference";
471 $method = $self->method_metaclass->wrap($body);
473 $self->get_method_map->{$method_name} = $method;
475 my $full_method_name = ($self->name . '::' . $method_name);
476 $self->add_package_symbol("&${method_name}" => subname $full_method_name => $body);
480 my $fetch_and_prepare_method = sub {
481 my ($self, $method_name) = @_;
483 my $method = $self->get_method($method_name);
484 # if we dont have local ...
486 # try to find the next method
487 $method = $self->find_next_method_by_name($method_name);
488 # die if it does not exist
490 || confess "The method '$method_name' is not found in the inheritance hierarchy for class " . $self->name;
491 # and now make sure to wrap it
492 # even if it is already wrapped
493 # because we need a new sub ref
494 $method = Class::MOP::Method::Wrapped->wrap($method);
497 # now make sure we wrap it properly
498 $method = Class::MOP::Method::Wrapped->wrap($method)
499 unless $method->isa('Class::MOP::Method::Wrapped');
501 $self->add_method($method_name => $method);
505 sub add_before_method_modifier {
506 my ($self, $method_name, $method_modifier) = @_;
507 (defined $method_name && $method_name)
508 || confess "You must pass in a method name";
509 my $method = $fetch_and_prepare_method->($self, $method_name);
510 $method->add_before_modifier(subname ':before' => $method_modifier);
513 sub add_after_method_modifier {
514 my ($self, $method_name, $method_modifier) = @_;
515 (defined $method_name && $method_name)
516 || confess "You must pass in a method name";
517 my $method = $fetch_and_prepare_method->($self, $method_name);
518 $method->add_after_modifier(subname ':after' => $method_modifier);
521 sub add_around_method_modifier {
522 my ($self, $method_name, $method_modifier) = @_;
523 (defined $method_name && $method_name)
524 || confess "You must pass in a method name";
525 my $method = $fetch_and_prepare_method->($self, $method_name);
526 $method->add_around_modifier(subname ':around' => $method_modifier);
530 # the methods above used to be named like this:
531 # ${pkg}::${method}:(before|after|around)
532 # but this proved problematic when using one modifier
533 # to wrap multiple methods (something which is likely
534 # to happen pretty regularly IMO). So instead of naming
535 # it like this, I have chosen to just name them purely
536 # with their modifier names, like so:
537 # :(before|after|around)
538 # The fact is that in a stack trace, it will be fairly
539 # evident from the context what method they are attached
540 # to, and so don't need the fully qualified name.
544 my ($self, $method_name, $method) = @_;
545 (defined $method_name && $method_name)
546 || confess "You must define a method name";
548 my $body = (blessed($method) ? $method->body : $method);
549 ('CODE' eq (reftype($body) || ''))
550 || confess "Your code block must be a CODE reference";
552 $self->add_package_symbol("&${method_name}" => $body);
556 my ($self, $method_name) = @_;
557 (defined $method_name && $method_name)
558 || confess "You must define a method name";
560 return 0 unless exists $self->get_method_map->{$method_name};
565 my ($self, $method_name) = @_;
566 (defined $method_name && $method_name)
567 || confess "You must define a method name";
570 # I don't really need this here, because
571 # if the method_map is missing a key it
572 # will just return undef for me now
573 # return unless $self->has_method($method_name);
575 return $self->get_method_map->{$method_name};
579 my ($self, $method_name) = @_;
580 (defined $method_name && $method_name)
581 || confess "You must define a method name";
583 my $removed_method = $self->get_method($method_name);
586 $self->remove_package_symbol("&${method_name}");
587 delete $self->get_method_map->{$method_name};
588 } if defined $removed_method;
590 return $removed_method;
593 sub get_method_list {
595 keys %{$self->get_method_map};
598 sub find_method_by_name {
599 my ($self, $method_name) = @_;
600 (defined $method_name && $method_name)
601 || confess "You must define a method name to find";
602 foreach my $class ($self->linearized_isa) {
603 # fetch the meta-class ...
604 my $meta = $self->initialize($class);
605 return $meta->get_method($method_name)
606 if $meta->has_method($method_name);
611 sub compute_all_applicable_methods {
613 my (@methods, %seen_method);
614 foreach my $class ($self->linearized_isa) {
615 # fetch the meta-class ...
616 my $meta = $self->initialize($class);
617 foreach my $method_name ($meta->get_method_list()) {
618 next if exists $seen_method{$method_name};
619 $seen_method{$method_name}++;
621 name => $method_name,
623 code => $meta->get_method($method_name)
630 sub find_all_methods_by_name {
631 my ($self, $method_name) = @_;
632 (defined $method_name && $method_name)
633 || confess "You must define a method name to find";
635 foreach my $class ($self->linearized_isa) {
636 # fetch the meta-class ...
637 my $meta = $self->initialize($class);
639 name => $method_name,
641 code => $meta->get_method($method_name)
642 } if $meta->has_method($method_name);
647 sub find_next_method_by_name {
648 my ($self, $method_name) = @_;
649 (defined $method_name && $method_name)
650 || confess "You must define a method name to find";
651 my @cpl = $self->linearized_isa;
652 shift @cpl; # discard ourselves
653 foreach my $class (@cpl) {
654 # fetch the meta-class ...
655 my $meta = $self->initialize($class);
656 return $meta->get_method($method_name)
657 if $meta->has_method($method_name);
666 # either we have an attribute object already
667 # or we need to create one from the args provided
668 my $attribute = blessed($_[0]) ? $_[0] : $self->attribute_metaclass->new(@_);
669 # make sure it is derived from the correct type though
670 ($attribute->isa('Class::MOP::Attribute'))
671 || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";
673 # first we attach our new attribute
674 # because it might need certain information
675 # about the class which it is attached to
676 $attribute->attach_to_class($self);
678 # then we remove attributes of a conflicting
679 # name here so that we can properly detach
680 # the old attr object, and remove any
681 # accessors it would have generated
682 $self->remove_attribute($attribute->name)
683 if $self->has_attribute($attribute->name);
685 # then onto installing the new accessors
686 $attribute->install_accessors();
687 $self->get_attribute_map->{$attribute->name} = $attribute;
691 my ($self, $attribute_name) = @_;
692 (defined $attribute_name && $attribute_name)
693 || confess "You must define an attribute name";
694 exists $self->get_attribute_map->{$attribute_name} ? 1 : 0;
698 my ($self, $attribute_name) = @_;
699 (defined $attribute_name && $attribute_name)
700 || confess "You must define an attribute name";
701 return $self->get_attribute_map->{$attribute_name}
703 # this will return undef anyway, so no need ...
704 # if $self->has_attribute($attribute_name);
708 sub remove_attribute {
709 my ($self, $attribute_name) = @_;
710 (defined $attribute_name && $attribute_name)
711 || confess "You must define an attribute name";
712 my $removed_attribute = $self->get_attribute_map->{$attribute_name};
713 return unless defined $removed_attribute;
714 delete $self->get_attribute_map->{$attribute_name};
715 $removed_attribute->remove_accessors();
716 $removed_attribute->detach_from_class();
717 return $removed_attribute;
720 sub get_attribute_list {
722 keys %{$self->get_attribute_map};
725 sub compute_all_applicable_attributes {
727 my (@attrs, %seen_attr);
728 foreach my $class ($self->linearized_isa) {
729 # fetch the meta-class ...
730 my $meta = $self->initialize($class);
731 foreach my $attr_name ($meta->get_attribute_list()) {
732 next if exists $seen_attr{$attr_name};
733 $seen_attr{$attr_name}++;
734 push @attrs => $meta->get_attribute($attr_name);
740 sub find_attribute_by_name {
741 my ($self, $attr_name) = @_;
742 foreach my $class ($self->linearized_isa) {
743 # fetch the meta-class ...
744 my $meta = $self->initialize($class);
745 return $meta->get_attribute($attr_name)
746 if $meta->has_attribute($attr_name);
754 sub is_immutable { 0 }
757 # Why I changed this (groditi)
758 # - One Metaclass may have many Classes through many Metaclass instances
759 # - One Metaclass should only have one Immutable Transformer instance
760 # - Each Class may have different Immutabilizing options
761 # - Therefore each Metaclass instance may have different Immutabilizing options
762 # - We need to store one Immutable Transformer instance per Metaclass
763 # - We need to store one set of Immutable Transformer options per Class
764 # - Upon make_mutable we may delete the Immutabilizing options
765 # - We could clean the immutable Transformer instance when there is no more
766 # immutable Classes of that type, but we can also keep it in case
767 # another class with this same Metaclass becomes immutable. It is a case
768 # of trading of storing an instance to avoid unnecessary instantiations of
769 # Immutable Transformers. You may view this as a memory leak, however
770 # Because we have few Metaclasses, in practice it seems acceptable
771 # - To allow Immutable Transformers instances to be cleaned up we could weaken
772 # the reference stored in $IMMUTABLE_TRANSFORMERS{$class} and ||= should DWIM
775 my %IMMUTABLE_TRANSFORMERS;
776 my %IMMUTABLE_OPTIONS;
780 my $class = blessed $self || $self;
782 $IMMUTABLE_TRANSFORMERS{$class} ||= $self->create_immutable_transformer;
783 my $transformer = $IMMUTABLE_TRANSFORMERS{$class};
785 $transformer->make_metaclass_immutable($self, %options);
786 $IMMUTABLE_OPTIONS{$self->name} =
787 { %options, IMMUTABLE_TRANSFORMER => $transformer };
789 if( exists $options{debug} && $options{debug} ){
790 print STDERR "# of Metaclass options: ", keys %IMMUTABLE_OPTIONS;
791 print STDERR "# of Immutable transformers: ", keys %IMMUTABLE_TRANSFORMERS;
797 return if $self->is_mutable;
798 my $options = delete $IMMUTABLE_OPTIONS{$self->name};
799 confess "unable to find immutabilizing options" unless ref $options;
800 my $transformer = delete $options->{IMMUTABLE_TRANSFORMER};
801 $transformer->make_metaclass_mutable($self, %$options);
805 sub create_immutable_transformer {
807 my $class = Class::MOP::Immutable->new($self, {
808 read_only => [qw/superclasses/],
816 remove_package_symbol
819 class_precedence_list => 'ARRAY',
820 linearized_isa => 'ARRAY',
821 compute_all_applicable_attributes => 'ARRAY',
822 get_meta_instance => 'SCALAR',
823 get_method_map => 'SCALAR',
837 Class::MOP::Class - Class Meta Object
841 # assuming that class Foo
842 # has been defined, you can
844 # use this for introspection ...
846 # add a method to Foo ...
847 Foo->meta->add_method('bar' => sub { ... })
849 # get a list of all the classes searched
850 # the method dispatcher in the correct order
851 Foo->meta->class_precedence_list()
853 # remove a method from Foo
854 Foo->meta->remove_method('bar');
856 # or use this to actually create classes ...
858 Class::MOP::Class->create('Bar' => (
860 superclasses => [ 'Foo' ],
862 Class::MOP:::Attribute->new('$bar'),
863 Class::MOP:::Attribute->new('$baz'),
866 calculate_bar => sub { ... },
867 construct_baz => sub { ... }
873 This is the largest and currently most complex part of the Perl 5
874 meta-object protocol. It controls the introspection and
875 manipulation of Perl 5 classes (and it can create them too). The
876 best way to understand what this module can do, is to read the
877 documentation for each of it's methods.
881 =head2 Self Introspection
887 This will return a B<Class::MOP::Class> instance which is related
888 to this class. Thereby allowing B<Class::MOP::Class> to actually
891 As with B<Class::MOP::Attribute>, B<Class::MOP> will actually
892 bootstrap this module by installing a number of attribute meta-objects
893 into it's metaclass. This will allow this class to reap all the benifits
894 of the MOP when subclassing it.
898 =head2 Class construction
900 These methods will handle creating B<Class::MOP::Class> objects,
901 which can be used to both create new classes, and analyze
902 pre-existing classes.
904 This module will internally store references to all the instances
905 you create with these methods, so that they do not need to be
906 created any more than nessecary. Basically, they are singletons.
910 =item B<create ($package_name,
911 version =E<gt> ?$version,
912 authority =E<gt> ?$authority,
913 superclasses =E<gt> ?@superclasses,
914 methods =E<gt> ?%methods,
915 attributes =E<gt> ?%attributes)>
917 This returns a B<Class::MOP::Class> object, bringing the specified
918 C<$package_name> into existence and adding any of the C<$version>,
919 C<$authority>, C<@superclasses>, C<%methods> and C<%attributes> to
922 =item B<create_anon_class (superclasses =E<gt> ?@superclasses,
923 methods =E<gt> ?%methods,
924 attributes =E<gt> ?%attributes)>
926 This will create an anonymous class, it works much like C<create> but
927 it does not need a C<$package_name>. Instead it will create a suitably
928 unique package name for you to stash things into.
930 On very important distinction is that anon classes are destroyed once
931 the metaclass they are attached to goes out of scope. In the DESTROY
932 method, the created package will be removed from the symbol table.
934 It is also worth noting that any instances created with an anon-class
935 will keep a special reference to the anon-meta which will prevent the
936 anon-class from going out of scope until all instances of it have also
937 been destroyed. This however only works for HASH based instance types,
938 as we use a special reserved slot (C<__MOP__>) to store this.
940 =item B<initialize ($package_name, %options)>
942 This initializes and returns returns a B<Class::MOP::Class> object
943 for a given a C<$package_name>.
945 =item B<reinitialize ($package_name, %options)>
947 This removes the old metaclass, and creates a new one in it's place.
948 Do B<not> use this unless you really know what you are doing, it could
949 very easily make a very large mess of your program.
951 =item B<construct_class_instance (%options)>
953 This will construct an instance of B<Class::MOP::Class>, it is
954 here so that we can actually "tie the knot" for B<Class::MOP::Class>
955 to use C<construct_instance> once all the bootstrapping is done. This
956 method is used internally by C<initialize> and should never be called
957 from outside of that method really.
959 =item B<check_metaclass_compatability>
961 This method is called as the very last thing in the
962 C<construct_class_instance> method. This will check that the
963 metaclass you are creating is compatible with the metaclasses of all
964 your ancestors. For more inforamtion about metaclass compatibility
965 see the C<About Metaclass compatibility> section in L<Class::MOP>.
969 =head2 Object instance construction and cloning
971 These methods are B<entirely optional>, it is up to you whether you want
976 =item B<instance_metaclass>
978 =item B<get_meta_instance>
980 =item B<new_object (%params)>
982 This is a convience method for creating a new object of the class, and
983 blessing it into the appropriate package as well. Ideally your class
984 would call a C<new> this method like so:
987 my ($class, %param) = @_;
988 $class->meta->new_object(%params);
991 Of course the ideal place for this would actually be in C<UNIVERSAL::>
992 but that is considered bad style, so we do not do that.
994 =item B<construct_instance (%params)>
996 This method is used to construct an instace structure suitable for
997 C<bless>-ing into your package of choice. It works in conjunction
998 with the Attribute protocol to collect all applicable attributes.
1000 This will construct and instance using a HASH ref as storage
1001 (currently only HASH references are supported). This will collect all
1002 the applicable attributes and layout out the fields in the HASH ref,
1003 it will then initialize them using either use the corresponding key
1004 in C<%params> or any default value or initializer found in the
1005 attribute meta-object.
1007 =item B<clone_object ($instance, %params)>
1009 This is a convience method for cloning an object instance, then
1010 blessing it into the appropriate package. This method will call
1011 C<clone_instance>, which performs a shallow copy of the object,
1012 see that methods documentation for more details. Ideally your
1013 class would call a C<clone> this method like so:
1015 sub MyClass::clone {
1016 my ($self, %param) = @_;
1017 $self->meta->clone_object($self, %params);
1020 Of course the ideal place for this would actually be in C<UNIVERSAL::>
1021 but that is considered bad style, so we do not do that.
1023 =item B<clone_instance($instance, %params)>
1025 This method is a compliment of C<construct_instance> (which means if
1026 you override C<construct_instance>, you need to override this one too),
1027 and clones the instance shallowly.
1029 The cloned structure returned is (like with C<construct_instance>) an
1030 unC<bless>ed HASH reference, it is your responsibility to then bless
1031 this cloned structure into the right class (which C<clone_object> will
1034 As of 0.11, this method will clone the C<$instance> structure shallowly,
1035 as opposed to the deep cloning implemented in prior versions. After much
1036 thought, research and discussion, I have decided that anything but basic
1037 shallow cloning is outside the scope of the meta-object protocol. I
1038 think Yuval "nothingmuch" Kogman put it best when he said that cloning
1039 is too I<context-specific> to be part of the MOP.
1043 =head2 Informational
1045 These are a few predicate methods for asking information about the class.
1049 =item B<is_anon_class>
1051 This returns true if the class is a C<Class::MOP::Class> created anon class.
1055 This returns true if the class is still mutable.
1057 =item B<is_immutable>
1059 This returns true if the class has been made immutable.
1063 =head2 Inheritance Relationships
1067 =item B<superclasses (?@superclasses)>
1069 This is a read-write attribute which represents the superclass
1070 relationships of the class the B<Class::MOP::Class> instance is
1071 associated with. Basically, it can get and set the C<@ISA> for you.
1074 Perl will occasionally perform some C<@ISA> and method caching, if
1075 you decide to change your superclass relationship at runtime (which
1076 is quite insane and very much not recommened), then you should be
1077 aware of this and the fact that this module does not make any
1078 attempt to address this issue.
1080 =item B<class_precedence_list>
1082 This computes the a list of all the class's ancestors in the same order
1083 in which method dispatch will be done. This is similair to
1084 what B<Class::ISA::super_path> does, but we don't remove duplicate names.
1086 =item B<linearized_isa>
1088 This returns a list based on C<class_precedence_list> but with all
1097 =item B<get_method_map>
1099 =item B<method_metaclass>
1101 =item B<add_method ($method_name, $method)>
1103 This will take a C<$method_name> and CODE reference to that
1104 C<$method> and install it into the class's package.
1107 This does absolutely nothing special to C<$method>
1108 other than use B<Sub::Name> to make sure it is tagged with the
1109 correct name, and therefore show up correctly in stack traces and
1112 =item B<alias_method ($method_name, $method)>
1114 This will take a C<$method_name> and CODE reference to that
1115 C<$method> and alias the method into the class's package.
1118 Unlike C<add_method>, this will B<not> try to name the
1119 C<$method> using B<Sub::Name>, it only aliases the method in
1120 the class's package.
1122 =item B<has_method ($method_name)>
1124 This just provides a simple way to check if the class implements
1125 a specific C<$method_name>. It will I<not> however, attempt to check
1126 if the class inherits the method (use C<UNIVERSAL::can> for that).
1128 This will correctly handle functions defined outside of the package
1129 that use a fully qualified name (C<sub Package::name { ... }>).
1131 This will correctly handle functions renamed with B<Sub::Name> and
1132 installed using the symbol tables. However, if you are naming the
1133 subroutine outside of the package scope, you must use the fully
1134 qualified name, including the package name, for C<has_method> to
1135 correctly identify it.
1137 This will attempt to correctly ignore functions imported from other
1138 packages using B<Exporter>. It breaks down if the function imported
1139 is an C<__ANON__> sub (such as with C<use constant>), which very well
1140 may be a valid method being applied to the class.
1142 In short, this method cannot always be trusted to determine if the
1143 C<$method_name> is actually a method. However, it will DWIM about
1144 90% of the time, so it's a small trade off I think.
1146 =item B<get_method ($method_name)>
1148 This will return a Class::MOP::Method instance related to the specified
1149 C<$method_name>, or return undef if that method does not exist.
1151 The Class::MOP::Method is codifiable, so you can use it like a normal
1152 CODE reference, see L<Class::MOP::Method> for more information.
1154 =item B<find_method_by_name ($method_name>
1156 This will return a CODE reference of the specified C<$method_name>,
1157 or return undef if that method does not exist.
1159 Unlike C<get_method> this will also look in the superclasses.
1161 =item B<remove_method ($method_name)>
1163 This will attempt to remove a given C<$method_name> from the class.
1164 It will return the CODE reference that it has removed, and will
1165 attempt to use B<Sub::Name> to clear the methods associated name.
1167 =item B<get_method_list>
1169 This will return a list of method names for all I<locally> defined
1170 methods. It does B<not> provide a list of all applicable methods,
1171 including any inherited ones. If you want a list of all applicable
1172 methods, use the C<compute_all_applicable_methods> method.
1174 =item B<compute_all_applicable_methods>
1176 This will return a list of all the methods names this class will
1177 respond to, taking into account inheritance. The list will be a list of
1178 HASH references, each one containing the following information; method
1179 name, the name of the class in which the method lives and a CODE
1180 reference for the actual method.
1182 =item B<find_all_methods_by_name ($method_name)>
1184 This will traverse the inheritence hierarchy and locate all methods
1185 with a given C<$method_name>. Similar to
1186 C<compute_all_applicable_methods> it returns a list of HASH references
1187 with the following information; method name (which will always be the
1188 same as C<$method_name>), the name of the class in which the method
1189 lives and a CODE reference for the actual method.
1191 The list of methods produced is a distinct list, meaning there are no
1192 duplicates in it. This is especially useful for things like object
1193 initialization and destruction where you only want the method called
1194 once, and in the correct order.
1196 =item B<find_next_method_by_name ($method_name)>
1198 This will return the first method to match a given C<$method_name> in
1199 the superclasses, this is basically equivalent to calling
1200 C<SUPER::$method_name>, but it can be dispatched at runtime.
1204 =head2 Method Modifiers
1206 Method modifiers are a concept borrowed from CLOS, in which a method
1207 can be wrapped with I<before>, I<after> and I<around> method modifiers
1208 that will be called everytime the method is called.
1210 =head3 How method modifiers work?
1212 Method modifiers work by wrapping the original method and then replacing
1213 it in the classes symbol table. The wrappers will handle calling all the
1214 modifiers in the appropariate orders and preserving the calling context
1215 for the original method.
1217 Each method modifier serves a particular purpose, which may not be
1218 obvious to users of other method wrapping modules. To start with, the
1219 return values of I<before> and I<after> modifiers are ignored. This is
1220 because thier purpose is B<not> to filter the input and output of the
1221 primary method (this is done with an I<around> modifier). This may seem
1222 like an odd restriction to some, but doing this allows for simple code
1223 to be added at the begining or end of a method call without jeapordizing
1224 the normal functioning of the primary method or placing any extra
1225 responsibility on the code of the modifier. Of course if you have more
1226 complex needs, then use the I<around> modifier, which uses a variation
1227 of continutation passing style to allow for a high degree of flexibility.
1229 Before and around modifiers are called in last-defined-first-called order,
1230 while after modifiers are called in first-defined-first-called order. So
1231 the call tree might looks something like this:
1241 To see examples of using method modifiers, see the following examples
1242 included in the distribution; F<InstanceCountingClass>, F<Perl6Attribute>,
1243 F<AttributesWithHistory> and F<C3MethodDispatchOrder>. There is also a
1244 classic CLOS usage example in the test F<017_add_method_modifier.t>.
1246 =head3 What is the performance impact?
1248 Of course there is a performance cost associated with method modifiers,
1249 but we have made every effort to make that cost be directly proportional
1250 to the amount of modifier features you utilize.
1252 The wrapping method does it's best to B<only> do as much work as it
1253 absolutely needs to. In order to do this we have moved some of the
1254 performance costs to set-up time, where they are easier to amortize.
1256 All this said, my benchmarks have indicated the following:
1258 simple wrapper with no modifiers 100% slower
1259 simple wrapper with simple before modifier 400% slower
1260 simple wrapper with simple after modifier 450% slower
1261 simple wrapper with simple around modifier 500-550% slower
1262 simple wrapper with all 3 modifiers 1100% slower
1264 These numbers may seem daunting, but you must remember, every feature
1265 comes with some cost. To put things in perspective, just doing a simple
1266 C<AUTOLOAD> which does nothing but extract the name of the method called
1267 and return it costs about 400% over a normal method call.
1271 =item B<add_before_method_modifier ($method_name, $code)>
1273 This will wrap the method at C<$method_name> and the supplied C<$code>
1274 will be passed the C<@_> arguments, and called before the original
1275 method is called. As specified above, the return value of the I<before>
1276 method modifiers is ignored, and it's ability to modify C<@_> is
1277 fairly limited. If you need to do either of these things, use an
1278 C<around> method modifier.
1280 =item B<add_after_method_modifier ($method_name, $code)>
1282 This will wrap the method at C<$method_name> so that the original
1283 method will be called, it's return values stashed, and then the
1284 supplied C<$code> will be passed the C<@_> arguments, and called.
1285 As specified above, the return value of the I<after> method
1286 modifiers is ignored, and it cannot modify the return values of
1287 the original method. If you need to do either of these things, use an
1288 C<around> method modifier.
1290 =item B<add_around_method_modifier ($method_name, $code)>
1292 This will wrap the method at C<$method_name> so that C<$code>
1293 will be called and passed the original method as an extra argument
1294 at the begining of the C<@_> argument list. This is a variation of
1295 continuation passing style, where the function prepended to C<@_>
1296 can be considered a continuation. It is up to C<$code> if it calls
1297 the original method or not, there is no restriction on what the
1298 C<$code> can or cannot do.
1304 It should be noted that since there is no one consistent way to define
1305 the attributes of a class in Perl 5. These methods can only work with
1306 the information given, and can not easily discover information on
1307 their own. See L<Class::MOP::Attribute> for more details.
1311 =item B<attribute_metaclass>
1313 =item B<get_attribute_map>
1315 =item B<add_attribute ($attribute_meta_object | $attribute_name, %attribute_spec)>
1317 This stores the C<$attribute_meta_object> (or creates one from the
1318 C<$attribute_name> and C<%attribute_spec>) in the B<Class::MOP::Class>
1319 instance associated with the given class. Unlike methods, attributes
1320 within the MOP are stored as meta-information only. They will be used
1321 later to construct instances from (see C<construct_instance> above).
1322 More details about the attribute meta-objects can be found in the
1323 L<Class::MOP::Attribute> or the L<Class::MOP/The Attribute protocol>
1326 It should be noted that any accessor, reader/writer or predicate
1327 methods which the C<$attribute_meta_object> has will be installed
1328 into the class at this time.
1331 If an attribute already exists for C<$attribute_name>, the old one
1332 will be removed (as well as removing all it's accessors), and then
1335 =item B<has_attribute ($attribute_name)>
1337 Checks to see if this class has an attribute by the name of
1338 C<$attribute_name> and returns a boolean.
1340 =item B<get_attribute ($attribute_name)>
1342 Returns the attribute meta-object associated with C<$attribute_name>,
1343 if none is found, it will return undef.
1345 =item B<remove_attribute ($attribute_name)>
1347 This will remove the attribute meta-object stored at
1348 C<$attribute_name>, then return the removed attribute meta-object.
1351 Removing an attribute will only affect future instances of
1352 the class, it will not make any attempt to remove the attribute from
1353 any existing instances of the class.
1355 It should be noted that any accessor, reader/writer or predicate
1356 methods which the attribute meta-object stored at C<$attribute_name>
1357 has will be removed from the class at this time. This B<will> make
1358 these attributes somewhat inaccessable in previously created
1359 instances. But if you are crazy enough to do this at runtime, then
1360 you are crazy enough to deal with something like this :).
1362 =item B<get_attribute_list>
1364 This returns a list of attribute names which are defined in the local
1365 class. If you want a list of all applicable attributes for a class,
1366 use the C<compute_all_applicable_attributes> method.
1368 =item B<compute_all_applicable_attributes>
1370 This will traverse the inheritance heirachy and return a list of all
1371 the applicable attributes for this class. It does not construct a
1372 HASH reference like C<compute_all_applicable_methods> because all
1373 that same information is discoverable through the attribute
1376 =item B<find_attribute_by_name ($attr_name)>
1378 This method will traverse the inheritance heirachy and find the
1379 first attribute whose name matches C<$attr_name>, then return it.
1380 It will return undef if nothing is found.
1384 =head2 Class Immutability
1388 =item B<make_immutable (%options)>
1390 This method will invoke a tranforamtion upon the class which will
1391 make it immutable. Details of this transformation can be found in
1392 the L<Class::MOP::Immutable> documentation.
1394 =item B<make_mutable>
1396 This method will reverse tranforamtion upon the class which
1399 =item B<create_immutable_transformer>
1401 Create a transformer suitable for making this class immutable
1407 Stevan Little E<lt>stevan@iinteractive.comE<gt>
1409 =head1 COPYRIGHT AND LICENSE
1411 Copyright 2006, 2007 by Infinity Interactive, Inc.
1413 L<http://www.iinteractive.com>
1415 This library is free software; you can redistribute it and/or modify
1416 it under the same terms as Perl itself.