[Melbourne-pm] NEXT + AUTOLOAD problems

[Bradley Dean]

Greetings folks,

I've been trying to get NEXT working with AUTOLOAD and it doesn't seem to
be behaving as I would expect.

Using $self->NEXT::ACTUAL::AUTOLOAD() should cause an exception to be
thrown if the search for another AUTOLOAD in the inheritance tree fails.
This allows AUTOLOADs to be written to handle specifif cases and then hand
the search on - for example:

  sub AUTOLOAD {
    my ($self, @params) = @_;
    if ( _i_handle_this_case() ) {
      # Do something
      ...
    }
    else {
      return $self->NEXT::ACTUAL::AUTOLOAD(@params);
    }
  }

NEXT::ACTUAL was added by Damian after Paul suggested that the default NEXT
behaviour of failing silently was not good for AUTOLOAD.

The problem I'm having is that I'm still seeing silent failures. I've
written a quick test script (included in this email after the __END__ tag
:) ) which results in the following output:

AUTOLOAD:A
a CALL: A
AUTOLOAD:A
AUTOLOAD:B
b CALL: B
AUTOLOAD:A
AUTOLOAD:B
AUTOLOAD:C
c CALL: C
AUTOLOAD:A
AUTOLOAD:B
AUTOLOAD:C
d [UNDEF]

That "d [UNDEF]" at the end means I'm getting an undef response from
$obj->d() whereas I would hope for an exception saying "Can't locate object
method ....". Poking around in NEXT.pm ($VERSION='0.60') the problem seems
to be around line 63:

  my $call_method = shift @{$NEXT::NEXT{$self,$wanted_method}};
  while ($wanted_class =~ /^NEXT\b.*\b(UNSEEN|DISTINCT)\b/
         && defined $call_method
         && $NEXT::SEEN->{$self,$call_method}++) {
    $call_method = shift @{$NEXT::NEXT{$self,$wanted_method}};
  }
  unless (defined $call_method) {
    return unless $wanted_class =~ /^NEXT:.*:ACTUAL/;
    (local $Carp::CarpLevel)++;
    croak qq(Can't locate object method "$wanted_method" ),
          qq(via package "$caller_class");
  };

The unless block deals with the lack of a found $call_method, but the
'return unless $wanted_class =~ /^NEXT:.*:ACTUAL/;' is always returning for
my test. Looking at the value of $wanted I see it's 'NEXT::AUTOLOAD' which
in turn means that the value of $wanted_class is not matching
/^NEXT:.*:ACTUAL/.

Looking further I can't see any place that $NEXT::AUTOLOAD is set (indeed
when I look at $NEXT::AUTOLOAD just in case it's being set automatically it
is undefined). This means that $wanted_class will never match the pattern,
so the exception will never be thrown.

So that leaves me somewhat confused - if I comment out the 'return
unless...' I get the result I want but that means that NEXT will start
behaving like NEXT::ACTUAL. I cannot for the life of me find the string
'ACTUAL' anywhere to match on. I know I could make it work by refactoring
the code to have hard coded noisy failures for NEXT::ACTUALL and quiet for
NEXT - but I figure this must have worked for some test so I'm still a bit
suspicious of my usage.

Any and all insights or suggestions gratefully accepted! :)

Cheerio,

 Brad

__END__
#!/usr/bin/env perl

use strict;
use warnings;

package B;
use NEXT; our $AUTOLOAD;
sub AUTOLOAD {
  print "AUTOLOAD:B\n";
  my ($self, @params) = @_;
  if ( $AUTOLOAD =~ /b/ ) {
    return 'CALL: B';
  }
  else {
    return $self->NEXT::ACTUAL::AUTOLOAD(@params);
  }
}
sub DESTROY {};

package C;
use NEXT; our $AUTOLOAD;
sub AUTOLOAD {
  print "AUTOLOAD:C\n";
  my ($self, @params) = @_;
  if ( $AUTOLOAD =~ /c/ ) {
    return 'CALL: C';
  }
  else {
    return $self->NEXT::ACTUAL::AUTOLOAD(@params);
  }
}
sub DESTROY {};

package A;
use NEXT; our $AUTOLOAD;
use base qw{B C};
sub AUTOLOAD {
  print "AUTOLOAD:A\n";
  my ($self, @params) = @_;
  if ( $AUTOLOAD =~ /a/ ) {
    return 'CALL: A';
  }
  else {
    return $self->NEXT::ACTUAL::AUTOLOAD(@params);
  }
}
sub DESTROY {};

package main;

my $obj = bless {}, 'A';

print 'a ' . do { $obj->a() || '[UNDEF]' } . "\n";
print 'b ' . do { $obj->b() || '[UNDEF]' } . "\n";
print 'c ' . do { $obj->c() || '[UNDEF]' } . "\n";
print 'd ' . do { $obj->d() || '[UNDEF]' } . "\n";


-- 
Bradley Dean
Software Engineer - http://bjdean.id.au/
Email: bjdean at bjdean.id.au Skype: skype at bjdean.id.au
Mobile(Aus): +61-413014395 Mobile(UK): +44-7846895073