X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FObject.pm;h=e619d1f136d96fc7a44d08f220ff1d11a99694af;hb=48ac876af2c1991bd6cdba0d54b775a121e01725;hp=16e18281fe69223c9ff7d08c03b928cefc67adf1;hpb=eae0508f6f8fca847956c2ed8c48ec23cebd3106;p=gitmo%2FMoose.git diff --git a/lib/Moose/Object.pm b/lib/Moose/Object.pm index 16e1828..e619d1f 100644 --- a/lib/Moose/Object.pm +++ b/lib/Moose/Object.pm @@ -4,30 +4,22 @@ package Moose::Object; use strict; use warnings; -use Devel::GlobalDestruction qw(in_global_destruction); -use MRO::Compat; -use Scalar::Util; +use Carp (); +use Devel::GlobalDestruction (); +use MRO::Compat (); +use Scalar::Util (); +use Try::Tiny (); use if ( not our $__mx_is_compiled ), 'Moose::Meta::Class'; use if ( not our $__mx_is_compiled ), metaclass => 'Moose::Meta::Class'; -our $VERSION = '0.81'; -$VERSION = eval $VERSION; -our $AUTHORITY = 'cpan:STEVAN'; - sub new { my $class = shift; - - my $params = $class->BUILDARGS(@_); - - # We want to support passing $self->new, but initialize - # takes only an unblessed class name my $real_class = Scalar::Util::blessed($class) || $class; - my $self = Class::MOP::Class->initialize($real_class)->new_object($params); - $self->BUILDALL($params); + my $params = $real_class->BUILDARGS(@_); - return $self; + return Class::MOP::Class->initialize($real_class)->new_object($params); } sub BUILDARGS { @@ -40,6 +32,12 @@ sub BUILDARGS { } return { %{ $_[0] } }; } + elsif ( @_ % 2 ) { + Carp::carp( + "The new() method for $class expects a hash reference or a key/value list." + . " You passed an odd number of arguments" ); + return { @_, undef }; + } else { return {@_}; } @@ -86,17 +84,18 @@ sub DEMOLISHALL { } sub DESTROY { - # if we have an exception here ... - if ($@) { - # localize the $@ ... - local $@; - # run DEMOLISHALL ourselves, ... - $_[0]->DEMOLISHALL(in_global_destruction); - # and return ... - return; + my $self = shift; + + local $?; + + Try::Tiny::try { + $self->DEMOLISHALL(Devel::GlobalDestruction::in_global_destruction); } - # otherwise it is normal destruction - $_[0]->DEMOLISHALL(in_global_destruction); + Try::Tiny::catch { + die $_; + }; + + return; } # support for UNIVERSAL::DOES ... @@ -113,14 +112,11 @@ BEGIN { # as appropiate see Moose::Meta::Role sub does { my ($self, $role_name) = @_; - my $meta = Class::MOP::class_of($self); + my $class = Scalar::Util::blessed($self) || $self; + my $meta = Class::MOP::Class->initialize($class); (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 - if $m->can('does_role') && $m->does_role($role_name); - } + || $meta->throw_error("You must supply a role name to does()"); + return 1 if $meta->can('does_role') && $meta->does_role($role_name); return 0; } @@ -133,22 +129,21 @@ sub dump { 1; +# ABSTRACT: The base object for Moose + __END__ =pod -=head1 NAME - -Moose::Object - The base object for Moose - =head1 DESCRIPTION This class is the default base class for all Moose-using classes. When you C in this class, your class will inherit from this class. -It provides a default constructor and destructor, which run the -C and C methods respectively. +It provides a default constructor and destructor, which run all of the +C and C methods in the inheritance hierarchy, +respectively. You don't actually I to inherit from this in order to use Moose, but it makes it easier to take advantage of all of Moose's features. @@ -157,13 +152,14 @@ but it makes it easier to take advantage of all of Moose's features. =over 4 -=item B<< Moose::Object->new(%params) >> +=item B<< Moose::Object->new(%params|$params) >> This method calls C<< $class->BUILDARGS(@_) >>, and then creates a new instance of the appropriate class. Once the instance is created, it -calls C<< $instance->BUILDALL($params) >>. +calls C<< $instance->BUILD($params) >> for each C method in the +inheritance hierarchy. -=item B<< Moose::Object->BUILDARGS(%params) >> +=item B<< Moose::Object->BUILDARGS(%params|$params) >> The default implementation of this method accepts a hash or hash reference of named parameters. If it receives a single argument that @@ -174,27 +170,11 @@ options passed to the constructor. This method should always return a hash reference of named options. -=item B<< $object->BUILDALL($params) >> - -This method will call every C method in the inheritance -hierarchy, starting with the most distant parent class and ending with -the object's class. - -The C method will be passed the hash reference returned by -C. - -=item B<< $object->DEMOLISHALL >> - -This will call every C method in the inheritance hierarchy, -starting with the object's class and ending with the most distant -parent. C and C will receive a boolean -indicating whether or not we are currently in global destruction. - =item B<< $object->does($role_name) >> This returns true if the object does the given role. -=item B +=item B<< $object->DOES($class_or_role_name) >> This is a a Moose role-aware implementation of L. @@ -210,25 +190,16 @@ C. This is a handy utility for Cing an object. By default, the maximum depth is 1, to avoid making a mess. -=back - -=head1 BUGS - -All complex software has bugs lurking in it, and this module is no -exception. If you find a bug please either email me, or add the bug -to cpan-RT. - -=head1 AUTHOR +=item B<< $object->DESTROY >> -Stevan Little Estevan@iinteractive.comE +A default destructor is provided, which calls +C<< $instance->DEMOLISH($in_global_destruction) >> for each C +method in the inheritance hierarchy. -=head1 COPYRIGHT AND LICENSE - -Copyright 2006-2009 by Infinity Interactive, Inc. +=back -L +=head1 BUGS -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. +See L for details on reporting bugs. =cut