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 '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 unshift @args, 'package' if @args % 2;
66 my $package = delete $opts{package};
67 return Class::MOP::get_metaclass_by_name($package)
68 || $class->SUPER::initialize($package,
69 'attribute_metaclass' => 'Moose::Meta::Attribute',
70 'method_metaclass' => 'Moose::Meta::Method',
71 'instance_metaclass' => 'Moose::Meta::Instance',
80 unshift @args, 'package' if @args % 2 == 1;
83 (ref $options{roles} eq 'ARRAY')
84 || $class->throw_error("You must pass an ARRAY ref of roles", data => $options{roles})
85 if exists $options{roles};
87 my $package = delete $options{package};
88 my $roles = delete $options{roles};
90 my $new_meta = $class->SUPER::create($package, %options);
93 Moose::Util::apply_all_roles( $new_meta, @$roles );
99 sub _meta_method_class { 'Moose::Meta::Method::Meta' }
101 sub _anon_package_prefix { 'Moose::Meta::Class::__ANON__::SERIAL::' }
103 sub _anon_cache_key {
107 my $superclass_key = join('|',
108 map { $_->[0] } @{ Data::OptList::mkopt($options{superclasses} || []) }
111 my $roles = Data::OptList::mkopt(($options{roles} || []), {
113 val_test => sub { ref($_[0]) eq 'HASH' },
117 for my $role_spec (@$roles) {
118 my ($role, $params) = @$role_spec;
119 $params = { %$params } if $params;
121 my $key = blessed($role) ? $role->name : $role;
123 if ($params && %$params) {
124 my $alias = delete $params->{'-alias'}
125 || delete $params->{'alias'}
127 my $excludes = delete $params->{'-excludes'}
128 || delete $params->{'excludes'}
130 $excludes = [$excludes] unless ref($excludes) eq 'ARRAY';
133 warn "Roles with parameters cannot be cached. Consider "
134 . "applying the parameters before calling "
135 . "create_anon_class, or using 'weaken => 0' instead";
139 $key .= '<' . join('+', 'a', join('%', sort %$alias),
140 'e', join('%', sort @$excludes)) . '>';
143 push @role_keys, $key;
146 my $role_key = join('|', sort @role_keys);
148 # Makes something like Super::Class|Super::Class::2=Role|Role::1
149 return join('=', $superclass_key, $role_key);
156 my $meta = blessed $pkg ? $pkg : Class::MOP::class_of($pkg);
158 my %existing_classes;
160 %existing_classes = map { $_ => $meta->$_() } qw(
163 wrapped_method_metaclass
171 return $self->SUPER::reinitialize(
179 my ($self, $role) = @_;
180 (blessed($role) && $role->isa('Moose::Meta::Role'))
181 || $self->throw_error("Roles must be instances of Moose::Meta::Role", data => $role);
182 push @{$self->roles} => $role;
185 sub role_applications {
188 return @{$self->_get_role_applications};
191 sub add_role_application {
192 my ($self, $application) = @_;
193 (blessed($application) && $application->isa('Moose::Meta::Role::Application::ToClass'))
194 || $self->throw_error("Role applications must be instances of Moose::Meta::Role::Application::ToClass", data => $application);
195 push @{$self->_get_role_applications} => $application;
198 sub calculate_all_roles {
201 grep { !$seen{$_->name}++ } map { $_->calculate_all_roles } @{ $self->roles };
204 sub calculate_all_roles_with_inheritance {
207 grep { !$seen{$_->name}++ }
208 map { Class::MOP::class_of($_)->can('calculate_all_roles')
209 ? Class::MOP::class_of($_)->calculate_all_roles
211 $self->linearized_isa;
215 my ($self, $role_name) = @_;
218 || $self->throw_error("You must supply a role name to look for");
220 foreach my $class ($self->class_precedence_list) {
221 my $meta = Class::MOP::class_of($class);
222 # when a Moose metaclass is itself extended with a role,
223 # this check needs to be done since some items in the
224 # class_precedence_list might in fact be Class::MOP
226 next unless $meta && $meta->can('roles');
227 foreach my $role (@{$meta->roles}) {
228 return 1 if $role->does_role($role_name);
235 my ($self, $role_name) = @_;
238 || $self->throw_error("You must supply a role name to look for");
240 foreach my $class ($self->class_precedence_list) {
241 my $meta = Class::MOP::class_of($class);
242 # when a Moose metaclass is itself extended with a role,
243 # this check needs to be done since some items in the
244 # class_precedence_list might in fact be Class::MOP
246 next unless $meta && $meta->can('roles');
247 foreach my $role (@{$meta->roles}) {
248 return 1 if $role->excludes_role($role_name);
256 my $params = @_ == 1 ? $_[0] : {@_};
257 my $object = $self->SUPER::new_object($params);
259 foreach my $attr ( $self->get_all_attributes() ) {
261 next unless $attr->can('has_trigger') && $attr->has_trigger;
263 my $init_arg = $attr->init_arg;
265 next unless defined $init_arg;
267 next unless exists $params->{$init_arg};
273 ? $attr->get_read_method_ref->($object)
274 : $params->{$init_arg}
279 $object->BUILDALL($params) if $object->can('BUILDALL');
284 sub _generate_fallback_constructor {
287 return $class . '->Moose::Object::new(@_)'
292 my ($params, $class) = @_;
294 'my ' . $params . ' = ',
295 $self->_inline_BUILDARGS($class, '@_'),
300 sub _inline_BUILDARGS {
302 my ($class, $args) = @_;
304 my $buildargs = $self->find_method_by_name("BUILDARGS");
307 && (!$buildargs or $buildargs->body == \&Moose::Object::BUILDARGS)) {
311 'if (scalar @_ == 1) {',
312 'if (!defined($_[0]) || ref($_[0]) ne \'HASH\') {',
313 $self->_inline_throw_error(
314 '"Single parameters to new() must be a HASH ref"',
318 '$params = { %{ $_[0] } };',
322 '"The new() method for ' . $class . ' expects a '
323 . 'hash reference or a key/value list. You passed an '
324 . 'odd number of arguments"',
326 '$params = {@_, undef};',
336 return $class . '->BUILDARGS(' . $args . ')';
340 sub _inline_slot_initializer {
342 my ($attr, $idx) = @_;
346 $self->_inline_check_required_attr($attr),
347 $self->SUPER::_inline_slot_initializer(@_),
351 sub _inline_check_required_attr {
355 return unless defined $attr->init_arg;
356 return unless $attr->can('is_required') && $attr->is_required;
357 return if $attr->has_default || $attr->has_builder;
360 'if (!exists $params->{\'' . $attr->init_arg . '\'}) {',
361 $self->_inline_throw_error(
362 '"Attribute (' . quotemeta($attr->name) . ') is required"'
368 # XXX: these two are duplicated from cmop, because we have to pass the tc stuff
369 # through to _inline_set_value - this should probably be fixed, but i'm not
370 # quite sure how. -doy
371 sub _inline_init_attr_from_constructor {
373 my ($attr, $idx) = @_;
375 my @initial_value = $attr->_inline_set_value(
377 '$params->{\'' . $attr->init_arg . '\'}',
378 '$type_constraint_bodies[' . $idx . ']',
379 '$type_constraints[' . $idx . ']',
383 push @initial_value, (
384 '$attrs->[' . $idx . ']->set_initial_value(',
386 $attr->_inline_instance_get('$instance'),
388 ) if $attr->has_initializer;
390 return @initial_value;
393 sub _inline_init_attr_from_default {
395 my ($attr, $idx) = @_;
397 return if $attr->can('is_lazy') && $attr->is_lazy;
398 my $default = $self->_inline_default_value($attr, $idx);
399 return unless $default;
401 my @initial_value = (
402 'my $default = ' . $default . ';',
403 $attr->_inline_set_value(
406 '$type_constraint_bodies[' . $idx . ']',
407 '$type_constraints[' . $idx . ']',
412 push @initial_value, (
413 '$attrs->[' . $idx . ']->set_initial_value(',
415 $attr->_inline_instance_get('$instance'),
417 ) if $attr->has_initializer;
419 return @initial_value;
422 sub _inline_extra_init {
425 $self->_inline_triggers,
426 $self->_inline_BUILDALL,
430 sub _inline_triggers {
434 my @attrs = sort { $a->name cmp $b->name } $self->get_all_attributes;
435 for my $i (0 .. $#attrs) {
436 my $attr = $attrs[$i];
438 next unless $attr->can('has_trigger') && $attr->has_trigger;
440 my $init_arg = $attr->init_arg;
441 next unless defined $init_arg;
444 'if (exists $params->{\'' . $init_arg . '\'}) {',
445 '$attrs->[' . $i . ']->trigger->(',
447 $attr->_inline_instance_get('$instance') . ',',
452 return @trigger_calls;
455 sub _inline_BUILDALL {
458 my @methods = reverse $self->find_all_methods_by_name('BUILD');
461 foreach my $method (@methods) {
463 '$instance->' . $method->{class} . '::BUILD($params);';
471 my $supers = Data::OptList::mkopt(\@_);
472 foreach my $super (@{ $supers }) {
473 my ($name, $opts) = @{ $super };
474 Class::MOP::load_class($name, $opts);
475 my $meta = Class::MOP::class_of($name);
476 $self->throw_error("You cannot inherit from a Moose Role ($name)")
477 if $meta && $meta->isa('Moose::Meta::Role')
479 return $self->SUPER::superclasses(map { $_->[0] } @{ $supers });
482 ### ---------------------------------------------
487 (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
489 : $self->_process_attribute(@_));
490 $self->SUPER::add_attribute($attr);
491 # it may be a Class::MOP::Attribute, theoretically, which doesn't have
492 # 'bare' and doesn't implement this method
493 if ($attr->can('_check_associated_methods')) {
494 $attr->_check_associated_methods;
499 sub add_override_method_modifier {
500 my ($self, $name, $method, $_super_package) = @_;
502 (!$self->has_method($name))
503 || $self->throw_error("Cannot add an override method if a local method is already present");
505 $self->add_method($name => Moose::Meta::Method::Overridden->new(
508 package => $_super_package, # need this for roles
513 sub add_augment_method_modifier {
514 my ($self, $name, $method) = @_;
515 (!$self->has_method($name))
516 || $self->throw_error("Cannot add an augment method if a local method is already present");
518 $self->add_method($name => Moose::Meta::Method::Augmented->new(
525 ## Private Utility methods ...
527 sub _find_next_method_by_name_which_is_not_overridden {
528 my ($self, $name) = @_;
529 foreach my $method ($self->find_all_methods_by_name($name)) {
530 return $method->{code}
531 if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overridden');
536 ## Metaclass compatibility
538 sub _base_metaclasses {
540 my %metaclasses = $self->SUPER::_base_metaclasses;
541 for my $class (keys %metaclasses) {
542 $metaclasses{$class} =~ s/^Class::MOP/Moose::Meta/;
546 error_class => 'Moose::Error::Default',
550 sub _fix_class_metaclass_incompatibility {
552 my ($super_meta) = @_;
554 $self->SUPER::_fix_class_metaclass_incompatibility(@_);
556 if ($self->_class_metaclass_can_be_made_compatible($super_meta)) {
558 || confess "Can't fix metaclass incompatibility for "
560 . " because it is not pristine.";
561 my $super_meta_name = $super_meta->_real_ref_name;
562 my $class_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass(blessed($self), $super_meta_name);
563 my $new_self = $class_meta_subclass_meta_name->reinitialize(
567 $self->_replace_self( $new_self, $class_meta_subclass_meta_name );
571 sub _fix_single_metaclass_incompatibility {
573 my ($metaclass_type, $super_meta) = @_;
575 $self->SUPER::_fix_single_metaclass_incompatibility(@_);
577 if ($self->_single_metaclass_can_be_made_compatible($super_meta, $metaclass_type)) {
579 || confess "Can't fix metaclass incompatibility for "
581 . " because it is not pristine.";
582 my $super_meta_name = $super_meta->_real_ref_name;
583 my $class_specific_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass($self->$metaclass_type, $super_meta->$metaclass_type);
584 my $new_self = $super_meta->reinitialize(
586 $metaclass_type => $class_specific_meta_subclass_meta_name,
589 $self->_replace_self( $new_self, $super_meta_name );
595 my ( $new_self, $new_class) = @_;
598 bless $self, $new_class;
600 # We need to replace the cached metaclass instance or else when it goes
601 # out of scope Class::MOP::Class destroy's the namespace for the
602 # metaclass's class, causing much havoc.
603 my $weaken = Class::MOP::metaclass_is_weak( $self->name );
604 Class::MOP::store_metaclass_by_name( $self->name, $self );
605 Class::MOP::weaken_metaclass( $self->name ) if $weaken;
608 sub _process_attribute {
609 my ( $self, $name, @args ) = @_;
611 @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
613 if (($name || '') =~ /^\+(.*)/) {
614 return $self->_process_inherited_attribute($1, @args);
617 return $self->_process_new_attribute($name, @args);
621 sub _process_new_attribute {
622 my ( $self, $name, @args ) = @_;
624 $self->attribute_metaclass->interpolate_class_and_new($name, @args);
627 sub _process_inherited_attribute {
628 my ($self, $attr_name, %options) = @_;
629 my $inherited_attr = $self->find_attribute_by_name($attr_name);
630 (defined $inherited_attr)
631 || $self->throw_error("Could not find an attribute by the name of '$attr_name' to inherit from in ${\$self->name}", data => $attr_name);
632 if ($inherited_attr->isa('Moose::Meta::Attribute')) {
633 return $inherited_attr->clone_and_inherit_options(%options);
637 # kind of a kludge to handle Class::MOP::Attributes
638 return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
642 # reinitialization support
644 sub _restore_metaobjects_from {
648 $self->SUPER::_restore_metaobjects_from($old_meta);
650 for my $role ( @{ $old_meta->roles } ) {
651 $self->add_role($role);
654 for my $application ( @{ $old_meta->_get_role_applications } ) {
655 $application->class($self);
656 $self->add_role_application ($application);
662 sub _immutable_options {
663 my ( $self, @args ) = @_;
665 $self->SUPER::_immutable_options(
666 inline_destructor => 1,
668 # Moose always does this when an attribute is created
669 inline_accessors => 0,
675 ## -------------------------------------------------
680 my ( $self, @args ) = @_;
681 local $error_level = ($error_level || 0) + 1;
682 $self->raise_error($self->create_error(@args));
685 sub _inline_throw_error {
686 my ( $self, $msg, $args ) = @_;
687 "\$meta->throw_error($msg" . ($args ? ", $args" : "") . ")"; # FIXME makes deparsing *REALLY* hard
691 my ( $self, @args ) = @_;
696 my ( $self, @args ) = @_;
700 local $error_level = ($error_level || 0 ) + 1;
702 if ( @args % 2 == 1 ) {
703 unshift @args, "message";
706 my %args = ( metaclass => $self, last_error => $@, @args );
708 $args{depth} += $error_level;
710 my $class = ref $self ? $self->error_class : "Moose::Error::Default";
712 Class::MOP::load_class($class);
715 Carp::caller_info($args{depth}),
722 # ABSTRACT: The Moose metaclass
730 This class is a subclass of L<Class::MOP::Class> that provides
731 additional Moose-specific functionality.
733 To really understand this class, you will need to start with the
734 L<Class::MOP::Class> documentation. This class can be understood as a
735 set of additional features on top of the basic feature provided by
740 C<Moose::Meta::Class> is a subclass of L<Class::MOP::Class>.
746 =item B<< Moose::Meta::Class->initialize($package_name, %options) >>
748 This overrides the parent's method in order to provide its own
749 defaults for the C<attribute_metaclass>, C<instance_metaclass>, and
750 C<method_metaclass> options.
752 These all default to the appropriate Moose class.
754 =item B<< Moose::Meta::Class->create($package_name, %options) >>
756 This overrides the parent's method in order to accept a C<roles>
757 option. This should be an array reference containing roles
758 that the class does, each optionally followed by a hashref of options
759 (C<-excludes> and C<-alias>).
761 my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
763 =item B<< Moose::Meta::Class->create_anon_class >>
765 This overrides the parent's method to accept a C<roles> option, just
768 It also accepts a C<cache> option. If this is true, then the anonymous
769 class will be cached based on its superclasses and roles. If an
770 existing anonymous class in the cache has the same superclasses and
771 roles, it will be reused.
773 my $metaclass = Moose::Meta::Class->create_anon_class(
774 superclasses => ['Foo'],
775 roles => [qw/Some Roles Go Here/],
779 Each entry in both the C<superclasses> and the C<roles> option can be
780 followed by a hash reference with arguments. The C<superclasses>
781 option can be supplied with a L<-version|Class::MOP/Class Loading
782 Options> option that ensures the loaded superclass satisfies the
783 required version. The C<role> option also takes the C<-version> as an
784 argument, but the option hash reference can also contain any other
785 role relevant values like exclusions or parameterized role arguments.
787 =item B<< $metaclass->make_immutable(%options) >>
789 This overrides the parent's method to add a few options. Specifically,
790 it uses the Moose-specific constructor and destructor classes, and
791 enables inlining the destructor.
793 Since Moose always inlines attributes, it sets the C<inline_accessors> option
796 =item B<< $metaclass->new_object(%params) >>
798 This overrides the parent's method in order to add support for
801 =item B<< $metaclass->superclasses(@superclasses) >>
803 This is the accessor allowing you to read or change the parents of
806 Each superclass can be followed by a hash reference containing a
807 L<-version|Class::MOP/Class Loading Options> value. If the version
808 requirement is not satisfied an error will be thrown.
810 =item B<< $metaclass->add_override_method_modifier($name, $sub) >>
812 This adds an C<override> method modifier to the package.
814 =item B<< $metaclass->add_augment_method_modifier($name, $sub) >>
816 This adds an C<augment> method modifier to the package.
818 =item B<< $metaclass->calculate_all_roles >>
820 This will return a unique array of C<Moose::Meta::Role> instances
821 which are attached to this class.
823 =item B<< $metaclass->calculate_all_roles_with_inheritance >>
825 This will return a unique array of C<Moose::Meta::Role> instances
826 which are attached to this class, and each of this class's ancestors.
828 =item B<< $metaclass->add_role($role) >>
830 This takes a L<Moose::Meta::Role> object, and adds it to the class's
831 list of roles. This I<does not> actually apply the role to the class.
833 =item B<< $metaclass->role_applications >>
835 Returns a list of L<Moose::Meta::Role::Application::ToClass>
836 objects, which contain the arguments to role application.
838 =item B<< $metaclass->add_role_application($application) >>
840 This takes a L<Moose::Meta::Role::Application::ToClass> object, and
841 adds it to the class's list of role applications. This I<does not>
842 actually apply any role to the class; it is only for tracking role
845 =item B<< $metaclass->does_role($role) >>
847 This returns a boolean indicating whether or not the class does the specified
848 role. The role provided can be either a role name or a L<Moose::Meta::Role>
849 object. This tests both the class and its parents.
851 =item B<< $metaclass->excludes_role($role_name) >>
853 A class excludes a role if it has already composed a role which
854 excludes the named role. This tests both the class and its parents.
856 =item B<< $metaclass->add_attribute($attr_name, %params|$params) >>
858 This overrides the parent's method in order to allow the parameters to
859 be provided as a hash reference.
861 =item B<< $metaclass->constructor_class($class_name) >>
863 =item B<< $metaclass->destructor_class($class_name) >>
865 These are the names of classes used when making a class immutable. These
866 default to L<Moose::Meta::Method::Constructor> and
867 L<Moose::Meta::Method::Destructor> respectively. These accessors are
868 read-write, so you can use them to change the class name.
870 =item B<< $metaclass->error_class($class_name) >>
872 The name of the class used to throw errors. This defaults to
873 L<Moose::Error::Default>, which generates an error with a stacktrace
874 just like C<Carp::confess>.
876 =item B<< $metaclass->throw_error($message, %extra) >>
878 Throws the error created by C<create_error> using C<raise_error>
884 See L<Moose/BUGS> for details on reporting bugs.