The solution I suggested in the other thread fixes this problem by deferring the check until after compilation is complete. My sample code doesn't deal properly with inherited methods, however. I think a hybrid approach might be effective.

You would use the INIT block approach that I showed, and then in the INIT block, use ->can, and check to see if the returns subroutine was equal to the stub:

sub INIT {
  ...
  my $ref = $inheriting_class->can($method);
  if (! defined($ref)|| 
      defined(&$method) && $ref == \&$method) {
    $bad = 1;
    warn ...;
  }
}
[download]

You still have the problem with abstract classes that inherit from other abstract classes, of course, but I think solving these problems should be just a SMOP.

Mark's (Dominus) solution in the other thread is just what I was looking for. I want all classes where I "use Interface;" to implement and not inherit the methods listed in the Interface package.

The particular design problem I need this for is one in which I need each class, regardless of what base class they inherit from, to implement themselves a group of methods.

Java provides a built in facility for doing this, the "implements" keyword, which works almost exactly as the "use Abstract;" Mark proposes. (To it I would suggest adding the word "Interface" to the abstract class name, to achieve Java-like clarity through convention). Thus his example would look like this:

package DuckInterface;
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 should implement DuckInterface, but does 
+not define $meth.\n";
        }
      }
    }
    croak "Compilation aborted" if $bad;
  }

  1;
[download]

And a class that "implements" DuckInterface:

package RedDuck;
use DuckInterface;

sub swim {
  "I swim like a red duck";
}

sub fly {
  "I fly like a red duck, and DuckInterface guarantees I do!";
}
[download]

If you want all that Java bondage, just get Class::Contract. Java in Perl, written by "the Damian".

-- Randal L. Schwartz, Perl hacker

There is no need to have an INIT function. Just have the import function skip the abstract class, and then have it do the check. Works exactly like my example did.

Please try it and attempt to produce a case of breakage.

In my tests it works perfectly.

In theory it should work fine as well.

If A is an abstract class and B inherits from it then the check that B has implemented the methods does not happen when B calls import on A since A ignores the method call with itself as the class. It only happens when A handles the call to import B into whatever C wanted to use it, at which point B has been compiled and loaded.

tilly says:

> In my tests it works perfectly.

Oh, I see! Yes, that's really clever.

Here is Foo.pm:

package Foo;
use Carp;

# Import method that checks existence of abstract methods in subclasse
+s.
sub import {
  my $pkg = shift;
  return if $pkg eq __PACKAGE__;
  foreach my $meth ( qw(foo) ) {
    $pkg->can($meth) or croak("Class $pkg does not define method $meth
+");
  }
  $pkg->SUPER::import(@_);
}

1;
[download]

package Bar;
use Carp;
use Foo;
@ISA = qw(Foo);

# Import method that checks existence of abstract methods in subclasse
+s.
sub import {
  my $pkg = shift;
  return if $pkg eq __PACKAGE__;
  foreach my $meth ( qw(bar) ) {
    $pkg->can($meth) or croak("Class $pkg does not define method $meth
+");
  }
  $pkg->SUPER::import(@_);
}

1;
[download]

package Baz;
use Bar;
@ISA = qw(Bar);

sub foo {print "This is method foo\n";}

sub bar {print "This is method bar\n";}

1;
[download]

use Baz;
[download]

die unless defined *{__PACKAGE__."::$_"}{CODE} for qw(foo bar);
[download]

-- Randal L. Schwartz, Perl hacker

That is why I said that the technique fails if the base class implements stubs. It must list, not define, the methods.

The direct defined check will work, but it means that every subclass must implement all of the methods. So if A is an abstract class, and B inherits from A and C inherits from B, then by default C has to define every one of the required methods.

1) This code will not call SUPER::import when it's imported by itself because of the first return.
2) Exporter uses caller() to populate the namespace, which is broken by this.

My modified code is here:

sub import {
    my $pkg = shift;

    if ($pkg ne __PACKAGE__) {
        foreach my $meth ( qw(foo bar) ) {
            $pkg->can($meth) or croak("Class $pkg does not define meth
+od $meth");
        }
    }

    my $is_exp = $pkg->isa('Exporter');
    $Exporter::ExportLevel++ if $is_exp;
    $pkg->SUPER::import(@_);
    $Exporter::ExportLevel-- if $is_exp;
}
[download]