Comment out alias/excludes warnings for 1.12 release
[gitmo/Moose.git] / lib / Moose / Object.pm
CommitLineData
fcd84ca9 1
2package Moose::Object;
3
4use strict;
5use warnings;
648e79ae 6
f25f9912 7use Devel::GlobalDestruction ();
8use MRO::Compat ();
9use Scalar::Util ();
10use Try::Tiny ();
2eaf25da 11
9922fa6f 12use if ( not our $__mx_is_compiled ), 'Moose::Meta::Class';
13use if ( not our $__mx_is_compiled ), metaclass => 'Moose::Meta::Class';
bc1e29b5 14
6b2f825e 15our $VERSION = '1.11';
e606ae5f 16$VERSION = eval $VERSION;
d44714be 17our $AUTHORITY = 'cpan:STEVAN';
fcd84ca9 18
19sub new {
2c0cbef7 20 my $class = shift;
f25f9912 21 my $real_class = Scalar::Util::blessed($class) || $class;
2eaf25da 22
a19ae3d7 23 my $params = $real_class->BUILDARGS(@_);
2eaf25da 24
a19ae3d7 25 return Class::MOP::Class->initialize($real_class)->new_object($params);
e606ae5f 26}
27
28sub BUILDARGS {
29 my $class = shift;
a62dcd43 30 if ( scalar @_ == 1 ) {
31 unless ( defined $_[0] && ref $_[0] eq 'HASH' ) {
46047bea 32 Class::MOP::class_of($class)->throw_error(
a62dcd43 33 "Single parameters to new() must be a HASH ref",
34 data => $_[0] );
86629f93 35 }
a62dcd43 36 return { %{ $_[0] } };
37 }
8a157bab 38 else {
e606ae5f 39 return {@_};
8a157bab 40 }
fcd84ca9 41}
42
c0e30cf5 43sub BUILDALL {
d03bd989 44 # NOTE: we ask Perl if we even
d44714be 45 # need to do this first, to avoid
46 # extra meta level calls
17819f17 47 return unless $_[0]->can('BUILD');
fb1e11d5 48 my ($self, $params) = @_;
505033d9 49 foreach my $method (reverse Class::MOP::class_of($self)->find_all_methods_by_name('BUILD')) {
b8f014e7 50 $method->{code}->execute($self, $params);
fb1e11d5 51 }
c0e30cf5 52}
53
54sub DEMOLISHALL {
8955a780 55 my $self = shift;
d9359278 56 my ($in_global_destruction) = @_;
8955a780 57
58 # NOTE: we ask Perl if we even
cb5c79c9 59 # need to do this first, to avoid
8955a780 60 # extra meta level calls
17819f17 61 return unless $self->can('DEMOLISH');
8955a780 62
2bc1eab6 63 my @isa;
64 if ( my $meta = Class::MOP::class_of($self ) ) {
65 @isa = $meta->linearized_isa;
66 } else {
67 # We cannot count on being able to retrieve a previously made
68 # metaclass, _or_ being able to make a new one during global
69 # destruction. However, we should still be able to use mro at
70 # that time (at least tests suggest so ;)
71 my $class_name = ref $self;
72 @isa = @{ mro::get_linear_isa($class_name) }
73 }
74
75 foreach my $class (@isa) {
c063fc8b 76 no strict 'refs';
77 my $demolish = *{"${class}::DEMOLISH"}{CODE};
78 $self->$demolish($in_global_destruction)
79 if defined $demolish;
3a0c064a 80 }
81}
82
d03bd989 83sub DESTROY {
b288593e 84 my $self = shift;
85
86 local $?;
87
f25f9912 88 Try::Tiny::try {
89 $self->DEMOLISHALL(Devel::GlobalDestruction::in_global_destruction);
b288593e 90 }
f25f9912 91 Try::Tiny::catch {
b288593e 92 # Without this, Perl will warn "\t(in cleanup)$@" because of some
93 # bizarre fucked-up logic deep in the internals.
94 no warnings 'misc';
95 die $_;
96 };
97
c989424b 98 return;
c0e30cf5 99}
100
e606ae5f 101# support for UNIVERSAL::DOES ...
102BEGIN {
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
d03bd989 111# new does() methods will be created
50bc108b 112# as appropiate see Moose::Meta::Role
0677220d 113sub does {
bdabd620 114 my ($self, $role_name) = @_;
66d33a5c 115 my $meta = Class::MOP::class_of($self);
be05faea 116 (defined $role_name)
d9de4f04 117 || $meta->throw_error("You must supply a role name to does()");
b82ef9c3 118 return 1 if $meta->can('does_role') && $meta->does_role($role_name);
d03bd989 119 return 0;
0677220d 120}
ef333f17 121
d03bd989 122sub dump {
f742dfef 123 my $self = shift;
124 require Data::Dumper;
1a386a6c 125 local $Data::Dumper::Maxdepth = shift if @_;
f742dfef 126 Data::Dumper::Dumper $self;
127}
128
fcd84ca9 1291;
130
131__END__
132
133=pod
134
135=head1 NAME
136
e522431d 137Moose::Object - The base object for Moose
fcd84ca9 138
fcd84ca9 139=head1 DESCRIPTION
140
080e3614 141This class is the default base class for all Moose-using classes. When
142you C<use Moose> in this class, your class will inherit from this
143class.
6ba6d68c 144
080e3614 145It provides a default constructor and destructor, which run the
146C<BUILDALL> and C<DEMOLISHALL> methods respectively.
147
148You don't actually I<need> to inherit from this in order to use Moose,
149but it makes it easier to take advantage of all of Moose's features.
6ba6d68c 150
fcd84ca9 151=head1 METHODS
152
153=over 4
154
080e3614 155=item B<< Moose::Object->new(%params) >>
156
157This method calls C<< $class->BUILDARGS(@_) >>, and then creates a new
158instance of the appropriate class. Once the instance is created, it
159calls C<< $instance->BUILDALL($params) >>.
fcd84ca9 160
080e3614 161=item B<< Moose::Object->BUILDARGS(%params) >>
6ba6d68c 162
080e3614 163The default implementation of this method accepts a hash or hash
164reference of named parameters. If it receives a single argument that
165I<isn't> a hash reference it throws an error.
fcd84ca9 166
080e3614 167You can override this method in your class to handle other types of
168options passed to the constructor.
e606ae5f 169
080e3614 170This method should always return a hash reference of named options.
e606ae5f 171
080e3614 172=item B<< $object->BUILDALL($params) >>
e522431d 173
080e3614 174This method will call every C<BUILD> method in the inheritance
175hierarchy, starting with the most distant parent class and ending with
176the object's class.
c0e30cf5 177
080e3614 178The C<BUILD> method will be passed the hash reference returned by
179C<BUILDARGS>.
e522431d 180
080e3614 181=item B<< $object->DEMOLISHALL >>
c0e30cf5 182
080e3614 183This will call every C<DEMOLISH> method in the inheritance hierarchy,
184starting with the object's class and ending with the most distant
c3fdacda 185parent. C<DEMOLISHALL> and C<DEMOLISH> will receive a boolean
186indicating whether or not we are currently in global destruction.
e522431d 187
080e3614 188=item B<< $object->does($role_name) >>
ef333f17 189
080e3614 190This returns true if the object does the given role.
02a0fb52 191
e606ae5f 192=item B<DOES ($class_or_role_name)>
193
080e3614 194This is a a Moose role-aware implementation of L<UNIVERSAL/DOES>.
e606ae5f 195
080e3614 196This is effectively the same as writing:
e606ae5f 197
080e3614 198 $object->does($name) || $object->isa($name)
f742dfef 199
080e3614 200This method will work with Perl 5.8, which did not implement
201C<UNIVERSAL::DOES>.
f742dfef 202
080e3614 203=item B<< $object->dump($maxdepth) >>
f742dfef 204
080e3614 205This is a handy utility for C<Data::Dumper>ing an object. By default,
206the maximum depth is 1, to avoid making a mess.
f742dfef 207
fcd84ca9 208=back
209
210=head1 BUGS
211
d4048ef3 212See L<Moose/BUGS> for details on reporting bugs.
fcd84ca9 213
fcd84ca9 214=head1 AUTHOR
215
216Stevan Little E<lt>stevan@iinteractive.comE<gt>
217
218=head1 COPYRIGHT AND LICENSE
219
7e0492d3 220Copyright 2006-2010 by Infinity Interactive, Inc.
fcd84ca9 221
222L<http://www.iinteractive.com>
223
224This library is free software; you can redistribute it and/or modify
d03bd989 225it under the same terms as Perl itself.
fcd84ca9 226
9922fa6f 227=cut