package Class::Virtually::Abstract;
use base qw(Class::Virtual);
use Carp::Assert;
assert( prototype('CORE::bless') eq '$;$' );
sub bless ($;$) {
my $class = $_[1] || caller;
if( grep { $_ eq 'Class::Virtually::Abstract' } @{$class.'::ISA'} ) {
confess("Connot bless objects into abstract class $class");
}
else {
CORE::bless(shift, $class);
}
}
sub import {
shift;
my $base = caller();
*{$base.'::bless'} = \&bless;
*{$base.'::import'} = sub {
my $class = shift;
return if $class eq $base;
foreach my $missing_meth ($class->missing_methods) {
require Carp;
Carp::croak("Class $class must define $missing_meth for class ".
"$base");
}
$class->SUPER::import(@_);
};
1;
}
####
package Foo;
require Some::Abstract::Class;
@ISA = qw(Some::Abstract::Class);
##
##
package Foo;
use base qw(Some::Abstract::Class);