I often get asked to explain AUTOLOAD, so here are
some examples of ways to use AUTOLOAD. Many of these
tools are particularly useful for debugging large programs, or for
`getting your feet wet' as you're learning a large, pre-existing code
base. You might not use all of these techniques exactly as I present
them (for that matter, you might not use any of these
techniques exactly as I present them!), but I hope that you'll find
them to be useful examples.
Log and ignore unknown method calls:
Sometimes you may wish to log a set of otherwise-fatal error
messages and let your program keep executing. For example, when
developing CGI applications, it's often difficult to debug a program
that doesn't exit normally.
# Catch all invalid method calls
# for all classes and objects:
sub UNIVERSAL::AUTOLOAD
{
my ($self, @args) = @_;
my ($class) = ref $self || $self;
print STDERR
"Unknown method call $class->$AUTOLOAD(@args)\n";
return;
}
Profile module usage:POSIX and Data::Dumper), and will
print a usage profile at the end listing all the functions you called
from said modules.
# Set this to a list of whatever modules
# you want to auto-use and profile:
@AUTOPACKAGES = qw(POSIX Data::Dumper);
sub AUTOLOAD
{
my @c = caller(0);
$AUTOLOAD =~ s/.*:://;
foreach (@AUTOPACKAGES) {
eval "require $_" or
die "Could not load package `$_': $@";
my $function = $_ . "::" . $AUTOLOAD;
if (defined &$function) {
$AUTOFUNCTIONS{$function}++;
no strict 'refs';
return $function->(@_);
}
}
# Reproduce Perl's standard
# `undefined subroutine' message:
die "Undefined subroutine $AUTOLOAD called at " .
"$c[1] line $c[2]\n";
}
# Print usage profile when program completes:
END
{
my $format = "%-25s %6s\n";
print "\n";
printf $format, "Function", "Called";
foreach (sort keys %AUTOFUNCTIONS) {
printf $format, $_, $AUTOFUNCTIONS{$_};
}
}
Custom inheritance:
sub AUTOLOAD
{
my ($self, @args) = @_;
my @c = caller(0);
$AUTOLOAD =~ s/.*:://;
die("Can't locate object method \"$AUTOLOAD\" .
"via package \"$self\" at $c[1] line $c[2]\n")
unless ref $self;
my $super_method = "SUPER::$AUTOLOAD";
return $self->$super_method(@args);
}
Map subroutines to an internal data structure:AUTOLOAD is to map a data structure in
your program to a set of functions. This example could be used in a
class that's fully-documented but only partially-implemented:
my %Methods = (
new => "This class is completely useless!",
do_this => "This method is not yet implemented.",
do_that => "Please call __do_that() (see in-line comments).",
do_more => "This method is not yet implemented.",
);
sub AUTOLOAD
{
my ($self, @args) = @_;
$AUTOLOAD =~ s/.*:://;
if (exists $Methods{$AUTOLOAD}) {
print STDERR "$AUTOLOAD: $Methods{$AUTOLOAD}\n";
return undef;
}
# Try and call an inherited method
#(this will die if there is no inherited method):
my $super_method = "SUPER::$AUTOLOAD";
$self->$super_method(@args);
}
Note that, when using this technique, you can define all of your
methods in %Method at the beginning of your development
project, and as you write the code for each method, it will
automatically be called instead of AUTOLOAD (without your
having to edit %Methods).AUTOLOAD is to map a data structure
outside your program (such as a directory in the filesystem) to
a set of functions. This example creates a function named after each
user account on your system.
sub AUTOLOAD
{
my $entry = shift @_;
$AUTOLOAD =~ s/.*:://;
my @pwent = getpwnam($AUTOLOAD);
die "No such user `$AUTOLOAD'" unless @pwent;
if ($entry eq 'name') { return $pwent[0] }
elsif ($entry eq 'passwd') { return $pwent[1] }
elsif ($entry eq 'uid') { return $pwent[2] }
elsif ($entry eq 'gid') { return $pwent[3] }
elsif ($entry eq 'gecos') { return $pwent[4] }
elsif ($entry eq 'dir') { return $pwent[5] }
elsif ($entry eq 'shell') { return $pwent[6] }
else { die "Unknown field `$entry'" }
}
Notice that I use die() for failure here. If a
dynamic system like this fails, it's often a good idea to make as much
noise as possible; simply returning undef would be prone
to sneaky errors.Shell.pm module (part of the standard Perl
distribution).
sub AUTOLOAD
{
$AUTOLOAD =~ s/.*:://;
die "Unknown function `$AUTOLOAD'"
unless $AUTOLOAD =~ s/^c([ad]+)r$/$1/;
while (length $AUTOLOAD) {
if ($AUTOLOAD =~ s/a$//) {
if (ref $_[0] eq 'ARRAY') { @_ = @{$_[0]} }
else { @_ = $_[0] }
} elsif ($AUTOLOAD =~ s/d$//) {
shift @_;
} else {
die "Can't happen: AUTOLOAD is $AUTOLOAD";
}
}
if (wantarray) { return @_ }
elsif ($#_ < 1) { return $_[0] }
else { return [ @_ ] }
}