Refactor many many things
[gitmo/Mouse.git] / lib / Mouse / Object.pm
CommitLineData
c3398f5b 1package Mouse::Object;
2use strict;
3use warnings;
c3398f5b 4
6d28c5cf 5use Mouse::Util;
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
df963a63 69sub dump {
8536d351 70 my($self, $maxdepth) = @_;
71
72 require 'Data/Dumper.pm'; # we don't want to create its namespace
73 my $dd = Data::Dumper->new([$self]);
1b9e472d 74 $dd->Maxdepth(defined($maxdepth) ? $maxdepth : 2);
75 $dd->Indent(1);
8536d351 76 return $dd->Dump();
df963a63 77}
78
56a558f9 79
80sub does {
81 my ($self, $role_name) = @_;
82 (defined $role_name)
fce211ae 83 || $self->meta->throw_error("You must supply a role name to does()");
3a63a2e7 84
3370794f 85 return $self->meta->does_role($role_name);
56a558f9 86};
87
c3398f5b 881;
89
90__END__
91
92=head1 NAME
93
94Mouse::Object - we don't need to steenkin' constructor
95
96=head1 METHODS
97
98=head2 new arguments -> object
99
100Instantiates a new Mouse::Object. This is obviously intended for subclasses.
101
102=head2 BUILDALL \%args
103
104Calls L</BUILD> on each class in the class hierarchy. This is called at the
105end of L</new>.
106
107=head2 BUILD \%args
108
109You may put any business logic initialization in BUILD methods. You don't
110need to redispatch or return any specific value.
111
442125dc 112=head2 BUILDARGS
113
114Lets you override the arguments that C<new> takes. Return a hashref of
115parameters.
116
c3398f5b 117=head2 DEMOLISHALL
118
119Calls L</DEMOLISH> on each class in the class hierarchy. This is called at
120L</DESTROY> time.
121
122=head2 DEMOLISH
123
124You may put any business logic deinitialization in DEMOLISH methods. You don't
125need to redispatch or return any specific value.
126
df963a63 127
56a558f9 128=head2 does $role_name
129
130This will check if the invocant's class "does" a given C<$role_name>.
131This is similar to "isa" for object, but it checks the roles instead.
132
133
df963a63 134=head2 B<dump ($maxdepth)>
135
136From the Moose POD:
137
138 C'mon, how many times have you written the following code while debugging:
139
140 use Data::Dumper;
141 warn Dumper $obj;
142
143 It can get seriously annoying, so why not just use this.
144
145The implementation was lifted directly from Moose::Object.
146
c3398f5b 147=cut
148
df963a63 149