File Coverage

blib/lib/Class/Accessor/Faster.pm
Criterion Covered Total %
statement 40 40 100.0
branch 14 14 100.0
condition 1 3 33.3
subroutine 10 10 100.0
pod 4 4 100.0
total 69 71 97.1


line stmt bran cond sub pod time code
1             package Class::Accessor::Faster;
2 3     3   2249 use base 'Class::Accessor';
  3         6  
  3         234  
3 3     3   16 use strict;
  3         5  
  3         1249  
4             $Class::Accessor::Faster::VERSION = $Class::Accessor::VERSION;
5              
6             my %slot;
7             sub _slot {
8 26     26   38 my($class, $field) = @_;
9 26         44 my $n = $slot{$class}->{$field};
10 26 100       49 return $n if defined $n;
11 16         19 $n = keys %{$slot{$class}};
  16         31  
12 16         24 $slot{$class}->{$field} = $n;
13 16         25 return $n;
14             }
15              
16             sub new {
17 4     4 1 4138 my($proto, $fields) = @_;
18 4   33     20 my($class) = ref $proto || $proto;
19 4         9 my $self = bless [], $class;
20              
21 4 100       11 $fields = {} unless defined $fields;
22 4         15 for my $k (keys %$fields) {
23 8         15 my $n = $class->_slot($k);
24 8         20 $self->[$n] = $fields->{$k};
25             }
26 4         14 return $self;
27             }
28              
29             sub make_accessor {
30 6     6 1 10 my($class, $field) = @_;
31 6         10 my $n = $class->_slot($field);
32             return sub {
33 12 100   12   1359 return $_[0]->[$n] if scalar(@_) == 1;
34 4 100       12 return $_[0]->[$n] = scalar(@_) == 2 ? $_[1] : [@_[1..$#_]];
35 6         31 };
36             }
37              
38             sub make_ro_accessor {
39 6     6 1 21 my($class, $field) = @_;
40 6         17 my $n = $class->_slot($field);
41             return sub {
42 6 100   6   28 return $_[0]->[$n] if @_ == 1;
43 1         4 my $caller = caller;
44 1         12 $_[0]->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'");
45 6         23 };
46             }
47              
48             sub make_wo_accessor {
49 6     6 1 11 my($class, $field) = @_;
50 6         12 my $n = $class->_slot($field);
51             return sub {
52 5 100   5   524 if (@_ == 1) {
53 1         3 my $caller = caller;
54 1         5 $_[0]->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'");
55             } else {
56 4 100       15 return $_[0]->[$n] = $_[1] if @_ == 2;
57 1         3 return (shift)->[$n] = \@_;
58             }
59 6         23 };
60             }
61              
62             1;
63              
64             __END__