I'd avoid AUTOLOAD. I see two realistic alternatives. The first is to not use different methods but one and the same and pass an argument. A possible implementation would be
{
package MyBase;
sub is {
my $self = shift;
my ($type) = @_;
my $method = 'is_' . $type;
if (my $code = $self->can($method)) {
return $self->$code;
}
return 0;
}
}
{
package Foo;
use base MyBase::;
sub is_foo { 1 }
}
{
package Bar;
use base MyBase::;
sub is_bar { 1 }
}
{
package FooAndBar; # Faker!
use base MyBase::;
sub is_foo { 1 }
sub is_bar { 1 }
}
printf "%-9s %s %s\n", $_, $_->is('foo'), $_->is('bar')
for Foo::, Bar::, FooAndBar::;
__END__
Foo 1 0
Bar 0 1
FooAndBar 1 1
Another alternative is that you use your base class to setup the inheritance and when doing that it also defines the
is_* methods. Here's an implementation:
package MyBase;
use strict;
use Symbol 'qualify_to_ref';
sub import {
my $class = shift;
if (@_) {
if ($_[0] eq '-base') {
my (undef, %p) = @_;
my $type = $p{is}
or die '...';
my $pkg = caller;
_setup_inheritance($class => ($pkg, $type));
}
else {
die '...';
}
}
}
sub _setup_inheritance {
my ($class) = shift;
my ($pkg, $type) = @_;
$type !~ /\W/
or die '...';
my $method = 'is_' . $type;
{
my $gref = qualify_to_ref($method);
*$gref = sub { 0 } unless defined &$gref;
}
{
my $gref = qualify_to_ref($method => $pkg);
*$gref = sub { 1 };
}
push @{*{qualify_to_ref(ISA => $pkg)}}, $class;
return;
}
1;
and the program:
{
package Foo;
use MyBase -base, is => 'foo';
}
{
package Bar;
use MyBase -base, is => 'bar';
}
printf "%-9s %s %s\n", $_, $_->is_foo, $_->is_bar
for Foo::, Bar::;
__END__
Foo 1 0
Bar 0 1
lodin