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 {
106 # Makes something like Super::Class|Super::Class::2=Role|Role::1
108 join( '|', @{ $options{superclasses} || [] } ),
109 join( '|', sort @{ $options{roles} || [] } ),
117 my $meta = blessed $pkg ? $pkg : Class::MOP::class_of($pkg);
119 my %existing_classes;
121 %existing_classes = map { $_ => $meta->$_() } qw(
124 wrapped_method_metaclass
132 return $self->SUPER::reinitialize(
140 my ($self, $role) = @_;
141 (blessed($role) && $role->isa('Moose::Meta::Role'))
142 || $self->throw_error("Roles must be instances of Moose::Meta::Role", data => $role);
143 push @{$self->roles} => $role;
146 sub role_applications {
149 return @{$self->_get_role_applications};
152 sub add_role_application {
153 my ($self, $application) = @_;
154 (blessed($application) && $application->isa('Moose::Meta::Role::Application::ToClass'))
155 || $self->throw_error("Role applications must be instances of Moose::Meta::Role::Application::ToClass", data => $application);
156 push @{$self->_get_role_applications} => $application;
159 sub calculate_all_roles {
162 grep { !$seen{$_->name}++ } map { $_->calculate_all_roles } @{ $self->roles };
165 sub calculate_all_roles_with_inheritance {
168 grep { !$seen{$_->name}++ }
169 map { Class::MOP::class_of($_)->can('calculate_all_roles')
170 ? Class::MOP::class_of($_)->calculate_all_roles
172 $self->linearized_isa;
176 my ($self, $role_name) = @_;
179 || $self->throw_error("You must supply a role name to look for");
181 foreach my $class ($self->class_precedence_list) {
182 my $meta = Class::MOP::class_of($class);
183 # when a Moose metaclass is itself extended with a role,
184 # this check needs to be done since some items in the
185 # class_precedence_list might in fact be Class::MOP
187 next unless $meta && $meta->can('roles');
188 foreach my $role (@{$meta->roles}) {
189 return 1 if $role->does_role($role_name);
196 my ($self, $role_name) = @_;
199 || $self->throw_error("You must supply a role name to look for");
201 foreach my $class ($self->class_precedence_list) {
202 my $meta = Class::MOP::class_of($class);
203 # when a Moose metaclass is itself extended with a role,
204 # this check needs to be done since some items in the
205 # class_precedence_list might in fact be Class::MOP
207 next unless $meta && $meta->can('roles');
208 foreach my $role (@{$meta->roles}) {
209 return 1 if $role->excludes_role($role_name);
217 my $params = @_ == 1 ? $_[0] : {@_};
218 my $object = $self->SUPER::new_object($params);
220 foreach my $attr ( $self->get_all_attributes() ) {
222 next unless $attr->can('has_trigger') && $attr->has_trigger;
224 my $init_arg = $attr->init_arg;
226 next unless defined $init_arg;
228 next unless exists $params->{$init_arg};
234 ? $attr->get_read_method_ref->($object)
235 : $params->{$init_arg}
240 $object->BUILDALL($params) if $object->can('BUILDALL');
245 sub _generate_fallback_constructor {
248 return $class . '->Moose::Object::new(@_)'
253 my ($params, $class) = @_;
255 'my ' . $params . ' = ',
256 $self->_inline_BUILDARGS($class, '@_'),
261 sub _inline_BUILDARGS {
263 my ($class, $args) = @_;
265 my $buildargs = $self->find_method_by_name("BUILDARGS");
268 && (!$buildargs or $buildargs->body == \&Moose::Object::BUILDARGS)) {
272 'if (scalar @_ == 1) {',
273 'if (!defined($_[0]) || ref($_[0]) ne \'HASH\') {',
274 $self->_inline_throw_error(
275 '"Single parameters to new() must be a HASH ref"',
279 '$params = { %{ $_[0] } };',
283 '"The new() method for ' . $class . ' expects a '
284 . 'hash reference or a key/value list. You passed an '
285 . 'odd number of arguments"',
287 '$params = {@_, undef};',
297 return $class . '->BUILDARGS(' . $args . ')';
301 sub _inline_slot_initializer {
303 my ($attr, $idx) = @_;
307 $self->_inline_check_required_attr($attr),
308 $self->SUPER::_inline_slot_initializer(@_),
312 sub _inline_check_required_attr {
316 return unless defined $attr->init_arg;
317 return unless $attr->can('is_required') && $attr->is_required;
318 return if $attr->has_default || $attr->has_builder;
321 'if (!exists $params->{\'' . $attr->init_arg . '\'}) {',
322 $self->_inline_throw_error(
323 '"Attribute (' . quotemeta($attr->name) . ') is required"'
329 # XXX: these two are duplicated from cmop, because we have to pass the tc stuff
330 # through to _inline_set_value - this should probably be fixed, but i'm not
331 # quite sure how. -doy
332 sub _inline_init_attr_from_constructor {
334 my ($attr, $idx) = @_;
336 my @initial_value = $attr->_inline_set_value(
338 '$params->{\'' . $attr->init_arg . '\'}',
339 '$type_constraint_bodies[' . $idx . ']',
340 '$type_constraints[' . $idx . ']',
344 push @initial_value, (
345 '$attrs->[' . $idx . ']->set_initial_value(',
347 $attr->_inline_instance_get('$instance'),
349 ) if $attr->has_initializer;
351 return @initial_value;
354 sub _inline_init_attr_from_default {
356 my ($attr, $idx) = @_;
358 return if $attr->can('is_lazy') && $attr->is_lazy;
359 my $default = $self->_inline_default_value($attr, $idx);
360 return unless $default;
362 my @initial_value = (
363 'my $default = ' . $default . ';',
364 $attr->_inline_set_value(
367 '$type_constraint_bodies[' . $idx . ']',
368 '$type_constraints[' . $idx . ']',
373 push @initial_value, (
374 '$attrs->[' . $idx . ']->set_initial_value(',
376 $attr->_inline_instance_get('$instance'),
378 ) if $attr->has_initializer;
380 return @initial_value;
383 sub _inline_extra_init {
386 $self->_inline_triggers,
387 $self->_inline_BUILDALL,
391 sub _inline_triggers {
395 my @attrs = sort { $a->name cmp $b->name } $self->get_all_attributes;
396 for my $i (0 .. $#attrs) {
397 my $attr = $attrs[$i];
399 next unless $attr->can('has_trigger') && $attr->has_trigger;
401 my $init_arg = $attr->init_arg;
402 next unless defined $init_arg;
405 'if (exists $params->{\'' . $init_arg . '\'}) {',
406 '$attrs->[' . $i . ']->trigger->(',
408 $attr->_inline_instance_get('$instance') . ',',
413 return @trigger_calls;
416 sub _inline_BUILDALL {
419 my @methods = reverse $self->find_all_methods_by_name('BUILD');
422 foreach my $method (@methods) {
424 '$instance->' . $method->{class} . '::BUILD($params);';
432 my $supers = Data::OptList::mkopt(\@_);
433 foreach my $super (@{ $supers }) {
434 my ($name, $opts) = @{ $super };
435 Class::MOP::load_class($name, $opts);
436 my $meta = Class::MOP::class_of($name);
437 $self->throw_error("You cannot inherit from a Moose Role ($name)")
438 if $meta && $meta->isa('Moose::Meta::Role')
440 return $self->SUPER::superclasses(map { $_->[0] } @{ $supers });
443 ### ---------------------------------------------
448 (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
450 : $self->_process_attribute(@_));
451 $self->SUPER::add_attribute($attr);
452 # it may be a Class::MOP::Attribute, theoretically, which doesn't have
453 # 'bare' and doesn't implement this method
454 if ($attr->can('_check_associated_methods')) {
455 $attr->_check_associated_methods;
460 sub add_override_method_modifier {
461 my ($self, $name, $method, $_super_package) = @_;
463 (!$self->has_method($name))
464 || $self->throw_error("Cannot add an override method if a local method is already present");
466 $self->add_method($name => Moose::Meta::Method::Overridden->new(
469 package => $_super_package, # need this for roles
474 sub add_augment_method_modifier {
475 my ($self, $name, $method) = @_;
476 (!$self->has_method($name))
477 || $self->throw_error("Cannot add an augment method if a local method is already present");
479 $self->add_method($name => Moose::Meta::Method::Augmented->new(
486 ## Private Utility methods ...
488 sub _find_next_method_by_name_which_is_not_overridden {
489 my ($self, $name) = @_;
490 foreach my $method ($self->find_all_methods_by_name($name)) {
491 return $method->{code}
492 if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overridden');
497 ## Metaclass compatibility
499 sub _base_metaclasses {
501 my %metaclasses = $self->SUPER::_base_metaclasses;
502 for my $class (keys %metaclasses) {
503 $metaclasses{$class} =~ s/^Class::MOP/Moose::Meta/;
507 error_class => 'Moose::Error::Default',
511 sub _fix_class_metaclass_incompatibility {
513 my ($super_meta) = @_;
515 $self->SUPER::_fix_class_metaclass_incompatibility(@_);
517 if ($self->_class_metaclass_can_be_made_compatible($super_meta)) {
519 || confess "Can't fix metaclass incompatibility for "
521 . " because it is not pristine.";
522 my $super_meta_name = $super_meta->_real_ref_name;
523 my $class_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass(blessed($self), $super_meta_name);
524 my $new_self = $class_meta_subclass_meta_name->reinitialize(
528 $self->_replace_self( $new_self, $class_meta_subclass_meta_name );
532 sub _fix_single_metaclass_incompatibility {
534 my ($metaclass_type, $super_meta) = @_;
536 $self->SUPER::_fix_single_metaclass_incompatibility(@_);
538 if ($self->_single_metaclass_can_be_made_compatible($super_meta, $metaclass_type)) {
540 || confess "Can't fix metaclass incompatibility for "
542 . " because it is not pristine.";
543 my $super_meta_name = $super_meta->_real_ref_name;
544 my $class_specific_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass($self->$metaclass_type, $super_meta->$metaclass_type);
545 my $new_self = $super_meta->reinitialize(
547 $metaclass_type => $class_specific_meta_subclass_meta_name,
550 $self->_replace_self( $new_self, $super_meta_name );
556 my ( $new_self, $new_class) = @_;
559 bless $self, $new_class;
561 # We need to replace the cached metaclass instance or else when it goes
562 # out of scope Class::MOP::Class destroy's the namespace for the
563 # metaclass's class, causing much havoc.
564 my $weaken = Class::MOP::metaclass_is_weak( $self->name );
565 Class::MOP::store_metaclass_by_name( $self->name, $self );
566 Class::MOP::weaken_metaclass( $self->name ) if $weaken;
569 sub _process_attribute {
570 my ( $self, $name, @args ) = @_;
572 @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
574 if (($name || '') =~ /^\+(.*)/) {
575 return $self->_process_inherited_attribute($1, @args);
578 return $self->_process_new_attribute($name, @args);
582 sub _process_new_attribute {
583 my ( $self, $name, @args ) = @_;
585 $self->attribute_metaclass->interpolate_class_and_new($name, @args);
588 sub _process_inherited_attribute {
589 my ($self, $attr_name, %options) = @_;
590 my $inherited_attr = $self->find_attribute_by_name($attr_name);
591 (defined $inherited_attr)
592 || $self->throw_error("Could not find an attribute by the name of '$attr_name' to inherit from in ${\$self->name}", data => $attr_name);
593 if ($inherited_attr->isa('Moose::Meta::Attribute')) {
594 return $inherited_attr->clone_and_inherit_options(%options);
598 # kind of a kludge to handle Class::MOP::Attributes
599 return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
603 # reinitialization support
605 sub _restore_metaobjects_from {
609 $self->SUPER::_restore_metaobjects_from($old_meta);
611 for my $role ( @{ $old_meta->roles } ) {
612 $self->add_role($role);
615 for my $application ( @{ $old_meta->_get_role_applications } ) {
616 $application->class($self);
617 $self->add_role_application ($application);
623 sub _immutable_options {
624 my ( $self, @args ) = @_;
626 $self->SUPER::_immutable_options(
627 inline_destructor => 1,
629 # Moose always does this when an attribute is created
630 inline_accessors => 0,
636 ## -------------------------------------------------
641 my ( $self, @args ) = @_;
642 local $error_level = ($error_level || 0) + 1;
643 $self->raise_error($self->create_error(@args));
646 sub _inline_throw_error {
647 my ( $self, $msg, $args ) = @_;
648 "\$meta->throw_error($msg" . ($args ? ", $args" : "") . ")"; # FIXME makes deparsing *REALLY* hard
652 my ( $self, @args ) = @_;
657 my ( $self, @args ) = @_;
661 local $error_level = ($error_level || 0 ) + 1;
663 if ( @args % 2 == 1 ) {
664 unshift @args, "message";
667 my %args = ( metaclass => $self, last_error => $@, @args );
669 $args{depth} += $error_level;
671 my $class = ref $self ? $self->error_class : "Moose::Error::Default";
673 Class::MOP::load_class($class);
676 Carp::caller_info($args{depth}),
683 # ABSTRACT: The Moose metaclass
691 This class is a subclass of L<Class::MOP::Class> that provides
692 additional Moose-specific functionality.
694 To really understand this class, you will need to start with the
695 L<Class::MOP::Class> documentation. This class can be understood as a
696 set of additional features on top of the basic feature provided by
701 C<Moose::Meta::Class> is a subclass of L<Class::MOP::Class>.
707 =item B<< Moose::Meta::Class->initialize($package_name, %options) >>
709 This overrides the parent's method in order to provide its own
710 defaults for the C<attribute_metaclass>, C<instance_metaclass>, and
711 C<method_metaclass> options.
713 These all default to the appropriate Moose class.
715 =item B<< Moose::Meta::Class->create($package_name, %options) >>
717 This overrides the parent's method in order to accept a C<roles>
718 option. This should be an array reference containing roles
719 that the class does, each optionally followed by a hashref of options
720 (C<-excludes> and C<-alias>).
722 my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
724 =item B<< Moose::Meta::Class->create_anon_class >>
726 This overrides the parent's method to accept a C<roles> option, just
729 It also accepts a C<cache> option. If this is true, then the anonymous
730 class will be cached based on its superclasses and roles. If an
731 existing anonymous class in the cache has the same superclasses and
732 roles, it will be reused.
734 my $metaclass = Moose::Meta::Class->create_anon_class(
735 superclasses => ['Foo'],
736 roles => [qw/Some Roles Go Here/],
740 Each entry in both the C<superclasses> and the C<roles> option can be
741 followed by a hash reference with arguments. The C<superclasses>
742 option can be supplied with a L<-version|Class::MOP/Class Loading
743 Options> option that ensures the loaded superclass satisfies the
744 required version. The C<role> option also takes the C<-version> as an
745 argument, but the option hash reference can also contain any other
746 role relevant values like exclusions or parameterized role arguments.
748 =item B<< $metaclass->make_immutable(%options) >>
750 This overrides the parent's method to add a few options. Specifically,
751 it uses the Moose-specific constructor and destructor classes, and
752 enables inlining the destructor.
754 Since Moose always inlines attributes, it sets the C<inline_accessors> option
757 =item B<< $metaclass->new_object(%params) >>
759 This overrides the parent's method in order to add support for
762 =item B<< $metaclass->superclasses(@superclasses) >>
764 This is the accessor allowing you to read or change the parents of
767 Each superclass can be followed by a hash reference containing a
768 L<-version|Class::MOP/Class Loading Options> value. If the version
769 requirement is not satisfied an error will be thrown.
771 =item B<< $metaclass->add_override_method_modifier($name, $sub) >>
773 This adds an C<override> method modifier to the package.
775 =item B<< $metaclass->add_augment_method_modifier($name, $sub) >>
777 This adds an C<augment> method modifier to the package.
779 =item B<< $metaclass->calculate_all_roles >>
781 This will return a unique array of C<Moose::Meta::Role> instances
782 which are attached to this class.
784 =item B<< $metaclass->calculate_all_roles_with_inheritance >>
786 This will return a unique array of C<Moose::Meta::Role> instances
787 which are attached to this class, and each of this class's ancestors.
789 =item B<< $metaclass->add_role($role) >>
791 This takes a L<Moose::Meta::Role> object, and adds it to the class's
792 list of roles. This I<does not> actually apply the role to the class.
794 =item B<< $metaclass->role_applications >>
796 Returns a list of L<Moose::Meta::Role::Application::ToClass>
797 objects, which contain the arguments to role application.
799 =item B<< $metaclass->add_role_application($application) >>
801 This takes a L<Moose::Meta::Role::Application::ToClass> object, and
802 adds it to the class's list of role applications. This I<does not>
803 actually apply any role to the class; it is only for tracking role
806 =item B<< $metaclass->does_role($role) >>
808 This returns a boolean indicating whether or not the class does the specified
809 role. The role provided can be either a role name or a L<Moose::Meta::Role>
810 object. This tests both the class and its parents.
812 =item B<< $metaclass->excludes_role($role_name) >>
814 A class excludes a role if it has already composed a role which
815 excludes the named role. This tests both the class and its parents.
817 =item B<< $metaclass->add_attribute($attr_name, %params|$params) >>
819 This overrides the parent's method in order to allow the parameters to
820 be provided as a hash reference.
822 =item B<< $metaclass->constructor_class($class_name) >>
824 =item B<< $metaclass->destructor_class($class_name) >>
826 These are the names of classes used when making a class immutable. These
827 default to L<Moose::Meta::Method::Constructor> and
828 L<Moose::Meta::Method::Destructor> respectively. These accessors are
829 read-write, so you can use them to change the class name.
831 =item B<< $metaclass->error_class($class_name) >>
833 The name of the class used to throw errors. This defaults to
834 L<Moose::Error::Default>, which generates an error with a stacktrace
835 just like C<Carp::confess>.
837 =item B<< $metaclass->throw_error($message, %extra) >>
839 Throws the error created by C<create_error> using C<raise_error>
845 See L<Moose/BUGS> for details on reporting bugs.