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