X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FObject.pm;h=a0ed7e4bdb0c3c61c182fcab48eaa0f79ea14e57;hb=9409e92e75a6e1060eb3d0adcfc7965713d3d776;hp=feab57b0de10d9fce36226c75d46459a129657dd;hpb=03e7dbecf3e631d5fb5884b16e3eafe4c14624c3;p=gitmo%2FMoose.git diff --git a/lib/Moose/Object.pm b/lib/Moose/Object.pm index feab57b..a0ed7e4 100644 --- a/lib/Moose/Object.pm +++ b/lib/Moose/Object.pm @@ -7,15 +7,14 @@ use warnings; 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.53'; +our $VERSION = '0.72'; +$VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; sub new { my $class = shift; my $params = $class->BUILDARGS(@_); - my $self = $class->meta->new_object(%$params); + my $self = $class->meta->new_object($params); $self->BUILDALL($params); return $self; } @@ -25,7 +24,7 @@ sub BUILDARGS { if (scalar @_ == 1) { if (defined $_[0]) { (ref($_[0]) eq 'HASH') - || confess "Single parameters to new() must be a HASH ref"; + || $class->meta->throw_error("Single parameters to new() must be a HASH ref", data => $_[0]); return {%{$_[0]}}; } else { @@ -44,22 +43,22 @@ sub BUILDALL { 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); + $method->{code}->execute($self, $params); } } sub DEMOLISHALL { my $self = shift; + # NOTE: we ask Perl if we even + # need to do this first, to avoid + # extra meta level calls + return unless $self->can('DEMOLISH'); foreach my $method ($self->meta->find_all_methods_by_name('DEMOLISH')) { - $method->{code}->body->($self); + $method->{code}->execute($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'); # if we have an exception here ... if ($@) { # localize the $@ ... @@ -74,23 +73,22 @@ sub DESTROY { } # support for UNIVERSAL::DOES ... -sub DOES { - my ( $self, $class_or_role_name ) = @_; - if (my $DOES = __PACKAGE__->meta->find_next_method_by_name('DOES')) { - return $DOES->body->($self, $class_or_role_name) +BEGIN { + my $does = UNIVERSAL->can("DOES") ? "SUPER::DOES" : "isa"; + eval 'sub DOES { + my ( $self, $class_or_role_name ) = @_; + return $self->'.$does.'($class_or_role_name) || $self->does($class_or_role_name); - } - return $self->isa($class_or_role_name) - || $self->does($class_or_role_name); + }'; } # new does() methods will be created -# as approiate see Moose::Meta::Role +# as appropiate see Moose::Meta::Role sub does { my ($self, $role_name) = @_; - (defined $role_name) - || confess "You must supply a role name to does()"; my $meta = $self->meta; + (defined $role_name) + || $meta->throw_error("You much supply a role name to does()"); foreach my $class ($meta->class_precedence_list) { my $m = $meta->initialize($class); return 1 @@ -99,15 +97,6 @@ sub does { return 0; } -# RANT: -# Cmon, how many times have you written -# the following code while debugging: -# -# use Data::Dumper; -# warn Dumper \%thing; -# -# It can get seriously annoying, so why -# not just do this ... sub dump { my $self = shift; require Data::Dumper; @@ -175,7 +164,7 @@ C is equivalent to C or C. =item B -Cmon, how many times have you written the following code while debugging: +C'mon, how many times have you written the following code while debugging: use Data::Dumper; warn Dumper $obj; @@ -196,7 +185,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2008 by Infinity Interactive, Inc. +Copyright 2006-2009 by Infinity Interactive, Inc. L