# 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