X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSelfLoader.pm;h=294b6bc6b076394a3135a217af4690429bc79df4;hb=6a93515622cf0655623a39a9eaff82a4b9b3268b;hp=8d80b575a121261f8e4aa9d8eba50362f52a6e79;hpb=40da2db335c65d50d3bca886fcc7161ed72faf74;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/SelfLoader.pm b/lib/SelfLoader.pm
index 8d80b57..294b6bc 100644
--- a/lib/SelfLoader.pm
+++ b/lib/SelfLoader.pm
@@ -1,31 +1,48 @@
 package SelfLoader;
-use Carp;
 require Exporter;
 @ISA = qw(Exporter);
 @EXPORT = qw(AUTOLOAD);
-$VERSION = 1.06; sub Version {$VERSION}
+$VERSION = "1.0905";
+sub Version {$VERSION}
 $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;
+
+# 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;
-    my $code = $Cache{$AUTOLOAD};
-    unless ($code) {
+    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.
         $AUTOLOAD =~ m/^(.*)::/;
         SelfLoader->_load_stubs($1) unless exists $Cache{"${1}::<DATA"};
-        $code = $Cache{$AUTOLOAD};
-        $code = "sub $AUTOLOAD { }" if (!$code and $AUTOLOAD =~ m/::DESTROY$/);
-        croak "Undefined subroutine $AUTOLOAD" unless $code;
+        $SL_code = $Cache{$AUTOLOAD};
+        $SL_code = "sub $AUTOLOAD { }"
+            if (!$SL_code and $AUTOLOAD =~ m/::DESTROY$/);
+        croak "Undefined subroutine $AUTOLOAD" unless $SL_code;
     }
-    print STDERR "SelfLoader::AUTOLOAD eval: $code\n" if $DEBUG;
-    eval $code;
+    print STDERR "SelfLoader::AUTOLOAD eval: $SL_code\n" if $DEBUG;
+
+    eval $SL_code;
     if ($@) {
         $@ =~ s/ at .*\n//;
         croak $@;
     }
+    $@ = $save;
     defined(&$AUTOLOAD) || die "SelfLoader inconsistency error";
     delete $Cache{$AUTOLOAD};
     goto &$AUTOLOAD
@@ -34,7 +51,8 @@ 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) = @_;
     my $fh = \*{"${callpack}::DATA"};
     my $currpack = $callpack;
     my($line,$name,@lines, @stubs, $protoype);
@@ -44,8 +62,9 @@ sub _load_stubs {
         unless fileno($fh);
     $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*(\([\$\@\;\%\\]*\))?/) {       # A sub declared
+	if ($line =~ m/^sub\s+([\w:]+)\s*((?:\([\\\$\@\%\&\*\;]*\))?(?:$attr_list)?)/) {
             push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
             $protoype = $2;
             @lines = ($line);
@@ -80,7 +99,16 @@ 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));
     eval join('', @stubs) if @stubs;
 }
@@ -89,7 +117,8 @@ sub _load_stubs {
 sub _add_to_cache {
     my($self,$fullname,$pack,$lines, $protoype) = @_;
     return () unless $fullname;
-    carp("Redefining sub $fullname") if exists $Cache{$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
@@ -109,9 +138,9 @@ SelfLoader - load functions only on demand
 
     package FOOBAR;
     use SelfLoader;
-    
+
     ... (initializing code)
-    
+
     __DATA__
     sub {....
 
@@ -130,7 +159,7 @@ is available for reading via the filehandle FOOBAR::DATA,
 where FOOBAR is the name of the current package when the C<__DATA__>
 token is reached. This works just the same as C<__END__> does in
 package 'main', but for other modules data after C<__END__> is not
-automatically retreivable , whereas data after C<__DATA__> is.
+automatically retrievable, whereas data after C<__DATA__> is.
 The C<__DATA__> token is not recognized in versions of perl prior to
 5.001m.
 
@@ -200,7 +229,7 @@ There is no need to inherit from the B<SelfLoader>.
 
 The B<SelfLoader> works similarly to the AutoLoader, but picks up the
 subs from after the C<__DATA__> instead of in the 'lib/auto' directory.
-There is a maintainance gain in not needing to run AutoSplit on the module
+There is a maintenance gain in not needing to run AutoSplit on the module
 at installation, and a runtime gain in not needing to keep opening and
 closing files to load subs. There is a runtime loss in needing
 to parse the code after the C<__DATA__>. Details of the B<AutoLoader> and