As a habitual C++ programmer, I have been thinking about the concept of virtual functions lately as implemented in that language. With a nod to the past discussions at
Interfaces and
interface.pm explained, I have an alternate system of doing this that I'd like to blather about for a bit.
First, the Requirements:
- For any class Foo, you should be able to specify the need for implementation of a method m without having to code a reference implementation (this is what makes Foo an abstract class).
- If you attempt to construct an object of some subclass where m() has not been defined, Perl will throw an exception. Ideally, this would be when the code is parsed, but a runtime error is acceptable.
- For any valid subclass of Foo where m has been defined, functions in Foo that call m() should get the method implemented by the subclass (this is what makes the function virtual.
Conflating apples and oranges for a bit, I think that any function f() defined by Foo() should remain usable even though you can't legitimately instantiate a Foo per se. This leads me to the following sample abstract class definition:
# 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
Given this, the code to implement a derived class might look like:
# 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
It is possible, however, to implement an intermediate base class XyzBase that doesn't define table_name():
# 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
And we derive a class from
XyzBase as follows:
# 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
Then, the following program shows how we could call that mess:
#!/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 i
+n
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();
Giving us the following results:
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_TAB
+LE
In Foo::doit() for class Xyz, my name is Ethel, and my table is XYZ_TA
+BLE
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
I like this implementation better than what I've seen because the code in
Interfaces doesn't throw an exception unless and until you try to call the missing method. In my experience, that could allow a defect to linger much longer than it ought.
It is possible that I'm just reinventing the wheel as created by Class::Trait, but I can't always get past the political/security approvals needed to add external modules to my code.
Having said all that, I'm interested in any commentary that might be gained by discussing this with other Perl programmers who like to work in an OO style.
