package Human;
use strict;
use vars qw($VERSION $AUTOLOAD);
use Carp;
$VERSION = 0.02;
{
# Encapsulated Class data
my %_attributes = # DEFAULT MODE
( _firstname => ['???', 'read'],
_surname => ['???', 'read'],
_dob => ['???', 'read/write'],
_sex => ['U', 'read/write'],
_NINumber => ['???', 'read/write'],
);
my $_count = 0;
# Class methods to act on encapsulated class data
# Is object attribute accessible in a given mode
sub _accessible
{
my ($self, $attr, $mode) = @_;
$_attributes{$attr}[1] =~ /$mode/;
}
# get class default value for a given attribute
sub _default_for
{
my ($self, $attr) = @_;
$_attributes{$attr}[0];
}
# List of object attributes
sub _standard_keys
{
keys %_attributes;
}
# Retrieve object count
sub get_count { $_count }
# Private count increment/decrement methods
my $_incr_count = sub { ++$_count };
my $_decr_count = sub { --$_count };
sub new
{
my ($caller, %arg) = @_;
my $caller_is_obj = ref($caller);
my $class = $caller_is_obj || $caller;
my $self = bless {}, $class;
foreach my $attrname ( $self->_standard_keys())
{
my ($argname) = ($attrname =~ /^_(.*)/);
if (exists $arg{$argname})
{
$self->{$attrname} = $arg{$argname};
}
elsif ($caller_is_obj)
{
$self->{$attrname} = $caller->{$attrname};
}
else
{
$self->{$attrname} = $self->_default_for($attrname);
}
}
$self->$_incr_count;
return $self;
}
# Destructor adjusts class count
sub DESTROY
{
$_[0]->$_decr_count;
}
}
# Public methods
sub get_fullname
{
($_[0]->get_firstname(),$_[0]->get_surname());
}
sub AUTOLOAD
{
no strict "refs";
my ($self, $newval) = @_;
if ($AUTOLOAD =~ /.*::get(_\w+)/ && $self->_accessible($1, 'read'))
{
my $attr_name = $1;
*{$AUTOLOAD} = sub { return $_[0]->{$attr_name}};
return $self->{$attr_name};
}
if ($AUTOLOAD =~ /.*::set(_\w+)/ && $self->_accessible($1, 'write'))
{
my $attr_name = $1;
*{$AUTOLOAD} = sub { $_[0]->{$attr_name} = $_[1]; return};
$self->{$1} = $newval;
return;
}
croak "No such method: $AUTOLOAD";
}
1;