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         # Without this, Perl will warn "\t(in cleanup)$@" because of some
  96         # bizarre fucked-up logic deep in the internals.
  97         no warnings 'misc';
  98         die $_;
  99     };
 100
 101     return;
 102 }
 103
 104 # support for UNIVERSAL::DOES ...
 105 BEGIN {
 106     my $does = UNIVERSAL->can("DOES") ? "SUPER::DOES" : "isa";
 107     eval 'sub DOES {
 108         my ( $self, $class_or_role_name ) = @_;
 109         return $self->'.$does.'($class_or_role_name)
 110             || $self->does($class_or_role_name);
 111     }';
 112 }
 113
 114 # new does() methods will be created
 115 # as appropiate see Moose::Meta::Role
 116 sub does {
 117     my ($self, $role_name) = @_;
 118     my $meta = Class::MOP::class_of($self);
 119     (defined $role_name)
 120         || $meta->throw_error("You must supply a role name to does()");
 121     return 1 if $meta->can('does_role') && $meta->does_role($role_name);
 122     return 0;
 123 }
 124
 125 sub dump {
 126     my $self = shift;
 127     require Data::Dumper;
 128     local $Data::Dumper::Maxdepth = shift if @_;
 129     Data::Dumper::Dumper $self;
 130 }
 131
 132 1;
 133
 134 # ABSTRACT: The base object for Moose
 135
 136 __END__
 137
 138 =pod
 139
 140 =head1 DESCRIPTION
 141
 142 This class is the default base class for all Moose-using classes. When
 143 you C<use Moose> in this class, your class will inherit from this
 144 class.
 145
 146 It provides a default constructor and destructor, which run the
 147 C<BUILDALL> and C<DEMOLISHALL> methods respectively.
 148
 149 You don't actually I<need> to inherit from this in order to use Moose,
 150 but it makes it easier to take advantage of all of Moose's features.
 151
 152 =head1 METHODS
 153
 154 =over 4
 155
 156 =item B<< Moose::Object->new(%params) >>
 157
 158 This method calls C<< $class->BUILDARGS(@_) >>, and then creates a new
 159 instance of the appropriate class. Once the instance is created, it
 160 calls C<< $instance->BUILDALL($params) >>.
 161
 162 =item B<< Moose::Object->BUILDARGS(%params) >>
 163
 164 The default implementation of this method accepts a hash or hash
 165 reference of named parameters. If it receives a single argument that
 166 I<isn't> a hash reference it throws an error.
 167
 168 You can override this method in your class to handle other types of
 169 options passed to the constructor.
 170
 171 This method should always return a hash reference of named options.
 172
 173 =item B<< $object->BUILDALL($params) >>
 174
 175 This method will call every C<BUILD> method in the inheritance
 176 hierarchy, starting with the most distant parent class and ending with
 177 the object's class.
 178
 179 The C<BUILD> method will be passed the hash reference returned by
 180 C<BUILDARGS>.
 181
 182 =item B<< $object->DEMOLISHALL >>
 183
 184 This will call every C<DEMOLISH> method in the inheritance hierarchy,
 185 starting with the object's class and ending with the most distant
 186 parent. C<DEMOLISHALL> and C<DEMOLISH> will receive a boolean
 187 indicating whether or not we are currently in global destruction.
 188
 189 =item B<< $object->does($role_name) >>
 190
 191 This returns true if the object does the given role.
 192
 193 =item B<DOES ($class_or_role_name)>
 194
 195 This is a a Moose role-aware implementation of L<UNIVERSAL/DOES>.
 196
 197 This is effectively the same as writing:
 198
 199   $object->does($name) || $object->isa($name)
 200
 201 This method will work with Perl 5.8, which did not implement
 202 C<UNIVERSAL::DOES>.
 203
 204 =item B<< $object->dump($maxdepth) >>
 205
 206 This is a handy utility for C<Data::Dumper>ing an object. By default,
 207 the maximum depth is 1, to avoid making a mess.
 208
 209 =back
 210
 211 =head1 BUGS
 212
 213 See L<Moose/BUGS> for details on reporting bugs.
 214
 215 =cut