Tidy
[gitmo/Mouse.git] / lib / Mouse / Object.pm
CommitLineData
c3398f5b 1package Mouse::Object;
2use strict;
3use warnings;
c3398f5b 4
53875581 5use Mouse::Util qw(does dump);
6d28c5cf 6
c3398f5b 7sub new {
8 my $class = shift;
d574882a 9
fce211ae 10 $class->throw_error('Cannot call new() on an instance') if ref $class;
da4cb913 11
8536d351 12 my $args = $class->BUILDARGS(@_);
c3398f5b 13
fce211ae 14 my $instance = Mouse::Meta::Class->initialize($class)->new_object($args);
d574882a 15 $instance->BUILDALL($args);
c3398f5b 16 return $instance;
17}
18
d574882a 19sub BUILDARGS {
20 my $class = shift;
21
22 if (scalar @_ == 1) {
c9aefe26 23 (ref($_[0]) eq 'HASH')
fce211ae 24 || $class->meta->throw_error("Single parameters to new() must be a HASH ref");
c9aefe26 25 return {%{$_[0]}};
d574882a 26 }
27 else {
28 return {@_};
29 }
30}
31
c3398f5b 32sub DESTROY { shift->DEMOLISHALL }
33
34sub BUILDALL {
35 my $self = shift;
36
37 # short circuit
38 return unless $self->can('BUILD');
39
2230a6a3 40 for my $class (reverse $self->meta->linearized_isa) {
cbe29bd9 41 no strict 'refs';
42 no warnings 'once';
c3398f5b 43 my $code = *{ $class . '::BUILD' }{CODE}
44 or next;
45 $code->($self, @_);
46 }
3a63a2e7 47 return;
c3398f5b 48}
49
50sub DEMOLISHALL {
51 my $self = shift;
52
53 # short circuit
54 return unless $self->can('DEMOLISH');
55
8536d351 56 # We cannot count on being able to retrieve a previously made
57 # metaclass, _or_ being able to make a new one during global
58 # destruction. However, we should still be able to use mro at
59 # that time (at least tests suggest so ;)
c26e296a 60
8536d351 61 foreach my $class (@{ Mouse::Util::get_linear_isa(ref $self) }) {
62 my $demolish = do{ no strict 'refs'; *{"${class}::DEMOLISH"}{CODE} };
63 $self->$demolish()
c26e296a 64 if defined $demolish;
c3398f5b 65 }
3a63a2e7 66 return;
c3398f5b 67}
68
691;
70
71__END__
72
73=head1 NAME
74
75Mouse::Object - we don't need to steenkin' constructor
76
77=head1 METHODS
78
79=head2 new arguments -> object
80
81Instantiates a new Mouse::Object. This is obviously intended for subclasses.
82
83=head2 BUILDALL \%args
84
85Calls L</BUILD> on each class in the class hierarchy. This is called at the
86end of L</new>.
87
88=head2 BUILD \%args
89
90You may put any business logic initialization in BUILD methods. You don't
91need to redispatch or return any specific value.
92
442125dc 93=head2 BUILDARGS
94
95Lets you override the arguments that C<new> takes. Return a hashref of
96parameters.
97
c3398f5b 98=head2 DEMOLISHALL
99
100Calls L</DEMOLISH> on each class in the class hierarchy. This is called at
101L</DESTROY> time.
102
103=head2 DEMOLISH
104
105You may put any business logic deinitialization in DEMOLISH methods. You don't
106need to redispatch or return any specific value.
107
df963a63 108
56a558f9 109=head2 does $role_name
110
111This will check if the invocant's class "does" a given C<$role_name>.
112This is similar to "isa" for object, but it checks the roles instead.
113
114
df963a63 115=head2 B<dump ($maxdepth)>
116
117From the Moose POD:
118
119 C'mon, how many times have you written the following code while debugging:
120
121 use Data::Dumper;
122 warn Dumper $obj;
123
124 It can get seriously annoying, so why not just use this.
125
126The implementation was lifted directly from Moose::Object.
127
c3398f5b 128=cut
129
df963a63 130