Filename | /usr/share/perl5/Class/Accessor.pm |
Statements | Executed 116 statements in 2.05ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 292µs | 407µs | _mk_accessors | Class::Accessor::
6 | 1 | 1 | 51µs | 51µs | make_accessor | Class::Accessor::
6 | 1 | 1 | 40µs | 40µs | accessor_name_for | Class::Accessor::
1 | 1 | 1 | 25µs | 432µs | mk_accessors | Class::Accessor::
6 | 1 | 1 | 24µs | 24µs | mutator_name_for | Class::Accessor::
1 | 1 | 1 | 22µs | 28µs | BEGIN@3 | Class::Accessor::
1 | 1 | 1 | 14µs | 42µs | BEGIN@150 | Class::Accessor::
1 | 1 | 1 | 10µs | 10µs | BEGIN@460 | Class::Accessor::
0 | 0 | 0 | 0s | 0s | __ANON__[:395] | Class::Accessor::
0 | 0 | 0 | 0s | 0s | __ANON__[:422] | Class::Accessor::
0 | 0 | 0 | 0s | 0s | __ANON__[:449] | Class::Accessor::
0 | 0 | 0 | 0s | 0s | _carp | Class::Accessor::
0 | 0 | 0 | 0s | 0s | _croak | Class::Accessor::
0 | 0 | 0 | 0s | 0s | best_practice_accessor_name_for | Class::Accessor::
0 | 0 | 0 | 0s | 0s | best_practice_mutator_name_for | Class::Accessor::
0 | 0 | 0 | 0s | 0s | follow_best_practice | Class::Accessor::
0 | 0 | 0 | 0s | 0s | get | Class::Accessor::
0 | 0 | 0 | 0s | 0s | make_ro_accessor | Class::Accessor::
0 | 0 | 0 | 0s | 0s | make_wo_accessor | Class::Accessor::
0 | 0 | 0 | 0s | 0s | mk_ro_accessors | Class::Accessor::
0 | 0 | 0 | 0s | 0s | mk_wo_accessors | Class::Accessor::
0 | 0 | 0 | 0s | 0s | new | Class::Accessor::
0 | 0 | 0 | 0s | 0s | set | Class::Accessor::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Class::Accessor; | ||||
2 | 1 | 26µs | require 5.00502; | ||
3 | 3 | 198µs | 2 | 34µs | # spent 28µs (22+6) within Class::Accessor::BEGIN@3 which was called:
# once (22µs+6µs) by base::import at line 3 # spent 28µs making 1 call to Class::Accessor::BEGIN@3
# spent 6µs making 1 call to strict::import |
4 | 1 | 2µs | $Class::Accessor::VERSION = '0.31'; | ||
5 | |||||
6 | =head1 NAME | ||||
7 | |||||
- - | |||||
115 | sub new { | ||||
116 | my($proto, $fields) = @_; | ||||
117 | my($class) = ref $proto || $proto; | ||||
118 | |||||
119 | $fields = {} unless defined $fields; | ||||
120 | |||||
121 | # make a copy of $fields. | ||||
122 | bless {%$fields}, $class; | ||||
123 | } | ||||
124 | |||||
125 | =head2 mk_accessors | ||||
126 | |||||
- - | |||||
142 | # spent 432µs (25+407) within Class::Accessor::mk_accessors which was called:
# once (25µs+407µs) by MARC::Charset::Table::BEGIN@38 at line 10 of MARC/Charset/Code.pm | ||||
143 | 1 | 6µs | my($self, @fields) = @_; | ||
144 | |||||
145 | 1 | 15µs | 1 | 407µs | $self->_mk_accessors('rw', @fields); # spent 407µs making 1 call to Class::Accessor::_mk_accessors |
146 | } | ||||
147 | |||||
148 | |||||
149 | { | ||||
150 | 4 | 1.23ms | 2 | 70µs | # spent 42µs (14+28) within Class::Accessor::BEGIN@150 which was called:
# once (14µs+28µs) by base::import at line 150 # spent 42µs making 1 call to Class::Accessor::BEGIN@150
# spent 28µs making 1 call to strict::unimport |
151 | |||||
152 | # spent 407µs (292+115) within Class::Accessor::_mk_accessors which was called:
# once (292µs+115µs) by Class::Accessor::mk_accessors at line 145 | ||||
153 | 1 | 5µs | my($self, $access, @fields) = @_; | ||
154 | 1 | 2µs | my $class = ref $self || $self; | ||
155 | 1 | 3µs | my $ra = $access eq 'rw' || $access eq 'ro'; | ||
156 | 1 | 2µs | my $wa = $access eq 'rw' || $access eq 'wo'; | ||
157 | |||||
158 | 1 | 9µs | foreach my $field (@fields) { | ||
159 | 6 | 41µs | 6 | 40µs | my $accessor_name = $self->accessor_name_for($field); # spent 40µs making 6 calls to Class::Accessor::accessor_name_for, avg 7µs/call |
160 | 6 | 31µs | 6 | 24µs | my $mutator_name = $self->mutator_name_for($field); # spent 24µs making 6 calls to Class::Accessor::mutator_name_for, avg 4µs/call |
161 | 6 | 8µs | if( $accessor_name eq 'DESTROY' or $mutator_name eq 'DESTROY' ) { | ||
162 | $self->_carp("Having a data accessor named DESTROY in '$class' is unwise."); | ||||
163 | } | ||||
164 | 6 | 22µs | if ($accessor_name eq $mutator_name) { | ||
165 | 6 | 5µs | my $accessor; | ||
166 | 6 | 30µs | 6 | 51µs | if ($ra && $wa) { # spent 51µs making 6 calls to Class::Accessor::make_accessor, avg 8µs/call |
167 | $accessor = $self->make_accessor($field); | ||||
168 | } elsif ($ra) { | ||||
169 | $accessor = $self->make_ro_accessor($field); | ||||
170 | } else { | ||||
171 | $accessor = $self->make_wo_accessor($field); | ||||
172 | } | ||||
173 | 6 | 40µs | unless (defined &{"${class}::$accessor_name"}) { | ||
174 | *{"${class}::$accessor_name"} = $accessor; | ||||
175 | } | ||||
176 | 6 | 18µs | if ($accessor_name eq $field) { | ||
177 | # the old behaviour | ||||
178 | 6 | 10µs | my $alias = "_${field}_accessor"; | ||
179 | 6 | 37µs | *{"${class}::$alias"} = $accessor unless defined &{"${class}::$alias"}; | ||
180 | } | ||||
181 | } else { | ||||
182 | if ($ra and not defined &{"${class}::$accessor_name"}) { | ||||
183 | *{"${class}::$accessor_name"} = $self->make_ro_accessor($field); | ||||
184 | } | ||||
185 | if ($wa and not defined &{"${class}::$mutator_name"}) { | ||||
186 | *{"${class}::$mutator_name"} = $self->make_wo_accessor($field); | ||||
187 | } | ||||
188 | } | ||||
189 | } | ||||
190 | } | ||||
191 | |||||
192 | sub follow_best_practice { | ||||
193 | my($self) = @_; | ||||
194 | my $class = ref $self || $self; | ||||
195 | *{"${class}::accessor_name_for"} = \&best_practice_accessor_name_for; | ||||
196 | *{"${class}::mutator_name_for"} = \&best_practice_mutator_name_for; | ||||
197 | } | ||||
198 | |||||
199 | } | ||||
200 | |||||
201 | =head2 mk_ro_accessors | ||||
202 | |||||
- - | |||||
221 | sub mk_ro_accessors { | ||||
222 | my($self, @fields) = @_; | ||||
223 | |||||
224 | $self->_mk_accessors('ro', @fields); | ||||
225 | } | ||||
226 | |||||
227 | =head2 mk_wo_accessors | ||||
228 | |||||
- - | |||||
249 | sub mk_wo_accessors { | ||||
250 | my($self, @fields) = @_; | ||||
251 | |||||
252 | $self->_mk_accessors('wo', @fields); | ||||
253 | } | ||||
254 | |||||
255 | =head1 DETAILS | ||||
256 | |||||
- - | |||||
292 | sub best_practice_accessor_name_for { | ||||
293 | my ($class, $field) = @_; | ||||
294 | return "get_$field"; | ||||
295 | } | ||||
296 | |||||
297 | sub best_practice_mutator_name_for { | ||||
298 | my ($class, $field) = @_; | ||||
299 | return "set_$field"; | ||||
300 | } | ||||
301 | |||||
302 | # spent 40µs within Class::Accessor::accessor_name_for which was called 6 times, avg 7µs/call:
# 6 times (40µs+0s) by Class::Accessor::_mk_accessors at line 159, avg 7µs/call | ||||
303 | 6 | 9µs | my ($class, $field) = @_; | ||
304 | 6 | 40µs | return $field; | ||
305 | } | ||||
306 | |||||
307 | # spent 24µs within Class::Accessor::mutator_name_for which was called 6 times, avg 4µs/call:
# 6 times (24µs+0s) by Class::Accessor::_mk_accessors at line 160, avg 4µs/call | ||||
308 | 6 | 8µs | my ($class, $field) = @_; | ||
309 | 6 | 28µs | return $field; | ||
310 | } | ||||
311 | |||||
312 | =head2 Modifying the behavior of the accessor | ||||
313 | |||||
- - | |||||
331 | sub set { | ||||
332 | my($self, $key) = splice(@_, 0, 2); | ||||
333 | |||||
334 | if(@_ == 1) { | ||||
335 | $self->{$key} = $_[0]; | ||||
336 | } | ||||
337 | elsif(@_ > 1) { | ||||
338 | $self->{$key} = [@_]; | ||||
339 | } | ||||
340 | else { | ||||
341 | $self->_croak("Wrong number of arguments received"); | ||||
342 | } | ||||
343 | } | ||||
344 | |||||
345 | =head2 get | ||||
346 | |||||
- - | |||||
356 | sub get { | ||||
357 | my $self = shift; | ||||
358 | |||||
359 | if(@_ == 1) { | ||||
360 | return $self->{$_[0]}; | ||||
361 | } | ||||
362 | elsif( @_ > 1 ) { | ||||
363 | return @{$self}{@_}; | ||||
364 | } | ||||
365 | else { | ||||
366 | $self->_croak("Wrong number of arguments received"); | ||||
367 | } | ||||
368 | } | ||||
369 | |||||
370 | =head2 make_accessor | ||||
371 | |||||
- - | |||||
382 | # spent 51µs within Class::Accessor::make_accessor which was called 6 times, avg 8µs/call:
# 6 times (51µs+0s) by Class::Accessor::_mk_accessors at line 166, avg 8µs/call | ||||
383 | 6 | 10µs | my ($class, $field) = @_; | ||
384 | |||||
385 | # Build a closure around $field. | ||||
386 | return sub { | ||||
387 | my $self = shift; | ||||
388 | |||||
389 | if(@_) { | ||||
390 | return $self->set($field, @_); | ||||
391 | } | ||||
392 | else { | ||||
393 | return $self->get($field); | ||||
394 | } | ||||
395 | 6 | 51µs | }; | ||
396 | } | ||||
397 | |||||
398 | =head2 make_ro_accessor | ||||
399 | |||||
- - | |||||
409 | sub make_ro_accessor { | ||||
410 | my($class, $field) = @_; | ||||
411 | |||||
412 | return sub { | ||||
413 | my $self = shift; | ||||
414 | |||||
415 | if (@_) { | ||||
416 | my $caller = caller; | ||||
417 | $self->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'"); | ||||
418 | } | ||||
419 | else { | ||||
420 | return $self->get($field); | ||||
421 | } | ||||
422 | }; | ||||
423 | } | ||||
424 | |||||
425 | =head2 make_wo_accessor | ||||
426 | |||||
- - | |||||
436 | sub make_wo_accessor { | ||||
437 | my($class, $field) = @_; | ||||
438 | |||||
439 | return sub { | ||||
440 | my $self = shift; | ||||
441 | |||||
442 | unless (@_) { | ||||
443 | my $caller = caller; | ||||
444 | $self->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'"); | ||||
445 | } | ||||
446 | else { | ||||
447 | return $self->set($field, @_); | ||||
448 | } | ||||
449 | }; | ||||
450 | } | ||||
451 | |||||
452 | =head1 EXCEPTIONS | ||||
453 | |||||
- - | |||||
460 | 3 | 159µs | 1 | 10µs | # spent 10µs within Class::Accessor::BEGIN@460 which was called:
# once (10µs+0s) by base::import at line 460 # spent 10µs making 1 call to Class::Accessor::BEGIN@460 |
461 | |||||
462 | sub _carp { | ||||
463 | my ($self, $msg) = @_; | ||||
464 | Carp::carp($msg || $self); | ||||
465 | return; | ||||
466 | } | ||||
467 | |||||
468 | sub _croak { | ||||
469 | my ($self, $msg) = @_; | ||||
470 | Carp::croak($msg || $self); | ||||
471 | return; | ||||
472 | } | ||||
473 | |||||
474 | =head1 EFFICIENCY | ||||
475 | |||||
- - | |||||
675 | 1 | 5µs | 1; |