From 4677aef710c292706460adb42ae4c5704ccecc56 Mon Sep 17 00:00:00 2001 From: Chris Williams Date: Sat, 12 Sep 2009 10:45:31 +0100 Subject: Moved AutoLoader from lib/ to ext/ --- MANIFEST | 8 +- Porting/Maintainers.pl | 2 +- ext/.gitignore | 1 + ext/AutoLoader/lib/AutoLoader.pm | 429 ++++++++++++++++++++++++++++ ext/AutoLoader/lib/AutoSplit.pm | 592 +++++++++++++++++++++++++++++++++++++++ ext/AutoLoader/t/01AutoLoader.t | 222 +++++++++++++++ ext/AutoLoader/t/02AutoSplit.t | 442 +++++++++++++++++++++++++++++ lib/.gitignore | 2 + lib/AutoLoader.pm | 429 ---------------------------- lib/AutoLoader/t/01AutoLoader.t | 222 --------------- lib/AutoLoader/t/02AutoSplit.t | 442 ----------------------------- lib/AutoSplit.pm | 592 --------------------------------------- make_ext.pl | 2 +- 13 files changed, 1694 insertions(+), 1691 deletions(-) create mode 100644 ext/AutoLoader/lib/AutoLoader.pm create mode 100644 ext/AutoLoader/lib/AutoSplit.pm create mode 100644 ext/AutoLoader/t/01AutoLoader.t create mode 100644 ext/AutoLoader/t/02AutoSplit.t delete mode 100644 lib/AutoLoader.pm delete mode 100644 lib/AutoLoader/t/01AutoLoader.t delete mode 100644 lib/AutoLoader/t/02AutoSplit.t delete mode 100644 lib/AutoSplit.pm diff --git a/MANIFEST b/MANIFEST index 29f16e3dbf..bbad138591 100644 --- a/MANIFEST +++ b/MANIFEST @@ -191,6 +191,10 @@ ext/autodie/t/user-context.t autodie - Context changes for usersubs ext/autodie/t/usersub.t autodie - user subroutine tests ext/autodie/t/version.t autodie - versioning tests ext/autodie/t/version_tag.t +ext/AutoLoader/lib/AutoLoader.pm Autoloader base class +ext/AutoLoader/lib/AutoSplit.pm Split up autoload functions +ext/AutoLoader/t/01AutoLoader.t See if AutoLoader works +ext/AutoLoader/t/02AutoSplit.t See if AutoSplit works ext/autouse/lib/autouse.pm Load and call a function only when it's used ext/autouse/t/autouse.t See if autouse works ext/base/Changes base.pm changelog @@ -2765,10 +2769,6 @@ lib/abbrev.pl An abbreviation table builder lib/AnyDBM_File.pm Perl module to emulate dbmopen lib/AnyDBM_File.t See if AnyDBM_File works lib/assert.pl assertion and panic with stack trace -lib/AutoLoader.pm Autoloader base class -lib/AutoLoader/t/01AutoLoader.t See if AutoLoader works -lib/AutoLoader/t/02AutoSplit.t See if AutoSplit works -lib/AutoSplit.pm Split up autoload functions lib/Benchmark.pm Measure execution time lib/Benchmark.t See if Benchmark works lib/bigfloat.pl An arbitrary precision floating point package diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 87656f4838..dd52b5456c 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -236,7 +236,7 @@ use File::Glob qw(:case); { 'MAINTAINER' => 'smueller', 'DISTRIBUTION' => 'SMUELLER/AutoLoader-5.69.tar.gz', - 'FILES' => q[lib/AutoLoader.pm lib/AutoSplit.pm lib/AutoLoader], + 'FILES' => q[ext/AutoLoader.pm], 'EXCLUDED' => [ qw( t/00pod.t ) ], 'CPAN' => 1, 'UPSTREAM' => "cpan", diff --git a/ext/.gitignore b/ext/.gitignore index 690756ca2b..aec8dd40c2 100644 --- a/ext/.gitignore +++ b/ext/.gitignore @@ -16,6 +16,7 @@ ppport.h /Attribute-Handlers/Makefile.PL /attributes/Makefile.PL /autodie/Makefile.PL +/AutoLoader/Makefile.PL /autouse/Makefile.PL /base/Makefile.PL /bignum/Makefile.PL diff --git a/ext/AutoLoader/lib/AutoLoader.pm b/ext/AutoLoader/lib/AutoLoader.pm new file mode 100644 index 0000000000..4ec7a3d474 --- /dev/null +++ b/ext/AutoLoader/lib/AutoLoader.pm @@ -0,0 +1,429 @@ +package AutoLoader; + +use strict; +use 5.006_001; + +our($VERSION, $AUTOLOAD); + +my $is_dosish; +my $is_epoc; +my $is_vms; +my $is_macos; + +BEGIN { + $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare'; + $is_epoc = $^O eq 'epoc'; + $is_vms = $^O eq 'VMS'; + $is_macos = $^O eq 'MacOS'; + $VERSION = '5.69'; +} + +AUTOLOAD { + my $sub = $AUTOLOAD; + my $filename = AutoLoader::find_filename( $sub ); + + my $save = $@; + local $!; # Do not munge the value. + eval { local $SIG{__DIE__}; require $filename }; + if ($@) { + if (substr($sub,-9) eq '::DESTROY') { + no strict 'refs'; + *$sub = sub {}; + $@ = undef; + } elsif ($@ =~ /^Can't locate/) { + # The load might just have failed because the filename was too + # long for some old SVR3 systems which treat long names as errors. + # If we can successfully truncate a long name then it's worth a go. + # There is a slight risk that we could pick up the wrong file here + # but autosplit should have warned about that when splitting. + if ($filename =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){ + eval { local $SIG{__DIE__}; require $filename }; + } + } + if ($@){ + $@ =~ s/ at .*\n//; + my $error = $@; + require Carp; + Carp::croak($error); + } + } + $@ = $save; + goto &$sub; +} + +sub find_filename { + my $sub = shift; + my $filename; + # Braces used to preserve $1 et al. + { + # Try to find the autoloaded file from the package-qualified + # name of the sub. e.g., if the sub needed is + # Getopt::Long::GetOptions(), then $INC{Getopt/Long.pm} is + # something like '/usr/lib/perl5/Getopt/Long.pm', and the + # autoload file is '/usr/lib/perl5/auto/Getopt/Long/GetOptions.al'. + # + # However, if @INC is a relative path, this might not work. If, + # for example, @INC = ('lib'), then $INC{Getopt/Long.pm} is + # 'lib/Getopt/Long.pm', and we want to require + # 'auto/Getopt/Long/GetOptions.al' (without the leading 'lib'). + # In this case, we simple prepend the 'auto/' and let the + # C take care of the searching for us. + + my ($pkg,$func) = ($sub =~ /(.*)::([^:]+)$/); + $pkg =~ s#::#/#g; + if (defined($filename = $INC{"$pkg.pm"})) { + if ($is_macos) { + $pkg =~ tr#/#:#; + $filename = undef + unless $filename =~ s#^(.*)$pkg\.pm\z#$1auto:$pkg:$func.al#s; + } else { + $filename = undef + unless $filename =~ s#^(.*)$pkg\.pm\z#$1auto/$pkg/$func.al#s; + } + + # if the file exists, then make sure that it is a + # a fully anchored path (i.e either '/usr/lib/auto/foo/bar.al', + # or './lib/auto/foo/bar.al'. This avoids C searching + # (and failing) to find the 'lib/auto/foo/bar.al' because it + # looked for 'lib/lib/auto/foo/bar.al', given @INC = ('lib'). + + if (defined $filename and -r $filename) { + unless ($filename =~ m|^/|s) { + if ($is_dosish) { + unless ($filename =~ m{^([a-z]:)?[\\/]}is) { + if ($^O ne 'NetWare') { + $filename = "./$filename"; + } else { + $filename = "$filename"; + } + } + } + elsif ($is_epoc) { + unless ($filename =~ m{^([a-z?]:)?[\\/]}is) { + $filename = "./$filename"; + } + } + elsif ($is_vms) { + # XXX todo by VMSmiths + $filename = "./$filename"; + } + elsif (!$is_macos) { + $filename = "./$filename"; + } + } + } + else { + $filename = undef; + } + } + unless (defined $filename) { + # let C do the searching + $filename = "auto/$sub.al"; + $filename =~ s#::#/#g; + } + } + return $filename; +} + +sub import { + my $pkg = shift; + my $callpkg = caller; + + # + # Export symbols, but not by accident of inheritance. + # + + if ($pkg eq 'AutoLoader') { + if ( @_ and $_[0] =~ /^&?AUTOLOAD$/ ) { + no strict 'refs'; + *{ $callpkg . '::AUTOLOAD' } = \&AUTOLOAD; + } + } + + # + # Try to find the autosplit index file. Eg., if the call package + # is POSIX, then $INC{POSIX.pm} is something like + # '/usr/local/lib/perl5/POSIX.pm', and the autosplit index file is in + # '/usr/local/lib/perl5/auto/POSIX/autosplit.ix', so we require that. + # + # However, if @INC is a relative path, this might not work. If, + # for example, @INC = ('lib'), then + # $INC{POSIX.pm} is 'lib/POSIX.pm', and we want to require + # 'auto/POSIX/autosplit.ix' (without the leading 'lib'). + # + + (my $calldir = $callpkg) =~ s#::#/#g; + my $path = $INC{$calldir . '.pm'}; + if (defined($path)) { + # Try absolute path name, but only eval it if the + # transformation from module path to autosplit.ix path + # succeeded! + my $replaced_okay; + if ($is_macos) { + (my $malldir = $calldir) =~ tr#/#:#; + $replaced_okay = ($path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:autosplit.ix#s); + } else { + $replaced_okay = ($path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/autosplit.ix#); + } + + eval { require $path; } if $replaced_okay; + # If that failed, try relative path with normal @INC searching. + if (!$replaced_okay or $@) { + $path ="auto/$calldir/autosplit.ix"; + eval { require $path; }; + } + if ($@) { + my $error = $@; + require Carp; + Carp::carp($error); + } + } +} + +sub unimport { + my $callpkg = caller; + + no strict 'refs'; + + for my $exported (qw( AUTOLOAD )) { + my $symname = $callpkg . '::' . $exported; + undef *{ $symname } if \&{ $symname } == \&{ $exported }; + *{ $symname } = \&{ $symname }; + } +} + +1; + +__END__ + +=head1 NAME + +AutoLoader - load subroutines only on demand + +=head1 SYNOPSIS + + package Foo; + use AutoLoader 'AUTOLOAD'; # import the default AUTOLOAD subroutine + + package Bar; + use AutoLoader; # don't import AUTOLOAD, define our own + sub AUTOLOAD { + ... + $AutoLoader::AUTOLOAD = "..."; + goto &AutoLoader::AUTOLOAD; + } + +=head1 DESCRIPTION + +The B module works with the B module and the +C<__END__> token to defer the loading of some subroutines until they are +used rather than loading them all at once. + +To use B, the author of a module has to place the +definitions of subroutines to be autoloaded after an C<__END__> token. +(See L.) The B module can then be run manually to +extract the definitions into individual files F. + +B implements an AUTOLOAD subroutine. When an undefined +subroutine in is called in a client module of B, +B's AUTOLOAD subroutine attempts to locate the subroutine in a +file with a name related to the location of the file from which the +client module was read. As an example, if F is located in +F, B will look for perl +subroutines B in F, where +the C<.al> file has the same name as the subroutine, sans package. If +such a file exists, AUTOLOAD will read and evaluate it, +thus (presumably) defining the needed subroutine. AUTOLOAD will then +C the newly defined subroutine. + +Once this process completes for a given function, it is defined, so +future calls to the subroutine will bypass the AUTOLOAD mechanism. + +=head2 Subroutine Stubs + +In order for object method lookup and/or prototype checking to operate +correctly even when methods have not yet been defined it is necessary to +"forward declare" each subroutine (as in C). See +L. Such forward declaration creates "subroutine +stubs", which are place holders with no code. + +The AutoSplit and B modules automate the creation of forward +declarations. The AutoSplit module creates an 'index' file containing +forward declarations of all the AutoSplit subroutines. When the +AutoLoader module is 'use'd it loads these declarations into its callers +package. + +Because of this mechanism it is important that B is always +Cd and not Cd. + +=head2 Using B's AUTOLOAD Subroutine + +In order to use B's AUTOLOAD subroutine you I +explicitly import it: + + use AutoLoader 'AUTOLOAD'; + +=head2 Overriding B's AUTOLOAD Subroutine + +Some modules, mainly extensions, provide their own AUTOLOAD subroutines. +They typically need to check for some special cases (such as constants) +and then fallback to B's AUTOLOAD for the rest. + +Such modules should I import B's AUTOLOAD subroutine. +Instead, they should define their own AUTOLOAD subroutines along these +lines: + + use AutoLoader; + use Carp; + + sub AUTOLOAD { + my $sub = $AUTOLOAD; + (my $constname = $sub) =~ s/.*:://; + my $val = constant($constname, @_ ? $_[0] : 0); + if ($! != 0) { + if ($! =~ /Invalid/ || $!{EINVAL}) { + $AutoLoader::AUTOLOAD = $sub; + goto &AutoLoader::AUTOLOAD; + } + else { + croak "Your vendor has not defined constant $constname"; + } + } + *$sub = sub { $val }; # same as: eval "sub $sub { $val }"; + goto &$sub; + } + +If any module's own AUTOLOAD subroutine has no need to fallback to the +AutoLoader's AUTOLOAD subroutine (because it doesn't have any AutoSplit +subroutines), then that module should not use B at all. + +=head2 Package Lexicals + +Package lexicals declared with C in the main block of a package +using B will not be visible to auto-loaded subroutines, due to +the fact that the given scope ends at the C<__END__> marker. A module +using such variables as package globals will not work properly under the +B. + +The C pragma (see L) may be used in such +situations as an alternative to explicitly qualifying all globals with +the package namespace. Variables pre-declared with this pragma will be +visible to any autoloaded routines (but will not be invisible outside +the package, unfortunately). + +=head2 Not Using AutoLoader + +You can stop using AutoLoader by simply + + no AutoLoader; + +=head2 B vs. B + +The B is similar in purpose to B: both delay the +loading of subroutines. + +B uses the C<__DATA__> marker rather than C<__END__>. +While this avoids the use of a hierarchy of disk files and the +associated open/close for each routine loaded, B suffers a +startup speed disadvantage in the one-time parsing of the lines after +C<__DATA__>, after which routines are cached. B can also +handle multiple packages in a file. + +B only reads code as it is requested, and in many cases +should be faster, but requires a mechanism like B be used to +create the individual files. L will invoke +B automatically if B is used in a module source +file. + +=head1 CAVEATS + +AutoLoaders prior to Perl 5.002 had a slightly different interface. Any +old modules which use B should be changed to the new calling +style. Typically this just means changing a require to a use, adding +the explicit C<'AUTOLOAD'> import if needed, and removing B +from C<@ISA>. + +On systems with restrictions on file name length, the file corresponding +to a subroutine may have a shorter name that the routine itself. This +can lead to conflicting file names. The I package warns of +these potential conflicts when used to split a module. + +AutoLoader may fail to find the autosplit files (or even find the wrong +ones) in cases where C<@INC> contains relative paths, B the program +does C. + +=head1 SEE ALSO + +L - an autoloader that doesn't use external files. + +=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, 2007, 2008, 2009 + 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/AutoLoader/lib/AutoSplit.pm b/ext/AutoLoader/lib/AutoSplit.pm new file mode 100644 index 0000000000..c093f2dd24 --- /dev/null +++ b/ext/AutoLoader/lib/AutoSplit.pm @@ -0,0 +1,592 @@ +package AutoSplit; + +use Exporter (); +use Config qw(%Config); +use File::Basename (); +use File::Path qw(mkpath); +use File::Spec::Functions qw(curdir catfile catdir); +use strict; +our($VERSION, @ISA, @EXPORT, @EXPORT_OK, $Verbose, $Keep, $Maxlen, + $CheckForAutoloader, $CheckModTime); + +$VERSION = "1.06"; +@ISA = qw(Exporter); +@EXPORT = qw(&autosplit &autosplit_lib_modules); +@EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime); + +=head1 NAME + +AutoSplit - split a package for autoloading + +=head1 SYNOPSIS + + autosplit($file, $dir, $keep, $check, $modtime); + + autosplit_lib_modules(@modules); + +=head1 DESCRIPTION + +This function will split up your program into files that the AutoLoader +module can handle. It is used by both the standard perl libraries and by +the MakeMaker utility, to automatically configure libraries for autoloading. + +The C interface splits the specified file into a hierarchy +rooted at the directory C<$dir>. It creates directories as needed to reflect +class hierarchy, and creates the file F. This file acts as +both forward declaration of all package routines, and as timestamp for the +last update of the hierarchy. + +The remaining three arguments to C govern other options to +the autosplitter. + +=over 2 + +=item $keep + +If the third argument, I<$keep>, is false, then any +pre-existing C<*.al> files in the autoload directory are removed if +they are no longer part of the module (obsoleted functions). +$keep defaults to 0. + +=item $check + +The +fourth argument, I<$check>, instructs C to check the module +currently being split to ensure that it includes a C +specification for the AutoLoader module, and skips the module if +AutoLoader is not detected. +$check defaults to 1. + +=item $modtime + +Lastly, the I<$modtime> argument specifies +that C is to check the modification time of the module +against that of the C file, and only split the module if +it is newer. +$modtime defaults to 1. + +=back + +Typical use of AutoSplit in the perl MakeMaker utility is via the command-line +with: + + perl -e 'use AutoSplit; autosplit($ARGV[0], $ARGV[1], 0, 1, 1)' + +Defined as a Make macro, it is invoked with file and directory arguments; +C will split the specified file into the specified directory and +delete obsolete C<.al> files, after checking first that the module does use +the AutoLoader, and ensuring that the module is not already currently split +in its current form (the modtime test). + +The C form is used in the building of perl. It takes +as input a list of files (modules) that are assumed to reside in a directory +B relative to the current directory. Each file is sent to the +autosplitter one at a time, to be split into the directory B. + +In both usages of the autosplitter, only subroutines defined following the +perl I<__END__> token are split out into separate files. Some +routines may be placed prior to this marker to force their immediate loading +and parsing. + +=head2 Multiple packages + +As of version 1.01 of the AutoSplit module it is possible to have +multiple packages within a single file. Both of the following cases +are supported: + + package NAME; + __END__ + sub AAA { ... } + package NAME::option1; + sub BBB { ... } + package NAME::option2; + sub BBB { ... } + + package NAME; + __END__ + sub AAA { ... } + sub NAME::option1::BBB { ... } + sub NAME::option2::BBB { ... } + +=head1 DIAGNOSTICS + +C will inform the user if it is necessary to create the +top-level directory specified in the invocation. It is preferred that +the script or installation process that invokes C have +created the full directory path ahead of time. This warning may +indicate that the module is being split into an incorrect path. + +C will warn the user of all subroutines whose name causes +potential file naming conflicts on machines with drastically limited +(8 characters or less) file name length. Since the subroutine name is +used as the file name, these warnings can aid in portability to such +systems. + +Warnings are issued and the file skipped if C cannot locate +either the I<__END__> marker or a "package Name;"-style specification. + +C will also emit general diagnostics for inability to +create directories or files. + +=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, 2007, 2008 + 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 + +# for portability warn about names longer than $maxlen +$Maxlen = 8; # 8 for dos, 11 (14-".al") for SYSVR3 +$Verbose = 1; # 0=none, 1=minimal, 2=list .al files +$Keep = 0; +$CheckForAutoloader = 1; +$CheckModTime = 1; + +my $IndexFile = "autosplit.ix"; # file also serves as timestamp +my $maxflen = 255; +$maxflen = 14 if $Config{'d_flexfnam'} ne 'define'; +if (defined (&Dos::UseLFN)) { + $maxflen = Dos::UseLFN() ? 255 : 11; +} +my $Is_VMS = ($^O eq 'VMS'); + +# allow checking for valid ': attrlist' attachments. +# extra jugglery required to support both 5.8 and 5.9/5.10 features +# (support for 5.8 required for cross-compiling environments) + +my $attr_list = + $] >= 5.009005 ? + eval <<'__QR__' + qr{ + \s* : \s* + (?: + # one attribute + (?> # no backtrack + (?! \d) \w+ + (? \( (?: [^()]++ | (?&nested)++ )*+ \) ) ? + ) + (?: \s* : \s* | \s+ (?! :) ) + )* + }x +__QR__ + : + do { + # In pre-5.9.5 world we have to do dirty tricks. + # (we use 'our' rather than 'my' here, due to the rather complex and buggy + # behaviour of lexicals with qr// and (??{$lex}) ) + our $trick1; # yes, cannot our and assign at the same time. + $trick1 = qr{ \( (?: (?> [^()]+ ) | (??{ $trick1 }) )* \) }x; + our $trick2 = qr{ (?> (?! \d) \w+ (?:$trick1)? ) (?:\s*\:\s*|\s+(?!\:)) }x; + qr{ \s* : \s* (?: $trick2 )* }x; + }; + +sub autosplit{ + my($file, $autodir, $keep, $ckal, $ckmt) = @_; + # $file - the perl source file to be split (after __END__) + # $autodir - the ".../auto" dir below which to write split subs + # Handle optional flags: + $keep = $Keep unless defined $keep; + $ckal = $CheckForAutoloader unless defined $ckal; + $ckmt = $CheckModTime unless defined $ckmt; + autosplit_file($file, $autodir, $keep, $ckal, $ckmt); +} + +sub carp{ + require Carp; + goto &Carp::carp; +} + +# This function is used during perl building/installation +# ./miniperl -e 'use AutoSplit; autosplit_lib_modules(@ARGV)' ... + +sub autosplit_lib_modules { + my(@modules) = @_; # list of Module names + local $_; # Avoid clobber. + while (defined($_ = shift @modules)) { + while (m#([^:]+)::([^:].*)#) { # in case specified as ABC::XYZ + $_ = catfile($1, $2); + } + s|\\|/|g; # bug in ksh OS/2 + s#^lib/##s; # incase specified as lib/*.pm + my($lib) = catfile(curdir(), "lib"); + if ($Is_VMS) { # may need to convert VMS-style filespecs + $lib =~ s#^\[\]#.\/#; + } + s#^$lib\W+##s; # incase specified as ./lib/*.pm + if ($Is_VMS && /[:>\]]/) { # may need to convert VMS-style filespecs + my ($dir,$name) = (/(.*])(.*)/s); + $dir =~ s/.*lib[\.\]]//s; + $dir =~ s#[\.\]]#/#g; + $_ = $dir . $name; + } + autosplit_file(catfile($lib, $_), catfile($lib, "auto"), + $Keep, $CheckForAutoloader, $CheckModTime); + } + 0; +} + + +# private functions + +my $self_mod_time = (stat __FILE__)[9]; + +sub autosplit_file { + my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time) + = @_; + my(@outfiles); + local($_); + local($/) = "\n"; + + # where to write output files + $autodir ||= catfile(curdir(), "lib", "auto"); + if ($Is_VMS) { + ($autodir = VMS::Filespec::unixpath($autodir)) =~ s|/\z||; + $filename = VMS::Filespec::unixify($filename); # may have dirs + } + unless (-d $autodir){ + mkpath($autodir,0,0755); + # We should never need to create the auto dir + # here. installperl (or similar) should have done + # it. Expecting it to exist is a valuable sanity check against + # autosplitting into some random directory by mistake. + print "Warning: AutoSplit had to create top-level " . + "$autodir unexpectedly.\n"; + } + + # allow just a package name to be used + $filename .= ".pm" unless ($filename =~ m/\.pm\z/); + + open(my $in, "<$filename") or die "AutoSplit: Can't open $filename: $!\n"; + my($pm_mod_time) = (stat($filename))[9]; + my($autoloader_seen) = 0; + my($in_pod) = 0; + my($def_package,$last_package,$this_package,$fnr); + while (<$in>) { + # Skip pod text. + $fnr++; + $in_pod = 1 if /^=\w/; + $in_pod = 0 if /^=cut/; + next if ($in_pod || /^=cut/); + next if /^\s*#/; + + # record last package name seen + $def_package = $1 if (m/^\s*package\s+([\w:]+)\s*;/); + ++$autoloader_seen if m/^\s*(use|require)\s+AutoLoader\b/; + ++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/; + last if /^__END__/; + } + if ($check_for_autoloader && !$autoloader_seen){ + print "AutoSplit skipped $filename: no AutoLoader used\n" + if ($Verbose>=2); + return 0; + } + $_ or die "Can't find __END__ in $filename\n"; + + $def_package or die "Can't find 'package Name;' in $filename\n"; + + my($modpname) = _modpname($def_package); + + # this _has_ to match so we have a reasonable timestamp file + die "Package $def_package ($modpname.pm) does not ". + "match filename $filename" + unless ($filename =~ m/\Q$modpname.pm\E$/ or + ($^O eq 'dos') or ($^O eq 'MSWin32') or ($^O eq 'NetWare') or + $Is_VMS && $filename =~ m/$modpname.pm/i); + + my($al_idx_file) = catfile($autodir, $modpname, $IndexFile); + + if ($check_mod_time){ + my($al_ts_time) = (stat("$al_idx_file"))[9] || 1; + if ($al_ts_time >= $pm_mod_time and + $al_ts_time >= $self_mod_time){ + print "AutoSplit skipped ($al_idx_file newer than $filename)\n" + if ($Verbose >= 2); + return undef; # one undef, not a list + } + } + + my($modnamedir) = catdir($autodir, $modpname); + print "AutoSplitting $filename ($modnamedir)\n" + if $Verbose; + + unless (-d $modnamedir){ + mkpath($modnamedir,0,0777); + } + + # We must try to deal with some SVR3 systems with a limit of 14 + # characters for file names. Sadly we *cannot* simply truncate all + # file names to 14 characters on these systems because we *must* + # create filenames which exactly match the names used by AutoLoader.pm. + # This is a problem because some systems silently truncate the file + # names while others treat long file names as an error. + + my $Is83 = $maxflen==11; # plain, case INSENSITIVE dos filenames + + my(@subnames, $subname, %proto, %package); + my @cache = (); + my $caching = 1; + $last_package = ''; + my $out; + while (<$in>) { + $fnr++; + $in_pod = 1 if /^=\w/; + $in_pod = 0 if /^=cut/; + next if ($in_pod || /^=cut/); + # the following (tempting) old coding gives big troubles if a + # cut is forgotten at EOF: + # next if /^=\w/ .. /^=cut/; + if (/^package\s+([\w:]+)\s*;/) { + $this_package = $def_package = $1; + } + + if (/^sub\s+([\w:]+)(\s*(?:\(.*?\))?(?:$attr_list)?)/) { + print $out "# end of $last_package\::$subname\n1;\n" + if $last_package; + $subname = $1; + my $proto = $2 || ''; + if ($subname =~ s/(.*):://){ + $this_package = $1; + } else { + $this_package = $def_package; + } + my $fq_subname = "$this_package\::$subname"; + $package{$fq_subname} = $this_package; + $proto{$fq_subname} = $proto; + push(@subnames, $fq_subname); + my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3)); + $modpname = _modpname($this_package); + my($modnamedir) = catdir($autodir, $modpname); + mkpath($modnamedir,0,0777); + my($lpath) = catfile($modnamedir, "$lname.al"); + my($spath) = catfile($modnamedir, "$sname.al"); + my $path; + + if (!$Is83 and open($out, ">$lpath")){ + $path=$lpath; + print " writing $lpath\n" if ($Verbose>=2); + } else { + open($out, ">$spath") or die "Can't create $spath: $!\n"; + $path=$spath; + print " writing $spath (with truncated name)\n" + if ($Verbose>=1); + } + push(@outfiles, $path); + my $lineno = $fnr - @cache; + print $out < lc($_) } @outfiles; + } else { + @outfiles{@outfiles} = @outfiles; + } + my(%outdirs,@outdirs); + for (@outfiles) { + $outdirs{File::Basename::dirname($_)}||=1; + } + for my $dir (keys %outdirs) { + opendir(my $outdir,$dir); + foreach (sort readdir($outdir)){ + next unless /\.al\z/; + my($file) = catfile($dir, $_); + $file = lc $file if $Is83 or $Is_VMS; + next if $outfiles{$file}; + print " deleting $file\n" if ($Verbose>=2); + my($deleted,$thistime); # catch all versions on VMS + do { $deleted += ($thistime = unlink $file) } while ($thistime); + carp ("Unable to delete $file: $!") unless $deleted; + } + closedir($outdir); + } + } + + open(my $ts,">$al_idx_file") or + carp ("AutoSplit: unable to create timestamp file ($al_idx_file): $!"); + print $ts "# Index created by AutoSplit for $filename\n"; + print $ts "# (file acts as timestamp)\n"; + $last_package = ''; + for my $fqs (@subnames) { + my($subname) = $fqs; + $subname =~ s/.*:://; + print $ts "package $package{$fqs};\n" + unless $last_package eq $package{$fqs}; + print $ts "sub $subname $proto{$fqs};\n"; + $last_package = $package{$fqs}; + } + print $ts "1;\n"; + close($ts); + + _check_unique($filename, $Maxlen, 1, @outfiles); + + @outfiles; +} + +sub _modpname ($) { + my($package) = @_; + my $modpname = $package; + if ($^O eq 'MSWin32') { + $modpname =~ s#::#\\#g; + } else { + my @modpnames = (); + while ($modpname =~ m#(.*?[^:])::([^:].*)#) { + push @modpnames, $1; + $modpname = $2; + } + $modpname = catfile(@modpnames, $modpname); + } + if ($Is_VMS) { + $modpname = VMS::Filespec::unixify($modpname); # may have dirs + } + $modpname; +} + +sub _check_unique { + my($filename, $maxlen, $warn, @outfiles) = @_; + my(%notuniq) = (); + my(%shorts) = (); + my(@toolong) = grep( + length(File::Basename::basename($_)) + > $maxlen, + @outfiles + ); + + foreach (@toolong){ + my($dir) = File::Basename::dirname($_); + my($file) = File::Basename::basename($_); + my($trunc) = substr($file,0,$maxlen); + $notuniq{$dir}{$trunc} = 1 if $shorts{$dir}{$trunc}; + $shorts{$dir}{$trunc} = $shorts{$dir}{$trunc} ? + "$shorts{$dir}{$trunc}, $file" : $file; + } + if (%notuniq && $warn){ + print "$filename: some names are not unique when " . + "truncated to $maxlen characters:\n"; + foreach my $dir (sort keys %notuniq){ + print " directory $dir:\n"; + foreach my $trunc (sort keys %{$notuniq{$dir}}) { + print " $shorts{$dir}{$trunc} truncate to $trunc\n"; + } + } + } +} + +1; +__END__ + +# test functions so AutoSplit.pm can be applied to itself: +sub test1 ($) { "test 1\n"; } +sub test2 ($$) { "test 2\n"; } +sub test3 ($$$) { "test 3\n"; } +sub testtesttesttest4_1 { "test 4\n"; } +sub testtesttesttest4_2 { "duplicate test 4\n"; } +sub Just::Another::test5 { "another test 5\n"; } +sub test6 { return join ":", __FILE__,__LINE__; } +package Yet::Another::AutoSplit; +sub testtesttesttest4_1 ($) { "another test 4\n"; } +sub testtesttesttest4_2 ($$) { "another duplicate test 4\n"; } +package Yet::More::Attributes; +sub test_a1 ($) : locked :locked { 1; } +sub test_a2 : locked { 1; } diff --git a/ext/AutoLoader/t/01AutoLoader.t b/ext/AutoLoader/t/01AutoLoader.t new file mode 100644 index 0000000000..dcee5c518a --- /dev/null +++ b/ext/AutoLoader/t/01AutoLoader.t @@ -0,0 +1,222 @@ +#!./perl -w + +BEGIN { + if ($ENV{PERL_CORE}) { + chdir 't' if -d 't'; + #@INC = '../lib'; + } +} + +use strict; +use File::Spec; +use File::Path; + +my $dir; +BEGIN +{ + $dir = File::Spec->catdir( "auto-$$" ); + unshift @INC, $dir; +} + +use Test::More tests => 18; + +sub write_file { + my ($file, $text) = @_; + open my $fh, '>', $file + or die "Could not open file '$file' for writing: $!"; + print $fh $text; + close $fh; +} + +# First we must set up some autoloader files +my $fulldir = File::Spec->catdir( $dir, 'auto', 'Foo' ); +mkpath( $fulldir ) or die "Can't mkdir '$fulldir': $!"; + +write_file( File::Spec->catfile( $fulldir, 'foo.al' ), <<'EOT' ); +package Foo; +sub foo { shift; shift || "foo" } +1; +EOT + +write_file( File::Spec->catfile( $fulldir, 'bazmarkhian.al' ), <<'EOT' ); +package Foo; +sub bazmarkhianish { shift; shift || "baz" } +1; +EOT + +my $blechanawilla_text = <<'EOT'; +package Foo; +sub blechanawilla { compilation error ( +EOT +write_file( File::Spec->catfile( $fulldir, 'blechanawilla.al' ), $blechanawilla_text ); +# This is just to keep the old SVR3 systems happy; they may fail +# to find the above file so we duplicate it where they should find it. +write_file( File::Spec->catfile( $fulldir, 'blechanawil.al' ), $blechanawilla_text ); + +# Let's define the package +package Foo; +require AutoLoader; +AutoLoader->import( 'AUTOLOAD' ); + +sub new { bless {}, shift }; +sub foo; +sub bazmarkhianish; + +package main; + +my $foo = Foo->new(); + +my $result = $foo->can( 'foo' ); +ok( $result, 'can() first time' ); +is( $foo->foo, 'foo', 'autoloaded first time' ); +is( $foo->foo, 'foo', 'regular call' ); +is( $result, \&Foo::foo, 'can() returns ref to regular installed sub' ); + +eval { + $foo->will_fail; +}; +like( $@, qr/^Can't locate/, 'undefined method' ); + +$result = $foo->can( 'will_fail' ); +ok( ! $result, 'can() should fail on undefined methods' ); + +# Used to be trouble with this +eval { + my $foo = Foo->new(); + die "oops"; +}; +like( $@, qr/oops/, 'indirect method call' ); + +# Pass regular expression variable to autoloaded function. This used +# to go wrong because AutoLoader used regular expressions to generate +# autoloaded filename. +'foo' =~ /(\w+)/; + +is( $foo->bazmarkhianish($1), 'foo', 'autoloaded method should not stomp match vars' ); +is( $foo->bazmarkhianish($1), 'foo', '(again)' ); + +# Used to retry long subnames with shorter filenames on any old +# exception, including compilation error. Now AutoLoader only +# tries shorter filenames if it can't find the long one. +eval { + $foo->blechanawilla; +}; +like( $@, qr/syntax error/i, 'require error propagates' ); + +# test recursive autoloads +write_file( File::Spec->catfile( $fulldir, 'a.al' ), <<'EOT' ); +package Foo; +BEGIN { b() } +sub a { ::ok( 1, 'adding a new autoloaded method' ); } +1; +EOT +write_file( File::Spec->catfile( $fulldir, 'b.al' ), <<'EOT' ); +package Foo; +sub b { ::ok( 1, 'adding a new autoloaded method' ) } +1; +EOT + +Foo::a(); + +package Bar; +AutoLoader->import(); +::ok( ! defined &AUTOLOAD, 'AutoLoader should not export AUTOLOAD by default' ); +::ok( ! defined &can, '... nor can()' ); + +package Foo; +AutoLoader->unimport(); +eval { Foo->baz() }; +::like( $@, qr/locate object method "baz"/, + 'unimport() should remove imported AUTOLOAD()' ); + +package Baz; + +sub AUTOLOAD { 'i am here' } + +AutoLoader->import(); +AutoLoader->unimport(); + +::is( Baz->AUTOLOAD(), 'i am here', '... but not non-imported AUTOLOAD()' ); + + +package SomeClass; +use AutoLoader 'AUTOLOAD'; +sub new { + bless {} => shift; +} + +package main; + +$INC{"SomeClass.pm"} = $0; # Prepare possible recursion +{ + my $p = SomeClass->new(); +} # <-- deep recursion in AUTOLOAD looking for SomeClass::DESTROY? +::ok(1, "AutoLoader shouldn't loop forever if \%INC is modified"); + +# Now test the bug that lead to AutoLoader 0.67: +# If the module is loaded from a file name different than normal, +# we could formerly have trouble finding autosplit.ix +# Contributed by Christoph Lamprecht. +# Recreate the following file structure: +# auto/MyAddon/autosplit.ix +# auto/MyAddon/testsub.al +# MyModule.pm +SCOPE: { + my $autopath = File::Spec->catdir( $dir, 'auto', 'MyAddon' ); + mkpath( $autopath ) or die "Can't mkdir '$autopath': $!"; + my $autosplit_text = <<'EOT'; +# Index created by AutoSplit for MyModule.pm +# (file acts as timestamp) +package MyAddon; +sub testsub ; +1; +EOT + write_file( File::Spec->catfile( $autopath, 'autosplit.ix' ), $autosplit_text ); + + my $testsub_text = <<'EOT'; +# NOTE: Derived from MyModule.pm. +# Changes made here will be lost when autosplit is run again. +# See AutoSplit.pm. +package MyAddon; + +#line 13 "MyModule.pm (autosplit into auto/MyAddon/testsub.al)" +sub testsub{ + return "MyAddon"; +} + +1; +# end of MyAddon::testsub +EOT + write_file( File::Spec->catfile( $autopath, 'testsub.al' ), $testsub_text); + + my $mymodule_text = <<'EOT'; +use strict; +use warnings; +package MyModule; +sub testsub{return 'MyModule';} + +package MyAddon; +our @ISA = ('MyModule'); +BEGIN{$INC{'MyAddon.pm'} = __FILE__} +use AutoLoader 'AUTOLOAD'; +1; +__END__ + +sub testsub{ + return "MyAddon"; +} +EOT + write_file( File::Spec->catfile( $dir, 'MyModule.pm' ), $mymodule_text); + + require MyModule; + + my $res = MyAddon->testsub(); + ::is ($res , 'MyAddon', 'invoke MyAddon::testsub'); +} + +# cleanup +END { + return unless $dir && -d $dir; + rmtree $dir; +} + diff --git a/ext/AutoLoader/t/02AutoSplit.t b/ext/AutoLoader/t/02AutoSplit.t new file mode 100644 index 0000000000..c652562b30 --- /dev/null +++ b/ext/AutoLoader/t/02AutoSplit.t @@ -0,0 +1,442 @@ +# AutoLoader.t runs before this test, so it seems safe to assume that it will +# work. + +my($incdir, $lib); +BEGIN { + chdir 't' if -d 't'; + if ($^O eq 'dos') { + print "1..0 # This test is not 8.3-aware.\n"; + exit 0; + } + if ($^O eq 'MacOS') { + $incdir = ":auto-$$"; + $lib = '-I::lib:'; + } else { + $incdir = "auto-$$"; + $lib = '"-I../lib"'; # ok on unix, nt, The extra \" are for VMS + } + unshift @INC, $incdir; + unshift @INC, '../lib'; +} +my $runperl = "$^X $lib"; + +use warnings; +use strict; +use Test::More tests => 58; +use File::Spec; +use File::Find; + +my $Is_VMS = $^O eq 'VMS'; +my $Is_VMS_mode = 0; +my $Is_VMS_lc = 0; + +if ($Is_VMS) { + require VMS::Filespec if $Is_VMS; + my $vms_unix_rpt; + my $vms_case; + + $Is_VMS_mode = 1; + $Is_VMS_lc = 1; + if (eval 'require VMS::Feature') { + $vms_unix_rpt = VMS::Feature::current("filename_unix_report"); + $vms_case = VMS::Feature::current("efs_case_preserve"); + } else { + my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; + my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || ''; + $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; + $vms_case = $efs_case =~ /^[ET1]/i; + } + $Is_VMS_lc = 0 if ($vms_case); + $Is_VMS_mode = 0 if ($vms_unix_rpt); +} + + +require AutoSplit; # Run time. Check it compiles. +ok (1, "AutoSplit loaded"); + +END { + use File::Path; + print "# $incdir being removed...\n"; + rmtree($incdir); +} + +mkdir $incdir,0755; + +my @tests; +{ + # local this else it buggers up the chomp() below. + # Hmm. Would be nice to have this as a regexp. + local $/ + = "################################################################\n"; + @tests = ; + close DATA; +} + +my $pathsep = $^O eq 'MSWin32' ? '\\' : $^O eq 'MacOS' ? ':' : '/'; +my $endpathsep = $^O eq 'MacOS' ? ':' : ''; + +sub split_a_file { + my $contents = shift; + my $file = $_[0]; + if (defined $contents) { + open FILE, ">$file" or die "Can't open $file: $!"; + print FILE $contents; + close FILE or die "Can't close $file: $!"; + } + + # Assumption: no characters in arguments need escaping from the shell or perl + my $com = qq($runperl -e "use AutoSplit; autosplit (qw(@_))"); + print "# command: $com\n"; + # There may be a way to capture STDOUT without spawning a child process, but + # it's probably worthwhile spawning, as it ensures that nothing in AutoSplit + # can load functions from split modules into this perl. + my $output = `$com`; + warn "Exit status $? from running: >>$com<<" if $?; + return $output; +} + +my $i = 0; +my $dir = File::Spec->catdir($incdir, 'auto'); +if ($Is_VMS_mode) { + $dir = VMS::Filespec::unixify($dir); + $dir =~ s/\/$//; +} elsif ($^O eq 'MacOS') { + $dir =~ s/:$//; +} + +foreach (@tests) { + my $module = 'A' . $i . '_' . $$ . 'splittest'; + my $file = File::Spec->catfile($incdir,"$module.pm"); + s/\*INC\*/$incdir/gm; + s/\*DIR\*/$dir/gm; + s/\*MOD\*/$module/gm; + s/\*PATHSEP\*/$pathsep/gm; + s/\*ENDPATHSEP\*/$endpathsep/gm; + s#//#/#gm; + # Build a hash for this test. + my %args = /^\#\#\ ([^\n]*)\n # Key is on a line starting ## + ((?:[^\#]+ # Any number of characters not # + | \#(?!\#) # or a # character not followed by # + | (?catfile ('auto', $args{Require}) . '"'; + $com =~ s{\\}{/}gm if ($^O eq 'MSWin32'); + eval $com; + # test n+3 + ok ($@ eq '', $com) or print "# \$\@ = '$@'\n"; + if (defined $body) { + eval $body or die $@; + } + } + # match tests to check for prototypes + if ($args{Match}) { + local $/; + my $file = File::Spec->catfile($dir, $args{Require}); + open IX, $file or die "Can't open '$file': $!"; + my $ix = ; + close IX or die "Can't close '$file': $!"; + foreach my $pat (split /\n/, $args{Match}) { + next if $pat =~ /^\#/; + like ($ix, qr/^\s*$pat\s*$/m, "match $pat"); + } + } + # code tests contain eval{}ed ok()s etc + if ($args{Tests}) { + foreach my $code (split /\n/, $args{Tests}) { + next if $code =~ /^\#/; + defined eval $code or fail(), print "# Code: $code\n# Error: $@"; + } + } + if (my $sleepfor = $args{Sleep}) { + # We need to sleep for a while + # Need the sleep hack else the next test is so fast that the timestamp + # compare routine in AutoSplit thinks that it shouldn't split the files. + my $time = time; + my $until = $time + $sleepfor; + my $attempts = 3; + do { + sleep ($sleepfor) + } while (time < $until && --$attempts > 0); + if ($attempts == 0) { + printf << "EOM", time; +# Attempted to sleep for $sleepfor second(s), started at $time, now %d. +# sleep attempt ppears to have failed; some tests may fail as a result. +EOM + } + } + unless ($args{SameAgain}) { + $i++; + rmtree($dir); + mkdir $dir, 0775; + } +} + +__DATA__ +## Name +tests from the end of the AutoSplit module. +## File +use AutoLoader 'AUTOLOAD'; +{package Just::Another; + use AutoLoader 'AUTOLOAD'; +} +@Yet::Another::AutoSplit::ISA = 'AutoLoader'; +1; +__END__ +sub test1 ($) { "test 1"; } +sub test2 ($$) { "test 2"; } +sub test3 ($$$) { "test 3"; } +sub testtesttesttest4_1 { "test 4"; } +sub testtesttesttest4_2 { "duplicate test 4"; } +sub Just::Another::test5 { "another test 5"; } +sub test6 { return join ":", __FILE__,__LINE__; } +package Yet::Another::AutoSplit; +sub testtesttesttest4_1 ($) { "another test 4"; } +sub testtesttesttest4_2 ($$) { "another duplicate test 4"; } +package Yet::More::Attributes; +sub test_a1 ($) : locked :locked { 1; } +sub test_a2 : locked { 1; } +# And that was all it has. You were expected to manually inspect the output +## Get +Warning: AutoSplit had to create top-level *DIR* unexpectedly. +AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) +*INC**PATHSEP**MOD*.pm: some names are not unique when truncated to 8 characters: + directory *DIR**PATHSEP**MOD**ENDPATHSEP*: + testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest + directory *DIR**PATHSEP*Yet*PATHSEP*Another*PATHSEP*AutoSplit*ENDPATHSEP*: + testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest +## Files +*DIR*/*MOD*/autosplit.ix +*DIR*/*MOD*/test1.al +*DIR*/*MOD*/test2.al +*DIR*/*MOD*/test3.al +*DIR*/*MOD*/testtesttesttest4_1.al +*DIR*/*MOD*/testtesttesttest4_2.al +*DIR*/Just/Another/test5.al +*DIR*/*MOD*/test6.al +*DIR*/Yet/Another/AutoSplit/testtesttesttest4_1.al +*DIR*/Yet/Another/AutoSplit/testtesttesttest4_2.al +*DIR*/Yet/More/Attributes/test_a1.al +*DIR*/Yet/More/Attributes/test_a2.al +## Require +*MOD*/autosplit.ix +## Match +# Need to find these lines somewhere in the required file +sub test1\s*\(\$\); +sub test2\s*\(\$\$\); +sub test3\s*\(\$\$\$\); +sub testtesttesttest4_1\s*\(\$\); +sub testtesttesttest4_2\s*\(\$\$\); +sub test_a1\s*\(\$\)\s*:\s*locked\s*:\s*locked\s*; +sub test_a2\s*:\s*locked\s*; +## Tests +is (*MOD*::test1 (1), 'test 1'); +is (*MOD*::test2 (1,2), 'test 2'); +is (*MOD*::test3 (1,2,3), 'test 3'); +ok (!defined eval "*MOD*::test1 () eq 'test 1'" and $@ =~ /^Not enough arguments for *MOD*::test1/, "Check prototypes mismatch fails") or print "# \$\@='$@'"; +is (&*MOD*::testtesttesttest4_1, "test 4"); +is (&*MOD*::testtesttesttest4_2, "duplicate test 4"); +is (&Just::Another::test5, "another test 5"); +# very messy way to interpolate function into regexp, but it's going to be +# needed to get : for Mac filespecs +like (&*MOD*::test6, qr!^\Q*INC**PATHSEP**MOD*\E\.pm \(autosplit into \Q@{[File::Spec->catfile('*DIR*','*MOD*', 'test6.al')]}\E\):\d+$!); +ok (Yet::Another::AutoSplit->testtesttesttest4_1 eq "another test 4"); +################################################################ +## Name +missing use AutoLoader; +## File +1; +__END__ +## Get +## Files +# There should be no files. +################################################################ +## Name +missing use AutoLoader; (but don't skip) +## Extra +0, 0 +## File +1; +__END__ +## Get +AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) +## Require +*MOD*/autosplit.ix +## Files +*DIR*/*MOD*/autosplit.ix +################################################################ +## Name +Split prior to checking whether obsolete files get deleted +## File +use AutoLoader 'AUTOLOAD'; +1; +__END__ +sub obsolete {our $hidden_a; return $hidden_a++;} +sub gonner {warn "This gonner function should never get called"} +## Get +AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) +## Require +*MOD*/autosplit.ix +## Files +*DIR*/*MOD*/autosplit.ix +*DIR*/*MOD*/gonner.al +*DIR*/*MOD*/obsolete.al +## Tests +is (&*MOD*::obsolete, 0); +is (&*MOD*::obsolete, 1); +## Sleep +4 +## SameAgain +True, so don't scrub this directory. +IIRC DOS FAT filesystems have only 2 second granularity. +################################################################ +## Name +Check whether obsolete files get deleted +## File +use AutoLoader 'AUTOLOAD'; +1; +__END__ +sub skeleton {"bones"}; +sub ghost {"scream"}; # This definition gets overwritten with the one below +sub ghoul {"wail"}; +sub zombie {"You didn't use fire."}; +sub flying_pig {"Oink oink flap flap"}; +## Get +AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) +## Require +*MOD*/autosplit.ix +## Files +*DIR*/*MOD*/autosplit.ix +*DIR*/*MOD*/skeleton.al +*DIR*/*MOD*/zombie.al +*DIR*/*MOD*/ghost.al +*DIR*/*MOD*/ghoul.al +*DIR*/*MOD*/flying_pig.al +## Tests +is (&*MOD*::skeleton, "bones", "skeleton"); +eval {&*MOD*::gonner}; ok ($@ =~ m!^Can't locate auto/*MOD*/gonner.al in \@INC!, "Check &*MOD*::gonner is now a gonner") or print "# \$\@='$@'\n"; +## Sleep +4 +## SameAgain +True, so don't scrub this directory. +################################################################ +## Name +Check whether obsolete files remain when keep is 1 +## Extra +1, 1 +## File +use AutoLoader 'AUTOLOAD'; +1; +__END__ +sub ghost {"bump"}; +sub wraith {9}; +## Get +AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) +## Require +*MOD*/autosplit.ix +## Files +*DIR*/*MOD*/autosplit.ix +*DIR*/*MOD*/skeleton.al +*DIR*/*MOD*/zombie.al +*DIR*/*MOD*/ghost.al +*DIR*/*MOD*/ghoul.al +*DIR*/*MOD*/wraith.al +*DIR*/*MOD*/flying_pig.al +## Tests +is (&*MOD*::ghost, "bump"); +is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies undead?"); +## Sleep +4 +## SameAgain +True, so don't scrub this directory. +################################################################ +## Name +Without the timestamp check make sure that nothing happens +## Extra +0, 1, 1 +## Require +*MOD*/autosplit.ix +## Files +*DIR*/*MOD*/autosplit.ix +*DIR*/*MOD*/skeleton.al +*DIR*/*MOD*/zombie.al +*DIR*/*MOD*/ghost.al +*DIR*/*MOD*/ghoul.al +*DIR*/*MOD*/wraith.al +*DIR*/*MOD*/flying_pig.al +## Tests +is (&*MOD*::ghoul, "wail", "still haunted"); +is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies still undead?"); +## Sleep +4 +## SameAgain +True, so don't scrub this directory. +################################################################ +## Name +With the timestamp check make sure that things happen (stuff gets deleted) +## Extra +0, 1, 0 +## Get +AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) +## Require +*MOD*/autosplit.ix +## Files +*DIR*/*MOD*/autosplit.ix +*DIR*/*MOD*/ghost.al +*DIR*/*MOD*/wraith.al +## Tests +is (&*MOD*::wraith, 9); +eval {&*MOD*::flying_pig}; ok ($@ =~ m!^Can't locate auto/*MOD*/flying_pig.al in \@INC!, "There are no flying pigs") or print "# \$\@='$@'\n"; diff --git a/lib/.gitignore b/lib/.gitignore index ab6d831c00..f819bf5ebd 100644 --- a/lib/.gitignore +++ b/lib/.gitignore @@ -3,6 +3,8 @@ /Archive/Tar/Constant.pm /Archive/Tar/File.pm /Attribute +/AutoLoader.pm +/AutoSplit.pl /autodie /autodie.pm /autouse.pm diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm deleted file mode 100644 index 4ec7a3d474..0000000000 --- a/lib/AutoLoader.pm +++ /dev/null @@ -1,429 +0,0 @@ -package AutoLoader; - -use strict; -use 5.006_001; - -our($VERSION, $AUTOLOAD); - -my $is_dosish; -my $is_epoc; -my $is_vms; -my $is_macos; - -BEGIN { - $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare'; - $is_epoc = $^O eq 'epoc'; - $is_vms = $^O eq 'VMS'; - $is_macos = $^O eq 'MacOS'; - $VERSION = '5.69'; -} - -AUTOLOAD { - my $sub = $AUTOLOAD; - my $filename = AutoLoader::find_filename( $sub ); - - my $save = $@; - local $!; # Do not munge the value. - eval { local $SIG{__DIE__}; require $filename }; - if ($@) { - if (substr($sub,-9) eq '::DESTROY') { - no strict 'refs'; - *$sub = sub {}; - $@ = undef; - } elsif ($@ =~ /^Can't locate/) { - # The load might just have failed because the filename was too - # long for some old SVR3 systems which treat long names as errors. - # If we can successfully truncate a long name then it's worth a go. - # There is a slight risk that we could pick up the wrong file here - # but autosplit should have warned about that when splitting. - if ($filename =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){ - eval { local $SIG{__DIE__}; require $filename }; - } - } - if ($@){ - $@ =~ s/ at .*\n//; - my $error = $@; - require Carp; - Carp::croak($error); - } - } - $@ = $save; - goto &$sub; -} - -sub find_filename { - my $sub = shift; - my $filename; - # Braces used to preserve $1 et al. - { - # Try to find the autoloaded file from the package-qualified - # name of the sub. e.g., if the sub needed is - # Getopt::Long::GetOptions(), then $INC{Getopt/Long.pm} is - # something like '/usr/lib/perl5/Getopt/Long.pm', and the - # autoload file is '/usr/lib/perl5/auto/Getopt/Long/GetOptions.al'. - # - # However, if @INC is a relative path, this might not work. If, - # for example, @INC = ('lib'), then $INC{Getopt/Long.pm} is - # 'lib/Getopt/Long.pm', and we want to require - # 'auto/Getopt/Long/GetOptions.al' (without the leading 'lib'). - # In this case, we simple prepend the 'auto/' and let the - # C take care of the searching for us. - - my ($pkg,$func) = ($sub =~ /(.*)::([^:]+)$/); - $pkg =~ s#::#/#g; - if (defined($filename = $INC{"$pkg.pm"})) { - if ($is_macos) { - $pkg =~ tr#/#:#; - $filename = undef - unless $filename =~ s#^(.*)$pkg\.pm\z#$1auto:$pkg:$func.al#s; - } else { - $filename = undef - unless $filename =~ s#^(.*)$pkg\.pm\z#$1auto/$pkg/$func.al#s; - } - - # if the file exists, then make sure that it is a - # a fully anchored path (i.e either '/usr/lib/auto/foo/bar.al', - # or './lib/auto/foo/bar.al'. This avoids C searching - # (and failing) to find the 'lib/auto/foo/bar.al' because it - # looked for 'lib/lib/auto/foo/bar.al', given @INC = ('lib'). - - if (defined $filename and -r $filename) { - unless ($filename =~ m|^/|s) { - if ($is_dosish) { - unless ($filename =~ m{^([a-z]:)?[\\/]}is) { - if ($^O ne 'NetWare') { - $filename = "./$filename"; - } else { - $filename = "$filename"; - } - } - } - elsif ($is_epoc) { - unless ($filename =~ m{^([a-z?]:)?[\\/]}is) { - $filename = "./$filename"; - } - } - elsif ($is_vms) { - # XXX todo by VMSmiths - $filename = "./$filename"; - } - elsif (!$is_macos) { - $filename = "./$filename"; - } - } - } - else { - $filename = undef; - } - } - unless (defined $filename) { - # let C do the searching - $filename = "auto/$sub.al"; - $filename =~ s#::#/#g; - } - } - return $filename; -} - -sub import { - my $pkg = shift; - my $callpkg = caller; - - # - # Export symbols, but not by accident of inheritance. - # - - if ($pkg eq 'AutoLoader') { - if ( @_ and $_[0] =~ /^&?AUTOLOAD$/ ) { - no strict 'refs'; - *{ $callpkg . '::AUTOLOAD' } = \&AUTOLOAD; - } - } - - # - # Try to find the autosplit index file. Eg., if the call package - # is POSIX, then $INC{POSIX.pm} is something like - # '/usr/local/lib/perl5/POSIX.pm', and the autosplit index file is in - # '/usr/local/lib/perl5/auto/POSIX/autosplit.ix', so we require that. - # - # However, if @INC is a relative path, this might not work. If, - # for example, @INC = ('lib'), then - # $INC{POSIX.pm} is 'lib/POSIX.pm', and we want to require - # 'auto/POSIX/autosplit.ix' (without the leading 'lib'). - # - - (my $calldir = $callpkg) =~ s#::#/#g; - my $path = $INC{$calldir . '.pm'}; - if (defined($path)) { - # Try absolute path name, but only eval it if the - # transformation from module path to autosplit.ix path - # succeeded! - my $replaced_okay; - if ($is_macos) { - (my $malldir = $calldir) =~ tr#/#:#; - $replaced_okay = ($path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:autosplit.ix#s); - } else { - $replaced_okay = ($path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/autosplit.ix#); - } - - eval { require $path; } if $replaced_okay; - # If that failed, try relative path with normal @INC searching. - if (!$replaced_okay or $@) { - $path ="auto/$calldir/autosplit.ix"; - eval { require $path; }; - } - if ($@) { - my $error = $@; - require Carp; - Carp::carp($error); - } - } -} - -sub unimport { - my $callpkg = caller; - - no strict 'refs'; - - for my $exported (qw( AUTOLOAD )) { - my $symname = $callpkg . '::' . $exported; - undef *{ $symname } if \&{ $symname } == \&{ $exported }; - *{ $symname } = \&{ $symname }; - } -} - -1; - -__END__ - -=head1 NAME - -AutoLoader - load subroutines only on demand - -=head1 SYNOPSIS - - package Foo; - use AutoLoader 'AUTOLOAD'; # import the default AUTOLOAD subroutine - - package Bar; - use AutoLoader; # don't import AUTOLOAD, define our own - sub AUTOLOAD { - ... - $AutoLoader::AUTOLOAD = "..."; - goto &AutoLoader::AUTOLOAD; - } - -=head1 DESCRIPTION - -The B module works with the B module and the -C<__END__> token to defer the loading of some subroutines until they are -used rather than loading them all at once. - -To use B, the author of a module has to place the -definitions of subroutines to be autoloaded after an C<__END__> token. -(See L.) The B module can then be run manually to -extract the definitions into individual files F. - -B implements an AUTOLOAD subroutine. When an undefined -subroutine in is called in a client module of B, -B's AUTOLOAD subroutine attempts to locate the subroutine in a -file with a name related to the location of the file from which the -client module was read. As an example, if F is located in -F, B will look for perl -subroutines B in F, where -the C<.al> file has the same name as the subroutine, sans package. If -such a file exists, AUTOLOAD will read and evaluate it, -thus (presumably) defining the needed subroutine. AUTOLOAD will then -C the newly defined subroutine. - -Once this process completes for a given function, it is defined, so -future calls to the subroutine will bypass the AUTOLOAD mechanism. - -=head2 Subroutine Stubs - -In order for object method lookup and/or prototype checking to operate -correctly even when methods have not yet been defined it is necessary to -"forward declare" each subroutine (as in C). See -L. Such forward declaration creates "subroutine -stubs", which are place holders with no code. - -The AutoSplit and B modules automate the creation of forward -declarations. The AutoSplit module creates an 'index' file containing -forward declarations of all the AutoSplit subroutines. When the -AutoLoader module is 'use'd it loads these declarations into its callers -package. - -Because of this mechanism it is important that B is always -Cd and not Cd. - -=head2 Using B's AUTOLOAD Subroutine - -In order to use B's AUTOLOAD subroutine you I -explicitly import it: - - use AutoLoader 'AUTOLOAD'; - -=head2 Overriding B's AUTOLOAD Subroutine - -Some modules, mainly extensions, provide their own AUTOLOAD subroutines. -They typically need to check for some special cases (such as constants) -and then fallback to B's AUTOLOAD for the rest. - -Such modules should I import B's AUTOLOAD subroutine. -Instead, they should define their own AUTOLOAD subroutines along these -lines: - - use AutoLoader; - use Carp; - - sub AUTOLOAD { - my $sub = $AUTOLOAD; - (my $constname = $sub) =~ s/.*:://; - my $val = constant($constname, @_ ? $_[0] : 0); - if ($! != 0) { - if ($! =~ /Invalid/ || $!{EINVAL}) { - $AutoLoader::AUTOLOAD = $sub; - goto &AutoLoader::AUTOLOAD; - } - else { - croak "Your vendor has not defined constant $constname"; - } - } - *$sub = sub { $val }; # same as: eval "sub $sub { $val }"; - goto &$sub; - } - -If any module's own AUTOLOAD subroutine has no need to fallback to the -AutoLoader's AUTOLOAD subroutine (because it doesn't have any AutoSplit -subroutines), then that module should not use B at all. - -=head2 Package Lexicals - -Package lexicals declared with C in the main block of a package -using B will not be visible to auto-loaded subroutines, due to -the fact that the given scope ends at the C<__END__> marker. A module -using such variables as package globals will not work properly under the -B. - -The C pragma (see L) may be used in such -situations as an alternative to explicitly qualifying all globals with -the package namespace. Variables pre-declared with this pragma will be -visible to any autoloaded routines (but will not be invisible outside -the package, unfortunately). - -=head2 Not Using AutoLoader - -You can stop using AutoLoader by simply - - no AutoLoader; - -=head2 B vs. B - -The B is similar in purpose to B: both delay the -loading of subroutines. - -B uses the C<__DATA__> marker rather than C<__END__>. -While this avoids the use of a hierarchy of disk files and the -associated open/close for each routine loaded, B suffers a -startup speed disadvantage in the one-time parsing of the lines after -C<__DATA__>, after which routines are cached. B can also -handle multiple packages in a file. - -B only reads code as it is requested, and in many cases -should be faster, but requires a mechanism like B be used to -create the individual files. L will invoke -B automatically if B is used in a module source -file. - -=head1 CAVEATS - -AutoLoaders prior to Perl 5.002 had a slightly different interface. Any -old modules which use B should be changed to the new calling -style. Typically this just means changing a require to a use, adding -the explicit C<'AUTOLOAD'> import if needed, and removing B -from C<@ISA>. - -On systems with restrictions on file name length, the file corresponding -to a subroutine may have a shorter name that the routine itself. This -can lead to conflicting file names. The I package warns of -these potential conflicts when used to split a module. - -AutoLoader may fail to find the autosplit files (or even find the wrong -ones) in cases where C<@INC> contains relative paths, B the program -does C. - -=head1 SEE ALSO - -L - an autoloader that doesn't use external files. - -=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, 2007, 2008, 2009 - 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/lib/AutoLoader/t/01AutoLoader.t b/lib/AutoLoader/t/01AutoLoader.t deleted file mode 100644 index 09a1425b4b..0000000000 --- a/lib/AutoLoader/t/01AutoLoader.t +++ /dev/null @@ -1,222 +0,0 @@ -#!./perl -w - -BEGIN { - if ($ENV{PERL_CORE}) { - chdir 't' if -d 't'; - @INC = '../lib'; - } -} - -use strict; -use File::Spec; -use File::Path; - -my $dir; -BEGIN -{ - $dir = File::Spec->catdir( "auto-$$" ); - unshift @INC, $dir; -} - -use Test::More tests => 18; - -sub write_file { - my ($file, $text) = @_; - open my $fh, '>', $file - or die "Could not open file '$file' for writing: $!"; - print $fh $text; - close $fh; -} - -# First we must set up some autoloader files -my $fulldir = File::Spec->catdir( $dir, 'auto', 'Foo' ); -mkpath( $fulldir ) or die "Can't mkdir '$fulldir': $!"; - -write_file( File::Spec->catfile( $fulldir, 'foo.al' ), <<'EOT' ); -package Foo; -sub foo { shift; shift || "foo" } -1; -EOT - -write_file( File::Spec->catfile( $fulldir, 'bazmarkhian.al' ), <<'EOT' ); -package Foo; -sub bazmarkhianish { shift; shift || "baz" } -1; -EOT - -my $blechanawilla_text = <<'EOT'; -package Foo; -sub blechanawilla { compilation error ( -EOT -write_file( File::Spec->catfile( $fulldir, 'blechanawilla.al' ), $blechanawilla_text ); -# This is just to keep the old SVR3 systems happy; they may fail -# to find the above file so we duplicate it where they should find it. -write_file( File::Spec->catfile( $fulldir, 'blechanawil.al' ), $blechanawilla_text ); - -# Let's define the package -package Foo; -require AutoLoader; -AutoLoader->import( 'AUTOLOAD' ); - -sub new { bless {}, shift }; -sub foo; -sub bazmarkhianish; - -package main; - -my $foo = Foo->new(); - -my $result = $foo->can( 'foo' ); -ok( $result, 'can() first time' ); -is( $foo->foo, 'foo', 'autoloaded first time' ); -is( $foo->foo, 'foo', 'regular call' ); -is( $result, \&Foo::foo, 'can() returns ref to regular installed sub' ); - -eval { - $foo->will_fail; -}; -like( $@, qr/^Can't locate/, 'undefined method' ); - -$result = $foo->can( 'will_fail' ); -ok( ! $result, 'can() should fail on undefined methods' ); - -# Used to be trouble with this -eval { - my $foo = Foo->new(); - die "oops"; -}; -like( $@, qr/oops/, 'indirect method call' ); - -# Pass regular expression variable to autoloaded function. This used -# to go wrong because AutoLoader used regular expressions to generate -# autoloaded filename. -'foo' =~ /(\w+)/; - -is( $foo->bazmarkhianish($1), 'foo', 'autoloaded method should not stomp match vars' ); -is( $foo->bazmarkhianish($1), 'foo', '(again)' ); - -# Used to retry long subnames with shorter filenames on any old -# exception, including compilation error. Now AutoLoader only -# tries shorter filenames if it can't find the long one. -eval { - $foo->blechanawilla; -}; -like( $@, qr/syntax error/i, 'require error propagates' ); - -# test recursive autoloads -write_file( File::Spec->catfile( $fulldir, 'a.al' ), <<'EOT' ); -package Foo; -BEGIN { b() } -sub a { ::ok( 1, 'adding a new autoloaded method' ); } -1; -EOT -write_file( File::Spec->catfile( $fulldir, 'b.al' ), <<'EOT' ); -package Foo; -sub b { ::ok( 1, 'adding a new autoloaded method' ) } -1; -EOT - -Foo::a(); - -package Bar; -AutoLoader->import(); -::ok( ! defined &AUTOLOAD, 'AutoLoader should not export AUTOLOAD by default' ); -::ok( ! defined &can, '... nor can()' ); - -package Foo; -AutoLoader->unimport(); -eval { Foo->baz() }; -::like( $@, qr/locate object method "baz"/, - 'unimport() should remove imported AUTOLOAD()' ); - -package Baz; - -sub AUTOLOAD { 'i am here' } - -AutoLoader->import(); -AutoLoader->unimport(); - -::is( Baz->AUTOLOAD(), 'i am here', '... but not non-imported AUTOLOAD()' ); - - -package SomeClass; -use AutoLoader 'AUTOLOAD'; -sub new { - bless {} => shift; -} - -package main; - -$INC{"SomeClass.pm"} = $0; # Prepare possible recursion -{ - my $p = SomeClass->new(); -} # <-- deep recursion in AUTOLOAD looking for SomeClass::DESTROY? -::ok(1, "AutoLoader shouldn't loop forever if \%INC is modified"); - -# Now test the bug that lead to AutoLoader 0.67: -# If the module is loaded from a file name different than normal, -# we could formerly have trouble finding autosplit.ix -# Contributed by Christoph Lamprecht. -# Recreate the following file structure: -# auto/MyAddon/autosplit.ix -# auto/MyAddon/testsub.al -# MyModule.pm -SCOPE: { - my $autopath = File::Spec->catdir( $dir, 'auto', 'MyAddon' ); - mkpath( $autopath ) or die "Can't mkdir '$autopath': $!"; - my $autosplit_text = <<'EOT'; -# Index created by AutoSplit for MyModule.pm -# (file acts as timestamp) -package MyAddon; -sub testsub ; -1; -EOT - write_file( File::Spec->catfile( $autopath, 'autosplit.ix' ), $autosplit_text ); - - my $testsub_text = <<'EOT'; -# NOTE: Derived from MyModule.pm. -# Changes made here will be lost when autosplit is run again. -# See AutoSplit.pm. -package MyAddon; - -#line 13 "MyModule.pm (autosplit into auto/MyAddon/testsub.al)" -sub testsub{ - return "MyAddon"; -} - -1; -# end of MyAddon::testsub -EOT - write_file( File::Spec->catfile( $autopath, 'testsub.al' ), $testsub_text); - - my $mymodule_text = <<'EOT'; -use strict; -use warnings; -package MyModule; -sub testsub{return 'MyModule';} - -package MyAddon; -our @ISA = ('MyModule'); -BEGIN{$INC{'MyAddon.pm'} = __FILE__} -use AutoLoader 'AUTOLOAD'; -1; -__END__ - -sub testsub{ - return "MyAddon"; -} -EOT - write_file( File::Spec->catfile( $dir, 'MyModule.pm' ), $mymodule_text); - - require MyModule; - - my $res = MyAddon->testsub(); - ::is ($res , 'MyAddon', 'invoke MyAddon::testsub'); -} - -# cleanup -END { - return unless $dir && -d $dir; - rmtree $dir; -} - diff --git a/lib/AutoLoader/t/02AutoSplit.t b/lib/AutoLoader/t/02AutoSplit.t deleted file mode 100644 index c652562b30..0000000000 --- a/lib/AutoLoader/t/02AutoSplit.t +++ /dev/null @@ -1,442 +0,0 @@ -# AutoLoader.t runs before this test, so it seems safe to assume that it will -# work. - -my($incdir, $lib); -BEGIN { - chdir 't' if -d 't'; - if ($^O eq 'dos') { - print "1..0 # This test is not 8.3-aware.\n"; - exit 0; - } - if ($^O eq 'MacOS') { - $incdir = ":auto-$$"; - $lib = '-I::lib:'; - } else { - $incdir = "auto-$$"; - $lib = '"-I../lib"'; # ok on unix, nt, The extra \" are for VMS - } - unshift @INC, $incdir; - unshift @INC, '../lib'; -} -my $runperl = "$^X $lib"; - -use warnings; -use strict; -use Test::More tests => 58; -use File::Spec; -use File::Find; - -my $Is_VMS = $^O eq 'VMS'; -my $Is_VMS_mode = 0; -my $Is_VMS_lc = 0; - -if ($Is_VMS) { - require VMS::Filespec if $Is_VMS; - my $vms_unix_rpt; - my $vms_case; - - $Is_VMS_mode = 1; - $Is_VMS_lc = 1; - if (eval 'require VMS::Feature') { - $vms_unix_rpt = VMS::Feature::current("filename_unix_report"); - $vms_case = VMS::Feature::current("efs_case_preserve"); - } else { - my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; - my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || ''; - $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; - $vms_case = $efs_case =~ /^[ET1]/i; - } - $Is_VMS_lc = 0 if ($vms_case); - $Is_VMS_mode = 0 if ($vms_unix_rpt); -} - - -require AutoSplit; # Run time. Check it compiles. -ok (1, "AutoSplit loaded"); - -END { - use File::Path; - print "# $incdir being removed...\n"; - rmtree($incdir); -} - -mkdir $incdir,0755; - -my @tests; -{ - # local this else it buggers up the chomp() below. - # Hmm. Would be nice to have this as a regexp. - local $/ - = "################################################################\n"; - @tests = ; - close DATA; -} - -my $pathsep = $^O eq 'MSWin32' ? '\\' : $^O eq 'MacOS' ? ':' : '/'; -my $endpathsep = $^O eq 'MacOS' ? ':' : ''; - -sub split_a_file { - my $contents = shift; - my $file = $_[0]; - if (defined $contents) { - open FILE, ">$file" or die "Can't open $file: $!"; - print FILE $contents; - close FILE or die "Can't close $file: $!"; - } - - # Assumption: no characters in arguments need escaping from the shell or perl - my $com = qq($runperl -e "use AutoSplit; autosplit (qw(@_))"); - print "# command: $com\n"; - # There may be a way to capture STDOUT without spawning a child process, but - # it's probably worthwhile spawning, as it ensures that nothing in AutoSplit - # can load functions from split modules into this perl. - my $output = `$com`; - warn "Exit status $? from running: >>$com<<" if $?; - return $output; -} - -my $i = 0; -my $dir = File::Spec->catdir($incdir, 'auto'); -if ($Is_VMS_mode) { - $dir = VMS::Filespec::unixify($dir); - $dir =~ s/\/$//; -} elsif ($^O eq 'MacOS') { - $dir =~ s/:$//; -} - -foreach (@tests) { - my $module = 'A' . $i . '_' . $$ . 'splittest'; - my $file = File::Spec->catfile($incdir,"$module.pm"); - s/\*INC\*/$incdir/gm; - s/\*DIR\*/$dir/gm; - s/\*MOD\*/$module/gm; - s/\*PATHSEP\*/$pathsep/gm; - s/\*ENDPATHSEP\*/$endpathsep/gm; - s#//#/#gm; - # Build a hash for this test. - my %args = /^\#\#\ ([^\n]*)\n # Key is on a line starting ## - ((?:[^\#]+ # Any number of characters not # - | \#(?!\#) # or a # character not followed by # - | (?catfile ('auto', $args{Require}) . '"'; - $com =~ s{\\}{/}gm if ($^O eq 'MSWin32'); - eval $com; - # test n+3 - ok ($@ eq '', $com) or print "# \$\@ = '$@'\n"; - if (defined $body) { - eval $body or die $@; - } - } - # match tests to check for prototypes - if ($args{Match}) { - local $/; - my $file = File::Spec->catfile($dir, $args{Require}); - open IX, $file or die "Can't open '$file': $!"; - my $ix = ; - close IX or die "Can't close '$file': $!"; - foreach my $pat (split /\n/, $args{Match}) { - next if $pat =~ /^\#/; - like ($ix, qr/^\s*$pat\s*$/m, "match $pat"); - } - } - # code tests contain eval{}ed ok()s etc - if ($args{Tests}) { - foreach my $code (split /\n/, $args{Tests}) { - next if $code =~ /^\#/; - defined eval $code or fail(), print "# Code: $code\n# Error: $@"; - } - } - if (my $sleepfor = $args{Sleep}) { - # We need to sleep for a while - # Need the sleep hack else the next test is so fast that the timestamp - # compare routine in AutoSplit thinks that it shouldn't split the files. - my $time = time; - my $until = $time + $sleepfor; - my $attempts = 3; - do { - sleep ($sleepfor) - } while (time < $until && --$attempts > 0); - if ($attempts == 0) { - printf << "EOM", time; -# Attempted to sleep for $sleepfor second(s), started at $time, now %d. -# sleep attempt ppears to have failed; some tests may fail as a result. -EOM - } - } - unless ($args{SameAgain}) { - $i++; - rmtree($dir); - mkdir $dir, 0775; - } -} - -__DATA__ -## Name -tests from the end of the AutoSplit module. -## File -use AutoLoader 'AUTOLOAD'; -{package Just::Another; - use AutoLoader 'AUTOLOAD'; -} -@Yet::Another::AutoSplit::ISA = 'AutoLoader'; -1; -__END__ -sub test1 ($) { "test 1"; } -sub test2 ($$) { "test 2"; } -sub test3 ($$$) { "test 3"; } -sub testtesttesttest4_1 { "test 4"; } -sub testtesttesttest4_2 { "duplicate test 4"; } -sub Just::Another::test5 { "another test 5"; } -sub test6 { return join ":", __FILE__,__LINE__; } -package Yet::Another::AutoSplit; -sub testtesttesttest4_1 ($) { "another test 4"; } -sub testtesttesttest4_2 ($$) { "another duplicate test 4"; } -package Yet::More::Attributes; -sub test_a1 ($) : locked :locked { 1; } -sub test_a2 : locked { 1; } -# And that was all it has. You were expected to manually inspect the output -## Get -Warning: AutoSplit had to create top-level *DIR* unexpectedly. -AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) -*INC**PATHSEP**MOD*.pm: some names are not unique when truncated to 8 characters: - directory *DIR**PATHSEP**MOD**ENDPATHSEP*: - testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest - directory *DIR**PATHSEP*Yet*PATHSEP*Another*PATHSEP*AutoSplit*ENDPATHSEP*: - testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest -## Files -*DIR*/*MOD*/autosplit.ix -*DIR*/*MOD*/test1.al -*DIR*/*MOD*/test2.al -*DIR*/*MOD*/test3.al -*DIR*/*MOD*/testtesttesttest4_1.al -*DIR*/*MOD*/testtesttesttest4_2.al -*DIR*/Just/Another/test5.al -*DIR*/*MOD*/test6.al -*DIR*/Yet/Another/AutoSplit/testtesttesttest4_1.al -*DIR*/Yet/Another/AutoSplit/testtesttesttest4_2.al -*DIR*/Yet/More/Attributes/test_a1.al -*DIR*/Yet/More/Attributes/test_a2.al -## Require -*MOD*/autosplit.ix -## Match -# Need to find these lines somewhere in the required file -sub test1\s*\(\$\); -sub test2\s*\(\$\$\); -sub test3\s*\(\$\$\$\); -sub testtesttesttest4_1\s*\(\$\); -sub testtesttesttest4_2\s*\(\$\$\); -sub test_a1\s*\(\$\)\s*:\s*locked\s*:\s*locked\s*; -sub test_a2\s*:\s*locked\s*; -## Tests -is (*MOD*::test1 (1), 'test 1'); -is (*MOD*::test2 (1,2), 'test 2'); -is (*MOD*::test3 (1,2,3), 'test 3'); -ok (!defined eval "*MOD*::test1 () eq 'test 1'" and $@ =~ /^Not enough arguments for *MOD*::test1/, "Check prototypes mismatch fails") or print "# \$\@='$@'"; -is (&*MOD*::testtesttesttest4_1, "test 4"); -is (&*MOD*::testtesttesttest4_2, "duplicate test 4"); -is (&Just::Another::test5, "another test 5"); -# very messy way to interpolate function into regexp, but it's going to be -# needed to get : for Mac filespecs -like (&*MOD*::test6, qr!^\Q*INC**PATHSEP**MOD*\E\.pm \(autosplit into \Q@{[File::Spec->catfile('*DIR*','*MOD*', 'test6.al')]}\E\):\d+$!); -ok (Yet::Another::AutoSplit->testtesttesttest4_1 eq "another test 4"); -################################################################ -## Name -missing use AutoLoader; -## File -1; -__END__ -## Get -## Files -# There should be no files. -################################################################ -## Name -missing use AutoLoader; (but don't skip) -## Extra -0, 0 -## File -1; -__END__ -## Get -AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) -## Require -*MOD*/autosplit.ix -## Files -*DIR*/*MOD*/autosplit.ix -################################################################ -## Name -Split prior to checking whether obsolete files get deleted -## File -use AutoLoader 'AUTOLOAD'; -1; -__END__ -sub obsolete {our $hidden_a; return $hidden_a++;} -sub gonner {warn "This gonner function should never get called"} -## Get -AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) -## Require -*MOD*/autosplit.ix -## Files -*DIR*/*MOD*/autosplit.ix -*DIR*/*MOD*/gonner.al -*DIR*/*MOD*/obsolete.al -## Tests -is (&*MOD*::obsolete, 0); -is (&*MOD*::obsolete, 1); -## Sleep -4 -## SameAgain -True, so don't scrub this directory. -IIRC DOS FAT filesystems have only 2 second granularity. -################################################################ -## Name -Check whether obsolete files get deleted -## File -use AutoLoader 'AUTOLOAD'; -1; -__END__ -sub skeleton {"bones"}; -sub ghost {"scream"}; # This definition gets overwritten with the one below -sub ghoul {"wail"}; -sub zombie {"You didn't use fire."}; -sub flying_pig {"Oink oink flap flap"}; -## Get -AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) -## Require -*MOD*/autosplit.ix -## Files -*DIR*/*MOD*/autosplit.ix -*DIR*/*MOD*/skeleton.al -*DIR*/*MOD*/zombie.al -*DIR*/*MOD*/ghost.al -*DIR*/*MOD*/ghoul.al -*DIR*/*MOD*/flying_pig.al -## Tests -is (&*MOD*::skeleton, "bones", "skeleton"); -eval {&*MOD*::gonner}; ok ($@ =~ m!^Can't locate auto/*MOD*/gonner.al in \@INC!, "Check &*MOD*::gonner is now a gonner") or print "# \$\@='$@'\n"; -## Sleep -4 -## SameAgain -True, so don't scrub this directory. -################################################################ -## Name -Check whether obsolete files remain when keep is 1 -## Extra -1, 1 -## File -use AutoLoader 'AUTOLOAD'; -1; -__END__ -sub ghost {"bump"}; -sub wraith {9}; -## Get -AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) -## Require -*MOD*/autosplit.ix -## Files -*DIR*/*MOD*/autosplit.ix -*DIR*/*MOD*/skeleton.al -*DIR*/*MOD*/zombie.al -*DIR*/*MOD*/ghost.al -*DIR*/*MOD*/ghoul.al -*DIR*/*MOD*/wraith.al -*DIR*/*MOD*/flying_pig.al -## Tests -is (&*MOD*::ghost, "bump"); -is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies undead?"); -## Sleep -4 -## SameAgain -True, so don't scrub this directory. -################################################################ -## Name -Without the timestamp check make sure that nothing happens -## Extra -0, 1, 1 -## Require -*MOD*/autosplit.ix -## Files -*DIR*/*MOD*/autosplit.ix -*DIR*/*MOD*/skeleton.al -*DIR*/*MOD*/zombie.al -*DIR*/*MOD*/ghost.al -*DIR*/*MOD*/ghoul.al -*DIR*/*MOD*/wraith.al -*DIR*/*MOD*/flying_pig.al -## Tests -is (&*MOD*::ghoul, "wail", "still haunted"); -is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies still undead?"); -## Sleep -4 -## SameAgain -True, so don't scrub this directory. -################################################################ -## Name -With the timestamp check make sure that things happen (stuff gets deleted) -## Extra -0, 1, 0 -## Get -AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) -## Require -*MOD*/autosplit.ix -## Files -*DIR*/*MOD*/autosplit.ix -*DIR*/*MOD*/ghost.al -*DIR*/*MOD*/wraith.al -## Tests -is (&*MOD*::wraith, 9); -eval {&*MOD*::flying_pig}; ok ($@ =~ m!^Can't locate auto/*MOD*/flying_pig.al in \@INC!, "There are no flying pigs") or print "# \$\@='$@'\n"; diff --git a/lib/AutoSplit.pm b/lib/AutoSplit.pm deleted file mode 100644 index c093f2dd24..0000000000 --- a/lib/AutoSplit.pm +++ /dev/null @@ -1,592 +0,0 @@ -package AutoSplit; - -use Exporter (); -use Config qw(%Config); -use File::Basename (); -use File::Path qw(mkpath); -use File::Spec::Functions qw(curdir catfile catdir); -use strict; -our($VERSION, @ISA, @EXPORT, @EXPORT_OK, $Verbose, $Keep, $Maxlen, - $CheckForAutoloader, $CheckModTime); - -$VERSION = "1.06"; -@ISA = qw(Exporter); -@EXPORT = qw(&autosplit &autosplit_lib_modules); -@EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime); - -=head1 NAME - -AutoSplit - split a package for autoloading - -=head1 SYNOPSIS - - autosplit($file, $dir, $keep, $check, $modtime); - - autosplit_lib_modules(@modules); - -=head1 DESCRIPTION - -This function will split up your program into files that the AutoLoader -module can handle. It is used by both the standard perl libraries and by -the MakeMaker utility, to automatically configure libraries for autoloading. - -The C interface splits the specified file into a hierarchy -rooted at the directory C<$dir>. It creates directories as needed to reflect -class hierarchy, and creates the file F. This file acts as -both forward declaration of all package routines, and as timestamp for the -last update of the hierarchy. - -The remaining three arguments to C govern other options to -the autosplitter. - -=over 2 - -=item $keep - -If the third argument, I<$keep>, is false, then any -pre-existing C<*.al> files in the autoload directory are removed if -they are no longer part of the module (obsoleted functions). -$keep defaults to 0. - -=item $check - -The -fourth argument, I<$check>, instructs C to check the module -currently being split to ensure that it includes a C -specification for the AutoLoader module, and skips the module if -AutoLoader is not detected. -$check defaults to 1. - -=item $modtime - -Lastly, the I<$modtime> argument specifies -that C is to check the modification time of the module -against that of the C file, and only split the module if -it is newer. -$modtime defaults to 1. - -=back - -Typical use of AutoSplit in the perl MakeMaker utility is via the command-line -with: - - perl -e 'use AutoSplit; autosplit($ARGV[0], $ARGV[1], 0, 1, 1)' - -Defined as a Make macro, it is invoked with file and directory arguments; -C will split the specified file into the specified directory and -delete obsolete C<.al> files, after checking first that the module does use -the AutoLoader, and ensuring that the module is not already currently split -in its current form (the modtime test). - -The C form is used in the building of perl. It takes -as input a list of files (modules) that are assumed to reside in a directory -B relative to the current directory. Each file is sent to the -autosplitter one at a time, to be split into the directory B. - -In both usages of the autosplitter, only subroutines defined following the -perl I<__END__> token are split out into separate files. Some -routines may be placed prior to this marker to force their immediate loading -and parsing. - -=head2 Multiple packages - -As of version 1.01 of the AutoSplit module it is possible to have -multiple packages within a single file. Both of the following cases -are supported: - - package NAME; - __END__ - sub AAA { ... } - package NAME::option1; - sub BBB { ... } - package NAME::option2; - sub BBB { ... } - - package NAME; - __END__ - sub AAA { ... } - sub NAME::option1::BBB { ... } - sub NAME::option2::BBB { ... } - -=head1 DIAGNOSTICS - -C will inform the user if it is necessary to create the -top-level directory specified in the invocation. It is preferred that -the script or installation process that invokes C have -created the full directory path ahead of time. This warning may -indicate that the module is being split into an incorrect path. - -C will warn the user of all subroutines whose name causes -potential file naming conflicts on machines with drastically limited -(8 characters or less) file name length. Since the subroutine name is -used as the file name, these warnings can aid in portability to such -systems. - -Warnings are issued and the file skipped if C cannot locate -either the I<__END__> marker or a "package Name;"-style specification. - -C will also emit general diagnostics for inability to -create directories or files. - -=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, 2007, 2008 - 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 - -# for portability warn about names longer than $maxlen -$Maxlen = 8; # 8 for dos, 11 (14-".al") for SYSVR3 -$Verbose = 1; # 0=none, 1=minimal, 2=list .al files -$Keep = 0; -$CheckForAutoloader = 1; -$CheckModTime = 1; - -my $IndexFile = "autosplit.ix"; # file also serves as timestamp -my $maxflen = 255; -$maxflen = 14 if $Config{'d_flexfnam'} ne 'define'; -if (defined (&Dos::UseLFN)) { - $maxflen = Dos::UseLFN() ? 255 : 11; -} -my $Is_VMS = ($^O eq 'VMS'); - -# allow checking for valid ': attrlist' attachments. -# extra jugglery required to support both 5.8 and 5.9/5.10 features -# (support for 5.8 required for cross-compiling environments) - -my $attr_list = - $] >= 5.009005 ? - eval <<'__QR__' - qr{ - \s* : \s* - (?: - # one attribute - (?> # no backtrack - (?! \d) \w+ - (? \( (?: [^()]++ | (?&nested)++ )*+ \) ) ? - ) - (?: \s* : \s* | \s+ (?! :) ) - )* - }x -__QR__ - : - do { - # In pre-5.9.5 world we have to do dirty tricks. - # (we use 'our' rather than 'my' here, due to the rather complex and buggy - # behaviour of lexicals with qr// and (??{$lex}) ) - our $trick1; # yes, cannot our and assign at the same time. - $trick1 = qr{ \( (?: (?> [^()]+ ) | (??{ $trick1 }) )* \) }x; - our $trick2 = qr{ (?> (?! \d) \w+ (?:$trick1)? ) (?:\s*\:\s*|\s+(?!\:)) }x; - qr{ \s* : \s* (?: $trick2 )* }x; - }; - -sub autosplit{ - my($file, $autodir, $keep, $ckal, $ckmt) = @_; - # $file - the perl source file to be split (after __END__) - # $autodir - the ".../auto" dir below which to write split subs - # Handle optional flags: - $keep = $Keep unless defined $keep; - $ckal = $CheckForAutoloader unless defined $ckal; - $ckmt = $CheckModTime unless defined $ckmt; - autosplit_file($file, $autodir, $keep, $ckal, $ckmt); -} - -sub carp{ - require Carp; - goto &Carp::carp; -} - -# This function is used during perl building/installation -# ./miniperl -e 'use AutoSplit; autosplit_lib_modules(@ARGV)' ... - -sub autosplit_lib_modules { - my(@modules) = @_; # list of Module names - local $_; # Avoid clobber. - while (defined($_ = shift @modules)) { - while (m#([^:]+)::([^:].*)#) { # in case specified as ABC::XYZ - $_ = catfile($1, $2); - } - s|\\|/|g; # bug in ksh OS/2 - s#^lib/##s; # incase specified as lib/*.pm - my($lib) = catfile(curdir(), "lib"); - if ($Is_VMS) { # may need to convert VMS-style filespecs - $lib =~ s#^\[\]#.\/#; - } - s#^$lib\W+##s; # incase specified as ./lib/*.pm - if ($Is_VMS && /[:>\]]/) { # may need to convert VMS-style filespecs - my ($dir,$name) = (/(.*])(.*)/s); - $dir =~ s/.*lib[\.\]]//s; - $dir =~ s#[\.\]]#/#g; - $_ = $dir . $name; - } - autosplit_file(catfile($lib, $_), catfile($lib, "auto"), - $Keep, $CheckForAutoloader, $CheckModTime); - } - 0; -} - - -# private functions - -my $self_mod_time = (stat __FILE__)[9]; - -sub autosplit_file { - my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time) - = @_; - my(@outfiles); - local($_); - local($/) = "\n"; - - # where to write output files - $autodir ||= catfile(curdir(), "lib", "auto"); - if ($Is_VMS) { - ($autodir = VMS::Filespec::unixpath($autodir)) =~ s|/\z||; - $filename = VMS::Filespec::unixify($filename); # may have dirs - } - unless (-d $autodir){ - mkpath($autodir,0,0755); - # We should never need to create the auto dir - # here. installperl (or similar) should have done - # it. Expecting it to exist is a valuable sanity check against - # autosplitting into some random directory by mistake. - print "Warning: AutoSplit had to create top-level " . - "$autodir unexpectedly.\n"; - } - - # allow just a package name to be used - $filename .= ".pm" unless ($filename =~ m/\.pm\z/); - - open(my $in, "<$filename") or die "AutoSplit: Can't open $filename: $!\n"; - my($pm_mod_time) = (stat($filename))[9]; - my($autoloader_seen) = 0; - my($in_pod) = 0; - my($def_package,$last_package,$this_package,$fnr); - while (<$in>) { - # Skip pod text. - $fnr++; - $in_pod = 1 if /^=\w/; - $in_pod = 0 if /^=cut/; - next if ($in_pod || /^=cut/); - next if /^\s*#/; - - # record last package name seen - $def_package = $1 if (m/^\s*package\s+([\w:]+)\s*;/); - ++$autoloader_seen if m/^\s*(use|require)\s+AutoLoader\b/; - ++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/; - last if /^__END__/; - } - if ($check_for_autoloader && !$autoloader_seen){ - print "AutoSplit skipped $filename: no AutoLoader used\n" - if ($Verbose>=2); - return 0; - } - $_ or die "Can't find __END__ in $filename\n"; - - $def_package or die "Can't find 'package Name;' in $filename\n"; - - my($modpname) = _modpname($def_package); - - # this _has_ to match so we have a reasonable timestamp file - die "Package $def_package ($modpname.pm) does not ". - "match filename $filename" - unless ($filename =~ m/\Q$modpname.pm\E$/ or - ($^O eq 'dos') or ($^O eq 'MSWin32') or ($^O eq 'NetWare') or - $Is_VMS && $filename =~ m/$modpname.pm/i); - - my($al_idx_file) = catfile($autodir, $modpname, $IndexFile); - - if ($check_mod_time){ - my($al_ts_time) = (stat("$al_idx_file"))[9] || 1; - if ($al_ts_time >= $pm_mod_time and - $al_ts_time >= $self_mod_time){ - print "AutoSplit skipped ($al_idx_file newer than $filename)\n" - if ($Verbose >= 2); - return undef; # one undef, not a list - } - } - - my($modnamedir) = catdir($autodir, $modpname); - print "AutoSplitting $filename ($modnamedir)\n" - if $Verbose; - - unless (-d $modnamedir){ - mkpath($modnamedir,0,0777); - } - - # We must try to deal with some SVR3 systems with a limit of 14 - # characters for file names. Sadly we *cannot* simply truncate all - # file names to 14 characters on these systems because we *must* - # create filenames which exactly match the names used by AutoLoader.pm. - # This is a problem because some systems silently truncate the file - # names while others treat long file names as an error. - - my $Is83 = $maxflen==11; # plain, case INSENSITIVE dos filenames - - my(@subnames, $subname, %proto, %package); - my @cache = (); - my $caching = 1; - $last_package = ''; - my $out; - while (<$in>) { - $fnr++; - $in_pod = 1 if /^=\w/; - $in_pod = 0 if /^=cut/; - next if ($in_pod || /^=cut/); - # the following (tempting) old coding gives big troubles if a - # cut is forgotten at EOF: - # next if /^=\w/ .. /^=cut/; - if (/^package\s+([\w:]+)\s*;/) { - $this_package = $def_package = $1; - } - - if (/^sub\s+([\w:]+)(\s*(?:\(.*?\))?(?:$attr_list)?)/) { - print $out "# end of $last_package\::$subname\n1;\n" - if $last_package; - $subname = $1; - my $proto = $2 || ''; - if ($subname =~ s/(.*):://){ - $this_package = $1; - } else { - $this_package = $def_package; - } - my $fq_subname = "$this_package\::$subname"; - $package{$fq_subname} = $this_package; - $proto{$fq_subname} = $proto; - push(@subnames, $fq_subname); - my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3)); - $modpname = _modpname($this_package); - my($modnamedir) = catdir($autodir, $modpname); - mkpath($modnamedir,0,0777); - my($lpath) = catfile($modnamedir, "$lname.al"); - my($spath) = catfile($modnamedir, "$sname.al"); - my $path; - - if (!$Is83 and open($out, ">$lpath")){ - $path=$lpath; - print " writing $lpath\n" if ($Verbose>=2); - } else { - open($out, ">$spath") or die "Can't create $spath: $!\n"; - $path=$spath; - print " writing $spath (with truncated name)\n" - if ($Verbose>=1); - } - push(@outfiles, $path); - my $lineno = $fnr - @cache; - print $out < lc($_) } @outfiles; - } else { - @outfiles{@outfiles} = @outfiles; - } - my(%outdirs,@outdirs); - for (@outfiles) { - $outdirs{File::Basename::dirname($_)}||=1; - } - for my $dir (keys %outdirs) { - opendir(my $outdir,$dir); - foreach (sort readdir($outdir)){ - next unless /\.al\z/; - my($file) = catfile($dir, $_); - $file = lc $file if $Is83 or $Is_VMS; - next if $outfiles{$file}; - print " deleting $file\n" if ($Verbose>=2); - my($deleted,$thistime); # catch all versions on VMS - do { $deleted += ($thistime = unlink $file) } while ($thistime); - carp ("Unable to delete $file: $!") unless $deleted; - } - closedir($outdir); - } - } - - open(my $ts,">$al_idx_file") or - carp ("AutoSplit: unable to create timestamp file ($al_idx_file): $!"); - print $ts "# Index created by AutoSplit for $filename\n"; - print $ts "# (file acts as timestamp)\n"; - $last_package = ''; - for my $fqs (@subnames) { - my($subname) = $fqs; - $subname =~ s/.*:://; - print $ts "package $package{$fqs};\n" - unless $last_package eq $package{$fqs}; - print $ts "sub $subname $proto{$fqs};\n"; - $last_package = $package{$fqs}; - } - print $ts "1;\n"; - close($ts); - - _check_unique($filename, $Maxlen, 1, @outfiles); - - @outfiles; -} - -sub _modpname ($) { - my($package) = @_; - my $modpname = $package; - if ($^O eq 'MSWin32') { - $modpname =~ s#::#\\#g; - } else { - my @modpnames = (); - while ($modpname =~ m#(.*?[^:])::([^:].*)#) { - push @modpnames, $1; - $modpname = $2; - } - $modpname = catfile(@modpnames, $modpname); - } - if ($Is_VMS) { - $modpname = VMS::Filespec::unixify($modpname); # may have dirs - } - $modpname; -} - -sub _check_unique { - my($filename, $maxlen, $warn, @outfiles) = @_; - my(%notuniq) = (); - my(%shorts) = (); - my(@toolong) = grep( - length(File::Basename::basename($_)) - > $maxlen, - @outfiles - ); - - foreach (@toolong){ - my($dir) = File::Basename::dirname($_); - my($file) = File::Basename::basename($_); - my($trunc) = substr($file,0,$maxlen); - $notuniq{$dir}{$trunc} = 1 if $shorts{$dir}{$trunc}; - $shorts{$dir}{$trunc} = $shorts{$dir}{$trunc} ? - "$shorts{$dir}{$trunc}, $file" : $file; - } - if (%notuniq && $warn){ - print "$filename: some names are not unique when " . - "truncated to $maxlen characters:\n"; - foreach my $dir (sort keys %notuniq){ - print " directory $dir:\n"; - foreach my $trunc (sort keys %{$notuniq{$dir}}) { - print " $shorts{$dir}{$trunc} truncate to $trunc\n"; - } - } - } -} - -1; -__END__ - -# test functions so AutoSplit.pm can be applied to itself: -sub test1 ($) { "test 1\n"; } -sub test2 ($$) { "test 2\n"; } -sub test3 ($$$) { "test 3\n"; } -sub testtesttesttest4_1 { "test 4\n"; } -sub testtesttesttest4_2 { "duplicate test 4\n"; } -sub Just::Another::test5 { "another test 5\n"; } -sub test6 { return join ":", __FILE__,__LINE__; } -package Yet::Another::AutoSplit; -sub testtesttesttest4_1 ($) { "another test 4\n"; } -sub testtesttesttest4_2 ($$) { "another duplicate test 4\n"; } -package Yet::More::Attributes; -sub test_a1 ($) : locked :locked { 1; } -sub test_a2 : locked { 1; } diff --git a/make_ext.pl b/make_ext.pl index f88c208046..795b7e5918 100644 --- a/make_ext.pl +++ b/make_ext.pl @@ -14,7 +14,7 @@ use Cwd; my @toolchain = qw(ext/constant/lib ext/ExtUtils-Command/lib ext/ExtUtils-Install/lib ext/ExtUtils-MakeMaker/lib ext/ExtUtils-Manifest/lib ext/Text-ParseWords/lib - ext/File-Path/lib); + ext/File-Path/lib ext/AutoLoader/lib); # This script acts as a simple interface for building extensions. -- cgit v1.2.1