I had the same issue as well. I wrote a class (attached) to encapsulate
references to routines via the name so that I could lazy-load them (this
is useful for template systems to avoid loading every possible tag
implementation every time). The logic tries to load the package for the
symbol if not present and assumes that all names are qualified (in the
real code, that is verified at a higher level). After the first
invocation, the code pointer is cached and used on subsequent invocations.
# -----------------------------------------------------------------------------
package Transfinitum::WikiVar::CodeRef;
# This is a specialized class just for handling references to subroutines.
# Bad things happen with AUTOLOAD if we try to capture a CODE reference before
# the symbol is defined. As a result, we need to pass in an object that has
# the name and can cache a CODE pointer so that we can lazy eval the CODE
# reference and potentially pull in the supporting package to avoid AUTOLOAD
# entirely.
# Two members, the fully qualified name and the CODE reference
use constant NAME_IDX => 0;
use constant CODE_IDX => 1;
# First argument is fully qualified name.
# Optional second is a CODE pointer. This is useful for closures
sub new {
bless [ $_[1], $_[2]], $_[0];
}
sub getName { return $_[0]->[NAME_IDX]; }
# Get a CODE pointer from the CodeRef.
# Returns a CODE object if it found the subroutine, or a string with
# an error condition if not.
sub getCode {
my ($self) = @_;
my $status;
if (not $self->[CODE_IDX]) { # no cached pointer
no strict 'refs';
# see if it's there already
my $name = $self->[NAME_IDX];
$self->[CODE_IDX] = *{$name}{CODE};
if (not $self->[CODE_IDX]) {
# not there, try to bring in the package
$self->[NAME_IDX] =~ m!(.*)::(?:[^:]+)$!o;
my $p = $1; # package name
eval "require $p;";
if ($@) {
$status = 'Defun Error: Failed to load package "' . $p
. '" for subroutine "' . $name
. '" because "' . $@ . '"';
} else {
$self->[CODE_IDX] = *{$name}{CODE};
if (not $self->[CODE_IDX]) {
$status = 'Defun Error: Undefined subroutine "'.$name.'"';
}
}
}
}
return $status ? $status : $self->[CODE_IDX];
}
_______________________________________________
ActivePerl mailing list
[email protected]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
