← Index
Performance Profile   « block view • line view • sub view »
For t/test-parsing
  Run on Sun Nov 14 09:49:57 2010
Reported on Sun Nov 14 09:50:12 2010

File /usr/local/lib/perl/5.10.0/Moose/Object.pm
Statements Executed 40
Total Time 0.0014742 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sMoose::Object::::BEGINMoose::Object::BEGIN
0000s0sMoose::Object::::BUILDALLMoose::Object::BUILDALL
0000s0sMoose::Object::::BUILDARGSMoose::Object::BUILDARGS
0000s0sMoose::Object::::DEMOLISHALLMoose::Object::DEMOLISHALL
0000s0sMoose::Object::::DESTROYMoose::Object::DESTROY
0000s0sMoose::Object::::__ANON__[:101]Moose::Object::__ANON__[:101]
0000s0sMoose::Object::::__ANON__[:95]Moose::Object::__ANON__[:95]
0000s0sMoose::Object::::doesMoose::Object::does
0000s0sMoose::Object::::dumpMoose::Object::dump
0000s0sMoose::Object::::newMoose::Object::new
LineStmts.Exclusive
Time
Avg.Code
1
2package Moose::Object;
3
4325µs8µsuse strict;
# spent 8µs making 1 call to strict::import
5327µs9µsuse warnings;
# spent 27µs making 1 call to warnings::import
6
7320µs6µsuse Devel::GlobalDestruction ();
8314µs5µsuse MRO::Compat ();
9319µs6µsuse Scalar::Util ();
10347µs16µsuse Try::Tiny ();
11
123361µs120µsuse if ( not our $__mx_is_compiled ), 'Moose::Meta::Class';
# spent 14µs making 1 call to if::import
133224µs75µsuse if ( not our $__mx_is_compiled ), metaclass => 'Moose::Meta::Class';
# spent 9µs making 1 call to if::import
14
151900ns900nsour $VERSION = '1.15';
16122µs22µs$VERSION = eval $VERSION;
171600ns600nsour $AUTHORITY = 'cpan:STEVAN';
18
19sub 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
28sub 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 ) {
403241µs80µs use YAML;
# spent 63µs making 1 call to Exporter::import
41 print "NON !!!", Dump(\@_);
42 exit;
43 }
44 return {@_};
45 }
46}
47
48sub 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
59sub 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) {
813164µs55µ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
88sub 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.
99387µs29µ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 ...
107BEGIN {
108112µs12µs my $does = UNIVERSAL->can("DOES") ? "SUPER::DOES" : "isa";
# spent 7µs making 1 call to UNIVERSAL::can
109161µs61µs 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 }';
1141144µs144µs}
115
116# new does() methods will be created
117# as appropiate see Moose::Meta::Role
118sub 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
127sub dump {
128 my $self = shift;
129 require Data::Dumper;
130 local $Data::Dumper::Maxdepth = shift if @_;
131 Data::Dumper::Dumper $self;
132}
133
13416µs6µs1;
135
136__END__
137
138=pod
139
140=head1 NAME
141
142Moose::Object - The base object for Moose
143
144=head1 DESCRIPTION
145
146This class is the default base class for all Moose-using classes. When
147you C<use Moose> in this class, your class will inherit from this
148class.
149
150It provides a default constructor and destructor, which run the
151C<BUILDALL> and C<DEMOLISHALL> methods respectively.
152
153You don't actually I<need> to inherit from this in order to use Moose,
154but 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
162This method calls C<< $class->BUILDARGS(@_) >>, and then creates a new
163instance of the appropriate class. Once the instance is created, it
164calls C<< $instance->BUILDALL($params) >>.
165
166=item B<< Moose::Object->BUILDARGS(%params) >>
167
168The default implementation of this method accepts a hash or hash
169reference of named parameters. If it receives a single argument that
170I<isn't> a hash reference it throws an error.
171
172You can override this method in your class to handle other types of
173options passed to the constructor.
174
175This method should always return a hash reference of named options.
176
177=item B<< $object->BUILDALL($params) >>
178
179This method will call every C<BUILD> method in the inheritance
180hierarchy, starting with the most distant parent class and ending with
181the object's class.
182
183The C<BUILD> method will be passed the hash reference returned by
184C<BUILDARGS>.
185
186=item B<< $object->DEMOLISHALL >>
187
188This will call every C<DEMOLISH> method in the inheritance hierarchy,
189starting with the object's class and ending with the most distant
190parent. C<DEMOLISHALL> and C<DEMOLISH> will receive a boolean
191indicating whether or not we are currently in global destruction.
192
193=item B<< $object->does($role_name) >>
194
195This returns true if the object does the given role.
196
197=item B<DOES ($class_or_role_name)>
198
199This is a a Moose role-aware implementation of L<UNIVERSAL/DOES>.
200
201This is effectively the same as writing:
202
203 $object->does($name) || $object->isa($name)
204
205This method will work with Perl 5.8, which did not implement
206C<UNIVERSAL::DOES>.
207
208=item B<< $object->dump($maxdepth) >>
209
210This is a handy utility for C<Data::Dumper>ing an object. By default,
211the maximum depth is 1, to avoid making a mess.
212
213=back
214
215=head1 BUGS
216
217See L<Moose/BUGS> for details on reporting bugs.
218
219=head1 AUTHOR
220
221Stevan Little E<lt>stevan@iinteractive.comE<gt>
222
223=head1 COPYRIGHT AND LICENSE
224
225Copyright 2006-2010 by Infinity Interactive, Inc.
226
227L<http://www.iinteractive.com>
228
229This library is free software; you can redistribute it and/or modify
230it under the same terms as Perl itself.
231
232=cut