| Filename | /usr/share/perl5/Class/Accessor.pm |
| Statements | Executed 116 statements in 2.00ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 268µs | 368µs | Class::Accessor::_mk_accessors |
| 6 | 1 | 1 | 44µs | 44µs | Class::Accessor::make_accessor |
| 6 | 1 | 1 | 31µs | 31µs | Class::Accessor::accessor_name_for |
| 6 | 1 | 1 | 25µs | 25µs | Class::Accessor::mutator_name_for |
| 1 | 1 | 1 | 23µs | 29µs | Class::Accessor::BEGIN@3 |
| 1 | 1 | 1 | 16µs | 384µs | Class::Accessor::mk_accessors |
| 1 | 1 | 1 | 13µs | 47µs | Class::Accessor::BEGIN@150 |
| 1 | 1 | 1 | 10µs | 10µs | Class::Accessor::BEGIN@460 |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::__ANON__[:395] |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::__ANON__[:422] |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::__ANON__[:449] |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::_carp |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::_croak |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::best_practice_accessor_name_for |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::best_practice_mutator_name_for |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::follow_best_practice |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::get |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::make_ro_accessor |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::make_wo_accessor |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::mk_ro_accessors |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::mk_wo_accessors |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::new |
| 0 | 0 | 0 | 0s | 0s | Class::Accessor::set |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Class::Accessor; | ||||
| 2 | 1 | 25µs | require 5.00502; | ||
| 3 | 3 | 194µs | 2 | 35µs | # spent 29µs (23+6) within Class::Accessor::BEGIN@3 which was called:
# once (23µs+6µs) by base::import at line 3 # spent 29µ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 384µs (16+368) within Class::Accessor::mk_accessors which was called:
# once (16µs+368µs) by MARC::Charset::Table::BEGIN@38 at line 10 of MARC/Charset/Code.pm | ||||
| 143 | 2 | 14µs | my($self, @fields) = @_; | ||
| 144 | |||||
| 145 | 1 | 368µs | $self->_mk_accessors('rw', @fields); # spent 368µs making 1 call to Class::Accessor::_mk_accessors | ||
| 146 | } | ||||
| 147 | |||||
| 148 | |||||
| 149 | { | ||||
| 150 | 4 | 1.23ms | 2 | 81µs | # spent 47µs (13+34) within Class::Accessor::BEGIN@150 which was called:
# once (13µs+34µs) by base::import at line 150 # spent 47µs making 1 call to Class::Accessor::BEGIN@150
# spent 34µs making 1 call to strict::unimport |
| 151 | |||||
| 152 | # spent 368µs (268+100) within Class::Accessor::_mk_accessors which was called:
# once (268µs+100µs) by Class::Accessor::mk_accessors at line 145 | ||||
| 153 | 5 | 15µs | my($self, $access, @fields) = @_; | ||
| 154 | my $class = ref $self || $self; | ||||
| 155 | my $ra = $access eq 'rw' || $access eq 'ro'; | ||||
| 156 | my $wa = $access eq 'rw' || $access eq 'wo'; | ||||
| 157 | |||||
| 158 | foreach my $field (@fields) { | ||||
| 159 | 24 | 86µs | 6 | 31µs | my $accessor_name = $self->accessor_name_for($field); # spent 31µs making 6 calls to Class::Accessor::accessor_name_for, avg 5µs/call |
| 160 | 6 | 25µs | my $mutator_name = $self->mutator_name_for($field); # spent 25µs making 6 calls to Class::Accessor::mutator_name_for, avg 4µs/call | ||
| 161 | 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 | 24 | 81µs | if ($accessor_name eq $mutator_name) { | ||
| 165 | my $accessor; | ||||
| 166 | 6 | 44µs | if ($ra && $wa) { # spent 44µs making 6 calls to Class::Accessor::make_accessor, avg 7µ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 | unless (defined &{"${class}::$accessor_name"}) { | ||||
| 174 | *{"${class}::$accessor_name"} = $accessor; | ||||
| 175 | } | ||||
| 176 | 12 | 50µs | if ($accessor_name eq $field) { | ||
| 177 | # the old behaviour | ||||
| 178 | my $alias = "_${field}_accessor"; | ||||
| 179 | *{"${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 31µs within Class::Accessor::accessor_name_for which was called 6 times, avg 5µs/call:
# 6 times (31µs+0s) by Class::Accessor::_mk_accessors at line 159, avg 5µs/call | ||||
| 303 | 12 | 43µs | my ($class, $field) = @_; | ||
| 304 | return $field; | ||||
| 305 | } | ||||
| 306 | |||||
| 307 | # spent 25µs within Class::Accessor::mutator_name_for which was called 6 times, avg 4µs/call:
# 6 times (25µs+0s) by Class::Accessor::_mk_accessors at line 160, avg 4µs/call | ||||
| 308 | 12 | 43µs | my ($class, $field) = @_; | ||
| 309 | 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 44µs within Class::Accessor::make_accessor which was called 6 times, avg 7µs/call:
# 6 times (44µs+0s) by Class::Accessor::_mk_accessors at line 166, avg 7µs/call | ||||
| 383 | 12 | 53µ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 | }; | ||||
| 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 | 160µ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; |