Require Dist::Zilla 4.200016+
[gitmo/Moose.git] / lib / Moose / Object.pm
index 6aee996..e619d1f 100644 (file)
@@ -4,6 +4,7 @@ package Moose::Object;
 use strict;
 use warnings;
 
+use Carp ();
 use Devel::GlobalDestruction ();
 use MRO::Compat ();
 use Scalar::Util ();
@@ -12,21 +13,13 @@ 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.94';
-$VERSION = eval $VERSION;
-our $AUTHORITY = 'cpan:STEVAN';
-
 sub new {
     my $class = shift;
-
-    my $params = $class->BUILDARGS(@_);
-
     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 {
@@ -39,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 {@_};
     }
@@ -48,16 +47,13 @@ sub BUILDALL {
     # NOTE: we ask Perl if we even
     # need to do this first, to avoid
     # extra meta level calls
-    return if $_[0]->can('BUILD') == \&BUILD;
+    return unless $_[0]->can('BUILD');
     my ($self, $params) = @_;
     foreach my $method (reverse Class::MOP::class_of($self)->find_all_methods_by_name('BUILD')) {
-        next if $method->{class} eq __PACKAGE__;
         $method->{code}->execute($self, $params);
     }
 }
 
-sub BUILD { }
-
 sub DEMOLISHALL {
     my $self = shift;
     my ($in_global_destruction) = @_;
@@ -65,7 +61,7 @@ sub DEMOLISHALL {
     # NOTE: we ask Perl if we even
     # need to do this first, to avoid
     # extra meta level calls
-    return if $self->can('DEMOLISH') == \&DEMOLISH;
+    return unless $self->can('DEMOLISH');
 
     my @isa;
     if ( my $meta = Class::MOP::class_of($self ) ) {
@@ -81,15 +77,12 @@ sub DEMOLISHALL {
 
     foreach my $class (@isa) {
         no strict 'refs';
-        next if $class eq __PACKAGE__;
         my $demolish = *{"${class}::DEMOLISH"}{CODE};
         $self->$demolish($in_global_destruction)
             if defined $demolish;
     }
 }
 
-sub DEMOLISH { }
-
 sub DESTROY {
     my $self = shift;
 
@@ -99,9 +92,6 @@ sub DESTROY {
         $self->DEMOLISHALL(Devel::GlobalDestruction::in_global_destruction);
     }
     Try::Tiny::catch {
-        # Without this, Perl will warn "\t(in cleanup)$@" because of some
-        # bizarre fucked-up logic deep in the internals.
-        no warnings 'misc';
         die $_;
     };
 
@@ -122,7 +112,8 @@ 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 must supply a role name to does()");
     return 1 if $meta->can('does_role') && $meta->does_role($role_name);
@@ -138,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<use Moose> in this class, your class will inherit from this
 class.
 
-It provides a default constructor and destructor, which run the
-C<BUILDALL> and C<DEMOLISHALL> methods respectively.
+It provides a default constructor and destructor, which run all of the
+C<BUILD> and C<DEMOLISH> methods in the inheritance hierarchy,
+respectively.
 
 You don't actually I<need> to inherit from this in order to use Moose,
 but it makes it easier to take advantage of all of Moose's features.
@@ -162,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<BUILD> 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
@@ -179,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<BUILD> method in the inheritance
-hierarchy, starting with the most distant parent class and ending with
-the object's class.
-
-The C<BUILD> method will be passed the hash reference returned by
-C<BUILDARGS>.
-
-=item B<< $object->DEMOLISHALL >>
-
-This will call every C<DEMOLISH> method in the inheritance hierarchy,
-starting with the object's class and ending with the most distant
-parent. C<DEMOLISHALL> and C<DEMOLISH> 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<DOES ($class_or_role_name)>
+=item B<< $object->DOES($class_or_role_name) >>
 
 This is a a Moose role-aware implementation of L<UNIVERSAL/DOES>.
 
@@ -215,23 +190,16 @@ C<UNIVERSAL::DOES>.
 This is a handy utility for C<Data::Dumper>ing an object. By default,
 the maximum depth is 1, to avoid making a mess.
 
+=item B<< $object->DESTROY >>
+
+A default destructor is provided, which calls
+C<< $instance->DEMOLISH($in_global_destruction) >> for each C<DEMOLISH>
+method in the inheritance hierarchy.
+
 =back
 
 =head1 BUGS
 
 See L<Moose/BUGS> for details on reporting bugs.
 
-=head1 AUTHOR
-
-Stevan Little E<lt>stevan@iinteractive.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2006-2010 by Infinity Interactive, Inc.
-
-L<http://www.iinteractive.com>
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
 =cut