File | /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Destructor.pm |
Statements Executed | 218 |
Total Time | 0.0019416 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
7 | 1 | 1 | 683µs | 3.67ms | new | Moose::Meta::Method::Destructor::
7 | 1 | 1 | 226µs | 2.96ms | _initialize_body | Moose::Meta::Method::Destructor::
7 | 1 | 1 | 68µs | 1.79ms | is_needed | Moose::Meta::Method::Destructor::
7 | 1 | 1 | 31µs | 31µs | options | Moose::Meta::Method::Destructor::
0 | 0 | 0 | 0s | 0s | BEGIN | Moose::Meta::Method::Destructor::
0 | 0 | 0 | 0s | 0s | initialize_body | Moose::Meta::Method::Destructor::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | ||||
2 | package Moose::Meta::Method::Destructor; | |||
3 | ||||
4 | 3 | 26µs | 9µs | use strict; # spent 11µs making 1 call to strict::import |
5 | 3 | 31µs | 10µs | use warnings; # spent 27µs making 1 call to warnings::import |
6 | ||||
7 | 3 | 24µs | 8µs | use Devel::GlobalDestruction (); |
8 | 3 | 29µs | 10µs | use Scalar::Util 'blessed', 'weaken'; # spent 65µs making 1 call to Exporter::import |
9 | 3 | 66µs | 22µs | use Try::Tiny (); |
10 | ||||
11 | 1 | 900ns | 900ns | our $VERSION = '1.15'; |
12 | 1 | 25µs | 25µs | $VERSION = eval $VERSION; |
13 | 1 | 600ns | 600ns | our $AUTHORITY = 'cpan:STEVAN'; |
14 | ||||
15 | use base 'Moose::Meta::Method', # spent 140µs making 1 call to base::import | |||
16 | 3 | 577µs | 192µs | 'Class::MOP::Method::Inlined'; |
17 | ||||
18 | # spent 3.67ms (683µs+2.99) within Moose::Meta::Method::Destructor::new which was called 7 times, avg 524µs/call:
# 7 times (683µs+2.99ms) by Class::MOP::Class::_inline_destructor at line 1332 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 524µs/call | |||
19 | 56 | 711µs | 13µs | my $class = shift; |
20 | my %options = @_; | |||
21 | ||||
22 | (ref $options{options} eq 'HASH') | |||
23 | || $class->throw_error("You must pass a hash of options", data => $options{options}); | |||
24 | ||||
25 | ($options{package_name} && $options{name}) | |||
26 | || $class->throw_error("You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT"); | |||
27 | ||||
28 | my $self = bless { | |||
29 | # from our superclass | |||
30 | 'body' => undef, | |||
31 | 'package_name' => $options{package_name}, | |||
32 | 'name' => $options{name}, | |||
33 | # ... | |||
34 | 'options' => $options{options}, | |||
35 | 'associated_metaclass' => $options{metaclass}, | |||
36 | } => $class; | |||
37 | ||||
38 | # we don't want this creating | |||
39 | # a cycle in the code, if not | |||
40 | # needed | |||
41 | weaken($self->{'associated_metaclass'}); # spent 24µs making 7 calls to Scalar::Util::weaken, avg 3µs/call | |||
42 | ||||
43 | $self->_initialize_body; # spent 2.96ms making 7 calls to Moose::Meta::Method::Destructor::_initialize_body, avg 423µs/call | |||
44 | ||||
45 | return $self; | |||
46 | } | |||
47 | ||||
48 | ## accessors | |||
49 | ||||
50 | 7 | 11µs | 2µs | # spent 31µs within Moose::Meta::Method::Destructor::options which was called 7 times, avg 4µs/call:
# 7 times (31µs+0s) by Moose::Meta::Method::Destructor::_initialize_body at line 109, avg 4µs/call |
51 | ||||
52 | ## method | |||
53 | ||||
54 | # spent 1.79ms (68µs+1.72) within Moose::Meta::Method::Destructor::is_needed which was called 7 times, avg 255µs/call:
# 7 times (68µs+1.72ms) by Class::MOP::Class::_inline_destructor at line 1330 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 255µs/call | |||
55 | 28 | 125µs | 4µs | my $self = shift; |
56 | my $metaclass = shift; | |||
57 | ||||
58 | ( blessed $metaclass && $metaclass->isa('Class::MOP::Class') ) # spent 30µs making 7 calls to UNIVERSAL::isa, avg 4µs/call
# spent 23µs making 7 calls to Scalar::Util::blessed, avg 3µs/call | |||
59 | || $self->throw_error( | |||
60 | "The is_needed method expected a metaclass object as its arugment"); | |||
61 | ||||
62 | return $metaclass->find_method_by_name("DEMOLISHALL"); # spent 1.67ms making 7 calls to Class::MOP::Class::find_method_by_name, avg 238µs/call | |||
63 | } | |||
64 | ||||
65 | sub initialize_body { | |||
66 | Carp::cluck('The initialize_body method has been made private.' | |||
67 | . " The public version is deprecated and will be removed in a future release.\n"); | |||
68 | shift->_initialize_body; | |||
69 | } | |||
70 | ||||
71 | # spent 2.96ms (226µs+2.74) within Moose::Meta::Method::Destructor::_initialize_body which was called 7 times, avg 423µs/call:
# 7 times (226µs+2.74ms) by Moose::Meta::Method::Destructor::new at line 43, avg 423µs/call | |||
72 | 105 | 312µs | 3µs | my $self = shift; |
73 | # TODO: | |||
74 | # the %options should also include a both | |||
75 | # a call 'initializer' and call 'SUPER::' | |||
76 | # options, which should cover approx 90% | |||
77 | # of the possible use cases (even if it | |||
78 | # requires some adaption on the part of | |||
79 | # the author, after all, nothing is free) | |||
80 | ||||
81 | my @DEMOLISH_methods = $self->associated_metaclass->find_all_methods_by_name('DEMOLISH'); # spent 1.54ms making 7 calls to Class::MOP::Class::find_all_methods_by_name, avg 219µs/call
# spent 28µs making 7 calls to Class::MOP::Method::associated_metaclass, avg 4µs/call | |||
82 | ||||
83 | my $source; | |||
84 | $source = 'sub {' . "\n"; | |||
85 | $source .= 'my $self = shift;' . "\n"; | |||
86 | $source .= 'return $self->Moose::Object::DESTROY(@_)' . "\n"; | |||
87 | $source .= ' if Scalar::Util::blessed($self) ne '; | |||
88 | $source .= "'" . $self->associated_metaclass->name . "'"; # spent 37µs making 7 calls to Class::MOP::Package::name, avg 5µs/call
# spent 28µs making 7 calls to Class::MOP::Method::associated_metaclass, avg 4µs/call | |||
89 | $source .= ';' . "\n"; | |||
90 | ||||
91 | if ( @DEMOLISH_methods ) { | |||
92 | $source .= 'local $?;' . "\n"; | |||
93 | ||||
94 | $source .= 'my $in_global_destruction = Devel::GlobalDestruction::in_global_destruction;' . "\n"; | |||
95 | ||||
96 | $source .= 'Try::Tiny::try {' . "\n"; | |||
97 | ||||
98 | $source .= '$self->' . $_->{class} . '::DEMOLISH($in_global_destruction);' . "\n" | |||
99 | for @DEMOLISH_methods; | |||
100 | ||||
101 | $source .= '}'; | |||
102 | $source .= q[ Try::Tiny::catch { no warnings 'misc'; die $_ };] . "\n"; | |||
103 | $source .= 'return;' . "\n"; | |||
104 | ||||
105 | } | |||
106 | ||||
107 | $source .= '}'; | |||
108 | ||||
109 | warn $source if $self->options->{debug}; # spent 31µs making 7 calls to Moose::Meta::Method::Destructor::options, avg 4µs/call | |||
110 | ||||
111 | my ( $code, $e ) = $self->_compile_code( # spent 1.08ms making 7 calls to Class::MOP::Method::Generated::_compile_code, avg 154µs/call | |||
112 | environment => {}, | |||
113 | code => $source, | |||
114 | ); | |||
115 | ||||
116 | $self->throw_error( | |||
117 | "Could not eval the destructor :\n\n$source\n\nbecause :\n\n$e", | |||
118 | error => $e, data => $source ) | |||
119 | if $e; | |||
120 | ||||
121 | $self->{'body'} = $code; | |||
122 | } | |||
123 | ||||
124 | ||||
125 | 1 | 4µs | 4µs | 1; |
126 | ||||
127 | __END__ | |||
128 | ||||
129 | =pod | |||
130 | ||||
131 | =head1 NAME | |||
132 | ||||
133 | Moose::Meta::Method::Destructor - Method Meta Object for destructors | |||
134 | ||||
135 | =head1 DESCRIPTION | |||
136 | ||||
137 | This class is a subclass of L<Class::MOP::Class::Generated> that | |||
138 | provides Moose-specific functionality for inlining destructors. | |||
139 | ||||
140 | To understand this class, you should read the the | |||
141 | L<Class::MOP::Class::Generated> documentation as well. | |||
142 | ||||
143 | =head1 INHERITANCE | |||
144 | ||||
145 | C<Moose::Meta::Method::Destructor> is a subclass of | |||
146 | L<Moose::Meta::Method> I<and> L<Class::MOP::Method::Generated>. | |||
147 | ||||
148 | =head1 METHODS | |||
149 | ||||
150 | =over 4 | |||
151 | ||||
152 | =item B<< Moose::Meta::Method::Destructor->new(%options) >> | |||
153 | ||||
154 | This constructs a new object. It accepts the following options: | |||
155 | ||||
156 | =over 8 | |||
157 | ||||
158 | =item * package_name | |||
159 | ||||
160 | The package for the class in which the destructor is being | |||
161 | inlined. This option is required. | |||
162 | ||||
163 | =item * name | |||
164 | ||||
165 | The name of the destructor method. This option is required. | |||
166 | ||||
167 | =item * metaclass | |||
168 | ||||
169 | The metaclass for the class this destructor belongs to. This is | |||
170 | optional, as it can be set later by calling C<< | |||
171 | $metamethod->attach_to_class >>. | |||
172 | ||||
173 | =back | |||
174 | ||||
175 | =item B<< Moose::Meta;:Method::Destructor->is_needed($metaclass) >> | |||
176 | ||||
177 | Given a L<Moose::Meta::Class> object, this method returns a boolean | |||
178 | indicating whether the class needs a destructor. If the class or any | |||
179 | of its parents defines a C<DEMOLISH> method, it needs a destructor. | |||
180 | ||||
181 | =back | |||
182 | ||||
183 | =head1 BUGS | |||
184 | ||||
185 | See L<Moose/BUGS> for details on reporting bugs. | |||
186 | ||||
187 | =head1 AUTHORS | |||
188 | ||||
189 | Stevan Little E<lt>stevan@iinteractive.comE<gt> | |||
190 | ||||
191 | =head1 COPYRIGHT AND LICENSE | |||
192 | ||||
193 | Copyright 2006-2010 by Infinity Interactive, Inc. | |||
194 | ||||
195 | L<http://www.iinteractive.com> | |||
196 | ||||
197 | This library is free software; you can redistribute it and/or modify | |||
198 | it under the same terms as Perl itself. | |||
199 | ||||
200 | =cut | |||
201 |