package SelfLoader;
-use Carp;
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT = qw(AUTOLOAD);
-$VERSION = 1.06; sub Version {$VERSION}
-$DEBUG = 0;
+
+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}
+sub DEBUG () { 0 }
my %Cache; # private cache for all SelfLoader's client packages
+# 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;
- my $code = $Cache{$AUTOLOAD};
- unless ($code) {
+ 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.
$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: $SL_code\n" if DEBUG;
+
+ {
+ no strict;
+ eval $SL_code;
}
- print STDERR "SelfLoader::AUTOLOAD eval: $code\n" if $DEBUG;
- eval $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
- while($line = <$fh> and $line !~ m/^__END__/) {
- if ($line =~ m/^sub\s+([\w:]+)\s*(\([\$\@\;\%\\]*\))?/) { # A sub declared
+ local($/) = "\n";
+ while(defined($line = <$fh>) and $line !~ m/^__END__/) {
+ 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;
- 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;
+ 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 {....
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.
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
the C<__DATA__> token and put your own data after those
declarations, using the C<__END__> token to mark the end
of subroutine declarations. You must also ensure that the B<SelfLoader>
-reads first by calling 'SelfLoader->load_stubs();', or by using a
+reads first by calling 'SelfLoader-E<gt>load_stubs();', or by using a
function which is selfloaded;
or
For modules which ARE classes, and need to handle inherited methods,
stubs are needed to ensure that the method inheritance mechanism works
properly. You can load the stubs into the module at 'require' time, by
-adding the statement 'SelfLoader->load_stubs();' to the module to do
+adding the statement 'SelfLoader-E<gt>load_stubs();' to the module to do
this.
The alternative is to put the stubs in before the C<__DATA__> token BEFORE
projects / p5sagit/p5-mst-13.2.git / blobdiff