Oh, boy. The short answer is "You can't". If you want a "method" that cannot be overridden, you need to use a subroutine reference and, then, it's essentially private (which means you cannot call it from the outside).

The long answer is: Inheritance in Perl is determined by the @ISA package variable (which is set by use base, if you're using that). That variable is in the child class. The parent actually never knows who's inheriting from it. You theoretically could check every single package that's been loaded and see if it's @ISA eventually gets back to you, but then you cannot know if another class has been created after that check was done. Remember - I can create new classes on the fly and load stuff on the fly.

You can inspect the value you get from ref($self). If that's not Baz, some other package is calling the method through inheritance (or some other wacky thing). From there, decide what you want to do.

I think that the code below will do what you want. You do need to make sure that new is called.

{
    package Baz;

    sub new
    {
        my $class = shift;

        if ($class ne 'Baz') {
            if ($class->can('foo') != Baz->can('foo')) {
                die "Don't do that $class";
            }
        }

        bless {}, $class;
    }

    sub foo
    {
        'foo';
    }
    sub boo
    {
        'foo';
    }
}
{
    package Foo;
    our @ISA = 'Baz';

    sub foo
    {
        'Foo';
    }
    sub boo
    {
        'Foo';
    }
}
{
    package Boo;
    our @ISA = 'Foo';

    sub boo
    {
        'Boo';
    }
}
{
    package Goo;
    our @ISA = 'Baz';

    sub boo
    {
        'Boo';
    }
}

my ($a, $b, $c);

eval {
    $a = new Baz;
};
warn $@ if $@;
eval {
    $c = new Foo;
};
warn $@ if $@;
eval {
    $b = new Boo;
};
warn $@ if $@;
eval {
    $b = new Goo;
};
warn $@ if $@;

If you just want to make sure that Baz::foo is being called from code you control you can just do:

$class->Baz::foo();

I can't think of anything that you could do in a BEGIN block that would help with this problem.

sub Baz::new {
    ...
    croak ...
        if  $class->can("foo") != \&Baz::foo;
    ...
}

?

I doubt I would encourage such tactics.

the usual way to do that on perl is:

=item foo

this method can not be redefined in derived classes

=cut

I've thinking about this more and I think you're missing something:

package Baz;

sub foo {
    # Do something here ...
}

package Baz::Ok;

use base 'Baz';

sub foo {
    my $self = shift;

    # Call parent method first!
    my $rv = $self->SUPER::foo( @_ );

    # Log the call somehow

    return $rv;
}

From the outside world, I didn't override foo(). I just decorated it a little. You might want to think about that.

I'm missing something here, or I wasn't clear. Here's some code:

# untested

package Foo;

sub bleep {...}
sub baz { ... }

package NewFoo;
use base qw(Foo);

sub baz { ... }

package main;

my $a = Foo->new;
my $b= NewFoo->new;

$a->bleep;
$b->bleep;

$a->baz;
$b->baz;

In this example, I am cool with a user calling bleep on either 'a' or 'b'. I'm also cool with a user calling baz on either 'a' or 'b'. What I'd like to detect from Foo is that a subclass (NewFoo) overrode a certain method. That is, $b->baz calls NewFoo::Baz, as that overrode Foo::Baz.

I'm looking for a way for Foo to detect and carp that a subclass took away its rights to own the code for method baz.

Probably this isn't "nice" OO -- "thou shalt never subclass me, dammnit" isnt friendly -- but I'm wondering how to do it anyway.

I really like the suggestion about just saying "never subclass baz" in the docs (++ to that post), but need something stronger.

The comments above about checking the ref on self don't seem relevant to me, as here the problem is that Foo::baz never gets involved when someone calls baz on $b... it is too late, the baz is then a NewFoo baz at that point.....?

[water]

Is something like this relevant?

Anyone suggest how to hack this trick into the behavior I need?

http://simon-cozens.org/programmer/releases/secret/classview

use Devel::Sub::Which qw/:universal/;

INIT { # after all modules have been loaded. Will break with mod_perl

    my $which = __PACKAGE__->which("foo");

    ( my $class = $which ) =~ s/::[^:]+$//;

    die "Subclassing 'foo' is not allowed" unless $class eq __PACKAGE__;
}

Technicalities aside - are you sure you really want to check this? I can't imagine a scenario where this would be a good thing to do.

Attribute::Final does just what you want (I agree that the module is poorly named).
Then you'll just have to declare your method with the :final attribute.

This nomenclature comes from Java final methods.

Methods can't be subclasses, only classes can be. Assuming that you mean 'inherited' instead, use Class::CanBeA to figure out what the subclasses of Baz are, then use exists() and can() to figure out what methods are being inherited in those subclasses and which are defined.

You need to be careful though - perl supports multiple inheritance, so you may need to figure out your subclasses and then figure out all of their parent classes to find all the other roots of the inheritance tree. And if you do have multiple inheritance, I can't think of any way of telling that this subroutine came from that superclass and that this other subroutine came from that other superclass.

package Foo;
sub foo { 'foo' }

package Bar;         # Bar inherits 'foo' from Foo
@ISA = qw(Foo);
sub bar { 'bar' }    # Bar defines 'bar'

package main;
use Class::CanBeA;
my @subclasses = @{Class::CanBeA::subclasses('Foo')};
foreach my $class (@subclasses) {
    print "$class is a subclass of Foo\n";
    foreach my $sub (qw(foo bar)) {
        if(!exists(&{$class.'::'.$sub}) && $class->can($sub)) {
            print $class.'::'.$sub." is inherited\n";
        }
    }
}