X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FClass.pm;h=607de86a1bd0d2a7a202b040a506945586669ae2;hp=e8593f641342324a451cb92c667d7f93537cdd11;hb=3b48bcc824fb6cfa90f907cf4d83e01c224a72dd;hpb=8aba926dbf11e9cf418c7c79b925d15e60e1e990 diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm index e8593f6..607de86 100644 --- a/lib/Mouse/Meta/Class.pm +++ b/lib/Mouse/Meta/Class.pm @@ -6,12 +6,21 @@ use Scalar::Util qw/blessed weaken/; use Mouse::Meta::Module; our @ISA = qw(Mouse::Meta::Module); -sub method_metaclass; +our @CARP_NOT = qw(Mouse); # trust Mouse + 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 +63,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 +80,39 @@ sub superclasses { return @{ $self->{superclasses} }; } +sub _reconcile_with_superclass_meta { + my($self, $super_meta) = @_; + + # find incompatible traits + 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($super_meta->meta->calculate_all_roles){ + if(!$self->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) @@ -140,15 +189,16 @@ sub add_attribute { $self->{attributes}{$attr->name} = $attr; $attr->install_accessors(); - if(Mouse::Util::_MOUSE_VERBOSE && !$attr->{associated_methods} && ($attr->{is} || '') ne 'bare'){ - Carp::cluck(qq{Attribute (}.$attr->name.qq{) of class }.$self->name.qq{ has no associated methods (did you mean to provide an "is" argument?)}); + if(!$attr->{associated_methods} && ($attr->{is} || '') ne 'bare'){ + Carp::carp(qq{Attribute ($name) of class }.$self->name + .qq{ has no associated methods (did you mean to provide an "is" argument?)}); } return $attr; } -sub compute_all_applicable_attributes { - Carp::cluck('compute_all_applicable_attributes() has been deprecated') - if Mouse::Util::_MOUSE_VERBOSE; +sub compute_all_applicable_attributes { # DEPRECATED + Carp::cluck('compute_all_applicable_attributes() has been deprecated. Use get_all_attributes() instead'); + return shift->get_all_attributes(@_) } @@ -159,48 +209,56 @@ sub new_object; sub clone_object { my $class = shift; my $object = shift; - my %params = (@_ == 1) ? %{$_[0]} : @_; + my $args = $object->Mouse::Object::BUILDARGS(@_); (blessed($object) && $object->isa($class->name)) || $class->throw_error("You must pass an instance of the metaclass (" . $class->name . "), not ($object)"); my $cloned = bless { %$object }, ref $object; - $class->_initialize_object($cloned, \%params); + $class->_initialize_object($cloned, $args); return $cloned; } -sub clone_instance { +sub clone_instance { # DEPRECATED my ($class, $instance, %params) = @_; - Carp::cluck('clone_instance has been deprecated. Use clone_object instead') - if Mouse::Util::_MOUSE_VERBOSE; + Carp::cluck('clone_instance() has been deprecated. Use clone_object() instead'); + return $class->clone_object($instance, %params); } -sub make_immutable { - my $self = shift; - my %args = ( + +sub immutable_options { + my ( $self, @args ) = @_; + + return ( inline_constructor => 1, inline_destructor => 1, constructor_name => 'new', - @_, + @args, ); +} + + +sub make_immutable { + my $self = shift; + my %args = $self->immutable_options(@_); $self->{is_immutable}++; + $self->{strict_constructor} = $args{strict_constructor}; + if ($args{inline_constructor}) { - my $c = $self->constructor_class; - Mouse::Util::load_class($c); $self->add_method($args{constructor_name} => - $c->_generate_constructor($self, \%args)); + Mouse::Util::load_class($self->constructor_class) + ->_generate_constructor($self, \%args)); } if ($args{inline_destructor}) { - my $c = $self->destructor_class; - Mouse::Util::load_class($c); $self->add_method(DESTROY => - $c->_generate_destructor($self, \%args)); + Mouse::Util::load_class($self->destructor_class) + ->_generate_destructor($self, \%args)); } # Moose's make_immutable returns true allowing calling code to skip setting an explicit true value @@ -208,10 +266,14 @@ sub make_immutable { return 1; } -sub make_mutable { not_supported } +sub make_mutable { + my($self) = @_; + $self->{is_immutable} = 0; + return; +} -sub is_immutable { $_[0]->{is_immutable} } -sub is_mutable { !$_[0]->{is_immutable} } +sub is_immutable; +sub is_mutable { !$_[0]->is_immutable } sub _install_modifier_pp{ my( $self, $type, $name, $code ) = @_; @@ -285,7 +347,7 @@ sub _install_modifier { # load Class::Method::Modifiers first my $no_cmm_fast = do{ local $@; - eval q{ require Class::Method::Modifiers::Fast }; + eval q{ use Class::Method::Modifiers::Fast 0.041 () }; $@; }; @@ -294,7 +356,7 @@ sub _install_modifier { $impl = \&_install_modifier_pp; } else{ - my $install_modifier = Class::Method::Modifiers::Fast->can('_install_modifier'); + my $install_modifier = Class::Method::Modifiers::Fast->can('install_modifier'); $impl = sub { my ( $self, $type, $name, $code ) = @_; my $into = $self->name; @@ -402,7 +464,7 @@ Mouse::Meta::Class - The Mouse class metaclass =head1 VERSION -This document describes Mouse version 0.40_07 +This document describes Mouse version 0.50_03 =head1 METHODS @@ -487,6 +549,8 @@ Throws an error with the given message. =head1 SEE ALSO +L + L L