package SelfLoader;
-# use Carp;
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT = qw(AUTOLOAD);
-$VERSION = "1.08";
+
+use 5.009005; # due to new regexp features
+use strict;
+
+use Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(AUTOLOAD);
+our $VERSION = "1.11";
sub Version {$VERSION}
-$DEBUG = 0;
+sub DEBUG () { 0 }
my %Cache; # private cache for all SelfLoader's client packages
-sub croak { require Carp; goto &Carp::croak }
+# allow checking for valid ': attrlist' attachments
+# see also AutoSplit
+
+my $attr_list = qr{
+ \s* : \s*
+ (?:
+ # one attribute
+ (?> # no backtrack
+ (?! \d) \w+
+ (?<nested> \( (?: [^()]++ | (?&nested)++ )*+ \) ) ?
+ )
+ (?: \s* : \s* | \s+ (?! :) )
+ )*
+}x;
+
+# in croak and carp, protect $@ from "require Carp;" RT #40216
+
+sub croak { { local $@; require Carp; } goto &Carp::croak }
+sub carp { { local $@; require Carp; } goto &Carp::carp }
AUTOLOAD {
- print STDERR "SelfLoader::AUTOLOAD for $AUTOLOAD\n" if $DEBUG;
+ our $AUTOLOAD;
+ print STDERR "SelfLoader::AUTOLOAD for $AUTOLOAD\n" if DEBUG;
my $SL_code = $Cache{$AUTOLOAD};
+ my $save = $@; # evals in both AUTOLOAD and _load_stubs can corrupt $@
unless ($SL_code) {
# Maybe this pack had stubs before __DATA__, and never initialized.
# Or, this maybe an automatic DESTROY method call when none exists.
if (!$SL_code and $AUTOLOAD =~ m/::DESTROY$/);
croak "Undefined subroutine $AUTOLOAD" unless $SL_code;
}
- print STDERR "SelfLoader::AUTOLOAD eval: $SL_code\n" if $DEBUG;
- eval $SL_code;
+ print STDERR "SelfLoader::AUTOLOAD eval: $SL_code\n" if DEBUG;
+
+ {
+ no strict;
+ eval $SL_code;
+ }
if ($@) {
$@ =~ s/ at .*\n//;
croak $@;
}
+ $@ = $save;
defined(&$AUTOLOAD) || die "SelfLoader inconsistency error";
delete $Cache{$AUTOLOAD};
goto &$AUTOLOAD
sub load_stubs { shift->_load_stubs((caller)[0]) }
sub _load_stubs {
- my($self, $callpack) = @_;
+ # $endlines is used by Devel::SelfStubber to capture lines after __END__
+ my($self, $callpack, $endlines) = @_;
+ no strict "refs";
my $fh = \*{"${callpack}::DATA"};
+ use strict;
my $currpack = $callpack;
my($line,$name,@lines, @stubs, $protoype);
- print STDERR "SelfLoader::load_stubs($callpack)\n" if $DEBUG;
+ print STDERR "SelfLoader::load_stubs($callpack)\n" if DEBUG;
croak("$callpack doesn't contain an __DATA__ token")
- unless fileno($fh);
+ unless defined fileno($fh);
+ # Protect: fork() shares the file pointer between the parent and the kid
+ if(sysseek($fh, tell($fh), 0)) {
+ open my $nfh, '<&', $fh or croak "reopen: $!";# dup() the fd
+ close $fh or die "close: $1"; # autocloses, but be paranoid
+ open $fh, '<&', $nfh or croak "reopen2: $!"; # dup() the fd "back"
+ close $nfh or die "close after reopen: $1"; # autocloses, but be paranoid
+ }
$Cache{"${currpack}::<DATA"} = 1; # indicate package is cached
local($/) = "\n";
while(defined($line = <$fh>) and $line !~ m/^__END__/) {
- if ($line =~ m/^sub\s+([\w:]+)\s*(\([\\\$\@\%\&\*\;]*\))?/) {
+ if ($line =~ m/^sub\s+([\w:]+)\s*((?:\([\\\$\@\%\&\*\;]*\))?(?:$attr_list)?)/) {
push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
$protoype = $2;
@lines = ($line);
push(@lines,$line);
}
}
- close($fh) unless defined($line) && $line =~ /^__END__\s*DATA/; # __END__
+ if (defined($line) && $line =~ /^__END__/) { # __END__
+ unless ($line =~ /^__END__\s*DATA/) {
+ if ($endlines) {
+ # Devel::SelfStubber would like us to capture the lines after
+ # __END__ so it can write out the entire file
+ @$endlines = <$fh>;
+ }
+ close($fh);
+ }
+ }
push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
+ no strict;
eval join('', @stubs) if @stubs;
}
sub _add_to_cache {
my($self,$fullname,$pack,$lines, $protoype) = @_;
return () unless $fullname;
- (require Carp), Carp::carp("Redefining sub $fullname")
+ carp("Redefining sub $fullname")
if exists $Cache{$fullname};
$Cache{$fullname} = join('', "package $pack; ",@$lines);
- print STDERR "SelfLoader cached $fullname: $Cache{$fullname}" if $DEBUG;
+ print STDERR "SelfLoader cached $fullname: $Cache{$fullname}" if DEBUG;
# return stub to be eval'd
defined($protoype) ? "sub $fullname $protoype;" : "sub $fullname;"
}
package FOOBAR;
use SelfLoader;
-
+
... (initializing code)
-
+
__DATA__
sub {....