X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FClass.pm;h=47fd2666625b06af29b0ace6d227cbc2702f0792;hb=d9659f80a6e4f20234968fcc003570c0da6b6ff1;hp=e8593f641342324a451cb92c667d7f93537cdd11;hpb=8aba926dbf11e9cf418c7c79b925d15e60e1e990;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm index e8593f6..47fd266 100644 --- a/lib/Mouse/Meta/Class.pm +++ b/lib/Mouse/Meta/Class.pm @@ -6,12 +6,19 @@ use Scalar::Util qw/blessed weaken/; use Mouse::Meta::Module; our @ISA = qw(Mouse::Meta::Module); -sub method_metaclass; sub attribute_metaclass; +sub method_metaclass; sub constructor_class; sub destructor_class; +my @MetaClassTypes = qw( + attribute_metaclass + method_metaclass + constructor_class + destructor_class +); + sub _construct_meta { my($class, %args) = @_; @@ -54,9 +61,16 @@ sub superclasses { foreach my $super(@_){ Mouse::Util::load_class($super); my $meta = Mouse::Util::get_metaclass_by_name($super); + + next if not defined $meta; + if(Mouse::Util::is_a_metarole($meta)){ $self->throw_error("You cannot inherit from a Mouse Role ($super)"); } + + next if $self->isa(ref $meta); # _superclass_meta_is_compatible + + $self->_reconcile_with_superclass_meta($meta); } @{ $self->{superclasses} } = @_; } @@ -64,6 +78,40 @@ sub superclasses { return @{ $self->{superclasses} }; } +sub _reconcile_with_superclass_meta { + my($self, $super_meta) = @_; + + my @incompatibles; + + foreach my $metaclass_type(@MetaClassTypes){ + my $super_c = $super_meta->$metaclass_type(); + my $self_c = $self->$metaclass_type(); + + if(!$super_c->isa($self_c)){ + push @incompatibles, ($metaclass_type => $super_c); + } + } + + my @roles; + + foreach my $role($self->meta->calculate_all_roles){ + if(!$super_meta->meta->does_role($role->name)){ + push @roles, $role->name; + } + } + + #print "reconcile($self vs. $super_meta; @roles; @incompatibles)\n"; + + require Mouse::Util::MetaRole; + Mouse::Util::MetaRole::apply_metaclass_roles( + for_class => $self, + metaclass => ref $super_meta, + metaclass_roles => \@roles, + @incompatibles, + ); + return; +} + sub find_method_by_name{ my($self, $method_name) = @_; defined($method_name) @@ -485,8 +533,56 @@ metaclass. Throws an error with the given message. +=head3 OTHER PUBLIC METHODS + +=head3 add_after_method_modifier + +=head3 add_around_method_modifier + +=head3 add_augment_method_modifier + +=head3 add_before_method_modifier + +=head3 add_override_method_modifier + +=head3 attribute_metaclass + +=head3 calculate_all_roles + +=head3 compute_all_applicable_attributes + +=head3 constructor_class + +=head3 create_anon_class + +=head3 destructor_class + +=head3 does_role + +=head3 find_attribute_by_name + +=head3 find_method_by_name + +=head3 get_all_method_names + +=head3 is_anon_class + +=head3 is_immutable + +=head3 is_mutable + +=head3 make_immutable + +=head3 make_mutable + +=head3 method_metaclass + +=head3 roles + =head1 SEE ALSO +L + L L