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