X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FObject.pm;h=58af2271f5ed96b253f36e267c53c72f0e35e408;hb=759e4e8ff4171bfabf1cb3d3843f760425676fe0;hp=4723e958415e0ba8fc30e9b10bbaaa605587cde2;hpb=4c4fbe56903bd83200bd4f6f5ee47bda793b30a3;p=gitmo%2FMoose.git diff --git a/lib/Moose/Object.pm b/lib/Moose/Object.pm index 4723e95..58af227 100644 --- a/lib/Moose/Object.pm +++ b/lib/Moose/Object.pm @@ -4,33 +4,52 @@ 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.05'; +our $VERSION = '0.10'; +our $AUTHORITY = 'cpan:STEVAN'; sub new { - my $class = shift; - my %params = (scalar @_ == 1) ? %{$_[0]} : @_; - my $self = $class->meta->new_object(%params); - $self->BUILDALL(\%params); - return $self; + my $class = shift; + my %params; + if (scalar @_ == 1) { + 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; } sub BUILDALL { - my ($self, $params) = @_; - foreach my $method (reverse $self->meta->find_all_methods_by_name('BUILD')) { - $method->{code}->($self, $params); - } + # 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); + } } sub DEMOLISHALL { - my $self = shift; - foreach my $method ($self->meta->find_all_methods_by_name('DEMOLISH')) { - $method->{code}->($self); - } + # 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); + } } sub DESTROY { goto &DEMOLISHALL } @@ -49,6 +68,22 @@ 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; + $Data::Dumper::Maxdepth = shift if @_; + Data::Dumper::Dumper $self; +} + 1; __END__ @@ -96,6 +131,15 @@ This will call every C method in the inheritance hierarchy. This will check if the invocant's class C a given C<$role_name>. This is similar to C for object, but it checks the roles instead. +=item B + +Cmon, how many times have you written the following code while debugging: + + use Data::Dumper; + warn Dumper $obj; + +It can get seriously annoying, so why not just use this. + =back =head1 BUGS @@ -110,11 +154,11 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006 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