X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSelfLoader.pm;h=1136cf09097a1d023e16374be49e14545a4044b1;hb=dfa4e5d386dd8c5329351699b02085856cdd140e;hp=c4e9175a79fa6d836fae43f6b17c72005f0df371;hpb=e3d0cac0c3bf9ec77cb3e2fc362639f009d309e4;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/SelfLoader.pm b/lib/SelfLoader.pm
index c4e9175..1136cf0 100644
--- a/lib/SelfLoader.pm
+++ b/lib/SelfLoader.pm
@@ -1,19 +1,42 @@
 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.
@@ -24,12 +47,17 @@ AUTOLOAD {
             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
@@ -38,19 +66,29 @@ 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);
@@ -85,8 +123,18 @@ sub _load_stubs {
             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;
 }
 
@@ -94,10 +142,10 @@ sub _load_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;"
 }
@@ -115,9 +163,9 @@ SelfLoader - load functions only on demand
 
     package FOOBAR;
     use SelfLoader;
-    
+
     ... (initializing code)
-    
+
     __DATA__
     sub {....