X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FClass.pm;h=b849e42b477639a8d5e3e369e73e634ed32877ff;hb=4bcbbb57ec37a9eeff3d7207fad57645d7254560;hp=de9da9020d27a631f2d8ebfaa0e6f0fa020c36cb;hpb=b90dd4efb05376361de7651f3d1fbfb60ac300a5;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index de9da90..b849e42 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -8,10 +8,10 @@ use Class::MOP; use Carp (); use List::Util qw( first ); -use List::MoreUtils qw( any all uniq ); +use List::MoreUtils qw( any all uniq first_index ); use Scalar::Util 'weaken', 'blessed'; -our $VERSION = '0.77'; +our $VERSION = '0.89_01'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -30,11 +30,10 @@ __PACKAGE__->meta->add_attribute('roles' => ( )); __PACKAGE__->meta->add_attribute('role_applications' => ( - reader => 'role_applications', + reader => '_get_role_applications', default => sub { [] } )); - __PACKAGE__->meta->add_attribute( Class::MOP::Attribute->new('immutable_trait' => ( accessor => "immutable_trait", @@ -141,11 +140,37 @@ sub add_role { push @{$self->roles} => $role; } +sub make_immutable { + my $self = shift; + + # we do this for metaclasses way too often to do this check for them + if ( !$self->name->isa('Class::MOP::Object') ) { + my @superclasses = grep { $_ ne 'Moose::Object' && $_ ne $self->name } + $self->linearized_isa; + for my $superclass (@superclasses) { + my $meta = Class::MOP::class_of($superclass); + next unless $meta && $meta->isa('Moose::Meta::Class'); + next unless $meta->is_mutable; + Carp::cluck( "Calling make_immutable on " + . $self->name + . ", which has a mutable ancestor ($superclass)" ); + last; + } + } + $self->SUPER::make_immutable(@_); +} + +sub role_applications { + my ($self) = @_; + + return @{$self->_get_role_applications}; +} + sub add_role_application { my ($self, $application) = @_; (blessed($application) && $application->isa('Moose::Meta::Role::Application::ToClass')) || $self->throw_error("Role applications must be instances of Moose::Meta::Role::Application::ToClass", data => $application); - push @{$self->role_applications} => $application; + push @{$self->_get_role_applications} => $application; } sub calculate_all_roles { @@ -222,27 +247,13 @@ sub new_object { return $self; } -sub _construct_instance { - my $class = shift; - my $params = @_ == 1 ? $_[0] : {@_}; - my $meta_instance = $class->get_meta_instance; - # FIXME: - # the code below is almost certainly incorrect - # but this is foreign inheritance, so we might - # have to kludge it in the end. - my $instance = $params->{'__INSTANCE__'} || $meta_instance->create_instance(); - foreach my $attr ($class->get_all_attributes()) { - $attr->initialize_instance_slot($meta_instance, $instance, $params); - } - return $instance; -} - sub superclasses { my $self = shift; my @supers = @_; foreach my $super (@supers) { - my $meta = Class::MOP::load_class($super); - Moose->throw_error("You cannot inherit from a Moose Role ($super)") + Class::MOP::load_class($super); + my $meta = Class::MOP::class_of($super); + $self->throw_error("You cannot inherit from a Moose Role ($super)") if $meta && $meta->isa('Moose::Meta::Role') } return $self->SUPER::superclasses(@supers); @@ -252,11 +263,17 @@ sub superclasses { sub add_attribute { my $self = shift; - $self->SUPER::add_attribute( + my $attr = (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute') ? $_[0] - : $self->_process_attribute(@_)) - ); + : $self->_process_attribute(@_)); + $self->SUPER::add_attribute($attr); + # it may be a Class::MOP::Attribute, theoretically, which doesn't have + # 'bare' and doesn't implement this method + if ($attr->can('_check_associated_methods')) { + $attr->_check_associated_methods; + } + return $attr; } sub add_override_method_modifier { @@ -300,24 +317,47 @@ sub _fix_metaclass_incompatibility { my ($self, @superclasses) = @_; foreach my $super (@superclasses) { - next if $self->_superclass_meta_is_compatible($super); + my $meta = Class::MOP::Class->initialize($super); - unless ( $self->is_pristine ) { - $self->throw_error( - "Cannot attempt to reinitialize metaclass for " - . $self->name - . ", it isn't pristine" ); + my @all_supers = $meta->linearized_isa; + shift @all_supers; + + my @super_metas_to_fix = ($meta); + + # We need to check & fix the immediate superclass. If its @ISA + # contains a class without a metaclass instance, followed by a + # class _with_ a metaclass instance, init a metaclass instance + # for classes without one and fix compat up to and including + # the class which was already initialized. + my $idx = first_index { Class::MOP::class_of($_) } @all_supers; + + push @super_metas_to_fix, + map { Class::MOP::Class->initialize($_) } @all_supers[ 0 .. $idx ] + if $idx >= 0; + + foreach my $super_meta (@super_metas_to_fix) { + $self->_fix_one_incompatible_metaclass($super_meta); } + } +} + +sub _fix_one_incompatible_metaclass { + my ($self, $meta) = @_; - $self->_reconcile_with_superclass_meta($super); + return if $self->_superclass_meta_is_compatible($meta); + + unless ( $self->is_pristine ) { + $self->throw_error( + "Cannot attempt to reinitialize metaclass for " + . $self->name + . ", it isn't pristine" ); } + + $self->_reconcile_with_superclass_meta($meta); } sub _superclass_meta_is_compatible { - my ($self, $super) = @_; - - my $super_meta = Class::MOP::Class->initialize($super) - or return 1; + my ($self, $super_meta) = @_; next unless $super_meta->isa("Class::MOP::Class"); @@ -343,9 +383,7 @@ my @MetaClassTypes = error_class ); sub _reconcile_with_superclass_meta { - my ($self, $super) = @_; - - my $super_meta = Class::MOP::class_of($super); + my ($self, $super_meta) = @_; my $super_meta_name = $super_meta->is_immutable @@ -655,7 +693,7 @@ These all default to the appropriate Moose class. This overrides the parent's method in order to accept a C option. This should be an array reference containing one more roles -that the class does. +that the class does, each optionally followed by a hashref of options. my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] ); @@ -709,7 +747,7 @@ list of roles. This I actually apply the role to the class. =item B<< $metaclass->role_applications >> -Returns an array reference of L +Returns a list of L objects, which contain the arguments to role application. =item B<< $metaclass->add_role_application($application) >>