Using Inheritance in Perl

I called the inherited module TT.pm.

Inheritance Techniques to be Demonstrated

• Using an inherited constructor
• Using an inherited clone constructor
• Overriding a constructor
• Adding a simple method
• Adding a method to set a new attribute
• Adding a method to get a new attribute
• Using an inherited method
• Using an overridden method

Difficulties with Perl and Inheritance

This example works for this one particular module, which is mostly written in a good programming style. There are a few routines in the Data::Table module that were perhaps written as afterthoughts. These afterthought-routines do not work with inheritance in the way that is illustrated here. An examination of the source code of the module shows why this is so.

I have enjoyed using the Data::Table module in several of my programs. Data::Table has a data structure that consists of a header and a two dimensional table of data. For my simple inheritance example, I added a comment and a date to the table data structure. I also changed the way that the number of columns in the table is reported by the nofCol method.

I wrote this program to work with Data::Table version 1.17. The current version of Data::Table as of this writing is 1.32, so some things may have changed.

The Calling Program

#!/usr/bin/perl

use strict;
use warnings;
use diagnostics;
use Data::Dumper;

use TT;
my $header = ["name", "age"];
my $data = [
             ["John", 20],
             ["Kate", 18],
             ["Mike", 23]
           ];

# Calling various constructors
my $t = new TT($data, $header, 0); # inherited constructor
my $t2= $t->clone();               # inherited clone constructor
bless $t2, "TT";                   # before, $t2 was a Data::Table
my $t3= mynew TT($data, $header, 0, "A comment"); # added constructor
my $t4= fromCSV TT("aaa.csv");     # overriden constructor

print "t:  ",ref($t),"\n",         # See that constructed
      "t2: ",ref($t2),"\n",        # objects all have the 
      "t3: ",ref($t3),"\n",        # correct class.
      "t4: ",ref($t4),"\n";        #

# Methods
$t->mine();                        # calling a simple added method
$t->set_date();                    # calling my added setter method
print $t->get_date,"\n";           # calling my added accessor method
print $t->html;                    # calling an inherited method
print $t->nofCol,"\n";             # calling an overriden method

# See the contents of some of the objects
print Dumper($t3);
print Dumper($t4);

The rest of the program illustrates various calls to added, inherited, and overridden methods. The Dumper calls at the bottom of the program show the contents of some of the objects.

The Module

package TT;

use strict;
use warnings;
use diagnostics;

use Data::Table;
our @ISA = qw(Data::Table);

sub mine
{
  my $self= shift;
  my $class= ref($self) || $self;
  print "Hello\n";
}

sub mynew
{
  my ($class, $data, $header, $type, $comment) = @_;
  my $self= new Data::Table($data, $header, $type);
  bless $self, $class;
  $self->{comment}= $comment;
  return $self;
}

sub set_date
{
  my $self= shift;
  my $class= ref($self) || $self;
  $self->{my_date}= scalar localtime;
}

sub get_date
{
  my $self= shift;
  my $class= ref($self) || $self;
  return "date unknown" if (not defined $self->{my_date});
  return $self->{my_date};
}

sub nofCol
{
  my $self= shift;
  my $class= ref($self) || $self;
  my $hcol= $self->SUPER::nofCol();
  $hcol = $hcol * 2;
  return $hcol;
}

sub fromCSV
{
  my ($class, $name, $header) = @_;
  my $self= Data::Table::fromCSV($name, $header);
  bless $self, $class;
  $self->{comment}= "Data is from file $name";
  $self->set_date();
  return $self;
}

1;

The Program Output

t:  TT
t2: TT
t3: TT
t4: TT
Hello
Wed Nov 28 20:08:59 2001

name
age
John
20
Kate
18
Mike
23

4
$VAR1 = bless( {
                 'header' => [
                               'name',
                               'age'
                             ],
                 'data' => [
                             [
                               'John',
                               20
                             ],
                             [
                               'Kate',
                               18
                             ],
                             [
                               'Mike',
                               23
                             ]
                           ],
                 'comment' => 'A comment',
                 'colHash' => {
                                'age' => 1,
                                'name' => 0
                              },
                 'type' => 0
               }, 'TT' );
$VAR1 = bless( {
                 'header' => [
                               'this',
                               'is',
                               'a',
                               'test'
                             ],
                 'data' => [
                             [
                               'that',
                               'is',
                               'a',
                               'copy'
                             ]
                           ],
                 'comment' => 'Data is from file aaa.csv',
                 'colHash' => {
                                'this' => 0,
                                'is' => 1,
                                'a' => 2,
                                'test' => 3
                              },
                 'my_date' => 'Wed Nov 28 20:08:59 2001',
                 'type' => 0
               }, 'TT' );

11/28/2001