2 package Moose::Meta::Class;
9 use Carp qw( confess );
11 use List::Util qw( first );
12 use List::MoreUtils qw( any all uniq first_index );
13 use Scalar::Util 'weaken', 'blessed';
15 use Moose::Meta::Method::Overridden;
16 use Moose::Meta::Method::Augmented;
17 use Moose::Error::Default;
18 use Moose::Meta::Class::Immutable::Trait;
19 use Moose::Meta::Method::Constructor;
20 use Moose::Meta::Method::Destructor;
21 use Moose::Meta::Method::Meta;
23 use Class::MOP::MiniTrait;
25 use base 'Class::MOP::Class';
27 Class::MOP::MiniTrait::apply(__PACKAGE__, 'Moose::Meta::Object::Trait');
29 __PACKAGE__->meta->add_attribute('roles' => (
34 __PACKAGE__->meta->add_attribute('role_applications' => (
35 reader => '_get_role_applications',
39 __PACKAGE__->meta->add_attribute(
40 Class::MOP::Attribute->new('immutable_trait' => (
41 accessor => "immutable_trait",
42 default => 'Moose::Meta::Class::Immutable::Trait',
46 __PACKAGE__->meta->add_attribute('constructor_class' => (
47 accessor => 'constructor_class',
48 default => 'Moose::Meta::Method::Constructor',
51 __PACKAGE__->meta->add_attribute('destructor_class' => (
52 accessor => 'destructor_class',
53 default => 'Moose::Meta::Method::Destructor',
56 __PACKAGE__->meta->add_attribute('error_class' => (
57 accessor => 'error_class',
58 default => 'Moose::Error::Default',
64 return Class::MOP::get_metaclass_by_name($pkg)
65 || $class->SUPER::initialize($pkg,
66 'attribute_metaclass' => 'Moose::Meta::Attribute',
67 'method_metaclass' => 'Moose::Meta::Method',
68 'instance_metaclass' => 'Moose::Meta::Instance',
74 my ($class, $package_name, %options) = @_;
76 (ref $options{roles} eq 'ARRAY')
77 || $class->throw_error("You must pass an ARRAY ref of roles", data => $options{roles})
78 if exists $options{roles};
79 my $roles = delete $options{roles};
81 my $new_meta = $class->SUPER::create($package_name, %options);
84 Moose::Util::apply_all_roles( $new_meta, @$roles );
92 sub create_anon_class {
93 my ($self, %options) = @_;
95 my $cache_ok = delete $options{cache};
98 = _anon_cache_key( $options{superclasses}, $options{roles} );
100 if ($cache_ok && defined $ANON_CLASSES{$cache_key}) {
101 return $ANON_CLASSES{$cache_key};
104 $options{weaken} = !$cache_ok
105 unless exists $options{weaken};
107 my $new_class = $self->SUPER::create_anon_class(%options);
110 $ANON_CLASSES{$cache_key} = $new_class;
111 weaken($ANON_CLASSES{$cache_key});
117 sub _meta_method_class { 'Moose::Meta::Method::Meta' }
119 sub _anon_cache_key {
120 # Makes something like Super::Class|Super::Class::2=Role|Role::1
122 join( '|', @{ $_[0] || [] } ),
123 join( '|', sort @{ $_[1] || [] } ),
131 my $meta = blessed $pkg ? $pkg : Class::MOP::class_of($pkg);
135 my %existing_classes;
137 %existing_classes = map { $_ => $meta->$_() } qw(
140 wrapped_method_metaclass
147 $cache_key = _anon_cache_key(
148 [ $meta->superclasses ],
149 [ map { $_->name } @{ $meta->roles } ],
150 ) if $meta->is_anon_class;
153 my $new_meta = $self->SUPER::reinitialize(
159 return $new_meta unless defined $cache_key;
161 my $new_cache_key = _anon_cache_key(
162 [ $meta->superclasses ],
163 [ map { $_->name } @{ $meta->roles } ],
166 delete $ANON_CLASSES{$cache_key};
167 $ANON_CLASSES{$new_cache_key} = $new_meta;
168 weaken($ANON_CLASSES{$new_cache_key});
174 my ($self, $role) = @_;
175 (blessed($role) && $role->isa('Moose::Meta::Role'))
176 || $self->throw_error("Roles must be instances of Moose::Meta::Role", data => $role);
177 push @{$self->roles} => $role;
180 sub role_applications {
183 return @{$self->_get_role_applications};
186 sub add_role_application {
187 my ($self, $application) = @_;
188 (blessed($application) && $application->isa('Moose::Meta::Role::Application::ToClass'))
189 || $self->throw_error("Role applications must be instances of Moose::Meta::Role::Application::ToClass", data => $application);
190 push @{$self->_get_role_applications} => $application;
193 sub calculate_all_roles {
196 grep { !$seen{$_->name}++ } map { $_->calculate_all_roles } @{ $self->roles };
199 sub calculate_all_roles_with_inheritance {
202 grep { !$seen{$_->name}++ }
203 map { Class::MOP::class_of($_)->can('calculate_all_roles')
204 ? Class::MOP::class_of($_)->calculate_all_roles
206 $self->linearized_isa;
210 my ($self, $role_name) = @_;
213 || $self->throw_error("You must supply a role name to look for");
215 foreach my $class ($self->class_precedence_list) {
216 my $meta = Class::MOP::class_of($class);
217 # when a Moose metaclass is itself extended with a role,
218 # this check needs to be done since some items in the
219 # class_precedence_list might in fact be Class::MOP
221 next unless $meta && $meta->can('roles');
222 foreach my $role (@{$meta->roles}) {
223 return 1 if $role->does_role($role_name);
230 my ($self, $role_name) = @_;
233 || $self->throw_error("You must supply a role name to look for");
235 foreach my $class ($self->class_precedence_list) {
236 my $meta = Class::MOP::class_of($class);
237 # when a Moose metaclass is itself extended with a role,
238 # this check needs to be done since some items in the
239 # class_precedence_list might in fact be Class::MOP
241 next unless $meta && $meta->can('roles');
242 foreach my $role (@{$meta->roles}) {
243 return 1 if $role->excludes_role($role_name);
251 my $params = @_ == 1 ? $_[0] : {@_};
252 my $object = $self->SUPER::new_object($params);
254 foreach my $attr ( $self->get_all_attributes() ) {
256 next unless $attr->can('has_trigger') && $attr->has_trigger;
258 my $init_arg = $attr->init_arg;
260 next unless defined $init_arg;
262 next unless exists $params->{$init_arg};
268 ? $attr->get_read_method_ref->($object)
269 : $params->{$init_arg}
274 $object->BUILDALL($params) if $object->can('BUILDALL');
279 sub _generate_fallback_constructor {
282 return $class . '->Moose::Object::new(@_)'
287 my ($params, $class) = @_;
289 'my ' . $params . ' = ',
290 $self->_inline_BUILDARGS($class, '@_'),
295 sub _inline_BUILDARGS {
297 my ($class, $args) = @_;
299 my $buildargs = $self->find_method_by_name("BUILDARGS");
302 && (!$buildargs or $buildargs->body == \&Moose::Object::BUILDARGS)) {
306 'if (scalar @_ == 1) {',
307 'if (!defined($_[0]) || ref($_[0]) ne \'HASH\') {',
308 $self->_inline_throw_error(
309 '"Single parameters to new() must be a HASH ref"',
313 '$params = { %{ $_[0] } };',
317 '"The new() method for ' . $class . ' expects a '
318 . 'hash reference or a key/value list. You passed an '
319 . 'odd number of arguments"',
321 '$params = {@_, undef};',
331 return $class . '->BUILDARGS(' . $args . ')';
335 sub _inline_slot_initializer {
337 my ($attr, $idx) = @_;
341 $self->_inline_check_required_attr($attr),
342 $self->SUPER::_inline_slot_initializer(@_),
346 sub _inline_check_required_attr {
350 return unless defined $attr->init_arg;
351 return unless $attr->can('is_required') && $attr->is_required;
352 return if $attr->has_default || $attr->has_builder;
355 'if (!exists $params->{\'' . $attr->init_arg . '\'}) {',
356 $self->_inline_throw_error(
357 '"Attribute (' . quotemeta($attr->name) . ') is required"'
363 # XXX: these two are duplicated from cmop, because we have to pass the tc stuff
364 # through to _inline_set_value - this should probably be fixed, but i'm not
365 # quite sure how. -doy
366 sub _inline_init_attr_from_constructor {
368 my ($attr, $idx) = @_;
370 my @initial_value = $attr->_inline_set_value(
372 '$params->{\'' . $attr->init_arg . '\'}',
373 '$type_constraint_bodies[' . $idx . ']',
374 '$type_constraints[' . $idx . ']',
378 push @initial_value, (
379 '$attrs->[' . $idx . ']->set_initial_value(',
381 $attr->_inline_instance_get('$instance'),
383 ) if $attr->has_initializer;
385 return @initial_value;
388 sub _inline_init_attr_from_default {
390 my ($attr, $idx) = @_;
392 return if $attr->can('is_lazy') && $attr->is_lazy;
393 my $default = $self->_inline_default_value($attr, $idx);
394 return unless $default;
396 my @initial_value = (
397 'my $default = ' . $default . ';',
398 $attr->_inline_set_value(
401 '$type_constraint_bodies[' . $idx . ']',
402 '$type_constraints[' . $idx . ']',
407 push @initial_value, (
408 '$attrs->[' . $idx . ']->set_initial_value(',
410 $attr->_inline_instance_get('$instance'),
412 ) if $attr->has_initializer;
414 return @initial_value;
417 sub _inline_extra_init {
420 $self->_inline_triggers,
421 $self->_inline_BUILDALL,
425 sub _inline_triggers {
429 my @attrs = sort { $a->name cmp $b->name } $self->get_all_attributes;
430 for my $i (0 .. $#attrs) {
431 my $attr = $attrs[$i];
433 next unless $attr->can('has_trigger') && $attr->has_trigger;
435 my $init_arg = $attr->init_arg;
436 next unless defined $init_arg;
439 'if (exists $params->{\'' . $init_arg . '\'}) {',
440 '$attrs->[' . $i . ']->trigger->(',
442 $attr->_inline_instance_get('$instance') . ',',
447 return @trigger_calls;
450 sub _inline_BUILDALL {
453 my @methods = reverse $self->find_all_methods_by_name('BUILD');
456 foreach my $method (@methods) {
458 '$instance->' . $method->{class} . '::BUILD($params);';
466 my $supers = Data::OptList::mkopt(\@_);
467 foreach my $super (@{ $supers }) {
468 my ($name, $opts) = @{ $super };
469 Class::MOP::load_class($name, $opts);
470 my $meta = Class::MOP::class_of($name);
471 $self->throw_error("You cannot inherit from a Moose Role ($name)")
472 if $meta && $meta->isa('Moose::Meta::Role')
474 return $self->SUPER::superclasses(map { $_->[0] } @{ $supers });
477 ### ---------------------------------------------
482 (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
484 : $self->_process_attribute(@_));
485 $self->SUPER::add_attribute($attr);
486 # it may be a Class::MOP::Attribute, theoretically, which doesn't have
487 # 'bare' and doesn't implement this method
488 if ($attr->can('_check_associated_methods')) {
489 $attr->_check_associated_methods;
494 sub add_override_method_modifier {
495 my ($self, $name, $method, $_super_package) = @_;
497 (!$self->has_method($name))
498 || $self->throw_error("Cannot add an override method if a local method is already present");
500 $self->add_method($name => Moose::Meta::Method::Overridden->new(
503 package => $_super_package, # need this for roles
508 sub add_augment_method_modifier {
509 my ($self, $name, $method) = @_;
510 (!$self->has_method($name))
511 || $self->throw_error("Cannot add an augment method if a local method is already present");
513 $self->add_method($name => Moose::Meta::Method::Augmented->new(
520 ## Private Utility methods ...
522 sub _find_next_method_by_name_which_is_not_overridden {
523 my ($self, $name) = @_;
524 foreach my $method ($self->find_all_methods_by_name($name)) {
525 return $method->{code}
526 if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overridden');
531 ## Metaclass compatibility
533 sub _base_metaclasses {
535 my %metaclasses = $self->SUPER::_base_metaclasses;
536 for my $class (keys %metaclasses) {
537 $metaclasses{$class} =~ s/^Class::MOP/Moose::Meta/;
541 error_class => 'Moose::Error::Default',
545 sub _fix_class_metaclass_incompatibility {
547 my ($super_meta) = @_;
549 $self->SUPER::_fix_class_metaclass_incompatibility(@_);
551 if ($self->_class_metaclass_can_be_made_compatible($super_meta)) {
553 || confess "Can't fix metaclass incompatibility for "
555 . " because it is not pristine.";
556 my $super_meta_name = $super_meta->_real_ref_name;
557 my $class_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass(blessed($self), $super_meta_name);
558 my $new_self = $class_meta_subclass_meta_name->reinitialize(
562 $self->_replace_self( $new_self, $class_meta_subclass_meta_name );
566 sub _fix_single_metaclass_incompatibility {
568 my ($metaclass_type, $super_meta) = @_;
570 $self->SUPER::_fix_single_metaclass_incompatibility(@_);
572 if ($self->_single_metaclass_can_be_made_compatible($super_meta, $metaclass_type)) {
574 || confess "Can't fix metaclass incompatibility for "
576 . " because it is not pristine.";
577 my $super_meta_name = $super_meta->_real_ref_name;
578 my $class_specific_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass($self->$metaclass_type, $super_meta->$metaclass_type);
579 my $new_self = $super_meta->reinitialize(
581 $metaclass_type => $class_specific_meta_subclass_meta_name,
584 $self->_replace_self( $new_self, $super_meta_name );
590 my ( $new_self, $new_class) = @_;
593 bless $self, $new_class;
595 # We need to replace the cached metaclass instance or else when it goes
596 # out of scope Class::MOP::Class destroy's the namespace for the
597 # metaclass's class, causing much havoc.
598 my $weaken = Class::MOP::metaclass_is_weak( $self->name );
599 Class::MOP::store_metaclass_by_name( $self->name, $self );
600 Class::MOP::weaken_metaclass( $self->name ) if $weaken;
603 sub _process_attribute {
604 my ( $self, $name, @args ) = @_;
606 @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
608 if (($name || '') =~ /^\+(.*)/) {
609 return $self->_process_inherited_attribute($1, @args);
612 return $self->_process_new_attribute($name, @args);
616 sub _process_new_attribute {
617 my ( $self, $name, @args ) = @_;
619 $self->attribute_metaclass->interpolate_class_and_new($name, @args);
622 sub _process_inherited_attribute {
623 my ($self, $attr_name, %options) = @_;
624 my $inherited_attr = $self->find_attribute_by_name($attr_name);
625 (defined $inherited_attr)
626 || $self->throw_error("Could not find an attribute by the name of '$attr_name' to inherit from in ${\$self->name}", data => $attr_name);
627 if ($inherited_attr->isa('Moose::Meta::Attribute')) {
628 return $inherited_attr->clone_and_inherit_options(%options);
632 # kind of a kludge to handle Class::MOP::Attributes
633 return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
639 sub _immutable_options {
640 my ( $self, @args ) = @_;
642 $self->SUPER::_immutable_options(
643 inline_destructor => 1,
645 # Moose always does this when an attribute is created
646 inline_accessors => 0,
652 ## -------------------------------------------------
657 my ( $self, @args ) = @_;
658 local $error_level = ($error_level || 0) + 1;
659 $self->raise_error($self->create_error(@args));
662 sub _inline_throw_error {
663 my ( $self, $msg, $args ) = @_;
664 "\$meta->throw_error($msg" . ($args ? ", $args" : "") . ")"; # FIXME makes deparsing *REALLY* hard
668 my ( $self, @args ) = @_;
673 my ( $self, @args ) = @_;
677 local $error_level = ($error_level || 0 ) + 1;
679 if ( @args % 2 == 1 ) {
680 unshift @args, "message";
683 my %args = ( metaclass => $self, last_error => $@, @args );
685 $args{depth} += $error_level;
687 my $class = ref $self ? $self->error_class : "Moose::Error::Default";
689 Class::MOP::load_class($class);
692 Carp::caller_info($args{depth}),
699 # ABSTRACT: The Moose metaclass
707 This class is a subclass of L<Class::MOP::Class> that provides
708 additional Moose-specific functionality.
710 To really understand this class, you will need to start with the
711 L<Class::MOP::Class> documentation. This class can be understood as a
712 set of additional features on top of the basic feature provided by
717 C<Moose::Meta::Class> is a subclass of L<Class::MOP::Class>.
723 =item B<< Moose::Meta::Class->initialize($package_name, %options) >>
725 This overrides the parent's method in order to provide its own
726 defaults for the C<attribute_metaclass>, C<instance_metaclass>, and
727 C<method_metaclass> options.
729 These all default to the appropriate Moose class.
731 =item B<< Moose::Meta::Class->create($package_name, %options) >>
733 This overrides the parent's method in order to accept a C<roles>
734 option. This should be an array reference containing roles
735 that the class does, each optionally followed by a hashref of options
736 (C<-excludes> and C<-alias>).
738 my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
740 =item B<< Moose::Meta::Class->create_anon_class >>
742 This overrides the parent's method to accept a C<roles> option, just
745 It also accepts a C<cache> option. If this is true, then the anonymous
746 class will be cached based on its superclasses and roles. If an
747 existing anonymous class in the cache has the same superclasses and
748 roles, it will be reused.
750 my $metaclass = Moose::Meta::Class->create_anon_class(
751 superclasses => ['Foo'],
752 roles => [qw/Some Roles Go Here/],
756 Each entry in both the C<superclasses> and the C<roles> option can be
757 followed by a hash reference with arguments. The C<superclasses>
758 option can be supplied with a L<-version|Class::MOP/Class Loading
759 Options> option that ensures the loaded superclass satisfies the
760 required version. The C<role> option also takes the C<-version> as an
761 argument, but the option hash reference can also contain any other
762 role relevant values like exclusions or parameterized role arguments.
764 =item B<< $metaclass->make_immutable(%options) >>
766 This overrides the parent's method to add a few options. Specifically,
767 it uses the Moose-specific constructor and destructor classes, and
768 enables inlining the destructor.
770 Since Moose always inlines attributes, it sets the C<inline_accessors> option
773 =item B<< $metaclass->new_object(%params) >>
775 This overrides the parent's method in order to add support for
778 =item B<< $metaclass->superclasses(@superclasses) >>
780 This is the accessor allowing you to read or change the parents of
783 Each superclass can be followed by a hash reference containing a
784 L<-version|Class::MOP/Class Loading Options> value. If the version
785 requirement is not satisfied an error will be thrown.
787 =item B<< $metaclass->add_override_method_modifier($name, $sub) >>
789 This adds an C<override> method modifier to the package.
791 =item B<< $metaclass->add_augment_method_modifier($name, $sub) >>
793 This adds an C<augment> method modifier to the package.
795 =item B<< $metaclass->calculate_all_roles >>
797 This will return a unique array of C<Moose::Meta::Role> instances
798 which are attached to this class.
800 =item B<< $metaclass->calculate_all_roles_with_inheritance >>
802 This will return a unique array of C<Moose::Meta::Role> instances
803 which are attached to this class, and each of this class's ancestors.
805 =item B<< $metaclass->add_role($role) >>
807 This takes a L<Moose::Meta::Role> object, and adds it to the class's
808 list of roles. This I<does not> actually apply the role to the class.
810 =item B<< $metaclass->role_applications >>
812 Returns a list of L<Moose::Meta::Role::Application::ToClass>
813 objects, which contain the arguments to role application.
815 =item B<< $metaclass->add_role_application($application) >>
817 This takes a L<Moose::Meta::Role::Application::ToClass> object, and
818 adds it to the class's list of role applications. This I<does not>
819 actually apply any role to the class; it is only for tracking role
822 =item B<< $metaclass->does_role($role) >>
824 This returns a boolean indicating whether or not the class does the specified
825 role. The role provided can be either a role name or a L<Moose::Meta::Role>
826 object. This tests both the class and its parents.
828 =item B<< $metaclass->excludes_role($role_name) >>
830 A class excludes a role if it has already composed a role which
831 excludes the named role. This tests both the class and its parents.
833 =item B<< $metaclass->add_attribute($attr_name, %params|$params) >>
835 This overrides the parent's method in order to allow the parameters to
836 be provided as a hash reference.
838 =item B<< $metaclass->constructor_class($class_name) >>
840 =item B<< $metaclass->destructor_class($class_name) >>
842 These are the names of classes used when making a class immutable. These
843 default to L<Moose::Meta::Method::Constructor> and
844 L<Moose::Meta::Method::Destructor> respectively. These accessors are
845 read-write, so you can use them to change the class name.
847 =item B<< $metaclass->error_class($class_name) >>
849 The name of the class used to throw errors. This defaults to
850 L<Moose::Error::Default>, which generates an error with a stacktrace
851 just like C<Carp::confess>.
853 =item B<< $metaclass->throw_error($message, %extra) >>
855 Throws the error created by C<create_error> using C<raise_error>
861 See L<Moose/BUGS> for details on reporting bugs.