File Coverage

blib/lib/Class/Accessor/Fast.pm
Criterion Covered Total %
statement 24 24 100.0
branch 8 10 80.0
condition n/a
subroutine 8 8 100.0
pod 3 3 100.0
total 43 45 95.6


line stmt bran cond sub pod time code
1             package Class::Accessor::Fast;
2 4     4   74 use base 'Class::Accessor';
  4         99  
  4         111  
3 4     4   64 use strict;
  4         39  
  4         55  
4             $Class::Accessor::Fast::VERSION = '0.30';
5              
6             =head1 NAME
7            
8             Class::Accessor::Fast - Faster, but less expandable, accessors
9            
10             =head1 SYNOPSIS
11            
12             package Foo;
13             use base qw(Class::Accessor::Fast);
14            
15             # The rest is the same as Class::Accessor but without set() and get().
16            
17             =head1 DESCRIPTION
18            
19             This is a faster but less expandable version of Class::Accessor.
20             Class::Accessor's generated accessors require two method calls to accompish
21             their task (one for the accessor, another for get() or set()).
22             Class::Accessor::Fast eliminates calling set()/get() and does the access itself,
23             resulting in a somewhat faster accessor.
24            
25             The downside is that you can't easily alter the behavior of your
26             accessors, nor can your subclasses. Of course, should you need this
27             later, you can always swap out Class::Accessor::Fast for
28             Class::Accessor.
29            
30             Read the documentation for Class::Accessor for more info.
31            
32             =cut
33              
34             sub make_accessor {
35 6     6 1 58     my($class, $field) = @_;
36              
37                 return sub {
38 10 100   10   258         return $_[0]->{$field} unless @_ > 1;
39 3         27         my $self = shift;
40 3 50       40         $self->{$field} = (@_ == 1 ? $_[0] : [@_]);
41 6         95     };
42             }
43              
44              
45             sub make_ro_accessor {
46 7     7 1 70     my($class, $field) = @_;
47              
48                 return sub {
49 7 100   7   131         return $_[0]->{$field} unless @_ > 1;
50 2         19         my $self = shift;
51 2         22         my $caller = caller;
52 2         47         $self->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'");
53 7         177     };
54             }
55              
56              
57             sub make_wo_accessor {
58 7     7 1 70     my($class, $field) = @_;
59              
60                 return sub {
61 5     5   76         my $self = shift;
62              
63 5 100       59         unless (@_) {
64 2         23             my $caller = caller;
65 2         36             $self->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'");
66                     }
67                     else {
68 3 50       54             return $self->{$field} = (@_ == 1 ? $_[0] : [@_]);
69                     }
70 7         216     };
71             }
72              
73              
74             =head1 EFFICIENCY
75            
76             L<Class::Accessor/EFFICIENCY> for an efficiency comparison.
77            
78             =head1 AUTHORS
79            
80             Copyright 2005 Marty Pauley <marty+perl@kasei.com>
81            
82             This program is free software; you can redistribute it and/or modify it under
83             the same terms as Perl itself. That means either (a) the GNU General Public
84             License or (b) the Artistic License.
85            
86             =head2 ORIGINAL AUTHOR
87            
88             Michael G Schwern <schwern@pobox.com>
89            
90             =head1 SEE ALSO
91            
92             L<Class::Accessor>
93            
94             =cut
95              
96             1;
97