Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation


by haggs (Initiate)
on Jun 06, 2000 at 23:38 UTC ( #16713=perlquestion: print w/replies, xml ) Need Help??

haggs has asked for the wisdom of the Perl Monks concerning the following question:

Is there a neat way to implement interfaces on Perl like C++ pure virtual classes or Java interfaces or abstract classes? It would greatly help if there was a way or merely an agreed upon way doing it.

Replies are listed 'Best First'.
Re: Interfaces
by ivey (Beadle) on Jun 06, 2000 at 23:54 UTC
    You could create an abstract class where each method prints an error, like so:
    package AbstractClass; sub new { my($class) = shift; bless { "classVar1" => undef, "classVar2" => undef }, $class; } sub methodOne { print "Error: Use of undefined Abstract Method\n"; } sub methodTwo { print "Error: Use of undefined Abstract Method\n"; }
    and then override the methods in the subclasses:
    package SomeObject; @ISA = ("AbstractClass"); sub methodOne { print "Doing the real function\n"; }

    that's very basic code...would it do something like what you want?

      Since you're writing a bunch of subroutines that do the same thing, you can be lazy and just alias them:
      sub cant_do_that { my $self = shift; print "Error: Use of undefined Abstract Method by $self.\n"; } use subs qw/methodOne methodTwo/; *methodOne = \&cant_do_that; *methodTwo = \&cant_do_that;
        Thus saith btrott:
        sub cant_do_that { my $self = shift; print "Error: Use of undefined Abstract Method by $self.\n"; } use subs qw/methodOne methodTwo/; *methodOne = \&cant_do_that; *methodTwo = \&cant_do_that;
        I'd simplify the whole lot of that by doing what use subs does directly:
        BEGIN { for my $fakir (qw(methodOne methodTwo)) { *$fakir = sub { die "undef abstract method $fakir used by ".(shift +); } } }
        No fuss, no muss, and you even get a distinguishing mark.

        -- Randal L. Schwartz, Perl hacker

      I've done something exactly like that. There is one additional bit in my code, though.
      sub methodOne { my $self = shift; print "Error: Use of undefined Abstract Method by $self\n"; }
      That way, you know exactly which subclass isn't overriding it.
Re: Interfaces
by Dominus (Parson) on Dec 01, 2000 at 04:28 UTC
    [oops, this is actually an answer to the very similar question posed in this thread. It's pretty much the same question, but the poster wants the checking for missing methods to occur at compile time instead of at run time (or not at all.) I hope this explanation makes clearer what problem I'm trying to solve and why I needed more code than the simpler solutions shown above]

    Well, I have an idea, but I've never really tried it out, so I don't know how practical it is. My idea is that the abstract base class can keep track of who is derived from it, and have an INIT block that checks to make sure all its derived classes define the appropriate methods. The INIT block is called after compilation is complete, but before program execution begins. A test implementation looked reasonable:

    package Abstract; use Carp; my @inheritors; sub import { my $caller = caller; push @inheritors, $caller; } my @abstract_methods = qw(swim fly); sub INIT { my $bad = 0; for my $class (@inheritors) { for my $meth (@abstract_methods) { no strict 'refs'; unless (defined &{"${class}::$meth"}) { $bad=1; warn "Class $class inherits from Abstract, but does not define + $meth.\n"; } } } croak "Compilation aborted" if $bad; } 1;
    Abstract wants its subclasses to define swim and fly methods. If you define a class, say Fish, which inherits from Abstract and defines a swim method but no fly method, you get a fatal error at compile time:
    Class Fish inherits from Abstract, but does not define fly. Compilation aborted at line 0
    Here's the Fish I used:
    package Fish; use Abstract; sub swim { "bloop bloop bloop"; } 1;
    Then test with perl -e 'use Fish'.

    There are some problems with this implementation. For example, you might want some way to derive less-abstract classes from the abstract base class, and this implementation doesn't allow that. But I think the basic idea is sound.

    The other thing that came to mind is that Damian Conway probably has something interesting to say about this. Have you checked his book?


      #!/usr/local/bin/perl -w # # my dbc OOPerl "interface" use strict; use warnings; use FindBin::libs; use Class::Contract; package Doable; { unless( eval { contract { # constant class attr 'NADA'; invar { ${self->NADA} = 0; }; abstract ctor 'new'; abstract dtor; # Control abstract method 'doTheThing'; # Test: DON'T implement doThatThing # and hope an exception is raised. abstract method 'doThatThing'; pre { defined ${Doable::caller} }; }; # end contract sub new; sub DESTROY; sub doTheThing; # sub doThatThing; 1; } # end eval ) { die( "\n\nThere has been a breach of contract.\n\n" ); } # end + unless } 1; # end Doable

      #!/usr/local/bin/perl -w # # my OOPerl "implementation" use strict; use warnings; use FindBin::libs; use Class::Contract; use private qw(_semprini); use protected qw(_friendly); use public qw(face); # Should be implementing rather than overloading or overriding use overload "Doable::doTheThing" => "Doer::doTheThing"; use Doable; # I want to IMPLEMENT, # not INHERIT, but anyway... package Doer; @Doer::ISA = qw(Doable); { sub new { my $classname = shift; my $self = bless { }, $classname; $self->{_semprini} = 'naughty'; $self->{face} = 'blank'; return($self); } # end new sub DESTROY { my $self = shift; } # end DESTROY sub doTheThing { print"\nTesting...\n\n"; } # end doTheThing # Don't uncomment unless testing. # sub doThatThing { return(0); } # end doThatThing } 1; # end Doer

      #!/usr/local/bin/perl -w # # my OOPerl "application" use strict; use warnings; use private qw(_MyApp _main _d); use Doer; # I don't want to inherit here, # I just want to "use" and make sub calls package _MyApp; @_MyApp::ISA = qw(Doer); { sub _main; { my $_d = Doer->new; # constructor $_d->doTheThing; # method # print $_d->NADA; # can't see the constant $_d->DESTROY; # destructor print("\nDone! exiting...\n\n"); exit(0); } # end _main } 1; # end _MyApp

      ...What's a clean way of doing that using Class::Contract ?

Log In?

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

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (3)
As of 2020-03-29 21:39 GMT
Find Nodes?
    Voting Booth?
    To "Disagree to disagree" means to:

    Results (171 votes). Check out past polls.