package SelfLoader;
-use Carp;
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT = qw(AUTOLOAD);
-$VERSION = 1.06; sub Version {$VERSION}
-$DEBUG = 0;
+use 5.008;
+use strict;
+our $VERSION = "1.16";
+
+# The following bit of eval-magic is necessary to make this work on
+# perls < 5.009005.
+use vars qw/$AttrList/;
+BEGIN {
+ if ($] > 5.009004) {
+ eval <<'NEWERPERL';
+use 5.009005; # due to new regexp features
+# allow checking for valid ': attrlist' attachments
+# see also AutoSplit
+$AttrList = qr{
+ \s* : \s*
+ (?:
+ # one attribute
+ (?> # no backtrack
+ (?! \d) \w+
+ (?<nested> \( (?: [^()]++ | (?&nested)++ )*+ \) ) ?
+ )
+ (?: \s* : \s* | \s+ (?! :) )
+ )*
+}x;
+
+NEWERPERL
+ }
+ else {
+ eval <<'OLDERPERL';
+# 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;
+$AttrList = qr{ \s* : \s* (?: $one_attr )* }x;
+OLDERPERL
+ }
+}
+use Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(AUTOLOAD);
+sub Version {$VERSION}
+sub DEBUG () { 0 }
my %Cache; # private cache for all SelfLoader's client packages
+# 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/^\s*sub\s+([\w:]+)\s*((?:\([\\\$\@\%\&\*\;]*\))?(?:$AttrList)?)/) {
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};
- $Cache{$fullname} = join('', "package $pack; ",@$lines);
- print STDERR "SelfLoader cached $fullname: $Cache{$fullname}" if $DEBUG;
+ carp("Redefining sub $fullname")
+ if exists $Cache{$fullname};
+ $Cache{$fullname} = join('', "\n\#line 1 \"sub $fullname\"\npackage $pack; ", @$lines);
+ #$Cache{$fullname} = join('', "package $pack; ",@$lines);
+ 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
B<SelfLoader> C<AUTOLOAD> method when the data after C<__DATA__> is first
parsed.
+=head1 AUTHOR
+
+C<SelfLoader> is maintained by the perl5-porters. Please direct
+any questions to the canonical mailing list. Anything that
+is applicable to the CPAN release can be sent to its maintainer,
+though.
+
+Author and Maintainer: The Perl5-Porters <perl5-porters@perl.org>
+
+Maintainer of the CPAN release: Steffen Mueller <smueller@cpan.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This package has been part of the perl core since the first release
+of perl5. It has been released separately to CPAN so older installations
+can benefit from bug fixes.
+
+This package has the same copyright and license as the perl core:
+
+ Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ 2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others
+
+ All rights reserved.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of either:
+
+ a) the GNU General Public License as published by the Free
+ Software Foundation; either version 1, or (at your option) any
+ later version, or
+
+ b) the "Artistic License" which comes with this Kit.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
+ the GNU General Public License or the Artistic License for more details.
+
+ You should have received a copy of the Artistic License with this
+ Kit, in the file named "Artistic". If not, I'll be glad to provide one.
+
+ You should also have received a copy of the GNU General Public License
+ along with this program in the file named "Copying". If not, write to the
+ Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+ 02111-1307, USA or visit their web page on the internet at
+ http://www.gnu.org/copyleft/gpl.html.
+
+ For those of you that choose to use the GNU General Public License,
+ my interpretation of the GNU General Public License is that no Perl
+ script falls under the terms of the GPL unless you explicitly put
+ said script under the terms of the GPL yourself. Furthermore, any
+ object code linked with perl does not automatically fall under the
+ terms of the GPL, provided such object code only adds definitions
+ of subroutines and variables, and does not otherwise impair the
+ resulting interpreter from executing any standard Perl script. I
+ consider linking in C subroutines in this manner to be the moral
+ equivalent of defining subroutines in the Perl language itself. You
+ may sell such an object file as proprietary provided that you provide
+ or offer to provide the Perl source, as specified by the GNU General
+ Public License. (This is merely an alternate way of specifying input
+ to the program.) You may also sell a binary produced by the dumping of
+ a running Perl script that belongs to you, provided that you provide or
+ offer to provide the Perl source as specified by the GPL. (The
+ fact that a Perl interpreter and your code are in the same binary file
+ is, in this case, a form of mere aggregation.) This is my interpretation
+ of the GPL. If you still have concerns or difficulties understanding
+ my intent, feel free to contact me. Of course, the Artistic License
+ spells all this out for your protection, so you may prefer to use that.
+
=cut
projects / p5sagit/p5-mst-13.2.git / blobdiff