From 2d99478739a24349cd74c9af7ec0da283ad4d42e Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Mon, 28 Sep 2009 16:30:53 +0100 Subject: Move SelfLoader from ext/ to dist/ --- MANIFEST | 6 +- Porting/Maintainers.pl | 2 +- dist/SelfLoader/lib/SelfLoader.pm | 435 +++++++++++++++++++++++++++++++++ dist/SelfLoader/t/01SelfLoader.t | 217 ++++++++++++++++ dist/SelfLoader/t/02SelfLoader-buggy.t | 46 ++++ ext/SelfLoader/lib/SelfLoader.pm | 435 --------------------------------- ext/SelfLoader/t/01SelfLoader.t | 217 ---------------- ext/SelfLoader/t/02SelfLoader-buggy.t | 46 ---- 8 files changed, 702 insertions(+), 702 deletions(-) create mode 100644 dist/SelfLoader/lib/SelfLoader.pm create mode 100644 dist/SelfLoader/t/01SelfLoader.t create mode 100644 dist/SelfLoader/t/02SelfLoader-buggy.t delete mode 100644 ext/SelfLoader/lib/SelfLoader.pm delete mode 100644 ext/SelfLoader/t/01SelfLoader.t delete mode 100644 ext/SelfLoader/t/02SelfLoader-buggy.t diff --git a/MANIFEST b/MANIFEST index 6cea1bde6e..135fcbd41b 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1160,6 +1160,9 @@ dist/Safe/t/safe3.t See if Safe works dist/Safe/t/safeload.t Tests that some modules can be loaded by Safe dist/Safe/t/safeops.t Tests that all ops can be trapped by Safe dist/Safe/t/safeuniversal.t Tests Safe with functions from universal.c +dist/SelfLoader/lib/SelfLoader.pm Load functions only on demand +dist/SelfLoader/t/01SelfLoader.t See if SelfLoader works +dist/SelfLoader/t/02SelfLoader-buggy.t See if SelfLoader works djgpp/config.over DOS/DJGPP port djgpp/configure.bat DOS/DJGPP port djgpp/djgpp.c DOS/DJGPP port @@ -2548,9 +2551,6 @@ ext/SDBM_File/sdbm/tune.h SDBM kit ext/SDBM_File/sdbm/util.c SDBM kit ext/SDBM_File/t/sdbm.t See if SDBM_File works ext/SDBM_File/typemap SDBM extension interface types -ext/SelfLoader/lib/SelfLoader.pm Load functions only on demand -ext/SelfLoader/t/01SelfLoader.t See if SelfLoader works -ext/SelfLoader/t/02SelfLoader-buggy.t See if SelfLoader works ext/Shell/Shell.pm Make AUTOLOADed system() calls ext/Shell/t/Shell.t Tests for above ext/Socket/Makefile.PL Socket extension makefile writer diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 738570df9f..802edfabca 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1330,7 +1330,7 @@ use File::Glob qw(:case); 'FILES' => q[ext/SelfLoader], 'EXCLUDED' => [ qw{ t/00pod.t } ], 'CPAN' => 1, - 'UPSTREAM' => "blead", + 'UPSTREAM' => 'blead', }, 'Shell' => diff --git a/dist/SelfLoader/lib/SelfLoader.pm b/dist/SelfLoader/lib/SelfLoader.pm new file mode 100644 index 0000000000..047f7768e8 --- /dev/null +++ b/dist/SelfLoader/lib/SelfLoader.pm @@ -0,0 +1,435 @@ +package SelfLoader; +use 5.008; +use strict; +our $VERSION = "1.17"; + +# 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)++ )*+ \) ) ? + ) + (?: \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 { + 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}::_load_stubs((caller)[0]) } + +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; + croak("$callpack doesn't contain an __DATA__ token") + 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: $!"; # autocloses, but be paranoid + open $fh, '<&', $nfh or croak "reopen2: $!"; # dup() the fd "back" + close $nfh or die "close after reopen: $!"; # autocloses, but be paranoid + } + $Cache{"${currpack}::) 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); + if (index($1,'::') == -1) { # simple sub name + $name = "${currpack}::$1"; + } else { # sub name with package + $name = $1; + $name =~ m/^(.*)::/; + if (defined(&{"${1}::AUTOLOAD"})) { + \&{"${1}::AUTOLOAD"} == \&SelfLoader::AUTOLOAD || + die 'SelfLoader Error: attempt to specify Selfloading', + " sub $name in non-selfloading module $1"; + } else { + $self->export($1,'AUTOLOAD'); + } + } + } elsif ($line =~ m/^package\s+([\w:]+)/) { # A package declared + push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype)); + $self->_package_defined($line); + $name = ''; + @lines = (); + $currpack = $1; + $Cache{"${currpack}::export($currpack,'AUTOLOAD'); + } + } else { + push(@lines,$line); + } + } + 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('', "\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;" +} + +sub _package_defined {} + +1; +__END__ + +=head1 NAME + +SelfLoader - load functions only on demand + +=head1 SYNOPSIS + + package FOOBAR; + use SelfLoader; + + ... (initializing code) + + __DATA__ + sub {.... + + +=head1 DESCRIPTION + +This module tells its users that functions in the FOOBAR package are to be +autoloaded from after the C<__DATA__> token. See also +L. + +=head2 The __DATA__ token + +The C<__DATA__> token tells the perl compiler that the perl code +for compilation is finished. Everything after the C<__DATA__> token +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 retrievable, whereas data after C<__DATA__> is. +The C<__DATA__> token is not recognized in versions of perl prior to +5.001m. + +Note that it is possible to have C<__DATA__> tokens in the same package +in multiple files, and that the last C<__DATA__> token in a given +package that is encountered by the compiler is the one accessible +by the filehandle. This also applies to C<__END__> and main, i.e. if +the 'main' program has an C<__END__>, but a module 'require'd (_not_ 'use'd) +by that program has a 'package main;' declaration followed by an 'C<__DATA__>', +then the C filehandle is set to access the data after the C<__DATA__> +in the module, _not_ the data after the C<__END__> token in the 'main' +program, since the compiler encounters the 'require'd file later. + +=head2 SelfLoader autoloading + +The B works by the user placing the C<__DATA__> +token I perl code which needs to be compiled and +run at 'require' time, but I subroutine declarations +that can be loaded in later - usually because they may never +be called. + +The B will read from the FOOBAR::DATA filehandle to +load in the data after C<__DATA__>, and load in any subroutine +when it is called. The costs are the one-time parsing of the +data after C<__DATA__>, and a load delay for the _first_ +call of any autoloaded function. The benefits (hopefully) +are a speeded up compilation phase, with no need to load +functions which are never used. + +The B will stop reading from C<__DATA__> if +it encounters the C<__END__> token - just as you would expect. +If the C<__END__> token is present, and is followed by the +token DATA, then the B leaves the FOOBAR::DATA +filehandle open on the line after that token. + +The B exports the C subroutine to the +package using the B, and this loads the called +subroutine when it is first called. + +There is no advantage to putting subroutines which will _always_ +be called after the C<__DATA__> token. + +=head2 Autoloading and package lexicals + +A 'my $pack_lexical' statement makes the variable $pack_lexical +local _only_ to the file up to the C<__DATA__> token. Subroutines +declared elsewhere _cannot_ see these types of variables, +just as if you declared subroutines in the package but in another +file, they cannot see these variables. + +So specifically, autoloaded functions cannot see package +lexicals (this applies to both the B and the Autoloader). +The C pragma provides an alternative to defining package-level +globals that will be visible to autoloaded routines. See the documentation +on B in the pragma section of L. + +=head2 SelfLoader and AutoLoader + +The B can replace the AutoLoader - just change 'use AutoLoader' +to 'use SelfLoader' (though note that the B exports +the AUTOLOAD function - but if you have your own AUTOLOAD and +are using the AutoLoader too, you probably know what you're doing), +and the C<__END__> token to C<__DATA__>. You will need perl version 5.001m +or later to use this (version 5.001 with all patches up to patch m). + +There is no need to inherit from the B. + +The B 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 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 and +another view of these distinctions can be found in that module's +documentation. + +=head2 __DATA__, __END__, and the FOOBAR::DATA filehandle. + +This section is only relevant if you want to use +the C together with the B. + +Data after the C<__DATA__> token in a module is read using the +FOOBAR::DATA filehandle. C<__END__> can still be used to denote the end +of the C<__DATA__> section if followed by the token DATA - this is supported +by the B. The C filehandle is left open if an +C<__END__> followed by a DATA is found, with the filehandle positioned at +the start of the line after the C<__END__> token. If no C<__END__> token is +present, or an C<__END__> token with no DATA token on the same line, then +the filehandle is closed. + +The B reads from wherever the current +position of the C filehandle is, until the +EOF or C<__END__>. This means that if you want to use +that filehandle (and ONLY if you want to), you should either + +1. Put all your subroutine declarations immediately after +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 +reads first by calling 'SelfLoader-Eload_stubs();', or by using a +function which is selfloaded; + +or + +2. You should read the C filehandle first, leaving +the handle open and positioned at the first line of subroutine +declarations. + +You could conceivably do both. + +=head2 Classes and inherited methods. + +For modules which are not classes, this section is not relevant. +This section is only relevant if you have methods which could +be inherited. + +A subroutine stub (or forward declaration) looks like + + sub stub; + +i.e. it is a subroutine declaration without the body of the +subroutine. For modules which are not classes, there is no real +need for stubs as far as autoloading is concerned. + +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-Eload_stubs();' to the module to do +this. + +The alternative is to put the stubs in before the C<__DATA__> token BEFORE +releasing the module, and for this purpose the C +module is available. However this does require the extra step of ensuring +that the stubs are in the module. If this is done I strongly recommend +that this is done BEFORE releasing the module - it should NOT be done +at install time in general. + +=head1 Multiple packages and fully qualified subroutine names + +Subroutines in multiple packages within the same file are supported - but you +should note that this requires exporting the C to +every package which requires it. This is done automatically by the +B when it first loads the subs into the cache, but you should +really specify it in the initialization before the C<__DATA__> by putting +a 'use SelfLoader' statement in each package. + +Fully qualified subroutine names are also supported. For example, + + __DATA__ + sub foo::bar {23} + package baz; + sub dob {32} + +will all be loaded correctly by the B, and the B +will ensure that the packages 'foo' and 'baz' correctly have the +B C method when the data after C<__DATA__> is first +parsed. + +=head1 AUTHOR + +C 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 + +Maintainer of the CPAN release: Steffen Mueller + +=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 diff --git a/dist/SelfLoader/t/01SelfLoader.t b/dist/SelfLoader/t/01SelfLoader.t new file mode 100644 index 0000000000..68c12296d9 --- /dev/null +++ b/dist/SelfLoader/t/01SelfLoader.t @@ -0,0 +1,217 @@ +BEGIN { + chdir 't' if -d 't'; + $dir = "self-$$"; + $sep = "/"; + + if ($^O eq 'MacOS') { + $dir = ":" . $dir; + $sep = ":"; + } + + unshift @INC, $dir; + unshift @INC, '../lib'; + + print "1..20\n"; + + # First we must set up some selfloader files + mkdir $dir, 0755 or die "Can't mkdir $dir: $!"; + + open(FOO, ">$dir${sep}Foo.pm") or die; + print FOO <<'EOT'; +package Foo; +use SelfLoader; + +sub new { bless {}, shift } +sub foo; +sub bar; +sub bazmarkhianish; +sub a; +sub never; # declared but definition should never be read +1; +__DATA__ + +sub foo { shift; shift || "foo" }; + +sub bar { shift; shift || "bar" } + +sub bazmarkhianish { shift; shift || "baz" } + +package sheep; +sub bleat { shift; shift || "baa" } +__END__ +sub never { die "D'oh" } +EOT + + close(FOO); + + open(BAR, ">$dir${sep}Bar.pm") or die; + print BAR <<'EOT'; +package Bar; +use SelfLoader; + +@ISA = 'Baz'; + +sub new { bless {}, shift } +sub a; +sub with_whitespace_in_front; + +1; +__DATA__ + +sub a { 'a Bar'; } +sub b { 'b Bar' } + + sub with_whitespace_in_front { + "with_whitespace_in_front Bar" +} + +__END__ DATA +sub never { die "D'oh" } +EOT + + close(BAR); +}; + + +package Baz; + +sub a { 'a Baz' } +sub b { 'b Baz' } +sub c { 'c Baz' } + + +package main; +use Foo; +use Bar; + +$foo = new Foo; + +print "not " unless $foo->foo eq 'foo'; # selfloaded first time +print "ok 1\n"; + +print "not " unless $foo->foo eq 'foo'; # regular call +print "ok 2\n"; + +# Try an undefined method +eval { + $foo->will_fail; +}; +if ($@ =~ /^Undefined subroutine/) { + print "ok 3\n"; +} else { + print "not ok 3 $@\n"; +} + +# Used to be trouble with this +eval { + my $foo = new Foo; + die "oops"; +}; +if ($@ =~ /oops/) { + print "ok 4\n"; +} else { + print "not ok 4 $@\n"; +} + +# Pass regular expression variable to autoloaded function. This used +# to go wrong in AutoLoader because it used regular expressions to generate +# autoloaded filename. +"foo" =~ /(\w+)/; +print "not " unless $1 eq 'foo'; +print "ok 5\n"; + +print "not " unless $foo->bar($1) eq 'foo'; +print "ok 6\n"; + +print "not " unless $foo->bar($1) eq 'foo'; +print "ok 7\n"; + +print "not " unless $foo->bazmarkhianish($1) eq 'foo'; +print "ok 8\n"; + +print "not " unless $foo->bazmarkhianish($1) eq 'foo'; +print "ok 9\n"; + +# Check nested packages inside __DATA__ +print "not " unless sheep::bleat() eq 'baa'; +print "ok 10\n"; + +# Now check inheritance: + +$bar = new Bar; + +# Before anything is SelfLoaded there is no declaration of Foo::b so we should +# get Baz::b +print "not " unless $bar->b() eq 'b Baz'; +print "ok 11\n"; + +# There is no Bar::c so we should get Baz::c +print "not " unless $bar->c() eq 'c Baz'; +print "ok 12\n"; + +# check that subs with whitespace in front work +print "not " unless $bar->with_whitespace_in_front() eq 'with_whitespace_in_front Bar'; +print "ok 13\n"; + +# This selfloads Bar::a because it is stubbed. It also stubs Bar::b as a side +# effect +print "not " unless $bar->a() eq 'a Bar'; +print "ok 14\n"; + +print "not " unless $bar->b() eq 'b Bar'; +print "ok 15\n"; + +print "not " unless $bar->c() eq 'c Baz'; +print "ok 16\n"; + + + +# Check that __END__ is honoured +# Try an subroutine that should never be noticed by selfloader +eval { + $foo->never; +}; +if ($@ =~ /^Undefined subroutine/) { + print "ok 17\n"; +} else { + print "not ok 17 $@\n"; +} + +# Try to read from the data file handle +{ + local $SIG{__WARN__} = sub { my $warn = shift; }; + my $foodata = ; + close Foo::DATA; + if (defined $foodata) { + print "not ok 18 # $foodata\n"; + } else { + print "ok 18\n"; + } +} + +# Check that __END__ DATA is honoured +# Try an subroutine that should never be noticed by selfloader +eval { + $bar->never; +}; +if ($@ =~ /^Undefined subroutine/) { + print "ok 19\n"; +} else { + print "not ok 19 $@\n"; +} + +# Try to read from the data file handle +my $bardata = ; +close Bar::DATA; +if ($bardata ne "sub never { die \"D'oh\" }\n") { + print "not ok 20 # $bardata\n"; +} else { + print "ok 20\n"; +} + +# cleanup +END { +return unless $dir && -d $dir; +unlink "$dir${sep}Foo.pm", "$dir${sep}Bar.pm"; +rmdir "$dir"; +} diff --git a/dist/SelfLoader/t/02SelfLoader-buggy.t b/dist/SelfLoader/t/02SelfLoader-buggy.t new file mode 100644 index 0000000000..7845d05228 --- /dev/null +++ b/dist/SelfLoader/t/02SelfLoader-buggy.t @@ -0,0 +1,46 @@ +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't' if -d 't'; + @INC = '../lib'; + } +} + +use SelfLoader; +print "1..1\n"; + +# this script checks that errors on self-loaded +# subroutines that affect $@ are reported + +eval { buggy(); }; +unless ($@ =~ /^syntax error/) { + print "not "; +} +print "ok 1 - syntax errors are reported\n"; + +__END__ + +sub buggy +{ + +>*; +} + + +# RT 40216 +# +# by Bo Lindbergh , at Aug 22, 2006 5:42 PM +# +# In the example below, there's a syntax error in the selfloaded +# code for main::buggy. When the eval fails, SelfLoader::AUTOLOAD +# tries to report this with "croak $@;". Unfortunately, +# SelfLoader::croak does "require Carp;" without protecting $@, +# which gets clobbered. The program then dies with the +# uninformative message " at ./example line 3". +# +# #! /usr/local/bin/perl +# use SelfLoader; +# buggy(); +# __END__ +# sub buggy +# { +# +>*; +# } diff --git a/ext/SelfLoader/lib/SelfLoader.pm b/ext/SelfLoader/lib/SelfLoader.pm deleted file mode 100644 index 047f7768e8..0000000000 --- a/ext/SelfLoader/lib/SelfLoader.pm +++ /dev/null @@ -1,435 +0,0 @@ -package SelfLoader; -use 5.008; -use strict; -our $VERSION = "1.17"; - -# 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)++ )*+ \) ) ? - ) - (?: \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 { - 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}::_load_stubs((caller)[0]) } - -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; - croak("$callpack doesn't contain an __DATA__ token") - 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: $!"; # autocloses, but be paranoid - open $fh, '<&', $nfh or croak "reopen2: $!"; # dup() the fd "back" - close $nfh or die "close after reopen: $!"; # autocloses, but be paranoid - } - $Cache{"${currpack}::) 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); - if (index($1,'::') == -1) { # simple sub name - $name = "${currpack}::$1"; - } else { # sub name with package - $name = $1; - $name =~ m/^(.*)::/; - if (defined(&{"${1}::AUTOLOAD"})) { - \&{"${1}::AUTOLOAD"} == \&SelfLoader::AUTOLOAD || - die 'SelfLoader Error: attempt to specify Selfloading', - " sub $name in non-selfloading module $1"; - } else { - $self->export($1,'AUTOLOAD'); - } - } - } elsif ($line =~ m/^package\s+([\w:]+)/) { # A package declared - push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype)); - $self->_package_defined($line); - $name = ''; - @lines = (); - $currpack = $1; - $Cache{"${currpack}::export($currpack,'AUTOLOAD'); - } - } else { - push(@lines,$line); - } - } - 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('', "\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;" -} - -sub _package_defined {} - -1; -__END__ - -=head1 NAME - -SelfLoader - load functions only on demand - -=head1 SYNOPSIS - - package FOOBAR; - use SelfLoader; - - ... (initializing code) - - __DATA__ - sub {.... - - -=head1 DESCRIPTION - -This module tells its users that functions in the FOOBAR package are to be -autoloaded from after the C<__DATA__> token. See also -L. - -=head2 The __DATA__ token - -The C<__DATA__> token tells the perl compiler that the perl code -for compilation is finished. Everything after the C<__DATA__> token -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 retrievable, whereas data after C<__DATA__> is. -The C<__DATA__> token is not recognized in versions of perl prior to -5.001m. - -Note that it is possible to have C<__DATA__> tokens in the same package -in multiple files, and that the last C<__DATA__> token in a given -package that is encountered by the compiler is the one accessible -by the filehandle. This also applies to C<__END__> and main, i.e. if -the 'main' program has an C<__END__>, but a module 'require'd (_not_ 'use'd) -by that program has a 'package main;' declaration followed by an 'C<__DATA__>', -then the C filehandle is set to access the data after the C<__DATA__> -in the module, _not_ the data after the C<__END__> token in the 'main' -program, since the compiler encounters the 'require'd file later. - -=head2 SelfLoader autoloading - -The B works by the user placing the C<__DATA__> -token I perl code which needs to be compiled and -run at 'require' time, but I subroutine declarations -that can be loaded in later - usually because they may never -be called. - -The B will read from the FOOBAR::DATA filehandle to -load in the data after C<__DATA__>, and load in any subroutine -when it is called. The costs are the one-time parsing of the -data after C<__DATA__>, and a load delay for the _first_ -call of any autoloaded function. The benefits (hopefully) -are a speeded up compilation phase, with no need to load -functions which are never used. - -The B will stop reading from C<__DATA__> if -it encounters the C<__END__> token - just as you would expect. -If the C<__END__> token is present, and is followed by the -token DATA, then the B leaves the FOOBAR::DATA -filehandle open on the line after that token. - -The B exports the C subroutine to the -package using the B, and this loads the called -subroutine when it is first called. - -There is no advantage to putting subroutines which will _always_ -be called after the C<__DATA__> token. - -=head2 Autoloading and package lexicals - -A 'my $pack_lexical' statement makes the variable $pack_lexical -local _only_ to the file up to the C<__DATA__> token. Subroutines -declared elsewhere _cannot_ see these types of variables, -just as if you declared subroutines in the package but in another -file, they cannot see these variables. - -So specifically, autoloaded functions cannot see package -lexicals (this applies to both the B and the Autoloader). -The C pragma provides an alternative to defining package-level -globals that will be visible to autoloaded routines. See the documentation -on B in the pragma section of L. - -=head2 SelfLoader and AutoLoader - -The B can replace the AutoLoader - just change 'use AutoLoader' -to 'use SelfLoader' (though note that the B exports -the AUTOLOAD function - but if you have your own AUTOLOAD and -are using the AutoLoader too, you probably know what you're doing), -and the C<__END__> token to C<__DATA__>. You will need perl version 5.001m -or later to use this (version 5.001 with all patches up to patch m). - -There is no need to inherit from the B. - -The B 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 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 and -another view of these distinctions can be found in that module's -documentation. - -=head2 __DATA__, __END__, and the FOOBAR::DATA filehandle. - -This section is only relevant if you want to use -the C together with the B. - -Data after the C<__DATA__> token in a module is read using the -FOOBAR::DATA filehandle. C<__END__> can still be used to denote the end -of the C<__DATA__> section if followed by the token DATA - this is supported -by the B. The C filehandle is left open if an -C<__END__> followed by a DATA is found, with the filehandle positioned at -the start of the line after the C<__END__> token. If no C<__END__> token is -present, or an C<__END__> token with no DATA token on the same line, then -the filehandle is closed. - -The B reads from wherever the current -position of the C filehandle is, until the -EOF or C<__END__>. This means that if you want to use -that filehandle (and ONLY if you want to), you should either - -1. Put all your subroutine declarations immediately after -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 -reads first by calling 'SelfLoader-Eload_stubs();', or by using a -function which is selfloaded; - -or - -2. You should read the C filehandle first, leaving -the handle open and positioned at the first line of subroutine -declarations. - -You could conceivably do both. - -=head2 Classes and inherited methods. - -For modules which are not classes, this section is not relevant. -This section is only relevant if you have methods which could -be inherited. - -A subroutine stub (or forward declaration) looks like - - sub stub; - -i.e. it is a subroutine declaration without the body of the -subroutine. For modules which are not classes, there is no real -need for stubs as far as autoloading is concerned. - -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-Eload_stubs();' to the module to do -this. - -The alternative is to put the stubs in before the C<__DATA__> token BEFORE -releasing the module, and for this purpose the C -module is available. However this does require the extra step of ensuring -that the stubs are in the module. If this is done I strongly recommend -that this is done BEFORE releasing the module - it should NOT be done -at install time in general. - -=head1 Multiple packages and fully qualified subroutine names - -Subroutines in multiple packages within the same file are supported - but you -should note that this requires exporting the C to -every package which requires it. This is done automatically by the -B when it first loads the subs into the cache, but you should -really specify it in the initialization before the C<__DATA__> by putting -a 'use SelfLoader' statement in each package. - -Fully qualified subroutine names are also supported. For example, - - __DATA__ - sub foo::bar {23} - package baz; - sub dob {32} - -will all be loaded correctly by the B, and the B -will ensure that the packages 'foo' and 'baz' correctly have the -B C method when the data after C<__DATA__> is first -parsed. - -=head1 AUTHOR - -C 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 - -Maintainer of the CPAN release: Steffen Mueller - -=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 diff --git a/ext/SelfLoader/t/01SelfLoader.t b/ext/SelfLoader/t/01SelfLoader.t deleted file mode 100644 index 68c12296d9..0000000000 --- a/ext/SelfLoader/t/01SelfLoader.t +++ /dev/null @@ -1,217 +0,0 @@ -BEGIN { - chdir 't' if -d 't'; - $dir = "self-$$"; - $sep = "/"; - - if ($^O eq 'MacOS') { - $dir = ":" . $dir; - $sep = ":"; - } - - unshift @INC, $dir; - unshift @INC, '../lib'; - - print "1..20\n"; - - # First we must set up some selfloader files - mkdir $dir, 0755 or die "Can't mkdir $dir: $!"; - - open(FOO, ">$dir${sep}Foo.pm") or die; - print FOO <<'EOT'; -package Foo; -use SelfLoader; - -sub new { bless {}, shift } -sub foo; -sub bar; -sub bazmarkhianish; -sub a; -sub never; # declared but definition should never be read -1; -__DATA__ - -sub foo { shift; shift || "foo" }; - -sub bar { shift; shift || "bar" } - -sub bazmarkhianish { shift; shift || "baz" } - -package sheep; -sub bleat { shift; shift || "baa" } -__END__ -sub never { die "D'oh" } -EOT - - close(FOO); - - open(BAR, ">$dir${sep}Bar.pm") or die; - print BAR <<'EOT'; -package Bar; -use SelfLoader; - -@ISA = 'Baz'; - -sub new { bless {}, shift } -sub a; -sub with_whitespace_in_front; - -1; -__DATA__ - -sub a { 'a Bar'; } -sub b { 'b Bar' } - - sub with_whitespace_in_front { - "with_whitespace_in_front Bar" -} - -__END__ DATA -sub never { die "D'oh" } -EOT - - close(BAR); -}; - - -package Baz; - -sub a { 'a Baz' } -sub b { 'b Baz' } -sub c { 'c Baz' } - - -package main; -use Foo; -use Bar; - -$foo = new Foo; - -print "not " unless $foo->foo eq 'foo'; # selfloaded first time -print "ok 1\n"; - -print "not " unless $foo->foo eq 'foo'; # regular call -print "ok 2\n"; - -# Try an undefined method -eval { - $foo->will_fail; -}; -if ($@ =~ /^Undefined subroutine/) { - print "ok 3\n"; -} else { - print "not ok 3 $@\n"; -} - -# Used to be trouble with this -eval { - my $foo = new Foo; - die "oops"; -}; -if ($@ =~ /oops/) { - print "ok 4\n"; -} else { - print "not ok 4 $@\n"; -} - -# Pass regular expression variable to autoloaded function. This used -# to go wrong in AutoLoader because it used regular expressions to generate -# autoloaded filename. -"foo" =~ /(\w+)/; -print "not " unless $1 eq 'foo'; -print "ok 5\n"; - -print "not " unless $foo->bar($1) eq 'foo'; -print "ok 6\n"; - -print "not " unless $foo->bar($1) eq 'foo'; -print "ok 7\n"; - -print "not " unless $foo->bazmarkhianish($1) eq 'foo'; -print "ok 8\n"; - -print "not " unless $foo->bazmarkhianish($1) eq 'foo'; -print "ok 9\n"; - -# Check nested packages inside __DATA__ -print "not " unless sheep::bleat() eq 'baa'; -print "ok 10\n"; - -# Now check inheritance: - -$bar = new Bar; - -# Before anything is SelfLoaded there is no declaration of Foo::b so we should -# get Baz::b -print "not " unless $bar->b() eq 'b Baz'; -print "ok 11\n"; - -# There is no Bar::c so we should get Baz::c -print "not " unless $bar->c() eq 'c Baz'; -print "ok 12\n"; - -# check that subs with whitespace in front work -print "not " unless $bar->with_whitespace_in_front() eq 'with_whitespace_in_front Bar'; -print "ok 13\n"; - -# This selfloads Bar::a because it is stubbed. It also stubs Bar::b as a side -# effect -print "not " unless $bar->a() eq 'a Bar'; -print "ok 14\n"; - -print "not " unless $bar->b() eq 'b Bar'; -print "ok 15\n"; - -print "not " unless $bar->c() eq 'c Baz'; -print "ok 16\n"; - - - -# Check that __END__ is honoured -# Try an subroutine that should never be noticed by selfloader -eval { - $foo->never; -}; -if ($@ =~ /^Undefined subroutine/) { - print "ok 17\n"; -} else { - print "not ok 17 $@\n"; -} - -# Try to read from the data file handle -{ - local $SIG{__WARN__} = sub { my $warn = shift; }; - my $foodata = ; - close Foo::DATA; - if (defined $foodata) { - print "not ok 18 # $foodata\n"; - } else { - print "ok 18\n"; - } -} - -# Check that __END__ DATA is honoured -# Try an subroutine that should never be noticed by selfloader -eval { - $bar->never; -}; -if ($@ =~ /^Undefined subroutine/) { - print "ok 19\n"; -} else { - print "not ok 19 $@\n"; -} - -# Try to read from the data file handle -my $bardata = ; -close Bar::DATA; -if ($bardata ne "sub never { die \"D'oh\" }\n") { - print "not ok 20 # $bardata\n"; -} else { - print "ok 20\n"; -} - -# cleanup -END { -return unless $dir && -d $dir; -unlink "$dir${sep}Foo.pm", "$dir${sep}Bar.pm"; -rmdir "$dir"; -} diff --git a/ext/SelfLoader/t/02SelfLoader-buggy.t b/ext/SelfLoader/t/02SelfLoader-buggy.t deleted file mode 100644 index 7845d05228..0000000000 --- a/ext/SelfLoader/t/02SelfLoader-buggy.t +++ /dev/null @@ -1,46 +0,0 @@ -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't' if -d 't'; - @INC = '../lib'; - } -} - -use SelfLoader; -print "1..1\n"; - -# this script checks that errors on self-loaded -# subroutines that affect $@ are reported - -eval { buggy(); }; -unless ($@ =~ /^syntax error/) { - print "not "; -} -print "ok 1 - syntax errors are reported\n"; - -__END__ - -sub buggy -{ - +>*; -} - - -# RT 40216 -# -# by Bo Lindbergh , at Aug 22, 2006 5:42 PM -# -# In the example below, there's a syntax error in the selfloaded -# code for main::buggy. When the eval fails, SelfLoader::AUTOLOAD -# tries to report this with "croak $@;". Unfortunately, -# SelfLoader::croak does "require Carp;" without protecting $@, -# which gets clobbered. The program then dies with the -# uninformative message " at ./example line 3". -# -# #! /usr/local/bin/perl -# use SelfLoader; -# buggy(); -# __END__ -# sub buggy -# { -# +>*; -# } -- cgit v1.2.1