X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FObject.pm;h=8871a19250662f4365d2ae902d964720e010254b;hp=079aa80bf0e5a473b6134b00cbd38136d4705dcf;hb=3a63a2e7ef8fbac5f61eab04baecbf5d19374b83;hpb=56a558f97f2da37b37db51a6a8ef7f923e84724e diff --git a/lib/Mouse/Object.pm b/lib/Mouse/Object.pm index 079aa80..8871a19 100644 --- a/lib/Mouse/Object.pm +++ b/lib/Mouse/Object.pm @@ -12,7 +12,7 @@ sub new { my $instance = bless {}, $class; - for my $attribute ($class->meta->compute_all_applicable_attributes) { + for my $attribute ($class->meta->get_all_attributes) { my $from = $attribute->init_arg; my $key = $attribute->name; @@ -27,7 +27,7 @@ sub new { if ref($instance->{$key}) && $attribute->is_weak_ref; if ($attribute->has_trigger) { - $attribute->trigger->($instance, $args->{$from}, $attribute); + $attribute->trigger->($instance, $args->{$from}); } } else { @@ -68,13 +68,9 @@ sub BUILDARGS { my $class = shift; if (scalar @_ == 1) { - if (defined $_[0]) { - (ref($_[0]) eq 'HASH') - || confess "Single parameters to new() must be a HASH ref"; - return {%{$_[0]}}; - } else { - return {}; - } + (ref($_[0]) eq 'HASH') + || confess "Single parameters to new() must be a HASH ref"; + return {%{$_[0]}}; } else { return {@_}; @@ -96,6 +92,7 @@ sub BUILDALL { or next; $code->($self, @_); } + return; } sub DEMOLISHALL { @@ -106,18 +103,32 @@ sub DEMOLISHALL { no strict 'refs'; - for my $class ($self->meta->linearized_isa) { - my $code = *{ $class . '::DEMOLISH' }{CODE} - or next; - $code->($self, @_); + my @isa; + if ( my $meta = Mouse::Meta::Class::class_of($self) ) { + @isa = $meta->linearized_isa; + } else { + # We cannot count on being able to retrieve a previously made + # metaclass, _or_ being able to make a new one during global + # destruction. However, we should still be able to use mro at + # that time (at least tests suggest so ;) + my $class_name = ref $self; + @isa = @{ Mouse::Util::get_linear_isa($class_name) } } + + foreach my $class (@isa) { + no strict 'refs'; + my $demolish = *{"${class}::DEMOLISH"}{CODE}; + $self->$demolish + if defined $demolish; + } + return; } sub dump { my $self = shift; require Data::Dumper; local $Data::Dumper::Maxdepth = shift if @_; - Data::Dumper::Dumper $self; + Data::Dumper::Dumper($self); } @@ -125,13 +136,14 @@ sub does { my ($self, $role_name) = @_; (defined $role_name) || confess "You must supply a role name to does()"; + my $meta = $self->meta; foreach my $class ($meta->linearized_isa) { - my $m = $meta->initialize($class); - return 1 - if $m->can('does_role') && $m->does_role($role_name); + my $m = ref($meta)->initialize($class); + return 1 + if $m->can('does_role') && $m->does_role($role_name); } - return 0; + return 0; }; 1;