X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FObject.pm;h=5a327fe5a33368de52a0872a054abe2e94e11ffc;hp=268e845e592fad06bba4559d69cb4f2846e35b7b;hb=01e830f796a9ecdec0d977f2b88110363ebf013f;hpb=9b9e4b6566015d6d6e2aa6c745644174efa74623 diff --git a/lib/Mouse/Object.pm b/lib/Mouse/Object.pm index 268e845..5a327fe 100644 --- a/lib/Mouse/Object.pm +++ b/lib/Mouse/Object.pm @@ -1,92 +1,14 @@ package Mouse::Object; -use Mouse::Util qw(does dump); # enables strict and warnings +use Mouse::Util qw(does dump meta); # enables strict and warnings -sub new { - my $class = shift; +sub new; +sub BUILDARGS; +sub BUILDALL; - $class->throw_error('Cannot call new() on an instance') if ref $class; - - my $args = $class->BUILDARGS(@_); - - my $instance = Mouse::Meta::Class->initialize($class)->new_object($args); - $instance->BUILDALL($args); - return $instance; -} - -sub BUILDARGS { - my $class = shift; - - if (scalar @_ == 1) { - (ref($_[0]) eq 'HASH') - || $class->meta->throw_error("Single parameters to new() must be a HASH ref"); - - return {%{$_[0]}}; - } - else { - return {@_}; - } -} - -sub DESTROY { - my $self = shift; - - local $?; - - my $e = do{ - local $@; - eval{ - $self->DEMOLISHALL(); - }; - $@; - }; - - no warnings 'misc'; - die $e if $e; # rethrow -} - -sub BUILDALL { - my $self = shift; - - # short circuit - return unless $self->can('BUILD'); - - for my $class (reverse $self->meta->linearized_isa) { - my $build = do{ - no strict 'refs'; - no warnings 'once'; - *{ $class . '::BUILD' }{CODE}; - } or next; - - $self->$build(@_); - } - return; -} - -sub DEMOLISHALL { - my $self = shift; - - # short circuit - return unless $self->can('DEMOLISH'); - - # 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 ;) - - foreach my $class (@{ Mouse::Util::get_linear_isa(ref $self) }) { - my $demolish = do{ - no strict 'refs'; - no warnings 'once'; - *{ $class . '::DEMOLISH'}{CODE}; - } or next; - - $self->$demolish(); - } - return; -} +sub DESTROY; +sub DEMOLISHALL; 1; - __END__ =head1 NAME @@ -95,7 +17,7 @@ Mouse::Object - The base object for Mouse classes =head1 VERSION -This document describes Mouse version 0.39 +This document describes Mouse version 0.49 =head1 METHODS @@ -134,7 +56,7 @@ need to redispatch or return any specific value. This will check if the invocant's class B a given C<$role_name>. This is similar to "isa" for object, but it checks the roles instead. -=head2 C< Str >> +=head2 C<< dump ($maxdepth) -> Str >> From the Moose POD: