File Coverage

blib/lib/accessors/classic.pm

Criterion	Covered	Total	%
statement	19	19	100.0
branch	2	2	100.0
condition			n/a
subroutine	7	7	100.0
pod	0	1	0.0
total	28	29	96.5

=head1 NAME

accessors::classic - create 'classic' read/write accessor methods in caller's package.

=head1 SYNOPSIS

  package Foo;
  use accessors::classic qw( foo bar baz );

  my $obj = bless {}, 'Foo';

  # always return the current value, even on set:
  $obj->foo( 'hello ' ) if $obj->bar( 'world' ) eq 'world';

  print $obj->foo, $obj->bar, $obj->baz( "!\n" );

=cut

package accessors::classic;

use strict;
use warnings::register;
use base qw( accessors );

our $VERSION  = '1.01';
our $REVISION = (split(/ /, ' $Revision: 1.5 $ '))[2];

use constant style => 'classic';

sub create_accessor {
    my ($class, $accessor, $property) = @_;
    # set/get is slightly faster if we eval instead of using a closure + anon
    # sub, but the difference is marginal (~5%), and this uses less memory...
    no strict 'refs';
    *{$accessor} = sub {
	(@_ > 1) ? $_[0]->{$property} = $_[1] : $_[0]->{$property};
    }
}

1;

__END__