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;