Commit | Line | Data |
c3398f5b |
1 | package Mouse::Object; |
2 | use strict; |
3 | use warnings; |
c3398f5b |
4 | |
6d28c5cf |
5 | use Mouse::Util; |
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"); |
c9aefe26 |
25 | return {%{$_[0]}}; |
d574882a |
26 | } |
27 | else { |
28 | return {@_}; |
29 | } |
30 | } |
31 | |
c3398f5b |
32 | sub DESTROY { shift->DEMOLISHALL } |
33 | |
34 | sub 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 | |
50 | sub 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 |
69 | sub 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 | |
80 | sub 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 |
88 | 1; |
89 | |
90 | __END__ |
91 | |
92 | =head1 NAME |
93 | |
94 | Mouse::Object - we don't need to steenkin' constructor |
95 | |
96 | =head1 METHODS |
97 | |
98 | =head2 new arguments -> object |
99 | |
100 | Instantiates a new Mouse::Object. This is obviously intended for subclasses. |
101 | |
102 | =head2 BUILDALL \%args |
103 | |
104 | Calls L</BUILD> on each class in the class hierarchy. This is called at the |
105 | end of L</new>. |
106 | |
107 | =head2 BUILD \%args |
108 | |
109 | You may put any business logic initialization in BUILD methods. You don't |
110 | need to redispatch or return any specific value. |
111 | |
442125dc |
112 | =head2 BUILDARGS |
113 | |
114 | Lets you override the arguments that C<new> takes. Return a hashref of |
115 | parameters. |
116 | |
c3398f5b |
117 | =head2 DEMOLISHALL |
118 | |
119 | Calls L</DEMOLISH> on each class in the class hierarchy. This is called at |
120 | L</DESTROY> time. |
121 | |
122 | =head2 DEMOLISH |
123 | |
124 | You may put any business logic deinitialization in DEMOLISH methods. You don't |
125 | need to redispatch or return any specific value. |
126 | |
df963a63 |
127 | |
56a558f9 |
128 | =head2 does $role_name |
129 | |
130 | This will check if the invocant's class "does" a given C<$role_name>. |
131 | This is similar to "isa" for object, but it checks the roles instead. |
132 | |
133 | |
df963a63 |
134 | =head2 B<dump ($maxdepth)> |
135 | |
136 | From 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 | |
145 | The implementation was lifted directly from Moose::Object. |
146 | |
c3398f5b |
147 | =cut |
148 | |
df963a63 |
149 | |