package SelfLoader;
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT = qw(AUTOLOAD);
-$VERSION = "1.10";
+
+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
# allow checking for valid ': attrlist' attachments
-# (we use 'our' rather than 'my' here, due to the rather complex and buggy
-# behaviour of lexicals with qr// and (??{$lex}) )
-our $nested;
-$nested = qr{ \( (?: (?> [^()]+ ) | (??{ $nested }) )* \) }x;
-our $one_attr = qr{ (?> (?! \d) \w+ (?:$nested)? ) (?:\s*\:\s*|\s+(?!\:)) }x;
-our $attr_list = qr{ \s* : \s* (?: $one_attr )* }x;
+# 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 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) {
if (!$SL_code and $AUTOLOAD =~ m/::DESTROY$/);
croak "Undefined subroutine $AUTOLOAD" unless $SL_code;
}
- print STDERR "SelfLoader::AUTOLOAD eval: $SL_code\n" if $DEBUG;
+ print STDERR "SelfLoader::AUTOLOAD eval: $SL_code\n" if DEBUG;
eval $SL_code;
if ($@) {
sub _load_stubs {
# $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 defined fileno($fh);
# Protect: fork() shares the file pointer between the parent and the kid
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;"
}