#lexical-methods-test.pl
use strict;
use warnings;
use 5.010;

use Foo;

my $obj = Foo->new;

# Look, we can call normal class methods:
$obj->foo;

# This will fail (which is why it's in an eval)
eval {
	$obj->bar;
	1;
} or do {
	print "Unable to call 'bar' on Foo object in this lexical scope\n";
};

{
	# Lexically allow method "bar" as a Foo method:
	use Bar;
	$obj->foo;
	$obj->bar;
}

# Out here, normal method calls still work
$obj->foo;

# Kaboom!
$obj->bar;

##</code><code>##

# Bar.pm
use strict;
use warnings;
use 5.010;

package Bar;

# Installs a method called bar
sub import {
	$^H{"Foo/bar"} = 'Bar/bar';
}

sub unimport {
	delete $^H{"Foo/bar"};
}

sub bar {
	print "Calling method bar from package Bar\n";
}

1;

##</code><code>##

# Foo.pm
use strict;
use warnings;
use 5.010;

package Foo;
use Carp 'croak';

sub new {
	my $class = shift;
	$class = ref($class) || $class;
	return bless {}, $class;
}

sub foo {
	print "Calling method foo from package Foo\n";
}

sub AUTOLOAD {
	my $self = $_[0];

	# Get the called method name and trim off the fully-qualified part
	( my $method = our $AUTOLOAD ) =~ s{.*::}{};

	# Get the hints hash for the calling lexical scope
	my $hinthash = (caller(0))[10];
	if (exists $hinthash->{"Foo/$method"}) {
		my ($package, $package_method)
			= split '/', $hinthash->{"Foo/$method"}, 2;

		# Retrieve the subref and goto() it
		my $subref = $package->can($package_method)
			or croak("Lexically scoped Foo method $method points to a nonexistent method ${package}::$package_method");
		goto &$subref;
	}
	elsif (my $super_method = $self->SUPER::can($method)) {
		goto &$super_method;
	}
	elsif ($method eq 'DESTROY') {
		# Do nothing if we come to this.
		return;
	}
	else {
		croak("Can't locate object method \"$method\" via package \"" . __PACKAGE__ . '"');
	}
}

sub can {
	my ($self, $method) = @_;

	# Check if it's a lexical method
	my $hinthash = (caller(0))[10];
	if (exists $hinthash->{"Foo/$method"}) {
		my ($package, $package_method)
			= split /\//, $hinthash->{"Foo/$method"}, 2;

		# Retrieve the subref and goto() it
		my $subref = $package->can($package_method)
			or croak("Lexically scoped Foo method $method points to a nonexistent method ${package}::$package_method");
		return $subref;
	}
	elsif (my $super_method = $self->SUPER::can($method)) {
		return $super_method;
	}
	else {
		return undef;
	}
}

1;