LinuxMonth - An Online monthly Linux magazine. Linux articles for Linux Enthusiasts.

This page printed from: https://www.linuxmonth.com/issue2/articles/perl/perl.html?print=1

Using Perl
by: Kurt Starsinic

Uses of Autoload

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:
What if you have a large Perl program that `uses' several modules, and you'd like to find out which functions you're actually calling from those modules, and how frequently? The following code will replace the `use' statements for the modules in question (in this example, 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:
Suppose you have a class that shouldn't obey Perl's standard inheritance rules. For example, let's suppose you have a class that should inherit class methods, but not instance methods.

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:
One use for 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).

Map subroutines to an external data structure:
Another use for 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.

Another example of this technique can be seen in the Shell.pm module (part of the standard Perl distribution).

Define subroutines in a huge namespace:
LISP hackers may be familiar with this technique. In LISP, there are two common list operators called `car' and `cdr'; `car' returns the first element of a list, and `cdr' returns all the rest of a list. Many LISP implementations define compound functions such as `cadr', which is equivalent to `car of cdr'.

Translating this to Perl will be, at best, an approximation of the original; in LISP, a list can be an element of a list, while in Perl, only a reference to a list can be an element of a list. This function attempts to `do the right thing' in mapping the LISP concept to Perl; you may wish to modify it to fit your view of `the right thing.'.

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 [ @_ ] }
}