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