From: gfx Date: Fri, 2 Oct 2009 10:43:42 +0000 (+0900) Subject: Tidy X-Git-Tag: 0.37_02~33 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=926290ac173b77f0ff0027dcbd95277c9cc2be54;p=gitmo%2FMouse.git Tidy --- diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index dffcb22..4c24850 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -142,11 +142,11 @@ sub new { $args{name} = $name; - my $instance = bless \%args, $class; + my $self = bless \%args, $class; # extra attributes if($class ne __PACKAGE__){ - $class->meta->_initialize_instance($instance,\%args); + $class->meta->_initialize_object($self, \%args); } # XXX: there is no fast way to check attribute validity @@ -156,7 +156,7 @@ sub new { # Carp::cluck("Found unknown argument(s) passed to '$name' attribute constructor in '$class': @bad"); # } - return $instance; + return $self; } # readers diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm index cc3824d..99944e8 100644 --- a/lib/Mouse/Meta/Class.pm +++ b/lib/Mouse/Meta/Class.pm @@ -159,14 +159,14 @@ sub new_object { my $self = shift; my %args = (@_ == 1 ? %{$_[0]} : @_); - my $instance = bless {}, $self->name; + my $object = bless {}, $self->name; - $self->_initialize_instance($instance, \%args); - return $instance; + $self->_initialize_object($object, \%args); + return $object; } -sub _initialize_instance{ - my($self, $instance, $args) = @_; +sub _initialize_object{ + my($self, $object, $args) = @_; my @triggers_queue; @@ -175,13 +175,13 @@ sub _initialize_instance{ my $key = $attribute->name; if (defined($from) && exists($args->{$from})) { - $instance->{$key} = $attribute->_coerce_and_verify($args->{$from}); + $object->{$key} = $attribute->_coerce_and_verify($args->{$from}); - weaken($instance->{$key}) - if ref($instance->{$key}) && $attribute->is_weak_ref; + weaken($object->{$key}) + if ref($object->{$key}) && $attribute->is_weak_ref; if ($attribute->has_trigger) { - push @triggers_queue, [ $attribute->trigger, $instance->{$from} ]; + push @triggers_queue, [ $attribute->trigger, $object->{$key} ]; } } else { @@ -189,15 +189,15 @@ sub _initialize_instance{ unless ($attribute->is_lazy) { my $default = $attribute->default; my $builder = $attribute->builder; - my $value = $builder ? $instance->$builder() - : ref($default) eq 'CODE' ? $instance->$default() + my $value = $builder ? $object->$builder() + : ref($default) eq 'CODE' ? $object->$default() : $default; # XXX: we cannot use $attribute->set_value() because it invokes triggers. - $instance->{$key} = $attribute->_coerce_and_verify($value, $instance);; + $object->{$key} = $attribute->_coerce_and_verify($value, $object);; - weaken($instance->{$key}) - if ref($instance->{$key}) && $attribute->is_weak_ref; + weaken($object->{$key}) + if ref($object->{$key}) && $attribute->is_weak_ref; } } else { @@ -210,35 +210,28 @@ sub _initialize_instance{ foreach my $trigger_and_value(@triggers_queue){ my($trigger, $value) = @{$trigger_and_value}; - $trigger->($instance, $value); + $trigger->($object, $value); } if($self->is_anon_class){ - $instance->{__METACLASS__} = $self; + $object->{__METACLASS__} = $self; } - return $instance; + return $object; } sub clone_object { - my $class = shift; - my $instance = shift; - my %params = (@_ == 1) ? %{$_[0]} : @_; + my $class = shift; + my $object = shift; + my %params = (@_ == 1) ? %{$_[0]} : @_; - (blessed($instance) && $instance->isa($class->name)) - || $class->throw_error("You must pass an instance of the metaclass (" . $class->name . "), not ($instance)"); + (blessed($object) && $object->isa($class->name)) + || $class->throw_error("You must pass an instance of the metaclass (" . $class->name . "), not ($object)"); - my $clone = bless { %$instance }, ref $instance; + my $cloned = bless { %$object }, ref $object; + $class->_initialize_object($cloned, \%params); - foreach my $attr ($class->get_all_attributes()) { - if ( defined( my $init_arg = $attr->init_arg ) ) { - if (exists $params{$init_arg}) { - $clone->{ $attr->name } = $params{$init_arg}; - } - } - } - - return $clone; + return $cloned; } sub clone_instance { diff --git a/t/031-clone.t b/t/031-clone.t index be9cfa1..cc39e22 100644 --- a/t/031-clone.t +++ b/t/031-clone.t @@ -1,9 +1,10 @@ #!/usr/bin/env perl use strict; use warnings; -use Test::More tests => 9; +use Test::More tests => 12; use Test::Exception; +my %triggered; do { package Foo; use Mouse; @@ -27,6 +28,10 @@ do { has quux => ( is => 'rw', init_arg => 'quuux', + trigger => sub{ + my($self, $value) = @_; + $triggered{$self} = $value; + }, ); sub clone { @@ -39,11 +44,17 @@ my $foo = Foo->new(bar => [ 1, 2, 3 ], quuux => "indeed"); is($foo->foo, "foo", "attr 1",); is($foo->quux, "indeed", "init_arg respected"); + +is $triggered{$foo}, "indeed"; + is_deeply($foo->bar, [ 1 .. 3 ], "attr 2"); $foo->baz("foo"); my $clone = $foo->clone(foo => "dancing", baz => "bar", quux => "nope", quuux => "yes"); +is $triggered{$foo}, "indeed"; +is $triggered{$clone}, "yes", 'clone_object() invokes triggers'; + is($clone->foo, "dancing", "overridden attr"); is_deeply($clone->bar, [ 1 .. 3 ], "clone attr"); is($clone->baz, "foo", "init_arg=undef means the attr is ignored"); @@ -55,6 +66,6 @@ throws_ok { throws_ok { Foo->meta->clone_object(Foo->meta) -} qr/You must pass an instance of the metaclass \(Foo\), not \(Mo.se::Meta::Class=HASH\(\w+\)\)/; +} qr/You must pass an instance of the metaclass \(Foo\), not \(Mouse::Meta::Class=HASH\(\w+\)\)/;