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 $class = Scalar::Util::blessed($self) || $self;
 116     my $meta = Class::MOP::Class->initialize($class);
 117     (defined $role_name)
 118         || $meta->throw_error("You must supply a role name to does()");
 119     return 1 if $meta->can('does_role') && $meta->does_role($role_name);
 120     return 0;
 121 }
 122
 123 sub dump {
 124     my $self = shift;
 125     require Data::Dumper;
 126     local $Data::Dumper::Maxdepth = shift if @_;
 127     Data::Dumper::Dumper $self;
 128 }
 129
 130 1;
 131
 132 # ABSTRACT: The base object for Moose
 133
 134 __END__
 135
 136 =pod
 137
 138 =head1 DESCRIPTION
 139
 140 This class is the default base class for all Moose-using classes. When
 141 you C<use Moose> in this class, your class will inherit from this
 142 class.
 143
 144 It provides a default constructor and destructor, which run all of the
 145 C<BUILD> and C<DEMOLISH> methods in the inheritance hierarchy,
 146 respectively.
 147
 148 You don't actually I<need> to inherit from this in order to use Moose,
 149 but it makes it easier to take advantage of all of Moose's features.
 150
 151 =head1 METHODS
 152
 153 =over 4
 154
 155 =item B<< Moose::Object->new(%params|$params) >>
 156
 157 This method calls C<< $class->BUILDARGS(@_) >>, and then creates a new
 158 instance of the appropriate class. Once the instance is created, it
 159 calls C<< $instance->BUILD($params) >> for each C<BUILD> method in the
 160 inheritance hierarchy.
 161
 162 =item B<< Moose::Object->BUILDARGS(%params|$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->does($role_name) >>
 174
 175 This returns true if the object does the given role.
 176
 177 =item B<< $object->DOES($class_or_role_name) >>
 178
 179 This is a a Moose role-aware implementation of L<UNIVERSAL/DOES>.
 180
 181 This is effectively the same as writing:
 182
 183   $object->does($name) || $object->isa($name)
 184
 185 This method will work with Perl 5.8, which did not implement
 186 C<UNIVERSAL::DOES>.
 187
 188 =item B<< $object->dump($maxdepth) >>
 189
 190 This is a handy utility for C<Data::Dumper>ing an object. By default,
 191 the maximum depth is 1, to avoid making a mess.
 192
 193 =item B<< $object->DESTROY >>
 194
 195 A default destructor is provided, which calls
 196 C<< $instance->DEMOLISH($in_global_destruction) >> for each C<DEMOLISH>
 197 method in the inheritance hierarchy.
 198
 199 =back
 200
 201 =head1 BUGS
 202
 203 See L<Moose/BUGS> for details on reporting bugs.
 204
 205 =cut