#!/usr/bin/perl -w
# Copyright 2010 Kevin Ryde
# This file is part of Time-Duration-Locale.
#
# Time-Duration-Locale is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 3, or (at your option) any
# later version.
#
# Time-Duration-Locale is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Time-Duration-Locale. If not, see <http://www.gnu.org/licenses/>.
use strict;
use warnings;
{
package Base;
sub foo {
my ($self) = @_;
print "foo() in Base\n";
}
}
{
package Derived;
our @ISA = ('Base');
use Carp;
use vars '$AUTOLOAD';
sub new {
my ($class) = @_;
return bless {}, $class;
}
sub can {
my ($self, $name) = @_;
print "can() Derived $name\n";
if ($name eq 'foo') {
return _make_foo();
} else {
return undef;
}
}
sub AUTOLOAD {
my $name = $AUTOLOAD;
print "AUTOLOAD() Derived $name\n";
$name =~ s/.*://;
if ($name eq 'foo') {
my $code = _make_foo();
goto $code;
} else {
print "AUTOLOAD() croak\n";
croak "No such function $name()";
}
}
sub _make_foo {
my $code = sub {
print "foo() in Derived\n";
};
no warnings 'once';
*foo = $code;
return $code;
}
}
my $obj = Derived->new;
$obj->foo;
exit 0;