The Sysadmin Notebook  

Sitemap

OOperl Object Example

Example Implementation for an Object in Perl

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;