File: Fast.pm

package info (click to toggle)
libclass-accessor-perl 0.19-2
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 96 kB
  • ctags: 19
  • sloc: perl: 209; makefile: 44
file content (94 lines) | stat: -rw-r--r-- 2,061 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
package Class::Accessor::Fast;
use base 'Class::Accessor';
use strict;
$Class::Accessor::Fast::VERSION = '0.19';

=head1 NAME

Class::Accessor::Fast - Faster, but less expandable, accessors

=head1 SYNOPSIS

  package Foo;
  use base qw(Class::Accessor::Fast);

  # The rest as Class::Accessor except no set() or get().

=head1 DESCRIPTION

This is a somewhat faster, but less expandable, version of
Class::Accessor.  Class::Accessor's generated accessors require two
method calls to accompish their task (one for the accessor, another
for get() or set()).  Class::Accessor::Fast eliminates calling
set()/get() and does the access itself, resulting in a somewhat faster
accessor.

The downside is that you can't easily alter the behavior of your
accessors, nor can your subclasses.  Of course, should you need this
later, you can always swap out Class::Accessor::Fast for
Class::Accessor.

=cut

sub make_accessor {
    my($class, $field) = @_;

    return sub {
        my $self = shift;
        return $self->{$field} unless @_;
        $self->{$field} = (@_ == 1 ? $_[0] : [@_]);
    };
}


sub make_ro_accessor {
    my($class, $field) = @_;

    return sub {
        return $_[0]->{$field} unless @_ > 1;
        my $caller = caller;
        require Carp;
        Carp::croak("'$caller' cannot alter the value of '$field' on ".
                    "objects of class '$class'");
    };
}


sub make_wo_accessor {
    my($class, $field) = @_;

    return sub {
        my $self = shift;

        unless (@_) {
            my $caller = caller;
            require Carp;
            Carp::croak("'$caller' cannot access the value of '$field' on ".
                        "objects of class '$class'");
        }
        else {
            return $self->{$field} = (@_ == 1 ? $_[0] : [@_]);
        }
    };
}


=head1 EFFICIENCY

L<Class::Accessor/EFFICIENCY> for an efficiency comparison.

=head1 CURRENT AUTHOR

Marty Pauley <marty+perl@kasei.com>

=head1 ORIGINAL AUTHOR

Michael G Schwern <schwern@pobox.com>

=head1 SEE ALSO

L<Class::Accessor>

=cut

1;