# Abstract class for consideration
# name() and doit() are a base class object methods.
# table_name() is a pure virtual method.
# database() is a base class "static" method.
package Foo;
require Exporter;
use vars ( @ISA );
@ISA = qw( Exporter );
# this is the list of pure virtual functions which must be
# implemented in any subclass that uses this base class.
my @VIRTUAL_METHODS = qw( table_name );
# this is the constructor, that validates the list of virtual methods.
sub new()
{
my $class = shift @_;
$class = ref $class if ref $class;
my @args = @_;
# verify pure virtual methods
for my $method ( @VIRTUAL_METHODS )
{
unless ( $class->can( $method ) )
{
die "$class: missing virtual method '$method'\n";
}
}
# create object
my $obj = {};
$obj->{NAME} = shift @args;
bless $obj, $class;
return( $obj );
} # new
# This is a base-class function that uses a base-class data member.
# You have to call it from a specific object instance of a
# derived class.
sub name
{
my $obj = shift @_;
my $key = 'NAME';
if ( scalar @_ )
{
$obj->{$key} = shift @_;
}
return( $obj->{$key} );
} # name
# This is a base-class function that doesn't need a class instance to
# function properly (it's not virtual, either );
sub database_name
{
return 'Foobase';
} # database_name
# This is a base-class function that uses a virtual method
# and also uses a base-class method.
sub doit()
{
my $obj = shift @_;
my @args = @_;
# Prove that base class was called from member object
printf "In %s\::doit() for class %s, ", __PACKAGE__, ref $obj;
printf "my name is %s, and my table is %s\n",
$obj->name(), $obj->table_name();
return(1);
} # doit
####
# Test module derived from Foo.
package Abc;
use Foo;
require Exporter;
use vars ( @ISA );
@ISA = qw( Foo );
# Implementation of the pure virtual function; if we don't do this,
# you won't be able to successfully call new() for this class.
sub table_name() { 'ABC_TABLE' }
# This function implements a method that my class can do, but
# is not meaningful for other classes derived from Foo.
sub abc_func
{
my $obj = shift @_;
my @args = @_;
printf "Local function for %s -- my name is %s, my table is %s\n",
__PACKAGE__, $obj->name(), $obj->table_name();
return( 1 );
} # abc_func
##
##
# Test module
package XyzBase; # partial inheritance of Foo
use Foo;
require Exporter;
use vars ( @ISA );
@ISA = qw( Foo );
# Implementation of the pure virtual function; if we don't do this,
# you won't be able to successfully call new() for this class.
# We don't implement the virtual function, so the constructor isn't
# meaningful.
#sub table_name() { 'NO_TABLE' }
# We can implement methods that would be "static" in C++, but not
# any method that takes an object (because we can't new Xyz() ).
# is not meaningful for other classes derived from Foo.
sub base_func
{
my $class = shift @_;
# we can still inherit from this class, so objects might exist.
# convert this into a classname for consistency.
$class = ref $class if ref $class;
printf "Local function for %s, called from %s\n",
__PACKAGE__, $class;
return( 1 );
} # base_func
##
##
# Test module
package Xyz;
use XyzBase;
require Exporter;
use vars ( @ISA );
@ISA = qw( XyzBase );
# Implementation of the pure virtual function; if we don't do this,
# you won't be able to successfully call new() for this class.
sub table_name() { 'XYZ_TABLE' }
# This function implements a method that my class can do, but
# is not meaningful for other classes derived from Foo.
sub xyz_func
{
my $obj = shift @_;
my @args = @_;
printf "Local function for %s -- my name is %s, my table is %s\n",
__PACKAGE__, $obj->name(), $obj->table_name();
return( 1 );
} # xyz_func
##
##
#!/usr/bin/perl -w
use strict;
use Abc;
use Xyz;
my $abc1 = new Abc( 'Fred' );
my $xyz1 = new Xyz( 'Ethel' );
# test specialized functions
$abc1->abc_func();
$xyz1->xyz_func();
# test common functions
$abc1->doit();
$xyz1->doit();
# This function has a class name, not an object of that type,
# but it can still access methods of that class.
sub class_specific_func
{
my ( $class ) = @_;
$class = ref $class if ref $class; # in case object was passed in
my $table = 'unknown';
$table = $class->table_name() if $class->can( 'table_name' );
printf "Table for %s is %s, database is %s\n", $class, $table,
$class->database_name();
}
class_specific_func( 'Abc' );
class_specific_func( 'Xyz' );
class_specific_func( 'XyzBase' );
# calls of static methods
XyzBase->base_func();
Xyz->base_func();
##
##
Local function for Abc -- my name is Fred, my table is ABC_TABLE
Local function for Xyz -- my name is Ethel, my table is XYZ_TABLE
In Foo::doit() for class Abc, my name is Fred, and my table is ABC_TABLE
In Foo::doit() for class Xyz, my name is Ethel, and my table is XYZ_TABLE
Table for Abc is ABC_TABLE, database is Foobase
Table for Xyz is XYZ_TABLE, database is Foobase
Table for XyzBase is unknown, database is Foobase
Local function for XyzBase, called from XyzBase
Local function for XyzBase, called from Xyz