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=a37a963618928d27466c960b32558cc9f8ea30b5;hp=dda62845fc14b6c4e0f53af2ac86b3fe6c1e01c4;hb=bd76a699d654075009bb9fd707021721eecf8299;hpb=29422d0044fd1ee33ccb2e947e39d4f04001a2a2 diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm index dda6284..a37a963 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) = @_; @@ -71,13 +78,6 @@ sub superclasses { return @{ $self->{superclasses} }; } -my @MetaClassTypes = qw( - attribute_metaclass - method_metaclass - constructor_class - destructor_class -); - sub _reconcile_with_superclass_meta { my($self, $super_meta) = @_; @@ -92,11 +92,26 @@ sub _reconcile_with_superclass_meta { } } - $super_meta->reinitialize($self, @incompatibles); + 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) @@ -179,9 +194,9 @@ sub add_attribute { 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(@_) } @@ -203,22 +218,30 @@ sub clone_object { 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}++; @@ -241,10 +264,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 ) = @_; @@ -318,7 +345,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 () }; $@; }; @@ -327,7 +354,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; @@ -435,7 +462,7 @@ Mouse::Meta::Class - The Mouse class metaclass =head1 VERSION -This document describes Mouse version 0.40_07 +This document describes Mouse version 0.47 =head1 METHODS @@ -520,6 +547,8 @@ Throws an error with the given message. =head1 SEE ALSO +L + L L