File | /usr/local/lib/perl/5.10.0/Moose/Object.pm |
Statements Executed | 40 |
Total Time | 0.0014742 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
0 | 0 | 0 | 0s | 0s | BEGIN | Moose::Object::
0 | 0 | 0 | 0s | 0s | BUILDALL | Moose::Object::
0 | 0 | 0 | 0s | 0s | BUILDARGS | Moose::Object::
0 | 0 | 0 | 0s | 0s | DEMOLISHALL | Moose::Object::
0 | 0 | 0 | 0s | 0s | DESTROY | Moose::Object::
0 | 0 | 0 | 0s | 0s | __ANON__[:101] | Moose::Object::
0 | 0 | 0 | 0s | 0s | __ANON__[:95] | Moose::Object::
0 | 0 | 0 | 0s | 0s | does | Moose::Object::
0 | 0 | 0 | 0s | 0s | dump | Moose::Object::
0 | 0 | 0 | 0s | 0s | new | Moose::Object::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | ||||
2 | package Moose::Object; | |||
3 | ||||
4 | 3 | 25µs | 8µs | use strict; # spent 8µs making 1 call to strict::import |
5 | 3 | 27µs | 9µs | use warnings; # spent 27µs making 1 call to warnings::import |
6 | ||||
7 | 3 | 20µs | 6µs | use Devel::GlobalDestruction (); |
8 | 3 | 14µs | 5µs | use MRO::Compat (); |
9 | 3 | 19µs | 6µs | use Scalar::Util (); |
10 | 3 | 47µs | 16µs | use Try::Tiny (); |
11 | ||||
12 | 3 | 361µs | 120µs | use if ( not our $__mx_is_compiled ), 'Moose::Meta::Class'; # spent 14µs making 1 call to if::import |
13 | 3 | 224µs | 75µs | use if ( not our $__mx_is_compiled ), metaclass => 'Moose::Meta::Class'; # spent 9µs making 1 call to if::import |
14 | ||||
15 | 1 | 900ns | 900ns | our $VERSION = '1.15'; |
16 | 1 | 22µs | 22µs | $VERSION = eval $VERSION; |
17 | 1 | 600ns | 600ns | our $AUTHORITY = 'cpan:STEVAN'; |
18 | ||||
19 | sub new { | |||
20 | my $class = shift; | |||
21 | my $real_class = Scalar::Util::blessed($class) || $class; | |||
22 | ||||
23 | my $params = $real_class->BUILDARGS(@_); | |||
24 | ||||
25 | return Class::MOP::Class->initialize($real_class)->new_object($params); | |||
26 | } | |||
27 | ||||
28 | sub BUILDARGS { | |||
29 | my $class = shift; | |||
30 | if ( scalar @_ == 1 ) { | |||
31 | unless ( defined $_[0] && ref $_[0] eq 'HASH' ) { | |||
32 | Class::MOP::class_of($class)->throw_error( | |||
33 | "Single parameters to new() must be a HASH ref", | |||
34 | data => $_[0] ); | |||
35 | } | |||
36 | return { %{ $_[0] } }; | |||
37 | } | |||
38 | else { | |||
39 | if ( @_ % 2 ) { | |||
40 | 3 | 241µs | 80µs | use YAML; # spent 63µs making 1 call to Exporter::import |
41 | print "NON !!!", Dump(\@_); | |||
42 | exit; | |||
43 | } | |||
44 | return {@_}; | |||
45 | } | |||
46 | } | |||
47 | ||||
48 | sub BUILDALL { | |||
49 | # NOTE: we ask Perl if we even | |||
50 | # need to do this first, to avoid | |||
51 | # extra meta level calls | |||
52 | return unless $_[0]->can('BUILD'); | |||
53 | my ($self, $params) = @_; | |||
54 | foreach my $method (reverse Class::MOP::class_of($self)->find_all_methods_by_name('BUILD')) { | |||
55 | $method->{code}->execute($self, $params); | |||
56 | } | |||
57 | } | |||
58 | ||||
59 | sub DEMOLISHALL { | |||
60 | my $self = shift; | |||
61 | my ($in_global_destruction) = @_; | |||
62 | ||||
63 | # NOTE: we ask Perl if we even | |||
64 | # need to do this first, to avoid | |||
65 | # extra meta level calls | |||
66 | return unless $self->can('DEMOLISH'); | |||
67 | ||||
68 | my @isa; | |||
69 | if ( my $meta = Class::MOP::class_of($self ) ) { | |||
70 | @isa = $meta->linearized_isa; | |||
71 | } else { | |||
72 | # We cannot count on being able to retrieve a previously made | |||
73 | # metaclass, _or_ being able to make a new one during global | |||
74 | # destruction. However, we should still be able to use mro at | |||
75 | # that time (at least tests suggest so ;) | |||
76 | my $class_name = ref $self; | |||
77 | @isa = @{ mro::get_linear_isa($class_name) } | |||
78 | } | |||
79 | ||||
80 | foreach my $class (@isa) { | |||
81 | 3 | 164µs | 55µs | no strict 'refs'; # spent 28µs making 1 call to strict::unimport |
82 | my $demolish = *{"${class}::DEMOLISH"}{CODE}; | |||
83 | $self->$demolish($in_global_destruction) | |||
84 | if defined $demolish; | |||
85 | } | |||
86 | } | |||
87 | ||||
88 | sub DESTROY { | |||
89 | my $self = shift; | |||
90 | ||||
91 | local $?; | |||
92 | ||||
93 | Try::Tiny::try { | |||
94 | $self->DEMOLISHALL(Devel::GlobalDestruction::in_global_destruction); | |||
95 | } | |||
96 | Try::Tiny::catch { | |||
97 | # Without this, Perl will warn "\t(in cleanup)$@" because of some | |||
98 | # bizarre fucked-up logic deep in the internals. | |||
99 | 3 | 87µs | 29µs | no warnings 'misc'; # spent 26µs making 1 call to warnings::unimport |
100 | die $_; | |||
101 | }; | |||
102 | ||||
103 | return; | |||
104 | } | |||
105 | ||||
106 | # support for UNIVERSAL::DOES ... | |||
107 | BEGIN { | |||
108 | 2 | 73µs | 36µs | my $does = UNIVERSAL->can("DOES") ? "SUPER::DOES" : "isa"; # spent 7µs making 1 call to UNIVERSAL::can |
109 | eval 'sub DOES { | |||
110 | my ( $self, $class_or_role_name ) = @_; | |||
111 | return $self->'.$does.'($class_or_role_name) | |||
112 | || $self->does($class_or_role_name); | |||
113 | }'; | |||
114 | 1 | 144µs | 144µs | } |
115 | ||||
116 | # new does() methods will be created | |||
117 | # as appropiate see Moose::Meta::Role | |||
118 | sub does { | |||
119 | my ($self, $role_name) = @_; | |||
120 | my $meta = Class::MOP::class_of($self); | |||
121 | (defined $role_name) | |||
122 | || $meta->throw_error("You must supply a role name to does()"); | |||
123 | return 1 if $meta->can('does_role') && $meta->does_role($role_name); | |||
124 | return 0; | |||
125 | } | |||
126 | ||||
127 | sub dump { | |||
128 | my $self = shift; | |||
129 | require Data::Dumper; | |||
130 | local $Data::Dumper::Maxdepth = shift if @_; | |||
131 | Data::Dumper::Dumper $self; | |||
132 | } | |||
133 | ||||
134 | 1 | 6µs | 6µs | 1; |
135 | ||||
136 | __END__ | |||
137 | ||||
138 | =pod | |||
139 | ||||
140 | =head1 NAME | |||
141 | ||||
142 | Moose::Object - The base object for Moose | |||
143 | ||||
144 | =head1 DESCRIPTION | |||
145 | ||||
146 | This class is the default base class for all Moose-using classes. When | |||
147 | you C<use Moose> in this class, your class will inherit from this | |||
148 | class. | |||
149 | ||||
150 | It provides a default constructor and destructor, which run the | |||
151 | C<BUILDALL> and C<DEMOLISHALL> methods respectively. | |||
152 | ||||
153 | You don't actually I<need> to inherit from this in order to use Moose, | |||
154 | but it makes it easier to take advantage of all of Moose's features. | |||
155 | ||||
156 | =head1 METHODS | |||
157 | ||||
158 | =over 4 | |||
159 | ||||
160 | =item B<< Moose::Object->new(%params) >> | |||
161 | ||||
162 | This method calls C<< $class->BUILDARGS(@_) >>, and then creates a new | |||
163 | instance of the appropriate class. Once the instance is created, it | |||
164 | calls C<< $instance->BUILDALL($params) >>. | |||
165 | ||||
166 | =item B<< Moose::Object->BUILDARGS(%params) >> | |||
167 | ||||
168 | The default implementation of this method accepts a hash or hash | |||
169 | reference of named parameters. If it receives a single argument that | |||
170 | I<isn't> a hash reference it throws an error. | |||
171 | ||||
172 | You can override this method in your class to handle other types of | |||
173 | options passed to the constructor. | |||
174 | ||||
175 | This method should always return a hash reference of named options. | |||
176 | ||||
177 | =item B<< $object->BUILDALL($params) >> | |||
178 | ||||
179 | This method will call every C<BUILD> method in the inheritance | |||
180 | hierarchy, starting with the most distant parent class and ending with | |||
181 | the object's class. | |||
182 | ||||
183 | The C<BUILD> method will be passed the hash reference returned by | |||
184 | C<BUILDARGS>. | |||
185 | ||||
186 | =item B<< $object->DEMOLISHALL >> | |||
187 | ||||
188 | This will call every C<DEMOLISH> method in the inheritance hierarchy, | |||
189 | starting with the object's class and ending with the most distant | |||
190 | parent. C<DEMOLISHALL> and C<DEMOLISH> will receive a boolean | |||
191 | indicating whether or not we are currently in global destruction. | |||
192 | ||||
193 | =item B<< $object->does($role_name) >> | |||
194 | ||||
195 | This returns true if the object does the given role. | |||
196 | ||||
197 | =item B<DOES ($class_or_role_name)> | |||
198 | ||||
199 | This is a a Moose role-aware implementation of L<UNIVERSAL/DOES>. | |||
200 | ||||
201 | This is effectively the same as writing: | |||
202 | ||||
203 | $object->does($name) || $object->isa($name) | |||
204 | ||||
205 | This method will work with Perl 5.8, which did not implement | |||
206 | C<UNIVERSAL::DOES>. | |||
207 | ||||
208 | =item B<< $object->dump($maxdepth) >> | |||
209 | ||||
210 | This is a handy utility for C<Data::Dumper>ing an object. By default, | |||
211 | the maximum depth is 1, to avoid making a mess. | |||
212 | ||||
213 | =back | |||
214 | ||||
215 | =head1 BUGS | |||
216 | ||||
217 | See L<Moose/BUGS> for details on reporting bugs. | |||
218 | ||||
219 | =head1 AUTHOR | |||
220 | ||||
221 | Stevan Little E<lt>stevan@iinteractive.comE<gt> | |||
222 | ||||
223 | =head1 COPYRIGHT AND LICENSE | |||
224 | ||||
225 | Copyright 2006-2010 by Infinity Interactive, Inc. | |||
226 | ||||
227 | L<http://www.iinteractive.com> | |||
228 | ||||
229 | This library is free software; you can redistribute it and/or modify | |||
230 | it under the same terms as Perl itself. | |||
231 | ||||
232 | =cut |