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=d95e4bed022b73ba28bb047d954ba9b20c756e72;hp=20605ad079f76e55e87fcf729abbce7efa4666bd;hb=2053291d1c9bd8c8008259f872fbce78f97d040c;hpb=ecb77ca40583d35617313267443dfc4970c3599a diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm index 20605ad..d95e4be 100644 --- a/lib/Mouse/Meta/Class.pm +++ b/lib/Mouse/Meta/Class.pm @@ -194,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(@_) } @@ -207,33 +207,41 @@ 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}++; @@ -256,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 ) = @_; @@ -333,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 () }; $@; }; @@ -342,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; @@ -450,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