Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery

Pure Virtual Functions

by papidave (Monk)
on Feb 06, 2009 at 21:41 UTC ( #742013=perlmeditation: print w/replies, xml ) Need Help??

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 explained, I have an alternate system of doing this that I'd like to blather about for a bit.

First, the Requirements:

  1. 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).
  2. 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.
  3. 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.

Replies are listed 'Best First'.
Re: Pure Virtual Functions
by Bloodnok (Vicar) on Feb 06, 2009 at 23:07 UTC
    I wholeheartedly agree with zwon, especially since I have been giving the subject a good coating of thinking about (and not a little discussion/argument) of late - with hardened Java programmers who have been loaded with the task to develop a product test harness/environment in perl.

    In my case the discussions have had occasion to plumb the depths of argument since the preferred implementation style...

    • implements a package in a single .pm file i.e. it doesn't (currently) utilise Test::More or any other of that good stuff supplied for free merely by utilising h2xs.
    • utilises a Test::Unit style implementation of a test regime - which to my mind is a white box test environment i.e. it avoids (proper) black box/interface testing as provided for by Test::More (A corollary of this is that, my agreement with zwon is tempered by the fact that, IMO, more thorough module testing could be acheived thro' the use of both i.e. Test::More & Test::Unit, approaches)
    As a perl script can be written to be essentially self-modifying, to my mind there may just be an advantage in run-time checking - since, together with the test harness, belt-and-braces checking of the interface implementation would be facilitated.

    A user level that continues to overstate my experience :-))
Re: Pure Virtual Functions
by zwon (Monsignor) on Feb 06, 2009 at 22:18 UTC

    I don't like the idea to check such things at runtime. C++ and Java use interfaces to do checks at compile time, and this makes sense for me; your method would do checking after module was released to production use adding useless loop to every object creation. My opinion is that right place to perform such checks is in the t/*.t and right function is can_ok from the Test::More.

Re: Pure Virtual Functions
by Arunbear (Parson) on Feb 07, 2009 at 19:27 UTC
    I've started using Moose for implementing abstract classes. Here is a demo, starting with your Foo module:
    package Foo; use Moose::Role; requires 'table_name'; has 'name' => (is => 'rw'); 1;
    and then a class that implements the abstract method:
    package Abc; use Moose; with 'Foo'; sub table_name { 'ABC_TABLE' } 1;
    and one that should but doesn't:
    package NoTableName; use Moose; with 'Foo'; 1;
    Then a script to test Abc:
    use strict; use warnings; use Abc; my $obj = Abc->new(name => 'Steve'); printf "My name is %s\n", $obj->name;
    (running it)
    C:\Users\arun>perl abc.t My name is Steve
    and one to test NoTableName
    use strict; use warnings; use NoTableName; my $obj = NoTableName->new(name => 'Bob'); printf "My name is %s\n", $obj->name;
    (just compiling it)
    C:\Users\arun>perl -c notablename.t 'Foo' requires the method 'table_name' to be implemented by 'NoTableNa +me' at C:/Perl/site/lib/Moose/Meta/Role/ line 59 Moose::Meta::Role::Application::apply('Moose::Meta::Role::Applicat +ion::ToClass=HASH(0x23ea6a4)', 'Moose::Meta::Role=HASH(0x379d674)', ' +Moose::Meta::Class=HASH(0x368b944)') called at C:/Perl/site/lib/Moose +/Meta/Role/Application/ line 18 Moose::Meta::Role::Application::ToClass::apply('Moose::Meta::Role: +:Application::ToClass=HASH(0x23ea6a4)', 'Moose::Meta::Role=HASH(0x379 +d674)', 'Moose::Meta::Class=HASH(0x368b944)') called at C:/Perl/site/ +lib/Moose/Meta/ line 448 Moose::Meta::Role::apply('Moose::Meta::Role=HASH(0x379d674)', 'Moo +se::Meta::Class=HASH(0x368b944)') called at C:/Perl/site/lib/Moose/Ut line 94 Moose::Util::apply_all_roles('Moose::Meta::Class=HASH(0x368b944)', + 'Foo') called at C:/Perl/site/lib/ line 77 Moose::with('NoTableName', 'Foo') called at C:/Perl/site/lib/Moose +/ line 201 Moose::with('Foo') called at line 5 require called at notablename.t line 3 main::BEGIN() called at line 0 eval {...} called at line 0 Compilation failed in require at notablename.t line 3. BEGIN failed--compilation aborted at notablename.t line 3.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://742013]
Approved by mr_mischief
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (5)
As of 2016-10-28 05:33 GMT
Find Nodes?
    Voting Booth?
    How many different varieties (color, size, etc) of socks do you have in your sock drawer?

    Results (375 votes). Check out past polls.