lib/Moose/Object.pm

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