Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

comment on

( #3333=superdoc: 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 interface.pm 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.


In reply to Pure Virtual Functions by papidave

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others avoiding work at the Monastery: (3)
    As of 2020-03-29 05:18 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      To "Disagree to disagree" means to:









      Results (169 votes). Check out past polls.

      Notices?