Detecting Overridden Methods in Perl

Question

Last week I was bitten twice by accidentally overriding methods in a subclass. While I am not a fan of inheritance, we (ab)use this in our application at work. What I would like to do is provide some declarative syntax for stating that a method is overriding a parent method. Something like this:

use Attribute::Override;

use parent 'Some::Class';

sub foo : override { ... } # fails if it doesn't override
sub bar { ... }            # fails if it does override

There are a couple of issues here. First, if method loading is delayed somehow (for example, methods loaded via AUTOLOAD or otherwise later installed in the symbol table), this won't detect those methods.

Walking the inheritance tree could also get similarly expensive. I do this with Class::Sniff, but it's not really suitable for running code. I could walk the inheritance tree and simply match where there's a defined CODE slot in the appropriate symbol table and that would be faster, but if the method cache is invalidated, that would break if I were to cache those results.

So I have two questions: is this a reasonable approach and is there a hook which allows me to check if the method cache has changed? (search for 'cache' in 'perldoc perlobj').

Of course, this shouldn't break production code, I am thinking about only having it fail or warn if the TEST_HARNESS environment variable is active (and have an explicit environment variable to force it to be inactive, if production code were to set the TEST_HARNESS environment variable for some reason).

Answer 1

One way to enforce this:

package Base;
...
sub new {
    my $class = shift;
    ...
    check_overrides( $class );
    ...
}

sub check_overrides {
    my $class = shift;
    for my $method ( @unoverridable ) {
        die "horribly" if __PACKAGE__->can( $method ) != $class->can( $method );
    }
}

Memoization of check_overrides may be helpful.

If there are some cases where you want exemptions, have an alternate method name and have the base class call that:

package Base;
...
my @unoverridable = 'DESTROY';
sub destroy {}
sub DESTROY {
    my $self = shift;
    # do essential stuff
    ...
    $self->destroy();
}