X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FObject.pm;h=6426dd644f777bf35484d5a2ee7811aac9ca1361;hb=4cf89c74c7bfc634dd2b3f884eb062ea7691e121;hp=b54a89a280fe2cd225e458b7ba381db92ef18b7b;hpb=d44714be2bf834a2df5e42da05fb7a760145adf8;p=gitmo%2FMoose.git diff --git a/lib/Moose/Object.pm b/lib/Moose/Object.pm index b54a89a..6426dd6 100644 --- a/lib/Moose/Object.pm +++ b/lib/Moose/Object.pm @@ -4,54 +4,68 @@ package Moose::Object; use strict; use warnings; -use Moose::Meta::Class; -use metaclass 'Moose::Meta::Class'; +use if ( not our $__mx_is_compiled ), 'Moose::Meta::Class'; +use if ( not our $__mx_is_compiled ), metaclass => 'Moose::Meta::Class'; use Carp 'confess'; -our $VERSION = '0.08'; +our $VERSION = '0.14'; our $AUTHORITY = 'cpan:STEVAN'; sub new { my $class = shift; my %params; if (scalar @_ == 1) { - (ref($_[0]) eq 'HASH') - || confess "Single parameters to new() must be a HASH ref"; - %params = %{$_[0]}; + if (defined $_[0]) { + (ref($_[0]) eq 'HASH') + || confess "Single parameters to new() must be a HASH ref"; + %params = %{$_[0]}; + } } else { %params = @_; } - my $self = $class->meta->new_object(%params); - $self->BUILDALL(\%params); - return $self; + my $self = $class->meta->new_object(%params); + $self->BUILDALL(\%params); + return $self; } sub BUILDALL { # NOTE: we ask Perl if we even # need to do this first, to avoid # extra meta level calls - return unless $_[0]->can('BUILD'); - my ($self, $params) = @_; - foreach my $method (reverse $self->meta->find_all_methods_by_name('BUILD')) { - $method->{code}->($self, $params); - } + return unless $_[0]->can('BUILD'); + my ($self, $params) = @_; + foreach my $method (reverse $self->meta->find_all_methods_by_name('BUILD')) { + $method->{code}->body->($self, $params); + } } sub DEMOLISHALL { + my $self = shift; + foreach my $method ($self->meta->find_all_methods_by_name('DEMOLISH')) { + $method->{code}->body->($self); + } +} + +sub DESTROY { # NOTE: we ask Perl if we even # need to do this first, to avoid # extra meta level calls - return unless $_[0]->can('DEMOLISH'); - my $self = shift; - foreach my $method ($self->meta->find_all_methods_by_name('DEMOLISH')) { - $method->{code}->($self); - } + return unless $_[0]->can('DEMOLISH'); + # if we have an exception here ... + if ($@) { + # localize the $@ ... + local $@; + # run DEMOLISHALL ourselves, ... + $_[0]->DEMOLISHALL; + # and return ... + return; + } + # otherwise it is normal destruction + $_[0]->DEMOLISHALL; } -sub DESTROY { goto &DEMOLISHALL } - # new does() methods will be created # as approiate see Moose::Meta::Role sub does { @@ -60,8 +74,9 @@ sub does { || confess "You much supply a role name to does()"; my $meta = $self->meta; foreach my $class ($meta->class_precedence_list) { + my $m = $meta->initialize($class); return 1 - if $meta->initialize($class)->does_role($role_name); + if $m->can('does_role') && $m->does_role($role_name); } return 0; } @@ -78,7 +93,7 @@ sub does { sub dump { my $self = shift; require Data::Dumper; - $Data::Dumper::Maxdepth = shift if @_; + local $Data::Dumper::Maxdepth = shift if @_; Data::Dumper::Dumper $self; } @@ -152,11 +167,11 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006, 2007 by Infinity Interactive, Inc. +Copyright 2006-2008 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. -=cut \ No newline at end of file +=cut