package SelfLoader; use Carp; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(AUTOLOAD); $VERSION = "1.08"; sub Version {$VERSION} $DEBUG = 0; my %Cache; # private cache for all SelfLoader's client packages AUTOLOAD { print STDERR "SelfLoader::AUTOLOAD for $AUTOLOAD\n" if $DEBUG; my $SL_code = $Cache{$AUTOLOAD}; unless ($SL_code) { # Maybe this pack had stubs before __DATA__, and never initialized. # Or, this maybe an automatic DESTROY method call when none exists. $AUTOLOAD =~ m/^(.*)::/; SelfLoader->_load_stubs($1) unless exists $Cache{"${1}::_load_stubs((caller)[0]) } sub _load_stubs { my($self, $callpack) = @_; my $fh = \*{"${callpack}::DATA"}; my $currpack = $callpack; my($line,$name,@lines, @stubs, $protoype); print STDERR "SelfLoader::load_stubs($callpack)\n" if $DEBUG; croak("$callpack doesn't contain an __DATA__ token") unless fileno($fh); $Cache{"${currpack}::) and $line !~ m/^__END__/) { if ($line =~ m/^sub\s+([\w:]+)\s*(\([\\\$\@\%\&\*\;]*\))?/) { push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype)); $protoype = $2; @lines = ($line); if (index($1,'::') == -1) { # simple sub name $name = "${currpack}::$1"; } else { # sub name with package $name = $1; $name =~ m/^(.*)::/; if (defined(&{"${1}::AUTOLOAD"})) { \&{"${1}::AUTOLOAD"} == \&SelfLoader::AUTOLOAD || die 'SelfLoader Error: attempt to specify Selfloading', " sub $name in non-selfloading module $1"; } else { $self->export($1,'AUTOLOAD'); } } } elsif ($line =~ m/^package\s+([\w:]+)/) { # A package declared push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype)); $self->_package_defined($line); $name = ''; @lines = (); $currpack = $1; $Cache{"${currpack}::export($currpack,'AUTOLOAD'); } } else { push(@lines,$line); } } close($fh) unless defined($line) && $line =~ /^__END__\s*DATA/; # __END__ push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype)); eval join('', @stubs) if @stubs; } sub _add_to_cache { my($self,$fullname,$pack,$lines, $protoype) = @_; return () unless $fullname; carp("Redefining sub $fullname") if exists $Cache{$fullname}; $Cache{$fullname} = join('', "package $pack; ",@$lines); print STDERR "SelfLoader cached $fullname: $Cache{$fullname}" if $DEBUG; # return stub to be eval'd defined($protoype) ? "sub $fullname $protoype;" : "sub $fullname;" } sub _package_defined {} 1;