[Israel.pm] bless and AUTOLOAD

Mikhael Goikhman migo at homemail.com
Wed Sep 26 15:09:48 PDT 2007


On 26 Sep 2007 12:00:33 +0200, Yuval Kogman wrote:
> 
> Personally I feel the only valid use for AUTOLOAD is when an object
> is masquerading as any number of other objects, for example a proxy
> object that relays methods over a network, or a wrapper that can
> handle all the methods of the object it wraps (and that object can
> be different every time).

This is mostly true. Dispatched delegation is the main use for AUTOLOAD,
but certainly not the only one. One of the other valid uses is supporting
alternative naming conventions, i.e. method names that differ from the
canonical names in capitalization or underscores (or other funny chars if
we speak about Perl 6). Another use is to implement lazy auto-creation of
missing methods. And of course AUTOLOAD is needed for conditional
dispatching and run-time delegation impossible at compile time.

Here is the longest AUTOLOAD I ever needed to write, that implements
non-trivial dispatching. This is only a small part of the larger code,
but the identificators and comments should be readable enough to
understand what happens in this real example.

In short, it allows such convenient shortcuts on the object:

    $component->something(@params)
        is dispatched if possible to
            $component->get_property("something")->access(@params)

    $component->something_extra(@params)
        is dispatched if possible to
            $component->get_property("something")->access_extra(@params)

    $component->something_property
        is just a shorter way to say
            $component->get_property("something")

    $component->something_else  like ->get_constant("name")
        is delegated if possible to another master object
            $component->get_root->something_else(@params)

    if all fails, exception "Unknown property or method" is thrown

Missing methods are auto-created on the fly to speed-up further calls.


package Podius::Component;

use strict;
use warnings;

use vars '$AUTOLOAD';

sub AUTOLOAD { 
    my $self = shift;
    my @params = @_;

    my $autoload_method = $AUTOLOAD;
    my $method = $autoload_method;

    # remove the package name
    $method =~ s/.*://g;

    # ignore DESTROY messages
    return if $method eq 'DESTROY';

    # pass "isa" further to UNIVERSAL; needed for reasons not explained here
    return $self->SUPER::isa(@params) if $method eq 'isa';

    # disallow calling from the class name
    throw("Calling method $method for non-component '$self'")
        unless ref($self);

    # catch accessor/modifier for properties
    my $property = $self->get_property($method);
    if (defined $property) {
        no strict 'refs';
        *{$autoload_method} = sub {
            shift()->get_property($method)->access(@_)
        } unless $self->can($autoload_method);  # unless already defined
        return $property->access(@params);
    }

    # catch shortcut for get_property
    if ($method =~ /^(.*)(?:_property|_collection)$/) {
        my $property_name = $1;
        $property = $self->get_property($property_name);
        if (defined $property) {
            no strict 'refs';
            *{$autoload_method} = sub {
                shift()->get_property($property_name)
            };
            return $property;
        }
    }

    # catch <property_name>_<extra> case
    my $postfix;
    foreach my $property_name (reverse @{$self->get_property_names}) {
        if ($method =~ /^$property_name(_.+)$/) {
            $property = $self->get_property($property_name);
            $postfix = $1; last;
        }
    }
    if (defined($property)) {
        my $property_name = $property->{name}; 
        my $property_method = "access$postfix";
        throw("No property or method '$property_name$postfix' in " . ref($self)
            . ", guessed property '$property_name', but " . ref($property)
            . " has no method '$property_method'")  
            unless $property->can($property_method);
        no strict 'refs';
        *{$autoload_method} = sub {
            shift()->get_property($property_name)->$property_method(@_)
        };
        return $property->$property_method(@params);
    }

    # finally try to delegate this method to root (if exists)
    my $root = $self->get_root;
    if (defined $root && $root != $self) {
        my $result;
        eval { $result = $root->$method(@params); 1; } && return $result;
    }

    # no luck today
    throw "Unknown component property or method '$method' in " . ref($self);
}


Regards,
Mikhael.

-- 
perl -e 'print+chr(64+hex)for+split//,d9b815c07f9b8d1e'



More information about the Perl mailing list