[Pdx-pm] [build in defaults to method calls from the outside] need some help thinking thru this one

[Michael G Schwern]

benh wrote:
> It works, but it seems needlessly messy. What I would like to do is to
> have some way to specify that all calls made to SingleBook that dont
> exits should then get passed to BookInfo with the know isbn.
> 
> I was thinking of doing something along these lines:
> 
> if ($self->can($action) ) {
>    return $self->$action;
> } elseif ($self->{bi}->can($action) {
>    return $self->{bi}->$action($self->{isbn});
> } else {
>    die 'freakout... why are we here?';
> }
> 
> ... but I would have no idea where to plug this in to intercept every
> call to this object, unless I build a sub that EVERYTHING goes thru...
> but thats alot of code to change, and again seems like a very cludgy
> way to trap things.
> 
> Any one have any other ideas? Am I on the right track? Completely
> missed the mark?

AUTOLOAD() is the method which gets called if Perl can't find a method.  Its
called with the same arguments as a regular method.  The original fully
qualified method name called is in $AUTOLOAD.

our $AUTOLOAD;
sub AUTOLOAD {
	my $self = shift;
	my $class = ref $self || $self;

	my($method) = $AUTOLOAD =~ m/:([^:]+)$/;

	return if $method eq 'DESTROY';

	if( $self->{bi}->can($method) ) {
		return $self->{bi}->$method($self->{isbn}, @_);
	}
	else {
		croak sprintf
			q[Can't locate object method "%s" via package "%s"],
			$method, ref $self;
	}
}


Since AUTOLOAD is overhead on each method call you can get tricksy.  The first
time a method is called AUTOLOAD makes one for it.  Then each call after a
real method is called.

our $AUTOLOAD;
sub AUTOLOAD {
	my $self = $_[0];
	my $class = ref $self || $self;

	my($method) = $AUTOLOAD =~ m/:([^:]+)$/;

	return if $method eq 'DESTROY';

	if( $self->{bi}->can($method) ) {
		my $code = sub {
			my $self = shift;
			$self->{bi}->$method($self->{isbn}, @_);
		};
		*{$class .'::'. $method} = $code;
		goto $code;
	}
	else {
		croak sprintf
			q[Can't locate object method "%s" via package "%s"],
			$method, ref $self;
	}
}


To complete the illusion, override can() so it can answer correctly for the
autoloaded methods which haven't been called yet.

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

	return 1 if $self->can($method);
	return 1 if $self->{bi}->can($method);

	return 0;
}