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