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.22';
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 =~ /^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->class_precedence_list;
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 # compatability 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')};
389 sub class_precedence_list {
392 # We need to check for ciruclar inheirtance here.
393 # This will do nothing if all is well, and blow
394 # up otherwise. Yes, it's an ugly hack, better
395 # suggestions are welcome.
396 { ($self->name || return)->isa('This is a test for circular inheritance') }
401 $self->initialize($_)->class_precedence_list()
402 } $self->superclasses()
409 my ($self, $method_name, $method) = @_;
410 (defined $method_name && $method_name)
411 || confess "You must define a method name";
414 if (blessed($method)) {
415 $body = $method->body;
419 ('CODE' eq (reftype($body) || ''))
420 || confess "Your code block must be a CODE reference";
421 $method = $self->method_metaclass->wrap($body);
423 $self->get_method_map->{$method_name} = $method;
425 my $full_method_name = ($self->name . '::' . $method_name);
426 $self->add_package_symbol("&${method_name}" => subname $full_method_name => $body);
430 my $fetch_and_prepare_method = sub {
431 my ($self, $method_name) = @_;
433 my $method = $self->get_method($method_name);
434 # if we dont have local ...
436 # try to find the next method
437 $method = $self->find_next_method_by_name($method_name);
438 # die if it does not exist
440 || confess "The method '$method_name' is not found in the inheritance hierarchy for class " . $self->name;
441 # and now make sure to wrap it
442 # even if it is already wrapped
443 # because we need a new sub ref
444 $method = Class::MOP::Method::Wrapped->wrap($method);
447 # now make sure we wrap it properly
448 $method = Class::MOP::Method::Wrapped->wrap($method)
449 unless $method->isa('Class::MOP::Method::Wrapped');
451 $self->add_method($method_name => $method);
455 sub add_before_method_modifier {
456 my ($self, $method_name, $method_modifier) = @_;
457 (defined $method_name && $method_name)
458 || confess "You must pass in a method name";
459 my $method = $fetch_and_prepare_method->($self, $method_name);
460 $method->add_before_modifier(subname ':before' => $method_modifier);
463 sub add_after_method_modifier {
464 my ($self, $method_name, $method_modifier) = @_;
465 (defined $method_name && $method_name)
466 || confess "You must pass in a method name";
467 my $method = $fetch_and_prepare_method->($self, $method_name);
468 $method->add_after_modifier(subname ':after' => $method_modifier);
471 sub add_around_method_modifier {
472 my ($self, $method_name, $method_modifier) = @_;
473 (defined $method_name && $method_name)
474 || confess "You must pass in a method name";
475 my $method = $fetch_and_prepare_method->($self, $method_name);
476 $method->add_around_modifier(subname ':around' => $method_modifier);
480 # the methods above used to be named like this:
481 # ${pkg}::${method}:(before|after|around)
482 # but this proved problematic when using one modifier
483 # to wrap multiple methods (something which is likely
484 # to happen pretty regularly IMO). So instead of naming
485 # it like this, I have chosen to just name them purely
486 # with their modifier names, like so:
487 # :(before|after|around)
488 # The fact is that in a stack trace, it will be fairly
489 # evident from the context what method they are attached
490 # to, and so don't need the fully qualified name.
494 my ($self, $method_name, $method) = @_;
495 (defined $method_name && $method_name)
496 || confess "You must define a method name";
498 my $body = (blessed($method) ? $method->body : $method);
499 ('CODE' eq (reftype($body) || ''))
500 || confess "Your code block must be a CODE reference";
502 $self->add_package_symbol("&${method_name}" => $body);
506 my ($self, $method_name) = @_;
507 (defined $method_name && $method_name)
508 || confess "You must define a method name";
510 return 0 unless exists $self->get_method_map->{$method_name};
515 my ($self, $method_name) = @_;
516 (defined $method_name && $method_name)
517 || confess "You must define a method name";
520 # I don't really need this here, because
521 # if the method_map is missing a key it
522 # will just return undef for me now
523 # return unless $self->has_method($method_name);
525 return $self->get_method_map->{$method_name};
529 my ($self, $method_name) = @_;
530 (defined $method_name && $method_name)
531 || confess "You must define a method name";
533 my $removed_method = $self->get_method($method_name);
536 $self->remove_package_symbol("&${method_name}");
537 delete $self->get_method_map->{$method_name};
538 } if defined $removed_method;
540 return $removed_method;
543 sub get_method_list {
545 keys %{$self->get_method_map};
548 sub find_method_by_name {
549 my ($self, $method_name) = @_;
550 (defined $method_name && $method_name)
551 || confess "You must define a method name to find";
552 # keep a record of what we have seen
553 # here, this will handle all the
554 # inheritence issues because we are
555 # using the &class_precedence_list
557 my @cpl = $self->class_precedence_list();
558 foreach my $class (@cpl) {
559 next if $seen_class{$class};
560 $seen_class{$class}++;
561 # fetch the meta-class ...
562 my $meta = $self->initialize($class);
563 return $meta->get_method($method_name)
564 if $meta->has_method($method_name);
569 sub compute_all_applicable_methods {
572 # keep a record of what we have seen
573 # here, this will handle all the
574 # inheritence issues because we are
575 # using the &class_precedence_list
576 my (%seen_class, %seen_method);
577 foreach my $class ($self->class_precedence_list()) {
578 next if $seen_class{$class};
579 $seen_class{$class}++;
580 # fetch the meta-class ...
581 my $meta = $self->initialize($class);
582 foreach my $method_name ($meta->get_method_list()) {
583 next if exists $seen_method{$method_name};
584 $seen_method{$method_name}++;
586 name => $method_name,
588 code => $meta->get_method($method_name)
595 sub find_all_methods_by_name {
596 my ($self, $method_name) = @_;
597 (defined $method_name && $method_name)
598 || confess "You must define a method name to find";
600 # keep a record of what we have seen
601 # here, this will handle all the
602 # inheritence issues because we are
603 # using the &class_precedence_list
605 foreach my $class ($self->class_precedence_list()) {
606 next if $seen_class{$class};
607 $seen_class{$class}++;
608 # fetch the meta-class ...
609 my $meta = $self->initialize($class);
611 name => $method_name,
613 code => $meta->get_method($method_name)
614 } if $meta->has_method($method_name);
619 sub find_next_method_by_name {
620 my ($self, $method_name) = @_;
621 (defined $method_name && $method_name)
622 || confess "You must define a method name to find";
623 # keep a record of what we have seen
624 # here, this will handle all the
625 # inheritence issues because we are
626 # using the &class_precedence_list
628 my @cpl = $self->class_precedence_list();
629 shift @cpl; # discard ourselves
630 foreach my $class (@cpl) {
631 next if $seen_class{$class};
632 $seen_class{$class}++;
633 # fetch the meta-class ...
634 my $meta = $self->initialize($class);
635 return $meta->get_method($method_name)
636 if $meta->has_method($method_name);
645 # either we have an attribute object already
646 # or we need to create one from the args provided
647 my $attribute = blessed($_[0]) ? $_[0] : $self->attribute_metaclass->new(@_);
648 # make sure it is derived from the correct type though
649 ($attribute->isa('Class::MOP::Attribute'))
650 || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";
652 # first we attach our new attribute
653 # because it might need certain information
654 # about the class which it is attached to
655 $attribute->attach_to_class($self);
657 # then we remove attributes of a conflicting
658 # name here so that we can properly detach
659 # the old attr object, and remove any
660 # accessors it would have generated
661 $self->remove_attribute($attribute->name)
662 if $self->has_attribute($attribute->name);
664 # then onto installing the new accessors
665 $attribute->install_accessors();
666 $self->get_attribute_map->{$attribute->name} = $attribute;
670 my ($self, $attribute_name) = @_;
671 (defined $attribute_name && $attribute_name)
672 || confess "You must define an attribute name";
673 exists $self->get_attribute_map->{$attribute_name} ? 1 : 0;
677 my ($self, $attribute_name) = @_;
678 (defined $attribute_name && $attribute_name)
679 || confess "You must define an attribute name";
680 return $self->get_attribute_map->{$attribute_name}
682 # this will return undef anyway, so no need ...
683 # if $self->has_attribute($attribute_name);
687 sub remove_attribute {
688 my ($self, $attribute_name) = @_;
689 (defined $attribute_name && $attribute_name)
690 || confess "You must define an attribute name";
691 my $removed_attribute = $self->get_attribute_map->{$attribute_name};
692 return unless defined $removed_attribute;
693 delete $self->get_attribute_map->{$attribute_name};
694 $removed_attribute->remove_accessors();
695 $removed_attribute->detach_from_class();
696 return $removed_attribute;
699 sub get_attribute_list {
701 keys %{$self->get_attribute_map};
704 sub compute_all_applicable_attributes {
707 # keep a record of what we have seen
708 # here, this will handle all the
709 # inheritence issues because we are
710 # using the &class_precedence_list
711 my (%seen_class, %seen_attr);
712 foreach my $class ($self->class_precedence_list()) {
713 next if $seen_class{$class};
714 $seen_class{$class}++;
715 # fetch the meta-class ...
716 my $meta = $self->initialize($class);
717 foreach my $attr_name ($meta->get_attribute_list()) {
718 next if exists $seen_attr{$attr_name};
719 $seen_attr{$attr_name}++;
720 push @attrs => $meta->get_attribute($attr_name);
726 sub find_attribute_by_name {
727 my ($self, $attr_name) = @_;
728 # keep a record of what we have seen
729 # here, this will handle all the
730 # inheritence issues because we are
731 # using the &class_precedence_list
733 foreach my $class ($self->class_precedence_list()) {
734 next if $seen_class{$class};
735 $seen_class{$class}++;
736 # fetch the meta-class ...
737 my $meta = $self->initialize($class);
738 return $meta->get_attribute($attr_name)
739 if $meta->has_attribute($attr_name);
747 sub is_immutable { 0 }
750 # Why I changed this (groditi)
751 # - One Metaclass may have many Classes through many Metaclass instances
752 # - One Metaclass should only have one Immutable Transformer instance
753 # - Each Class may have different Immutabilizing options
754 # - Therefore each Metaclass instance may have different Immutabilizing options
755 # - We need to store one Immutable Transformer instance per Metaclass
756 # - We need to store one set of Immutable Transformer options per Class
757 # - Upon make_mutable we may delete the Immutabilizing options
758 # - We could clean the immutable Transformer instance when there is no more
759 # immutable Classes of that type, but we can also keep it in case
760 # another class with this same Metaclass becomes immutable. It is a case
761 # of trading of storing an instance to avoid unnecessary instantiations of
762 # Immutable Transformers. You may view this as a memory leak, however
763 # Because we have few Metaclasses, in practice it seems acceptable
764 # - To allow Immutable Transformers instances to be cleaned up we could weaken
765 # the reference stored in $IMMUTABLE_TRANSFORMERS{$class} and ||= should DWIM
768 my %IMMUTABLE_TRANSFORMERS;
769 my %IMMUTABLE_OPTIONS;
773 my $class = blessed $self || $self;
775 $IMMUTABLE_TRANSFORMERS{$class} ||= $self->create_immutable_transformer;
776 my $transformer = $IMMUTABLE_TRANSFORMERS{$class};
778 $transformer->make_metaclass_immutable($self, %options);
779 $IMMUTABLE_OPTIONS{$self->name} =
780 { %options, IMMUTABLE_TRANSFORMER => $transformer };
782 if( exists $options{debug} && $options{debug} ){
783 print STDERR "# of Metaclass options: ", keys %IMMUTABLE_OPTIONS;
784 print STDERR "# of Immutable transformers: ", keys %IMMUTABLE_TRANSFORMERS;
790 return if $self->is_mutable;
791 my $options = delete $IMMUTABLE_OPTIONS{$self->name};
792 confess "unable to find immutabilizing options" unless $options;
793 my $transformer = delete $options->{IMMUTABLE_TRANSFORMER};
794 $transformer->make_metaclass_mutable($self, %$options);
798 sub create_immutable_transformer {
800 my $class = Class::MOP::Immutable->new($self, {
801 read_only => [qw/superclasses/],
809 remove_package_symbol
812 class_precedence_list => 'ARRAY',
813 compute_all_applicable_attributes => 'ARRAY',
814 get_meta_instance => 'SCALAR',
815 get_method_map => 'SCALAR',
829 Class::MOP::Class - Class Meta Object
833 # assuming that class Foo
834 # has been defined, you can
836 # use this for introspection ...
838 # add a method to Foo ...
839 Foo->meta->add_method('bar' => sub { ... })
841 # get a list of all the classes searched
842 # the method dispatcher in the correct order
843 Foo->meta->class_precedence_list()
845 # remove a method from Foo
846 Foo->meta->remove_method('bar');
848 # or use this to actually create classes ...
850 Class::MOP::Class->create('Bar' => (
852 superclasses => [ 'Foo' ],
854 Class::MOP:::Attribute->new('$bar'),
855 Class::MOP:::Attribute->new('$baz'),
858 calculate_bar => sub { ... },
859 construct_baz => sub { ... }
865 This is the largest and currently most complex part of the Perl 5
866 meta-object protocol. It controls the introspection and
867 manipulation of Perl 5 classes (and it can create them too). The
868 best way to understand what this module can do, is to read the
869 documentation for each of it's methods.
873 =head2 Self Introspection
879 This will return a B<Class::MOP::Class> instance which is related
880 to this class. Thereby allowing B<Class::MOP::Class> to actually
883 As with B<Class::MOP::Attribute>, B<Class::MOP> will actually
884 bootstrap this module by installing a number of attribute meta-objects
885 into it's metaclass. This will allow this class to reap all the benifits
886 of the MOP when subclassing it.
890 =head2 Class construction
892 These methods will handle creating B<Class::MOP::Class> objects,
893 which can be used to both create new classes, and analyze
894 pre-existing classes.
896 This module will internally store references to all the instances
897 you create with these methods, so that they do not need to be
898 created any more than nessecary. Basically, they are singletons.
902 =item B<create ($package_name,
903 version =E<gt> ?$version,
904 authority =E<gt> ?$authority,
905 superclasses =E<gt> ?@superclasses,
906 methods =E<gt> ?%methods,
907 attributes =E<gt> ?%attributes)>
909 This returns a B<Class::MOP::Class> object, bringing the specified
910 C<$package_name> into existence and adding any of the C<$version>,
911 C<$authority>, C<@superclasses>, C<%methods> and C<%attributes> to
914 =item B<create_anon_class (superclasses =E<gt> ?@superclasses,
915 methods =E<gt> ?%methods,
916 attributes =E<gt> ?%attributes)>
918 This will create an anonymous class, it works much like C<create> but
919 it does not need a C<$package_name>. Instead it will create a suitably
920 unique package name for you to stash things into.
922 On very important distinction is that anon classes are destroyed once
923 the metaclass they are attached to goes out of scope. In the DESTROY
924 method, the created package will be removed from the symbol table.
926 It is also worth noting that any instances created with an anon-class
927 will keep a special reference to the anon-meta which will prevent the
928 anon-class from going out of scope until all instances of it have also
929 been destroyed. This however only works for HASH based instance types,
930 as we use a special reserved slot (C<__MOP__>) to store this.
932 =item B<initialize ($package_name, %options)>
934 This initializes and returns returns a B<Class::MOP::Class> object
935 for a given a C<$package_name>.
937 =item B<reinitialize ($package_name, %options)>
939 This removes the old metaclass, and creates a new one in it's place.
940 Do B<not> use this unless you really know what you are doing, it could
941 very easily make a very large mess of your program.
943 =item B<construct_class_instance (%options)>
945 This will construct an instance of B<Class::MOP::Class>, it is
946 here so that we can actually "tie the knot" for B<Class::MOP::Class>
947 to use C<construct_instance> once all the bootstrapping is done. This
948 method is used internally by C<initialize> and should never be called
949 from outside of that method really.
951 =item B<check_metaclass_compatability>
953 This method is called as the very last thing in the
954 C<construct_class_instance> method. This will check that the
955 metaclass you are creating is compatible with the metaclasses of all
956 your ancestors. For more inforamtion about metaclass compatibility
957 see the C<About Metaclass compatibility> section in L<Class::MOP>.
961 =head2 Object instance construction and cloning
963 These methods are B<entirely optional>, it is up to you whether you want
968 =item B<instance_metaclass>
970 =item B<get_meta_instance>
972 =item B<new_object (%params)>
974 This is a convience method for creating a new object of the class, and
975 blessing it into the appropriate package as well. Ideally your class
976 would call a C<new> this method like so:
979 my ($class, %param) = @_;
980 $class->meta->new_object(%params);
983 Of course the ideal place for this would actually be in C<UNIVERSAL::>
984 but that is considered bad style, so we do not do that.
986 =item B<construct_instance (%params)>
988 This method is used to construct an instace structure suitable for
989 C<bless>-ing into your package of choice. It works in conjunction
990 with the Attribute protocol to collect all applicable attributes.
992 This will construct and instance using a HASH ref as storage
993 (currently only HASH references are supported). This will collect all
994 the applicable attributes and layout out the fields in the HASH ref,
995 it will then initialize them using either use the corresponding key
996 in C<%params> or any default value or initializer found in the
997 attribute meta-object.
999 =item B<clone_object ($instance, %params)>
1001 This is a convience method for cloning an object instance, then
1002 blessing it into the appropriate package. This method will call
1003 C<clone_instance>, which performs a shallow copy of the object,
1004 see that methods documentation for more details. Ideally your
1005 class would call a C<clone> this method like so:
1007 sub MyClass::clone {
1008 my ($self, %param) = @_;
1009 $self->meta->clone_object($self, %params);
1012 Of course the ideal place for this would actually be in C<UNIVERSAL::>
1013 but that is considered bad style, so we do not do that.
1015 =item B<clone_instance($instance, %params)>
1017 This method is a compliment of C<construct_instance> (which means if
1018 you override C<construct_instance>, you need to override this one too),
1019 and clones the instance shallowly.
1021 The cloned structure returned is (like with C<construct_instance>) an
1022 unC<bless>ed HASH reference, it is your responsibility to then bless
1023 this cloned structure into the right class (which C<clone_object> will
1026 As of 0.11, this method will clone the C<$instance> structure shallowly,
1027 as opposed to the deep cloning implemented in prior versions. After much
1028 thought, research and discussion, I have decided that anything but basic
1029 shallow cloning is outside the scope of the meta-object protocol. I
1030 think Yuval "nothingmuch" Kogman put it best when he said that cloning
1031 is too I<context-specific> to be part of the MOP.
1035 =head2 Informational
1037 These are a few predicate methods for asking information about the class.
1041 =item B<is_anon_class>
1043 This returns true if the class is a C<Class::MOP::Class> created anon class.
1047 This returns true if the class is still mutable.
1049 =item B<is_immutable>
1051 This returns true if the class has been made immutable.
1055 =head2 Inheritance Relationships
1059 =item B<superclasses (?@superclasses)>
1061 This is a read-write attribute which represents the superclass
1062 relationships of the class the B<Class::MOP::Class> instance is
1063 associated with. Basically, it can get and set the C<@ISA> for you.
1066 Perl will occasionally perform some C<@ISA> and method caching, if
1067 you decide to change your superclass relationship at runtime (which
1068 is quite insane and very much not recommened), then you should be
1069 aware of this and the fact that this module does not make any
1070 attempt to address this issue.
1072 =item B<class_precedence_list>
1074 This computes the a list of all the class's ancestors in the same order
1075 in which method dispatch will be done. This is similair to
1076 what B<Class::ISA::super_path> does, but we don't remove duplicate names.
1084 =item B<get_method_map>
1086 =item B<method_metaclass>
1088 =item B<add_method ($method_name, $method)>
1090 This will take a C<$method_name> and CODE reference to that
1091 C<$method> and install it into the class's package.
1094 This does absolutely nothing special to C<$method>
1095 other than use B<Sub::Name> to make sure it is tagged with the
1096 correct name, and therefore show up correctly in stack traces and
1099 =item B<alias_method ($method_name, $method)>
1101 This will take a C<$method_name> and CODE reference to that
1102 C<$method> and alias the method into the class's package.
1105 Unlike C<add_method>, this will B<not> try to name the
1106 C<$method> using B<Sub::Name>, it only aliases the method in
1107 the class's package.
1109 =item B<has_method ($method_name)>
1111 This just provides a simple way to check if the class implements
1112 a specific C<$method_name>. It will I<not> however, attempt to check
1113 if the class inherits the method (use C<UNIVERSAL::can> for that).
1115 This will correctly handle functions defined outside of the package
1116 that use a fully qualified name (C<sub Package::name { ... }>).
1118 This will correctly handle functions renamed with B<Sub::Name> and
1119 installed using the symbol tables. However, if you are naming the
1120 subroutine outside of the package scope, you must use the fully
1121 qualified name, including the package name, for C<has_method> to
1122 correctly identify it.
1124 This will attempt to correctly ignore functions imported from other
1125 packages using B<Exporter>. It breaks down if the function imported
1126 is an C<__ANON__> sub (such as with C<use constant>), which very well
1127 may be a valid method being applied to the class.
1129 In short, this method cannot always be trusted to determine if the
1130 C<$method_name> is actually a method. However, it will DWIM about
1131 90% of the time, so it's a small trade off I think.
1133 =item B<get_method ($method_name)>
1135 This will return a Class::MOP::Method instance related to the specified
1136 C<$method_name>, or return undef if that method does not exist.
1138 The Class::MOP::Method is codifiable, so you can use it like a normal
1139 CODE reference, see L<Class::MOP::Method> for more information.
1141 =item B<find_method_by_name ($method_name>
1143 This will return a CODE reference of the specified C<$method_name>,
1144 or return undef if that method does not exist.
1146 Unlike C<get_method> this will also look in the superclasses.
1148 =item B<remove_method ($method_name)>
1150 This will attempt to remove a given C<$method_name> from the class.
1151 It will return the CODE reference that it has removed, and will
1152 attempt to use B<Sub::Name> to clear the methods associated name.
1154 =item B<get_method_list>
1156 This will return a list of method names for all I<locally> defined
1157 methods. It does B<not> provide a list of all applicable methods,
1158 including any inherited ones. If you want a list of all applicable
1159 methods, use the C<compute_all_applicable_methods> method.
1161 =item B<compute_all_applicable_methods>
1163 This will return a list of all the methods names this class will
1164 respond to, taking into account inheritance. The list will be a list of
1165 HASH references, each one containing the following information; method
1166 name, the name of the class in which the method lives and a CODE
1167 reference for the actual method.
1169 =item B<find_all_methods_by_name ($method_name)>
1171 This will traverse the inheritence hierarchy and locate all methods
1172 with a given C<$method_name>. Similar to
1173 C<compute_all_applicable_methods> it returns a list of HASH references
1174 with the following information; method name (which will always be the
1175 same as C<$method_name>), the name of the class in which the method
1176 lives and a CODE reference for the actual method.
1178 The list of methods produced is a distinct list, meaning there are no
1179 duplicates in it. This is especially useful for things like object
1180 initialization and destruction where you only want the method called
1181 once, and in the correct order.
1183 =item B<find_next_method_by_name ($method_name)>
1185 This will return the first method to match a given C<$method_name> in
1186 the superclasses, this is basically equivalent to calling
1187 C<SUPER::$method_name>, but it can be dispatched at runtime.
1191 =head2 Method Modifiers
1193 Method modifiers are a concept borrowed from CLOS, in which a method
1194 can be wrapped with I<before>, I<after> and I<around> method modifiers
1195 that will be called everytime the method is called.
1197 =head3 How method modifiers work?
1199 Method modifiers work by wrapping the original method and then replacing
1200 it in the classes symbol table. The wrappers will handle calling all the
1201 modifiers in the appropariate orders and preserving the calling context
1202 for the original method.
1204 Each method modifier serves a particular purpose, which may not be
1205 obvious to users of other method wrapping modules. To start with, the
1206 return values of I<before> and I<after> modifiers are ignored. This is
1207 because thier purpose is B<not> to filter the input and output of the
1208 primary method (this is done with an I<around> modifier). This may seem
1209 like an odd restriction to some, but doing this allows for simple code
1210 to be added at the begining or end of a method call without jeapordizing
1211 the normal functioning of the primary method or placing any extra
1212 responsibility on the code of the modifier. Of course if you have more
1213 complex needs, then use the I<around> modifier, which uses a variation
1214 of continutation passing style to allow for a high degree of flexibility.
1216 Before and around modifiers are called in last-defined-first-called order,
1217 while after modifiers are called in first-defined-first-called order. So
1218 the call tree might looks something like this:
1228 To see examples of using method modifiers, see the following examples
1229 included in the distribution; F<InstanceCountingClass>, F<Perl6Attribute>,
1230 F<AttributesWithHistory> and F<C3MethodDispatchOrder>. There is also a
1231 classic CLOS usage example in the test F<017_add_method_modifier.t>.
1233 =head3 What is the performance impact?
1235 Of course there is a performance cost associated with method modifiers,
1236 but we have made every effort to make that cost be directly proportional
1237 to the amount of modifier features you utilize.
1239 The wrapping method does it's best to B<only> do as much work as it
1240 absolutely needs to. In order to do this we have moved some of the
1241 performance costs to set-up time, where they are easier to amortize.
1243 All this said, my benchmarks have indicated the following:
1245 simple wrapper with no modifiers 100% slower
1246 simple wrapper with simple before modifier 400% slower
1247 simple wrapper with simple after modifier 450% slower
1248 simple wrapper with simple around modifier 500-550% slower
1249 simple wrapper with all 3 modifiers 1100% slower
1251 These numbers may seem daunting, but you must remember, every feature
1252 comes with some cost. To put things in perspective, just doing a simple
1253 C<AUTOLOAD> which does nothing but extract the name of the method called
1254 and return it costs about 400% over a normal method call.
1258 =item B<add_before_method_modifier ($method_name, $code)>
1260 This will wrap the method at C<$method_name> and the supplied C<$code>
1261 will be passed the C<@_> arguments, and called before the original
1262 method is called. As specified above, the return value of the I<before>
1263 method modifiers is ignored, and it's ability to modify C<@_> is
1264 fairly limited. If you need to do either of these things, use an
1265 C<around> method modifier.
1267 =item B<add_after_method_modifier ($method_name, $code)>
1269 This will wrap the method at C<$method_name> so that the original
1270 method will be called, it's return values stashed, and then the
1271 supplied C<$code> will be passed the C<@_> arguments, and called.
1272 As specified above, the return value of the I<after> method
1273 modifiers is ignored, and it cannot modify the return values of
1274 the original method. If you need to do either of these things, use an
1275 C<around> method modifier.
1277 =item B<add_around_method_modifier ($method_name, $code)>
1279 This will wrap the method at C<$method_name> so that C<$code>
1280 will be called and passed the original method as an extra argument
1281 at the begining of the C<@_> argument list. This is a variation of
1282 continuation passing style, where the function prepended to C<@_>
1283 can be considered a continuation. It is up to C<$code> if it calls
1284 the original method or not, there is no restriction on what the
1285 C<$code> can or cannot do.
1291 It should be noted that since there is no one consistent way to define
1292 the attributes of a class in Perl 5. These methods can only work with
1293 the information given, and can not easily discover information on
1294 their own. See L<Class::MOP::Attribute> for more details.
1298 =item B<attribute_metaclass>
1300 =item B<get_attribute_map>
1302 =item B<add_attribute ($attribute_meta_object | $attribute_name, %attribute_spec)>
1304 This stores the C<$attribute_meta_object> (or creates one from the
1305 C<$attribute_name> and C<%attribute_spec>) in the B<Class::MOP::Class>
1306 instance associated with the given class. Unlike methods, attributes
1307 within the MOP are stored as meta-information only. They will be used
1308 later to construct instances from (see C<construct_instance> above).
1309 More details about the attribute meta-objects can be found in the
1310 L<Class::MOP::Attribute> or the L<Class::MOP/The Attribute protocol>
1313 It should be noted that any accessor, reader/writer or predicate
1314 methods which the C<$attribute_meta_object> has will be installed
1315 into the class at this time.
1318 If an attribute already exists for C<$attribute_name>, the old one
1319 will be removed (as well as removing all it's accessors), and then
1322 =item B<has_attribute ($attribute_name)>
1324 Checks to see if this class has an attribute by the name of
1325 C<$attribute_name> and returns a boolean.
1327 =item B<get_attribute ($attribute_name)>
1329 Returns the attribute meta-object associated with C<$attribute_name>,
1330 if none is found, it will return undef.
1332 =item B<remove_attribute ($attribute_name)>
1334 This will remove the attribute meta-object stored at
1335 C<$attribute_name>, then return the removed attribute meta-object.
1338 Removing an attribute will only affect future instances of
1339 the class, it will not make any attempt to remove the attribute from
1340 any existing instances of the class.
1342 It should be noted that any accessor, reader/writer or predicate
1343 methods which the attribute meta-object stored at C<$attribute_name>
1344 has will be removed from the class at this time. This B<will> make
1345 these attributes somewhat inaccessable in previously created
1346 instances. But if you are crazy enough to do this at runtime, then
1347 you are crazy enough to deal with something like this :).
1349 =item B<get_attribute_list>
1351 This returns a list of attribute names which are defined in the local
1352 class. If you want a list of all applicable attributes for a class,
1353 use the C<compute_all_applicable_attributes> method.
1355 =item B<compute_all_applicable_attributes>
1357 This will traverse the inheritance heirachy and return a list of all
1358 the applicable attributes for this class. It does not construct a
1359 HASH reference like C<compute_all_applicable_methods> because all
1360 that same information is discoverable through the attribute
1363 =item B<find_attribute_by_name ($attr_name)>
1365 This method will traverse the inheritance heirachy and find the
1366 first attribute whose name matches C<$attr_name>, then return it.
1367 It will return undef if nothing is found.
1371 =head2 Class Immutability
1375 =item B<make_immutable (%options)>
1377 This method will invoke a tranforamtion upon the class which will
1378 make it immutable. Details of this transformation can be found in
1379 the L<Class::MOP::Immutable> documentation.
1381 =item B<make_mutable>
1383 This method will reverse tranforamtion upon the class which
1386 =item B<create_immutable_transformer>
1388 Create a transformer suitable for making this class immutable
1394 Stevan Little E<lt>stevan@iinteractive.comE<gt>
1396 =head1 COPYRIGHT AND LICENSE
1398 Copyright 2006, 2007 by Infinity Interactive, Inc.
1400 L<http://www.iinteractive.com>
1402 This library is free software; you can redistribute it and/or modify
1403 it under the same terms as Perl itself.