local-lib5/lib/perl5/Class/Accessor/Faster.pm

   1 package Class::Accessor::Faster;
   2 use base 'Class::Accessor';
   3 use strict;
   4 $Class::Accessor::Faster::VERSION = '0.34';
   5
   6 my %slot;
   7 sub _slot {
   8     my($class, $field) = @_;
   9     my $n = $slot{$class}->{$field};
  10     return $n if defined $n;
  11     $n = keys %{$slot{$class}};
  12     $slot{$class}->{$field} = $n;
  13     return $n;
  14 }
  15
  16 sub new {
  17     my($proto, $fields) = @_;
  18     my($class) = ref $proto || $proto;
  19     my $self = bless [], $class;
  20
  21     $fields = {} unless defined $fields;
  22     for my $k (keys %$fields) {
  23         my $n = $class->_slot($k);
  24         $self->[$n] = $fields->{$k};
  25     }
  26     return $self;
  27 }
  28
  29 sub make_accessor {
  30     my($class, $field) = @_;
  31     my $n = $class->_slot($field);
  32     return sub {
  33         return $_[0]->[$n] if scalar(@_) == 1;
  34         return $_[0]->[$n]  = scalar(@_) == 2 ? $_[1] : [@_[1..$#_]];
  35     };
  36 }
  37
  38 sub make_ro_accessor {
  39     my($class, $field) = @_;
  40     my $n = $class->_slot($field);
  41     return sub {
  42         return $_[0]->[$n] if @_ == 1;
  43         my $caller = caller;
  44         $_[0]->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'");
  45     };
  46 }
  47
  48 sub make_wo_accessor {
  49     my($class, $field) = @_;
  50     my $n = $class->_slot($field);
  51     return sub {
  52         if (@_ == 1) {
  53             my $caller = caller;
  54             $_[0]->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'");
  55         } else {
  56             return $_[0]->[$n] = $_[1] if @_ == 2;
  57             return (shift)->[$n] = \@_;
  58         }
  59     };
  60 }
  61
  62 1;
  63
  64 __END__
  65
  66 =head1 NAME
  67
  68 Class::Accessor::Faster - Even faster, but less expandable, accessors
  69
  70 =head1 SYNOPSIS
  71
  72   package Foo;
  73   use base qw(Class::Accessor::Faster);
  74
  75 =head1 DESCRIPTION
  76
  77 This is a faster but less expandable version of Class::Accessor::Fast.
  78
  79 Class::Accessor's generated accessors require two method calls to accompish
  80 their task (one for the accessor, another for get() or set()).
  81
  82 Class::Accessor::Fast eliminates calling set()/get() and does the access itself,
  83 resulting in a somewhat faster accessor.
  84
  85 Class::Accessor::Faster uses an array reference underneath to be faster.
  86
  87 Read the documentation for Class::Accessor for more info.
  88
  89 =head1 AUTHORS
  90
  91 Copyright 2007 Marty Pauley <marty+perl@kasei.com>
  92
  93 This program is free software; you can redistribute it and/or modify it under
  94 the same terms as Perl itself.  That means either (a) the GNU General Public
  95 License or (b) the Artistic License.
  96
  97 =head1 SEE ALSO
  98
  99 L<Class::Accessor>
 100
 101 =cut