File Coverage

blib/lib/accessors/ro.pm

Criterion	Covered	Total	%
statement	19	19	100.0
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod	0	1	0.0
total	26	27	96.3

=head1 NAME

accessors::ro - create 'classic' read-only accessor methods in caller's package.

=head1 SYNOPSIS

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

  my $obj = bless { foo => 'read only? ' }, 'Foo';

  # values are read-only, so set is disabled:
  print "oh my!\n" if $obj->foo( "set?" ) eq 'read only? ';

  # if you really need to change the vars,
  # you must use direct-variable-access:
  $obj->{bar} = 'i need a drink ';
  $obj->{baz} = 'now';

  # always returns the current value:
  print $obj->foo, $obj->bar, $obj->baz, "!\n";

=cut

package accessors::ro;

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

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

use constant style => 'ro';

sub create_accessor {
    my ($class, $accessor, $property) = @_;
    # 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 { return $_[0]->{$property} };
}

1;

__END__