2 package Class::MOP::Class;
8 use Scalar::Util 'blessed', 'reftype', 'weaken';
9 use Sub::Name 'subname';
10 use B 'svref_2object';
12 our $VERSION = '0.17';
13 our $AUTHORITY = 'cpan:STEVAN';
15 use base 'Class::MOP::Module';
17 use Class::MOP::Instance;
21 sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) }
26 # we need a sufficiently annoying prefix
27 # this should suffice for now, this is
28 # used in a couple of places below, so
29 # need to put it up here for now.
30 my $ANON_CLASS_PREFIX = 'Class::MOP::Class::__ANON__::SERIAL::';
35 # Metaclasses are singletons, so we cache them here.
36 # there is no need to worry about destruction though
37 # because they should die only when the program dies.
38 # After all, do package definitions even get reaped?
41 # means of accessing all the metaclasses that have
42 # been initialized thus far (for mugwumps obj browser)
43 sub get_all_metaclasses { %METAS }
44 sub get_all_metaclass_instances { values %METAS }
45 sub get_all_metaclass_names { keys %METAS }
49 my $package_name = shift;
50 (defined $package_name && $package_name && !blessed($package_name))
51 || confess "You must pass a package name and it cannot be blessed";
52 $class->construct_class_instance(':package' => $package_name, @_);
57 my $package_name = shift;
58 (defined $package_name && $package_name && !blessed($package_name))
59 || confess "You must pass a package name and it cannot be blessed";
60 $METAS{$package_name} = undef;
61 $class->construct_class_instance(':package' => $package_name, @_);
64 # NOTE: (meta-circularity)
65 # this is a special form of &construct_instance
66 # (see below), which is used to construct class
67 # meta-object instances for any Class::MOP::*
68 # class. All other classes will use the more
69 # normal &construct_instance.
70 sub construct_class_instance {
73 my $package_name = $options{':package'};
74 (defined $package_name && $package_name)
75 || confess "You must pass a package name";
77 # return the metaclass if we have it cached,
78 # and it is still defined (it has not been
79 # reaped by DESTROY yet, which can happen
80 # annoyingly enough during global destruction)
81 return $METAS{$package_name}
82 if exists $METAS{$package_name} && defined $METAS{$package_name};
85 # we need to deal with the possibility
86 # of class immutability here, and then
87 # get the name of the class appropriately
88 $class = (blessed($class)
89 ? ($class->is_immutable
90 ? $class->get_mutable_metaclass_name()
94 $class = blessed($class) || $class;
95 # now create the metaclass
97 if ($class =~ /^Class::MOP::Class$/) {
100 # inherited from Class::MOP::Package
101 '$:package' => $package_name,
102 '%:namespace' => \%{$package_name . '::'},
103 # inherited from Class::MOP::Module
104 '$:version' => (exists ${$package_name . '::'}{'VERSION'} ? ${$package_name . '::VERSION'} : undef),
105 '$:authority' => (exists ${$package_name . '::'}{'AUTHORITY'} ? ${$package_name . '::AUTHORITY'} : undef),
107 '%:attributes' => {},
108 '$:attribute_metaclass' => $options{':attribute_metaclass'} || 'Class::MOP::Attribute',
109 '$:method_metaclass' => $options{':method_metaclass'} || 'Class::MOP::Method',
110 '$:instance_metaclass' => $options{':instance_metaclass'} || 'Class::MOP::Instance',
115 # it is safe to use meta here because
116 # class will always be a subclass of
117 # Class::MOP::Class, which defines meta
118 $meta = $class->meta->construct_instance(%options)
121 # and check the metaclass compatibility
122 $meta->check_metaclass_compatability();
123 $METAS{$package_name} = $meta;
125 # we need to weaken any anon classes
126 # so that they can call DESTROY properly
127 weaken($METAS{$package_name})
128 if $package_name =~ /^$ANON_CLASS_PREFIX/;
132 sub check_metaclass_compatability {
135 # this is always okay ...
136 return if blessed($self) eq 'Class::MOP::Class' &&
137 $self->instance_metaclass eq 'Class::MOP::Instance';
139 my @class_list = $self->class_precedence_list;
140 shift @class_list; # shift off $self->name
142 foreach my $class_name (@class_list) {
143 my $meta = $METAS{$class_name} || next;
146 # we need to deal with the possibility
147 # of class immutability here, and then
148 # get the name of the class appropriately
149 my $meta_type = ($meta->is_immutable
150 ? $meta->get_mutable_metaclass_name()
153 ($self->isa($meta_type))
154 || confess $self->name . "->meta => (" . (blessed($self)) . ")" .
155 " is not compatible with the " .
156 $class_name . "->meta => (" . ($meta_type) . ")";
158 # we also need to check that instance metaclasses
159 # are compatabile in the same the class.
160 ($self->instance_metaclass->isa($meta->instance_metaclass))
161 || confess $self->name . "->meta => (" . ($self->instance_metaclass) . ")" .
162 " is not compatible with the " .
163 $class_name . "->meta => (" . ($meta->instance_metaclass) . ")";
172 # this should be sufficient, if you have a
173 # use case where it is not, write a test and
175 my $ANON_CLASS_SERIAL = 0;
177 sub create_anon_class {
178 my ($class, %options) = @_;
179 my $package_name = $ANON_CLASS_PREFIX . ++$ANON_CLASS_SERIAL;
180 return $class->create($package_name, '0.00', %options);
185 # this will only get called for
186 # anon-classes, all other calls
187 # are assumed to occur during
188 # global destruction and so don't
189 # really need to be handled explicitly
192 return unless $self->name =~ /^$ANON_CLASS_PREFIX/;
193 my ($serial_id) = ($self->name =~ /^$ANON_CLASS_PREFIX(\d+)/);
195 foreach my $key (keys %{$ANON_CLASS_PREFIX . $serial_id}) {
196 delete ${$ANON_CLASS_PREFIX . $serial_id}{$key};
198 delete ${'main::' . $ANON_CLASS_PREFIX}{$serial_id . '::'};
201 # creating classes with MOP ...
204 my ($class, $package_name, $package_version, %options) = @_;
205 (defined $package_name && $package_name)
206 || confess "You must pass a package name";
207 my $code = "package $package_name;";
208 $code .= "\$$package_name\:\:VERSION = '$package_version';"
209 if defined $package_version;
211 confess "creation of $package_name failed : $@" if $@;
212 my $meta = $class->initialize($package_name);
214 $meta->add_method('meta' => sub {
215 $class->initialize(blessed($_[0]) || $_[0]);
218 $meta->superclasses(@{$options{superclasses}})
219 if exists $options{superclasses};
221 # process attributes first, so that they can
222 # install accessors, but locally defined methods
223 # can then overwrite them. It is maybe a little odd, but
224 # I think this should be the order of things.
225 if (exists $options{attributes}) {
226 foreach my $attr (@{$options{attributes}}) {
227 $meta->add_attribute($attr);
230 if (exists $options{methods}) {
231 foreach my $method_name (keys %{$options{methods}}) {
232 $meta->add_method($method_name, $options{methods}->{$method_name});
241 # all these attribute readers will be bootstrapped
242 # away in the Class::MOP bootstrap section
244 sub get_attribute_map { $_[0]->{'%:attributes'} }
245 sub attribute_metaclass { $_[0]->{'$:attribute_metaclass'} }
246 sub method_metaclass { $_[0]->{'$:method_metaclass'} }
247 sub instance_metaclass { $_[0]->{'$:instance_metaclass'} }
249 # Instance Construction & Cloning
254 # we need to protect the integrity of the
255 # Class::MOP::Class singletons here, so we
256 # delegate this to &construct_class_instance
257 # which will deal with the singletons
258 return $class->construct_class_instance(@_)
259 if $class->name->isa('Class::MOP::Class');
260 return $class->construct_instance(@_);
263 sub construct_instance {
264 my ($class, %params) = @_;
265 my $meta_instance = $class->get_meta_instance();
266 my $instance = $meta_instance->create_instance();
267 foreach my $attr ($class->compute_all_applicable_attributes()) {
268 $attr->initialize_instance_slot($meta_instance, $instance, \%params);
273 sub get_meta_instance {
275 return $class->instance_metaclass->new(
277 $class->compute_all_applicable_attributes()
283 my $instance = shift;
284 (blessed($instance) && $instance->isa($class->name))
285 || confess "You must pass an instance ($instance) of the metaclass (" . $class->name . ")";
287 # we need to protect the integrity of the
288 # Class::MOP::Class singletons here, they
289 # should not be cloned.
290 return $instance if $instance->isa('Class::MOP::Class');
291 $class->clone_instance($instance, @_);
295 my ($class, $instance, %params) = @_;
297 || confess "You can only clone instances, \$self is not a blessed instance";
298 my $meta_instance = $class->get_meta_instance();
299 my $clone = $meta_instance->clone_instance($instance);
300 foreach my $key (keys %params) {
301 next unless $meta_instance->is_valid_slot($key);
302 $meta_instance->set_slot_value($clone, $key, $params{$key});
313 @{$self->get_package_symbol('@ISA')} = @supers;
315 # we need to check the metaclass
316 # compatability here so that we can
317 # be sure that the superclass is
318 # not potentially creating an issues
319 # we don't know about
320 $self->check_metaclass_compatability();
322 @{$self->get_package_symbol('@ISA')};
325 sub class_precedence_list {
328 # We need to check for ciruclar inheirtance here.
329 # This will do nothing if all is well, and blow
330 # up otherwise. Yes, it's an ugly hack, better
331 # suggestions are welcome.
332 { ($self->name || return)->isa('This is a test for circular inheritance') }
333 # ... and now back to our regularly scheduled program
337 $self->initialize($_)->class_precedence_list()
338 } $self->superclasses()
345 my ($self, $method_name, $method) = @_;
346 (defined $method_name && $method_name)
347 || confess "You must define a method name";
348 # use reftype here to allow for blessed subs ...
349 ('CODE' eq (reftype($method) || ''))
350 || confess "Your code block must be a CODE reference";
351 my $full_method_name = ($self->name . '::' . $method_name);
354 # dont bless subs, its bad mkay
355 $method = $self->method_metaclass->wrap($method) unless blessed($method);
357 $self->add_package_symbol("&${method_name}" => subname $full_method_name => $method);
361 my $fetch_and_prepare_method = sub {
362 my ($self, $method_name) = @_;
364 my $method = $self->get_method($method_name);
365 # if we dont have local ...
367 # try to find the next method
368 $method = $self->find_next_method_by_name($method_name);
369 # die if it does not exist
371 || confess "The method '$method_name' is not found in the inherience hierarchy for this class";
372 # and now make sure to wrap it
373 # even if it is already wrapped
374 # because we need a new sub ref
375 $method = Class::MOP::Method::Wrapped->wrap($method);
378 # now make sure we wrap it properly
379 $method = Class::MOP::Method::Wrapped->wrap($method)
380 unless $method->isa('Class::MOP::Method::Wrapped');
382 $self->add_method($method_name => $method);
386 sub add_before_method_modifier {
387 my ($self, $method_name, $method_modifier) = @_;
388 (defined $method_name && $method_name)
389 || confess "You must pass in a method name";
390 my $method = $fetch_and_prepare_method->($self, $method_name);
391 $method->add_before_modifier(subname ':before' => $method_modifier);
394 sub add_after_method_modifier {
395 my ($self, $method_name, $method_modifier) = @_;
396 (defined $method_name && $method_name)
397 || confess "You must pass in a method name";
398 my $method = $fetch_and_prepare_method->($self, $method_name);
399 $method->add_after_modifier(subname ':after' => $method_modifier);
402 sub add_around_method_modifier {
403 my ($self, $method_name, $method_modifier) = @_;
404 (defined $method_name && $method_name)
405 || confess "You must pass in a method name";
406 my $method = $fetch_and_prepare_method->($self, $method_name);
407 $method->add_around_modifier(subname ':around' => $method_modifier);
411 # the methods above used to be named like this:
412 # ${pkg}::${method}:(before|after|around)
413 # but this proved problematic when using one modifier
414 # to wrap multiple methods (something which is likely
415 # to happen pretty regularly IMO). So instead of naming
416 # it like this, I have chosen to just name them purely
417 # with their modifier names, like so:
418 # :(before|after|around)
419 # The fact is that in a stack trace, it will be fairly
420 # evident from the context what method they are attached
421 # to, and so don't need the fully qualified name.
425 my ($self, $method_name, $method) = @_;
426 (defined $method_name && $method_name)
427 || confess "You must define a method name";
428 # use reftype here to allow for blessed subs ...
429 ('CODE' eq (reftype($method) || ''))
430 || confess "Your code block must be a CODE reference";
433 # dont bless subs, its bad mkay
434 $method = $self->method_metaclass->wrap($method) unless blessed($method);
436 $self->add_package_symbol("&${method_name}" => $method);
439 sub find_method_by_name {
440 my ($self, $method_name) = @_;
441 return $self->name->can($method_name);
445 my ($self, $method_name) = @_;
446 (defined $method_name && $method_name)
447 || confess "You must define a method name";
449 return 0 if !$self->has_package_symbol("&${method_name}");
450 my $method = $self->get_package_symbol("&${method_name}");
451 return 0 if (svref_2object($method)->GV->STASH->NAME || '') ne $self->name &&
452 (svref_2object($method)->GV->NAME || '') ne '__ANON__';
455 # dont bless subs, its bad mkay
456 $self->method_metaclass->wrap($method) unless blessed($method);
462 my ($self, $method_name) = @_;
463 (defined $method_name && $method_name)
464 || confess "You must define a method name";
466 return unless $self->has_method($method_name);
468 return $self->get_package_symbol("&${method_name}");
472 my ($self, $method_name) = @_;
473 (defined $method_name && $method_name)
474 || confess "You must define a method name";
476 my $removed_method = $self->get_method($method_name);
478 $self->remove_package_symbol("&${method_name}")
479 if defined $removed_method;
481 return $removed_method;
484 sub get_method_list {
486 grep { $self->has_method($_) } $self->list_all_package_symbols;
489 sub compute_all_applicable_methods {
492 # keep a record of what we have seen
493 # here, this will handle all the
494 # inheritence issues because we are
495 # using the &class_precedence_list
496 my (%seen_class, %seen_method);
497 foreach my $class ($self->class_precedence_list()) {
498 next if $seen_class{$class};
499 $seen_class{$class}++;
500 # fetch the meta-class ...
501 my $meta = $self->initialize($class);
502 foreach my $method_name ($meta->get_method_list()) {
503 next if exists $seen_method{$method_name};
504 $seen_method{$method_name}++;
506 name => $method_name,
508 code => $meta->get_method($method_name)
515 sub find_all_methods_by_name {
516 my ($self, $method_name) = @_;
517 (defined $method_name && $method_name)
518 || confess "You must define a method name to find";
520 # keep a record of what we have seen
521 # here, this will handle all the
522 # inheritence issues because we are
523 # using the &class_precedence_list
525 foreach my $class ($self->class_precedence_list()) {
526 next if $seen_class{$class};
527 $seen_class{$class}++;
528 # fetch the meta-class ...
529 my $meta = $self->initialize($class);
531 name => $method_name,
533 code => $meta->get_method($method_name)
534 } if $meta->has_method($method_name);
539 sub find_next_method_by_name {
540 my ($self, $method_name) = @_;
541 (defined $method_name && $method_name)
542 || confess "You must define a method name to find";
543 # keep a record of what we have seen
544 # here, this will handle all the
545 # inheritence issues because we are
546 # using the &class_precedence_list
548 my @cpl = $self->class_precedence_list();
549 shift @cpl; # discard ourselves
550 foreach my $class (@cpl) {
551 next if $seen_class{$class};
552 $seen_class{$class}++;
553 # fetch the meta-class ...
554 my $meta = $self->initialize($class);
555 return $meta->get_method($method_name)
556 if $meta->has_method($method_name);
565 # either we have an attribute object already
566 # or we need to create one from the args provided
567 my $attribute = blessed($_[0]) ? $_[0] : $self->attribute_metaclass->new(@_);
568 # make sure it is derived from the correct type though
569 ($attribute->isa('Class::MOP::Attribute'))
570 || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";
571 $attribute->attach_to_class($self);
572 $attribute->install_accessors();
573 $self->get_attribute_map->{$attribute->name} = $attribute;
577 my ($self, $attribute_name) = @_;
578 (defined $attribute_name && $attribute_name)
579 || confess "You must define an attribute name";
580 exists $self->get_attribute_map->{$attribute_name} ? 1 : 0;
584 my ($self, $attribute_name) = @_;
585 (defined $attribute_name && $attribute_name)
586 || confess "You must define an attribute name";
587 return $self->get_attribute_map->{$attribute_name}
588 if $self->has_attribute($attribute_name);
592 sub remove_attribute {
593 my ($self, $attribute_name) = @_;
594 (defined $attribute_name && $attribute_name)
595 || confess "You must define an attribute name";
596 my $removed_attribute = $self->get_attribute_map->{$attribute_name};
597 return unless defined $removed_attribute;
598 delete $self->get_attribute_map->{$attribute_name};
599 $removed_attribute->remove_accessors();
600 $removed_attribute->detach_from_class();
601 return $removed_attribute;
604 sub get_attribute_list {
606 keys %{$self->get_attribute_map};
609 sub compute_all_applicable_attributes {
612 # keep a record of what we have seen
613 # here, this will handle all the
614 # inheritence issues because we are
615 # using the &class_precedence_list
616 my (%seen_class, %seen_attr);
617 foreach my $class ($self->class_precedence_list()) {
618 next if $seen_class{$class};
619 $seen_class{$class}++;
620 # fetch the meta-class ...
621 my $meta = $self->initialize($class);
622 foreach my $attr_name ($meta->get_attribute_list()) {
623 next if exists $seen_attr{$attr_name};
624 $seen_attr{$attr_name}++;
625 push @attrs => $meta->get_attribute($attr_name);
631 sub find_attribute_by_name {
632 my ($self, $attr_name) = @_;
633 # keep a record of what we have seen
634 # here, this will handle all the
635 # inheritence issues because we are
636 # using the &class_precedence_list
638 foreach my $class ($self->class_precedence_list()) {
639 next if $seen_class{$class};
640 $seen_class{$class}++;
641 # fetch the meta-class ...
642 my $meta = $self->initialize($class);
643 return $meta->get_attribute($attr_name)
644 if $meta->has_attribute($attr_name);
652 sub is_immutable { 0 }
655 return Class::MOP::Class::Immutable->make_metaclass_immutable(@_);
666 Class::MOP::Class - Class Meta Object
670 # assuming that class Foo
671 # has been defined, you can
673 # use this for introspection ...
675 # add a method to Foo ...
676 Foo->meta->add_method('bar' => sub { ... })
678 # get a list of all the classes searched
679 # the method dispatcher in the correct order
680 Foo->meta->class_precedence_list()
682 # remove a method from Foo
683 Foo->meta->remove_method('bar');
685 # or use this to actually create classes ...
687 Class::MOP::Class->create('Bar' => '0.01' => (
688 superclasses => [ 'Foo' ],
690 Class::MOP:::Attribute->new('$bar'),
691 Class::MOP:::Attribute->new('$baz'),
694 calculate_bar => sub { ... },
695 construct_baz => sub { ... }
701 This is the largest and currently most complex part of the Perl 5
702 meta-object protocol. It controls the introspection and
703 manipulation of Perl 5 classes (and it can create them too). The
704 best way to understand what this module can do, is to read the
705 documentation for each of it's methods.
709 =head2 Self Introspection
715 This will return a B<Class::MOP::Class> instance which is related
716 to this class. Thereby allowing B<Class::MOP::Class> to actually
719 As with B<Class::MOP::Attribute>, B<Class::MOP> will actually
720 bootstrap this module by installing a number of attribute meta-objects
721 into it's metaclass. This will allow this class to reap all the benifits
722 of the MOP when subclassing it.
724 =item B<get_all_metaclasses>
726 This will return an hash of all the metaclass instances that have
727 been cached by B<Class::MOP::Class> keyed by the package name.
729 =item B<get_all_metaclass_instances>
731 This will return an array of all the metaclass instances that have
732 been cached by B<Class::MOP::Class>.
734 =item B<get_all_metaclass_names>
736 This will return an array of all the metaclass names that have
737 been cached by B<Class::MOP::Class>.
741 =head2 Class construction
743 These methods will handle creating B<Class::MOP::Class> objects,
744 which can be used to both create new classes, and analyze
745 pre-existing classes.
747 This module will internally store references to all the instances
748 you create with these methods, so that they do not need to be
749 created any more than nessecary. Basically, they are singletons.
753 =item B<create ($package_name, ?$package_version,
754 superclasses =E<gt> ?@superclasses,
755 methods =E<gt> ?%methods,
756 attributes =E<gt> ?%attributes)>
758 This returns a B<Class::MOP::Class> object, bringing the specified
759 C<$package_name> into existence and adding any of the
760 C<$package_version>, C<@superclasses>, C<%methods> and C<%attributes>
763 =item B<create_anon_class (superclasses =E<gt> ?@superclasses,
764 methods =E<gt> ?%methods,
765 attributes =E<gt> ?%attributes)>
767 This will create an anonymous class, it works much like C<create> but
768 it does not need a C<$package_name>. Instead it will create a suitably
769 unique package name for you to stash things into.
771 =item B<initialize ($package_name, %options)>
773 This initializes and returns returns a B<Class::MOP::Class> object
774 for a given a C<$package_name>.
776 =item B<reinitialize ($package_name, %options)>
778 This removes the old metaclass, and creates a new one in it's place.
779 Do B<not> use this unless you really know what you are doing, it could
780 very easily make a very large mess of your program.
782 =item B<construct_class_instance (%options)>
784 This will construct an instance of B<Class::MOP::Class>, it is
785 here so that we can actually "tie the knot" for B<Class::MOP::Class>
786 to use C<construct_instance> once all the bootstrapping is done. This
787 method is used internally by C<initialize> and should never be called
788 from outside of that method really.
790 =item B<check_metaclass_compatability>
792 This method is called as the very last thing in the
793 C<construct_class_instance> method. This will check that the
794 metaclass you are creating is compatible with the metaclasses of all
795 your ancestors. For more inforamtion about metaclass compatibility
796 see the C<About Metaclass compatibility> section in L<Class::MOP>.
800 =head2 Object instance construction and cloning
802 These methods are B<entirely optional>, it is up to you whether you want
807 =item B<instance_metaclass>
809 =item B<get_meta_instance>
811 =item B<new_object (%params)>
813 This is a convience method for creating a new object of the class, and
814 blessing it into the appropriate package as well. Ideally your class
815 would call a C<new> this method like so:
818 my ($class, %param) = @_;
819 $class->meta->new_object(%params);
822 Of course the ideal place for this would actually be in C<UNIVERSAL::>
823 but that is considered bad style, so we do not do that.
825 =item B<construct_instance (%params)>
827 This method is used to construct an instace structure suitable for
828 C<bless>-ing into your package of choice. It works in conjunction
829 with the Attribute protocol to collect all applicable attributes.
831 This will construct and instance using a HASH ref as storage
832 (currently only HASH references are supported). This will collect all
833 the applicable attributes and layout out the fields in the HASH ref,
834 it will then initialize them using either use the corresponding key
835 in C<%params> or any default value or initializer found in the
836 attribute meta-object.
838 =item B<clone_object ($instance, %params)>
840 This is a convience method for cloning an object instance, then
841 blessing it into the appropriate package. This method will call
842 C<clone_instance>, which performs a shallow copy of the object,
843 see that methods documentation for more details. Ideally your
844 class would call a C<clone> this method like so:
847 my ($self, %param) = @_;
848 $self->meta->clone_object($self, %params);
851 Of course the ideal place for this would actually be in C<UNIVERSAL::>
852 but that is considered bad style, so we do not do that.
854 =item B<clone_instance($instance, %params)>
856 This method is a compliment of C<construct_instance> (which means if
857 you override C<construct_instance>, you need to override this one too),
858 and clones the instance shallowly.
860 The cloned structure returned is (like with C<construct_instance>) an
861 unC<bless>ed HASH reference, it is your responsibility to then bless
862 this cloned structure into the right class (which C<clone_object> will
865 As of 0.11, this method will clone the C<$instance> structure shallowly,
866 as opposed to the deep cloning implemented in prior versions. After much
867 thought, research and discussion, I have decided that anything but basic
868 shallow cloning is outside the scope of the meta-object protocol. I
869 think Yuval "nothingmuch" Kogman put it best when he said that cloning
870 is too I<context-specific> to be part of the MOP.
880 This is a read-only attribute which returns the package name for the
881 given B<Class::MOP::Class> instance.
885 This is a read-only attribute which returns the C<$VERSION> of the
886 package for the given B<Class::MOP::Class> instance.
890 =head2 Inheritance Relationships
894 =item B<superclasses (?@superclasses)>
896 This is a read-write attribute which represents the superclass
897 relationships of the class the B<Class::MOP::Class> instance is
898 associated with. Basically, it can get and set the C<@ISA> for you.
901 Perl will occasionally perform some C<@ISA> and method caching, if
902 you decide to change your superclass relationship at runtime (which
903 is quite insane and very much not recommened), then you should be
904 aware of this and the fact that this module does not make any
905 attempt to address this issue.
907 =item B<class_precedence_list>
909 This computes the a list of all the class's ancestors in the same order
910 in which method dispatch will be done. This is similair to
911 what B<Class::ISA::super_path> does, but we don't remove duplicate names.
919 =item B<method_metaclass>
921 =item B<add_method ($method_name, $method)>
923 This will take a C<$method_name> and CODE reference to that
924 C<$method> and install it into the class's package.
927 This does absolutely nothing special to C<$method>
928 other than use B<Sub::Name> to make sure it is tagged with the
929 correct name, and therefore show up correctly in stack traces and
932 =item B<alias_method ($method_name, $method)>
934 This will take a C<$method_name> and CODE reference to that
935 C<$method> and alias the method into the class's package.
938 Unlike C<add_method>, this will B<not> try to name the
939 C<$method> using B<Sub::Name>, it only aliases the method in
942 =item B<has_method ($method_name)>
944 This just provides a simple way to check if the class implements
945 a specific C<$method_name>. It will I<not> however, attempt to check
946 if the class inherits the method (use C<UNIVERSAL::can> for that).
948 This will correctly handle functions defined outside of the package
949 that use a fully qualified name (C<sub Package::name { ... }>).
951 This will correctly handle functions renamed with B<Sub::Name> and
952 installed using the symbol tables. However, if you are naming the
953 subroutine outside of the package scope, you must use the fully
954 qualified name, including the package name, for C<has_method> to
955 correctly identify it.
957 This will attempt to correctly ignore functions imported from other
958 packages using B<Exporter>. It breaks down if the function imported
959 is an C<__ANON__> sub (such as with C<use constant>), which very well
960 may be a valid method being applied to the class.
962 In short, this method cannot always be trusted to determine if the
963 C<$method_name> is actually a method. However, it will DWIM about
964 90% of the time, so it's a small trade off I think.
966 =item B<get_method ($method_name)>
968 This will return a CODE reference of the specified C<$method_name>,
969 or return undef if that method does not exist.
971 =item B<find_method_by_name ($method_name>
973 This will return a CODE reference of the specified C<$method_name>,
974 or return undef if that method does not exist.
976 Unlike C<get_method> this will also look in the superclasses.
978 =item B<remove_method ($method_name)>
980 This will attempt to remove a given C<$method_name> from the class.
981 It will return the CODE reference that it has removed, and will
982 attempt to use B<Sub::Name> to clear the methods associated name.
984 =item B<get_method_list>
986 This will return a list of method names for all I<locally> defined
987 methods. It does B<not> provide a list of all applicable methods,
988 including any inherited ones. If you want a list of all applicable
989 methods, use the C<compute_all_applicable_methods> method.
991 =item B<compute_all_applicable_methods>
993 This will return a list of all the methods names this class will
994 respond to, taking into account inheritance. The list will be a list of
995 HASH references, each one containing the following information; method
996 name, the name of the class in which the method lives and a CODE
997 reference for the actual method.
999 =item B<find_all_methods_by_name ($method_name)>
1001 This will traverse the inheritence hierarchy and locate all methods
1002 with a given C<$method_name>. Similar to
1003 C<compute_all_applicable_methods> it returns a list of HASH references
1004 with the following information; method name (which will always be the
1005 same as C<$method_name>), the name of the class in which the method
1006 lives and a CODE reference for the actual method.
1008 The list of methods produced is a distinct list, meaning there are no
1009 duplicates in it. This is especially useful for things like object
1010 initialization and destruction where you only want the method called
1011 once, and in the correct order.
1013 =item B<find_next_method_by_name ($method_name)>
1015 This will return the first method to match a given C<$method_name> in
1016 the superclasses, this is basically equivalent to calling
1017 C<SUPER::$method_name>, but it can be dispatched at runtime.
1021 =head2 Method Modifiers
1023 Method modifiers are a concept borrowed from CLOS, in which a method
1024 can be wrapped with I<before>, I<after> and I<around> method modifiers
1025 that will be called everytime the method is called.
1027 =head3 How method modifiers work?
1029 Method modifiers work by wrapping the original method and then replacing
1030 it in the classes symbol table. The wrappers will handle calling all the
1031 modifiers in the appropariate orders and preserving the calling context
1032 for the original method.
1034 Each method modifier serves a particular purpose, which may not be
1035 obvious to users of other method wrapping modules. To start with, the
1036 return values of I<before> and I<after> modifiers are ignored. This is
1037 because thier purpose is B<not> to filter the input and output of the
1038 primary method (this is done with an I<around> modifier). This may seem
1039 like an odd restriction to some, but doing this allows for simple code
1040 to be added at the begining or end of a method call without jeapordizing
1041 the normal functioning of the primary method or placing any extra
1042 responsibility on the code of the modifier. Of course if you have more
1043 complex needs, then use the I<around> modifier, which uses a variation
1044 of continutation passing style to allow for a high degree of flexibility.
1046 Before and around modifiers are called in last-defined-first-called order,
1047 while after modifiers are called in first-defined-first-called order. So
1048 the call tree might looks something like this:
1058 To see examples of using method modifiers, see the following examples
1059 included in the distribution; F<InstanceCountingClass>, F<Perl6Attribute>,
1060 F<AttributesWithHistory> and F<C3MethodDispatchOrder>. There is also a
1061 classic CLOS usage example in the test F<017_add_method_modifier.t>.
1063 =head3 What is the performance impact?
1065 Of course there is a performance cost associated with method modifiers,
1066 but we have made every effort to make that cost be directly proportional
1067 to the amount of modifier features you utilize.
1069 The wrapping method does it's best to B<only> do as much work as it
1070 absolutely needs to. In order to do this we have moved some of the
1071 performance costs to set-up time, where they are easier to amortize.
1073 All this said, my benchmarks have indicated the following:
1075 simple wrapper with no modifiers 100% slower
1076 simple wrapper with simple before modifier 400% slower
1077 simple wrapper with simple after modifier 450% slower
1078 simple wrapper with simple around modifier 500-550% slower
1079 simple wrapper with all 3 modifiers 1100% slower
1081 These numbers may seem daunting, but you must remember, every feature
1082 comes with some cost. To put things in perspective, just doing a simple
1083 C<AUTOLOAD> which does nothing but extract the name of the method called
1084 and return it costs about 400% over a normal method call.
1088 =item B<add_before_method_modifier ($method_name, $code)>
1090 This will wrap the method at C<$method_name> and the supplied C<$code>
1091 will be passed the C<@_> arguments, and called before the original
1092 method is called. As specified above, the return value of the I<before>
1093 method modifiers is ignored, and it's ability to modify C<@_> is
1094 fairly limited. If you need to do either of these things, use an
1095 C<around> method modifier.
1097 =item B<add_after_method_modifier ($method_name, $code)>
1099 This will wrap the method at C<$method_name> so that the original
1100 method will be called, it's return values stashed, and then the
1101 supplied C<$code> will be passed the C<@_> arguments, and called.
1102 As specified above, the return value of the I<after> method
1103 modifiers is ignored, and it cannot modify the return values of
1104 the original method. If you need to do either of these things, use an
1105 C<around> method modifier.
1107 =item B<add_around_method_modifier ($method_name, $code)>
1109 This will wrap the method at C<$method_name> so that C<$code>
1110 will be called and passed the original method as an extra argument
1111 at the begining of the C<@_> argument list. This is a variation of
1112 continuation passing style, where the function prepended to C<@_>
1113 can be considered a continuation. It is up to C<$code> if it calls
1114 the original method or not, there is no restriction on what the
1115 C<$code> can or cannot do.
1121 It should be noted that since there is no one consistent way to define
1122 the attributes of a class in Perl 5. These methods can only work with
1123 the information given, and can not easily discover information on
1124 their own. See L<Class::MOP::Attribute> for more details.
1128 =item B<attribute_metaclass>
1130 =item B<get_attribute_map>
1132 =item B<add_attribute ($attribute_name, $attribute_meta_object)>
1134 This stores a C<$attribute_meta_object> in the B<Class::MOP::Class>
1135 instance associated with the given class, and associates it with
1136 the C<$attribute_name>. Unlike methods, attributes within the MOP
1137 are stored as meta-information only. They will be used later to
1138 construct instances from (see C<construct_instance> above).
1139 More details about the attribute meta-objects can be found in the
1140 L<Class::MOP::Attribute> or the L<Class::MOP/The Attribute protocol>
1143 It should be noted that any accessor, reader/writer or predicate
1144 methods which the C<$attribute_meta_object> has will be installed
1145 into the class at this time.
1147 =item B<has_attribute ($attribute_name)>
1149 Checks to see if this class has an attribute by the name of
1150 C<$attribute_name> and returns a boolean.
1152 =item B<get_attribute ($attribute_name)>
1154 Returns the attribute meta-object associated with C<$attribute_name>,
1155 if none is found, it will return undef.
1157 =item B<remove_attribute ($attribute_name)>
1159 This will remove the attribute meta-object stored at
1160 C<$attribute_name>, then return the removed attribute meta-object.
1163 Removing an attribute will only affect future instances of
1164 the class, it will not make any attempt to remove the attribute from
1165 any existing instances of the class.
1167 It should be noted that any accessor, reader/writer or predicate
1168 methods which the attribute meta-object stored at C<$attribute_name>
1169 has will be removed from the class at this time. This B<will> make
1170 these attributes somewhat inaccessable in previously created
1171 instances. But if you are crazy enough to do this at runtime, then
1172 you are crazy enough to deal with something like this :).
1174 =item B<get_attribute_list>
1176 This returns a list of attribute names which are defined in the local
1177 class. If you want a list of all applicable attributes for a class,
1178 use the C<compute_all_applicable_attributes> method.
1180 =item B<compute_all_applicable_attributes>
1182 This will traverse the inheritance heirachy and return a list of all
1183 the applicable attributes for this class. It does not construct a
1184 HASH reference like C<compute_all_applicable_methods> because all
1185 that same information is discoverable through the attribute
1188 =item B<find_attribute_by_name ($attr_name)>
1190 This method will traverse the inheritance heirachy and find the
1191 first attribute whose name matches C<$attr_name>, then return it.
1192 It will return undef if nothing is found.
1196 =head2 Package Variables
1198 Since Perl's classes are built atop the Perl package system, it is
1199 fairly common to use package scoped variables for things like static
1200 class variables. The following methods are convience methods for
1201 the creation and inspection of package scoped variables.
1205 =item B<add_package_symbol ($variable_name, ?$initial_value)>
1207 Given a C<$variable_name>, which must contain a leading sigil, this
1208 method will create that variable within the package which houses the
1209 class. It also takes an optional C<$initial_value>, which must be a
1210 reference of the same type as the sigil of the C<$variable_name>
1213 =item B<get_package_symbol ($variable_name)>
1215 This will return a reference to the package variable in
1218 =item B<has_package_symbol ($variable_name)>
1220 Returns true (C<1>) if there is a package variable defined for
1221 C<$variable_name>, and false (C<0>) otherwise.
1223 =item B<remove_package_symbol ($variable_name)>
1225 This will attempt to remove the package variable at C<$variable_name>.
1229 =head2 Class closing
1235 =item B<is_immutable>
1237 =item B<make_immutable>
1243 Stevan Little E<lt>stevan@iinteractive.comE<gt>
1245 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
1247 =head1 COPYRIGHT AND LICENSE
1249 Copyright 2006 by Infinity Interactive, Inc.
1251 L<http://www.iinteractive.com>
1253 This library is free software; you can redistribute it and/or modify
1254 it under the same terms as Perl itself.