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.25';
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
1093 This returns a list of subclasses for this class.
1101 =item B<get_method_map>
1103 =item B<method_metaclass>
1105 =item B<add_method ($method_name, $method)>
1107 This will take a C<$method_name> and CODE reference to that
1108 C<$method> and install it into the class's package.
1111 This does absolutely nothing special to C<$method>
1112 other than use B<Sub::Name> to make sure it is tagged with the
1113 correct name, and therefore show up correctly in stack traces and
1116 =item B<alias_method ($method_name, $method)>
1118 This will take a C<$method_name> and CODE reference to that
1119 C<$method> and alias the method into the class's package.
1122 Unlike C<add_method>, this will B<not> try to name the
1123 C<$method> using B<Sub::Name>, it only aliases the method in
1124 the class's package.
1126 =item B<has_method ($method_name)>
1128 This just provides a simple way to check if the class implements
1129 a specific C<$method_name>. It will I<not> however, attempt to check
1130 if the class inherits the method (use C<UNIVERSAL::can> for that).
1132 This will correctly handle functions defined outside of the package
1133 that use a fully qualified name (C<sub Package::name { ... }>).
1135 This will correctly handle functions renamed with B<Sub::Name> and
1136 installed using the symbol tables. However, if you are naming the
1137 subroutine outside of the package scope, you must use the fully
1138 qualified name, including the package name, for C<has_method> to
1139 correctly identify it.
1141 This will attempt to correctly ignore functions imported from other
1142 packages using B<Exporter>. It breaks down if the function imported
1143 is an C<__ANON__> sub (such as with C<use constant>), which very well
1144 may be a valid method being applied to the class.
1146 In short, this method cannot always be trusted to determine if the
1147 C<$method_name> is actually a method. However, it will DWIM about
1148 90% of the time, so it's a small trade off I think.
1150 =item B<get_method ($method_name)>
1152 This will return a Class::MOP::Method instance related to the specified
1153 C<$method_name>, or return undef if that method does not exist.
1155 The Class::MOP::Method is codifiable, so you can use it like a normal
1156 CODE reference, see L<Class::MOP::Method> for more information.
1158 =item B<find_method_by_name ($method_name>
1160 This will return a CODE reference of the specified C<$method_name>,
1161 or return undef if that method does not exist.
1163 Unlike C<get_method> this will also look in the superclasses.
1165 =item B<remove_method ($method_name)>
1167 This will attempt to remove a given C<$method_name> from the class.
1168 It will return the CODE reference that it has removed, and will
1169 attempt to use B<Sub::Name> to clear the methods associated name.
1171 =item B<get_method_list>
1173 This will return a list of method names for all I<locally> defined
1174 methods. It does B<not> provide a list of all applicable methods,
1175 including any inherited ones. If you want a list of all applicable
1176 methods, use the C<compute_all_applicable_methods> method.
1178 =item B<compute_all_applicable_methods>
1180 This will return a list of all the methods names this class will
1181 respond to, taking into account inheritance. The list will be a list of
1182 HASH references, each one containing the following information; method
1183 name, the name of the class in which the method lives and a CODE
1184 reference for the actual method.
1186 =item B<find_all_methods_by_name ($method_name)>
1188 This will traverse the inheritence hierarchy and locate all methods
1189 with a given C<$method_name>. Similar to
1190 C<compute_all_applicable_methods> it returns a list of HASH references
1191 with the following information; method name (which will always be the
1192 same as C<$method_name>), the name of the class in which the method
1193 lives and a CODE reference for the actual method.
1195 The list of methods produced is a distinct list, meaning there are no
1196 duplicates in it. This is especially useful for things like object
1197 initialization and destruction where you only want the method called
1198 once, and in the correct order.
1200 =item B<find_next_method_by_name ($method_name)>
1202 This will return the first method to match a given C<$method_name> in
1203 the superclasses, this is basically equivalent to calling
1204 C<SUPER::$method_name>, but it can be dispatched at runtime.
1208 =head2 Method Modifiers
1210 Method modifiers are a concept borrowed from CLOS, in which a method
1211 can be wrapped with I<before>, I<after> and I<around> method modifiers
1212 that will be called everytime the method is called.
1214 =head3 How method modifiers work?
1216 Method modifiers work by wrapping the original method and then replacing
1217 it in the classes symbol table. The wrappers will handle calling all the
1218 modifiers in the appropariate orders and preserving the calling context
1219 for the original method.
1221 Each method modifier serves a particular purpose, which may not be
1222 obvious to users of other method wrapping modules. To start with, the
1223 return values of I<before> and I<after> modifiers are ignored. This is
1224 because thier purpose is B<not> to filter the input and output of the
1225 primary method (this is done with an I<around> modifier). This may seem
1226 like an odd restriction to some, but doing this allows for simple code
1227 to be added at the begining or end of a method call without jeapordizing
1228 the normal functioning of the primary method or placing any extra
1229 responsibility on the code of the modifier. Of course if you have more
1230 complex needs, then use the I<around> modifier, which uses a variation
1231 of continutation passing style to allow for a high degree of flexibility.
1233 Before and around modifiers are called in last-defined-first-called order,
1234 while after modifiers are called in first-defined-first-called order. So
1235 the call tree might looks something like this:
1245 To see examples of using method modifiers, see the following examples
1246 included in the distribution; F<InstanceCountingClass>, F<Perl6Attribute>,
1247 F<AttributesWithHistory> and F<C3MethodDispatchOrder>. There is also a
1248 classic CLOS usage example in the test F<017_add_method_modifier.t>.
1250 =head3 What is the performance impact?
1252 Of course there is a performance cost associated with method modifiers,
1253 but we have made every effort to make that cost be directly proportional
1254 to the amount of modifier features you utilize.
1256 The wrapping method does it's best to B<only> do as much work as it
1257 absolutely needs to. In order to do this we have moved some of the
1258 performance costs to set-up time, where they are easier to amortize.
1260 All this said, my benchmarks have indicated the following:
1262 simple wrapper with no modifiers 100% slower
1263 simple wrapper with simple before modifier 400% slower
1264 simple wrapper with simple after modifier 450% slower
1265 simple wrapper with simple around modifier 500-550% slower
1266 simple wrapper with all 3 modifiers 1100% slower
1268 These numbers may seem daunting, but you must remember, every feature
1269 comes with some cost. To put things in perspective, just doing a simple
1270 C<AUTOLOAD> which does nothing but extract the name of the method called
1271 and return it costs about 400% over a normal method call.
1275 =item B<add_before_method_modifier ($method_name, $code)>
1277 This will wrap the method at C<$method_name> and the supplied C<$code>
1278 will be passed the C<@_> arguments, and called before the original
1279 method is called. As specified above, the return value of the I<before>
1280 method modifiers is ignored, and it's ability to modify C<@_> is
1281 fairly limited. If you need to do either of these things, use an
1282 C<around> method modifier.
1284 =item B<add_after_method_modifier ($method_name, $code)>
1286 This will wrap the method at C<$method_name> so that the original
1287 method will be called, it's return values stashed, and then the
1288 supplied C<$code> will be passed the C<@_> arguments, and called.
1289 As specified above, the return value of the I<after> method
1290 modifiers is ignored, and it cannot modify the return values of
1291 the original method. If you need to do either of these things, use an
1292 C<around> method modifier.
1294 =item B<add_around_method_modifier ($method_name, $code)>
1296 This will wrap the method at C<$method_name> so that C<$code>
1297 will be called and passed the original method as an extra argument
1298 at the begining of the C<@_> argument list. This is a variation of
1299 continuation passing style, where the function prepended to C<@_>
1300 can be considered a continuation. It is up to C<$code> if it calls
1301 the original method or not, there is no restriction on what the
1302 C<$code> can or cannot do.
1308 It should be noted that since there is no one consistent way to define
1309 the attributes of a class in Perl 5. These methods can only work with
1310 the information given, and can not easily discover information on
1311 their own. See L<Class::MOP::Attribute> for more details.
1315 =item B<attribute_metaclass>
1317 =item B<get_attribute_map>
1319 =item B<add_attribute ($attribute_meta_object | $attribute_name, %attribute_spec)>
1321 This stores the C<$attribute_meta_object> (or creates one from the
1322 C<$attribute_name> and C<%attribute_spec>) in the B<Class::MOP::Class>
1323 instance associated with the given class. Unlike methods, attributes
1324 within the MOP are stored as meta-information only. They will be used
1325 later to construct instances from (see C<construct_instance> above).
1326 More details about the attribute meta-objects can be found in the
1327 L<Class::MOP::Attribute> or the L<Class::MOP/The Attribute protocol>
1330 It should be noted that any accessor, reader/writer or predicate
1331 methods which the C<$attribute_meta_object> has will be installed
1332 into the class at this time.
1335 If an attribute already exists for C<$attribute_name>, the old one
1336 will be removed (as well as removing all it's accessors), and then
1339 =item B<has_attribute ($attribute_name)>
1341 Checks to see if this class has an attribute by the name of
1342 C<$attribute_name> and returns a boolean.
1344 =item B<get_attribute ($attribute_name)>
1346 Returns the attribute meta-object associated with C<$attribute_name>,
1347 if none is found, it will return undef.
1349 =item B<remove_attribute ($attribute_name)>
1351 This will remove the attribute meta-object stored at
1352 C<$attribute_name>, then return the removed attribute meta-object.
1355 Removing an attribute will only affect future instances of
1356 the class, it will not make any attempt to remove the attribute from
1357 any existing instances of the class.
1359 It should be noted that any accessor, reader/writer or predicate
1360 methods which the attribute meta-object stored at C<$attribute_name>
1361 has will be removed from the class at this time. This B<will> make
1362 these attributes somewhat inaccessable in previously created
1363 instances. But if you are crazy enough to do this at runtime, then
1364 you are crazy enough to deal with something like this :).
1366 =item B<get_attribute_list>
1368 This returns a list of attribute names which are defined in the local
1369 class. If you want a list of all applicable attributes for a class,
1370 use the C<compute_all_applicable_attributes> method.
1372 =item B<compute_all_applicable_attributes>
1374 This will traverse the inheritance heirachy and return a list of all
1375 the applicable attributes for this class. It does not construct a
1376 HASH reference like C<compute_all_applicable_methods> because all
1377 that same information is discoverable through the attribute
1380 =item B<find_attribute_by_name ($attr_name)>
1382 This method will traverse the inheritance heirachy and find the
1383 first attribute whose name matches C<$attr_name>, then return it.
1384 It will return undef if nothing is found.
1388 =head2 Class Immutability
1392 =item B<make_immutable (%options)>
1394 This method will invoke a tranforamtion upon the class which will
1395 make it immutable. Details of this transformation can be found in
1396 the L<Class::MOP::Immutable> documentation.
1398 =item B<make_mutable>
1400 This method will reverse tranforamtion upon the class which
1403 =item B<create_immutable_transformer>
1405 Create a transformer suitable for making this class immutable
1411 Stevan Little E<lt>stevan@iinteractive.comE<gt>
1413 =head1 COPYRIGHT AND LICENSE
1415 Copyright 2006, 2007 by Infinity Interactive, Inc.
1417 L<http://www.iinteractive.com>
1419 This library is free software; you can redistribute it and/or modify
1420 it under the same terms as Perl itself.