Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Greetings Monks.

The code included here was adapted from two books, "Advanced Perl Programming" (Sriram Srinivasan) and "Object Oriented Perl" (Damian Conway). These books taught me quite a bit about OO in general. I have been using the parent/child classes to create projects for the last year and this combination of qualities (using classes in Perl would be a good way to sum it up) has proven to be very sane and stable.

Three pieces of code are included in this message.

Simple.pm is a parent class with data attributes and get/set methods generated through AUTOLOAD. It has a single method, yip.

Simple/Child.pm is a child of Simple.pm. Child.pm inherits behavior and data from Simple.pm. It overrides the yip method and has its own data that can be accessed through the parent's get/set methods.

A small test harness to show off the features of these classes and the output has been included.

Do you have anything to add or subtract from these classes? Right now, all child classes require code from Child.pm in order to use the parent's get/set methods. It would be nice not to have to copy and paste to make a new child class.

Simple.pm:

package Simple;
use vars qw ($AUTOLOAD);
use Carp;

{
my $version = "1.0.0";

# object data

my %_attr_data = 
  (
  "_debug" => [ 0, "r" ], 
  "_version" => [ $version, "r" ], 
  );

sub _accessible
  {
  my ($self, $attr, $mode) = @_;
  $_attr_data{$attr}[1] =~ /$mode/
  }

sub _default_for
  {
  my ($self, $attr) = @_;
  $_attr_data{$attr}[0];
  }

sub _standard_keys
  {
  keys %_attr_data;
  }

sub new
  {
  my ($caller, %arg) = @_;
  my $caller_is_obj = ref($caller);
  my $class = $caller_is_obj || $caller;
  my $self = bless {}, $class;
  foreach my $membername ( $self->_standard_keys() )
    {
    my ($argname) = ($membername =~ /^_(.*)/);
    if (exists $arg{$argname})
      { $self->{$membername} = $arg{$argname} }
    elsif ($caller_is_obj)
      { $self->{$membername} = $caller->{$membername} }
    else
      { $self->{$membername} = $self->_default_for($membername) }
    }
  return $self;
  }

sub yip
  {
  my ($self) = @_;
  print "yip!\n";
  }

sub AUTOLOAD
  {
  no strict "refs";
  my ($self, $newval) = @_;

  if ($AUTOLOAD =~ /.*::get(_\w+)/ && $self->_accessible($1,'r'))
    {
    my $attr_name = $1;
    *{$AUTOLOAD} = sub { return $_[0]->{$attr_name} };
    return $self->{$attr_name}
    }

  if ($AUTOLOAD =~ /.*::set(_\w+)/ && $self->_accessible($1,'rw'))
    {
    my $attr_name = $1;
    *{$AUTOLOAD} = sub { $_[0]->{$attr_name} = $_[1] };
    $self->{$1} = $newval;
    return
    }

  carp "no such method: $AUTOLOAD";
  }

sub DESTROY
  {
  }
}

1;

[download]

Simple/Child.pm:

package Simple::Child;

use Carp;
use lib ".";
use Simple;
@ISA = qw (Simple);
use vars qw ($AUTOLOAD);

{
my %_attr_data = 
  (
  "_foo" => [ "bar", "rw" ],
  );

sub _accessible
  {
  my ($self, $attr, $mode) = @_;
  return $_attr_data{$attr}[1] =~ /$mode/ if exists $_attr_data{$attr}
+;
  return $self->SUPER::_accessible($attr,$mode);
  }

sub _default_for
  {
  my ($self, $attr) = @_;
  return $_attr_data{$attr}[0] if exists $_attr_data{$attr};
  return $self->SUPER::_default_for($attr);
  }

sub _standard_keys
  {
  my ($self) = @_;
  ($self->SUPER::_standard_keys(), keys %_attr_data);
  }

sub yip
  {
  my ($self) = @_;
  print "yip! yip!\n";
  }
}

1;

[download]

Test harness:

#!/usr/bin/perl -w

use strict;
use lib ".";
use Simple::Child;

my $thingy = new Simple::Child;

print $thingy->get_foo . "\n" . $thingy->get_version . "\n";

$thingy->yip();

[download]

Output:

bar
1.0.0
yip! yip!

Edit by tye to add <readmore>

Back to Seekers of Perl Wisdom