lib/Moose/Object.pm

   1
   2 package Moose::Object;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Carp ();
   8 use Devel::GlobalDestruction ();
   9 use MRO::Compat ();
  10 use Scalar::Util ();
  11 use Try::Tiny ();
  12
  13 use if ( not our $__mx_is_compiled ), 'Moose::Meta::Class';
  14 use if ( not our $__mx_is_compiled ), metaclass => 'Moose::Meta::Class';
  15
  16 sub new {
  17     my $class = shift;
  18     my $real_class = Scalar::Util::blessed($class) || $class;
  19
  20     my $params = $real_class->BUILDARGS(@_);
  21
  22     return Class::MOP::Class->initialize($real_class)->new_object($params);
  23 }
  24
  25 sub BUILDARGS {
  26     my $class = shift;
  27     if ( scalar @_ == 1 ) {
  28         unless ( defined $_[0] && ref $_[0] eq 'HASH' ) {
  29             Class::MOP::class_of($class)->throw_error(
  30                 "Single parameters to new() must be a HASH ref",
  31                 data => $_[0] );
  32         }
  33         return { %{ $_[0] } };
  34     }
  35     elsif ( @_ % 2 ) {
  36         Carp::carp(
  37             "The new() method for $class expects a hash reference or a key/value list."
  38                 . " You passed an odd number of arguments" );
  39         return { @_, undef };
  40     }
  41     else {
  42         return {@_};
  43     }
  44 }
  45
  46 sub BUILDALL {
  47     # NOTE: we ask Perl if we even
  48     # need to do this first, to avoid
  49     # extra meta level calls
  50     return unless $_[0]->can('BUILD');
  51     my ($self, $params) = @_;
  52     foreach my $method (reverse Class::MOP::class_of($self)->find_all_methods_by_name('BUILD')) {
  53         $method->{code}->execute($self, $params);
  54     }
  55 }
  56
  57 sub DEMOLISHALL {
  58     my $self = shift;
  59     my ($in_global_destruction) = @_;
  60
  61     # NOTE: we ask Perl if we even
  62     # need to do this first, to avoid
  63     # extra meta level calls
  64     return unless $self->can('DEMOLISH');
  65
  66     my @isa;
  67     if ( my $meta = Class::MOP::class_of($self ) ) {
  68         @isa = $meta->linearized_isa;
  69     } else {
  70         # We cannot count on being able to retrieve a previously made
  71         # metaclass, _or_ being able to make a new one during global
  72         # destruction. However, we should still be able to use mro at
  73         # that time (at least tests suggest so ;)
  74         my $class_name = ref $self;
  75         @isa = @{ mro::get_linear_isa($class_name) }
  76     }
  77
  78     foreach my $class (@isa) {
  79         no strict 'refs';
  80         my $demolish = *{"${class}::DEMOLISH"}{CODE};
  81         $self->$demolish($in_global_destruction)
  82             if defined $demolish;
  83     }
  84 }
  85
  86 sub DESTROY {
  87     my $self = shift;
  88
  89     local $?;
  90
  91     Try::Tiny::try {
  92         $self->DEMOLISHALL(Devel::GlobalDestruction::in_global_destruction);
  93     }
  94     Try::Tiny::catch {
  95         die $_;
  96     };
  97
  98     return;
  99 }
 100
 101 # support for UNIVERSAL::DOES ...
 102 BEGIN {
 103     my $does = UNIVERSAL->can("DOES") ? "SUPER::DOES" : "isa";
 104     eval 'sub DOES {
 105         my ( $self, $class_or_role_name ) = @_;
 106         return $self->'.$does.'($class_or_role_name)
 107             || $self->does($class_or_role_name);
 108     }';
 109 }
 110
 111 # new does() methods will be created
 112 # as appropiate see Moose::Meta::Role
 113 sub does {
 114     my ($self, $role_name) = @_;
 115     my $meta = Class::MOP::class_of($self);
 116     (defined $role_name)
 117         || $meta->throw_error("You must supply a role name to does()");
 118     return 1 if $meta->can('does_role') && $meta->does_role($role_name);
 119     return 0;
 120 }
 121
 122 sub dump {
 123     my $self = shift;
 124     require Data::Dumper;
 125     local $Data::Dumper::Maxdepth = shift if @_;
 126     Data::Dumper::Dumper $self;
 127 }
 128
 129 1;
 130
 131 # ABSTRACT: The base object for Moose
 132
 133 __END__
 134
 135 =pod
 136
 137 =head1 DESCRIPTION
 138
 139 This class is the default base class for all Moose-using classes. When
 140 you C<use Moose> in this class, your class will inherit from this
 141 class.
 142
 143 It provides a default constructor and destructor, which run the
 144 C<BUILDALL> and C<DEMOLISHALL> methods respectively.
 145
 146 You don't actually I<need> to inherit from this in order to use Moose,
 147 but it makes it easier to take advantage of all of Moose's features.
 148
 149 =head1 METHODS
 150
 151 =over 4
 152
 153 =item B<< Moose::Object->new(%params) >>
 154
 155 This method calls C<< $class->BUILDARGS(@_) >>, and then creates a new
 156 instance of the appropriate class. Once the instance is created, it
 157 calls C<< $instance->BUILDALL($params) >>.
 158
 159 =item B<< Moose::Object->BUILDARGS(%params) >>
 160
 161 The default implementation of this method accepts a hash or hash
 162 reference of named parameters. If it receives a single argument that
 163 I<isn't> a hash reference it throws an error.
 164
 165 You can override this method in your class to handle other types of
 166 options passed to the constructor.
 167
 168 This method should always return a hash reference of named options.
 169
 170 =item B<< $object->BUILDALL($params) >>
 171
 172 This method will call every C<BUILD> method in the inheritance
 173 hierarchy, starting with the most distant parent class and ending with
 174 the object's class.
 175
 176 The C<BUILD> method will be passed the hash reference returned by
 177 C<BUILDARGS>.
 178
 179 =item B<< $object->DEMOLISHALL >>
 180
 181 This will call every C<DEMOLISH> method in the inheritance hierarchy,
 182 starting with the object's class and ending with the most distant
 183 parent. C<DEMOLISHALL> and C<DEMOLISH> will receive a boolean
 184 indicating whether or not we are currently in global destruction.
 185
 186 =item B<< $object->does($role_name) >>
 187
 188 This returns true if the object does the given role.
 189
 190 =item B<DOES ($class_or_role_name)>
 191
 192 This is a a Moose role-aware implementation of L<UNIVERSAL/DOES>.
 193
 194 This is effectively the same as writing:
 195
 196   $object->does($name) || $object->isa($name)
 197
 198 This method will work with Perl 5.8, which did not implement
 199 C<UNIVERSAL::DOES>.
 200
 201 =item B<< $object->dump($maxdepth) >>
 202
 203 This is a handy utility for C<Data::Dumper>ing an object. By default,
 204 the maximum depth is 1, to avoid making a mess.
 205
 206 =back
 207
 208 =head1 BUGS
 209
 210 See L<Moose/BUGS> for details on reporting bugs.
 211
 212 =cut