lib/Moose/Object.pm

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