lib/Moose/Object.pm

   1
   2 package Moose::Object;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Scalar::Util;
   8 use Devel::GlobalDestruction qw(in_global_destruction);
   9
  10 use if ( not our $__mx_is_compiled ), 'Moose::Meta::Class';
  11 use if ( not our $__mx_is_compiled ), metaclass => 'Moose::Meta::Class';
  12
  13 our $VERSION   = '0.76';
  14 $VERSION = eval $VERSION;
  15 our $AUTHORITY = 'cpan:STEVAN';
  16
  17 sub new {
  18     my $class = shift;
  19
  20     my $params = $class->BUILDARGS(@_);
  21
  22     # We want to support passing $self->new, but initialize
  23     # takes only an unblessed class name
  24     my $real_class = Scalar::Util::blessed($class) || $class;
  25     my $self = Class::MOP::Class->initialize($real_class)->new_object($params);
  26
  27     $self->BUILDALL($params);
  28
  29     return $self;
  30 }
  31
  32 sub BUILDARGS {
  33     my $class = shift;
  34     if ( scalar @_ == 1 ) {
  35         unless ( defined $_[0] && ref $_[0] eq 'HASH' ) {
  36             Class::MOP::class_of($class)->throw_error(
  37                 "Single parameters to new() must be a HASH ref",
  38                 data => $_[0] );
  39         }
  40         return { %{ $_[0] } };
  41     }
  42     else {
  43         return {@_};
  44     }
  45 }
  46
  47 sub BUILDALL {
  48     # NOTE: we ask Perl if we even
  49     # need to do this first, to avoid
  50     # extra meta level calls
  51     return unless $_[0]->can('BUILD');
  52     my ($self, $params) = @_;
  53     foreach my $method (reverse Class::MOP::class_of($self)->find_all_methods_by_name('BUILD')) {
  54         $method->{code}->execute($self, $params);
  55     }
  56 }
  57
  58 sub DEMOLISHALL {
  59     my $self = shift;
  60     my ($in_global_destruction) = @_;
  61
  62     # NOTE: we ask Perl if we even
  63     # need to do this first, to avoid
  64     # extra meta level calls
  65     return unless $self->can('DEMOLISH');
  66
  67     # This is a hack, because Moose::Meta::Class may not be the right
  68     # metaclass, but class_of may return undef during global
  69     # destruction, if the metaclass object has already been cleaned
  70     # up.
  71     my $meta = Class::MOP::class_of($self)
  72         || Moose::Meta::Class->initialize( ref $self );
  73
  74     foreach my $method ( $meta->find_all_methods_by_name('DEMOLISH') ) {
  75         $method->{code}->execute($self, $in_global_destruction);
  76     }
  77 }
  78
  79 sub DESTROY {
  80     # if we have an exception here ...
  81     if ($@) {
  82         # localize the $@ ...
  83         local $@;
  84         # run DEMOLISHALL ourselves, ...
  85         $_[0]->DEMOLISHALL(in_global_destruction);
  86         # and return ...
  87         return;
  88     }
  89     # otherwise it is normal destruction
  90     $_[0]->DEMOLISHALL(in_global_destruction);
  91 }
  92
  93 # support for UNIVERSAL::DOES ...
  94 BEGIN {
  95     my $does = UNIVERSAL->can("DOES") ? "SUPER::DOES" : "isa";
  96     eval 'sub DOES {
  97         my ( $self, $class_or_role_name ) = @_;
  98         return $self->'.$does.'($class_or_role_name)
  99             || $self->does($class_or_role_name);
 100     }';
 101 }
 102
 103 # new does() methods will be created
 104 # as appropiate see Moose::Meta::Role
 105 sub does {
 106     my ($self, $role_name) = @_;
 107     my $meta = Class::MOP::class_of($self);
 108     (defined $role_name)
 109         || $meta->throw_error("You much supply a role name to does()");
 110     foreach my $class ($meta->class_precedence_list) {
 111         my $m = $meta->initialize($class);
 112         return 1
 113             if $m->can('does_role') && $m->does_role($role_name);
 114     }
 115     return 0;
 116 }
 117
 118 sub dump {
 119     my $self = shift;
 120     require Data::Dumper;
 121     local $Data::Dumper::Maxdepth = shift if @_;
 122     Data::Dumper::Dumper $self;
 123 }
 124
 125 1;
 126
 127 __END__
 128
 129 =pod
 130
 131 =head1 NAME
 132
 133 Moose::Object - The base object for Moose
 134
 135 =head1 DESCRIPTION
 136
 137 This class is the default base class for all Moose-using classes. When
 138 you C<use Moose> in this class, your class will inherit from this
 139 class.
 140
 141 It provides a default constructor and destructor, which run the
 142 C<BUILDALL> and C<DEMOLISHALL> methods respectively.
 143
 144 You don't actually I<need> to inherit from this in order to use Moose,
 145 but it makes it easier to take advantage of all of Moose's features.
 146
 147 =head1 METHODS
 148
 149 =over 4
 150
 151 =item B<< Moose::Object->new(%params) >>
 152
 153 This method calls C<< $class->BUILDARGS(@_) >>, and then creates a new
 154 instance of the appropriate class. Once the instance is created, it
 155 calls C<< $instance->BUILDALL($params) >>.
 156
 157 =item B<< Moose::Object->BUILDARGS(%params) >>
 158
 159 The default implementation of this method accepts a hash or hash
 160 reference of named parameters. If it receives a single argument that
 161 I<isn't> a hash reference it throws an error.
 162
 163 You can override this method in your class to handle other types of
 164 options passed to the constructor.
 165
 166 This method should always return a hash reference of named options.
 167
 168 =item B<< $object->BUILDALL($params) >>
 169
 170 This method will call every C<BUILD> method in the inheritance
 171 hierarchy, starting with the most distant parent class and ending with
 172 the object's class.
 173
 174 The C<BUILD> method will be passed the hash reference returned by
 175 C<BUILDARGS>.
 176
 177 =item B<< $object->DEMOLISHALL >>
 178
 179 This will call every C<DEMOLISH> method in the inheritance hierarchy,
 180 starting with the object's class and ending with the most distant
 181 parent. C<DEMOLISHALL> and C<DEMOLISH> will receive a boolean
 182 indicating whether or not we are currently in global destruction.
 183
 184 =item B<< $object->does($role_name) >>
 185
 186 This returns true if the object does the given role.
 187
 188 =item B<DOES ($class_or_role_name)>
 189
 190 This is a a Moose role-aware implementation of L<UNIVERSAL/DOES>.
 191
 192 This is effectively the same as writing:
 193
 194   $object->does($name) || $object->isa($name)
 195
 196 This method will work with Perl 5.8, which did not implement
 197 C<UNIVERSAL::DOES>.
 198
 199 =item B<< $object->dump($maxdepth) >>
 200
 201 This is a handy utility for C<Data::Dumper>ing an object. By default,
 202 the maximum depth is 1, to avoid making a mess.
 203
 204 =back
 205
 206 =head1 BUGS
 207
 208 All complex software has bugs lurking in it, and this module is no
 209 exception. If you find a bug please either email me, or add the bug
 210 to cpan-RT.
 211
 212 =head1 AUTHOR
 213
 214 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 215
 216 =head1 COPYRIGHT AND LICENSE
 217
 218 Copyright 2006-2009 by Infinity Interactive, Inc.
 219
 220 L<http://www.iinteractive.com>
 221
 222 This library is free software; you can redistribute it and/or modify
 223 it under the same terms as Perl itself.
 224
 225 =cut