Skip to content

Commit

Permalink
Merge branch 'master' of github.com:agentzh/nginx-eval-module
Browse files Browse the repository at this point in the history
  • Loading branch information
@agentzh
agentzh committed Nov 7, 2010
2 parents 64bf7b0 + 5592b71 commit 69f260f
Show file tree
Hide file tree
Showing 20 changed files with 1,155 additions and 1,106 deletions.
19 changes: 17 additions & 2 deletions test/inc/Module/AutoInstall.pm
View file
Expand Up @@ -253,6 +253,8 @@ sub import {
# import to main::
no strict 'refs';
*{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';

return (@Existing, @Missing);
}

sub _running_under {
Expand Down Expand Up @@ -672,7 +674,20 @@ sub _load {
sub _load_cpan {
return if $CPAN::VERSION and $CPAN::Config and not @_;
require CPAN;
if ( $CPAN::HandleConfig::VERSION ) {

# CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to
# CPAN::HandleConfig->load. CPAN reports that the redirection
# is deprecated in a warning printed at the user.

# CPAN-1.81 expects CPAN::HandleConfig->load, does not have
# $CPAN::HandleConfig::VERSION but cannot handle
# CPAN::Config->load

# Which "versions expect CPAN::Config->load?

if ( $CPAN::HandleConfig::VERSION
|| CPAN::HandleConfig->can('load')
) {
# Newer versions of CPAN have a HandleConfig module
CPAN::HandleConfig->load;
} else {
Expand Down Expand Up @@ -802,4 +817,4 @@ END_MAKE

__END__
#line 1056
#line 1071
214 changes: 125 additions & 89 deletions test/inc/Module/Install.pm
View file
Expand Up @@ -19,6 +19,9 @@ package Module::Install;

use 5.005;
use strict 'vars';
use Cwd ();
use File::Find ();
use File::Path ();

use vars qw{$VERSION $MAIN};
BEGIN {
Expand All @@ -28,7 +31,7 @@ BEGIN {
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
$VERSION = '0.91';
$VERSION = '0.99';

# Storage for the pseudo-singleton
$MAIN = undef;
Expand All @@ -38,18 +41,25 @@ BEGIN {

}

sub import {
my $class = shift;
my $self = $class->new(@_);
my $who = $self->_caller;




# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) { die <<"END_DIE" }
#-------------------------------------------------------------
# all of the following checks should be included in import(),
# to allow "eval 'require Module::Install; 1' to test
# installation of Module::Install. (RT #51267)
#-------------------------------------------------------------

# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) { die <<"END_DIE" }
Please invoke ${\__PACKAGE__} with:
Expand All @@ -61,26 +71,28 @@ not:
END_DIE





# If the script that is loading Module::Install is from the future,
# then make will detect this and cause it to re-run over and over
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
# for now we should catch this and refuse to run.
if ( -f $0 ) {
my $s = (stat($0))[9];

# If the modification time is only slightly in the future,
# sleep briefly to remove the problem.
my $a = $s - time;
if ( $a > 0 and $a < 5 ) { sleep 5 }

# Too far in the future, throw an error.
my $t = time;
if ( $s > $t ) { die <<"END_DIE" }
# This reportedly fixes a rare Win32 UTC file time issue, but
# as this is a non-cross-platform XS module not in the core,
# we shouldn't really depend on it. See RT #24194 for detail.
# (Also, this module only supports Perl 5.6 and above).
eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;

# If the script that is loading Module::Install is from the future,
# then make will detect this and cause it to re-run over and over
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
# for now we should catch this and refuse to run.
if ( -f $0 ) {
my $s = (stat($0))[9];

# If the modification time is only slightly in the future,
# sleep briefly to remove the problem.
my $a = $s - time;
if ( $a > 0 and $a < 5 ) { sleep 5 }

# Too far in the future, throw an error.
my $t = time;
if ( $s > $t ) { die <<"END_DIE" }
Your installer $0 has a modification time in the future ($s > $t).
Expand All @@ -89,15 +101,12 @@ This is known to create infinite loops in make.
Please correct this, then run $0 again.
END_DIE
}



}


# Build.PL was formerly supported, but no longer is due to excessive
# difficulty in implementing every single feature twice.
if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
# Build.PL was formerly supported, but no longer is due to excessive
# difficulty in implementing every single feature twice.
if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
Module::Install no longer supports Build.PL.
Expand All @@ -107,23 +116,42 @@ Please remove all Build.PL files and only use the Makefile.PL installer.
END_DIE

#-------------------------------------------------------------

# To save some more typing in Module::Install installers, every...
# use inc::Module::Install
# ...also acts as an implicit use strict.
$^H |= strict::bits(qw(refs subs vars));

#-------------------------------------------------------------

unless ( -f $self->{file} ) {
foreach my $key (keys %INC) {
delete $INC{$key} if $key =~ /Module\/Install/;
}

# To save some more typing in Module::Install installers, every...
# use inc::Module::Install
# ...also acts as an implicit use strict.
$^H |= strict::bits(qw(refs subs vars));

local $^W;
require "$self->{path}/$self->{dispatch}.pm";
File::Path::mkpath("$self->{prefix}/$self->{author}");
$self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
$self->{admin}->init;
@_ = ($class, _self => $self);
goto &{"$self->{name}::import"};
}

local $^W;
*{"${who}::AUTOLOAD"} = $self->autoload;
$self->preload;

# Unregister loader and worker packages so subdirs can use them again
delete $INC{'inc/Module/Install.pm'};
delete $INC{'Module/Install.pm'};

# Save to the singleton
$MAIN = $self;

use Cwd ();
use File::Find ();
use File::Path ();
use FindBin;
return 1;
}

sub autoload {
my $self = shift;
Expand All @@ -136,7 +164,21 @@ sub autoload {
# Delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
}
$$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
unless ($$sym =~ s/([^:]+)$//) {
# XXX: it looks like we can't retrieve the missing function
# via $$sym (usually $main::AUTOLOAD) in this case.
# I'm still wondering if we should slurp Makefile.PL to
# get some context or not ...
my ($package, $file, $line) = caller;
die <<"EOT";
Unknown function is found at $file line $line.
Execution of $file aborted due to runtime errors.
If you're a contributor to a project, you may need to install
some Module::Install extensions from CPAN (or other repository).
If you're a user of a module, please contact the author.
EOT
}
my $method = $1;
if ( uc($method) eq $method ) {
# Do nothing
Expand All @@ -152,33 +194,6 @@ sub autoload {
};
}

sub import {
my $class = shift;
my $self = $class->new(@_);
my $who = $self->_caller;

unless ( -f $self->{file} ) {
require "$self->{path}/$self->{dispatch}.pm";
File::Path::mkpath("$self->{prefix}/$self->{author}");
$self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
$self->{admin}->init;
@_ = ($class, _self => $self);
goto &{"$self->{name}::import"};
}

*{"${who}::AUTOLOAD"} = $self->autoload;
$self->preload;

# Unregister loader and worker packages so subdirs can use them again
delete $INC{"$self->{file}"};
delete $INC{"$self->{path}.pm"};

# Save to the singleton
$MAIN = $self;

return 1;
}

sub preload {
my $self = shift;
unless ( $self->{extensions} ) {
Expand All @@ -204,6 +219,7 @@ sub preload {

my $who = $self->_caller;
foreach my $name ( sort keys %seen ) {
local $^W;
*{"${who}::$name"} = sub {
${"${who}::AUTOLOAD"} = "${who}::$name";
goto &{"${who}::AUTOLOAD"};
Expand All @@ -214,12 +230,14 @@ sub preload {
sub new {
my ($class, %args) = @_;

delete $INC{'FindBin.pm'};
require FindBin;

# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
delete $args{prefix};
}

return $args{_self} if $args{_self};

$args{dispatch} ||= 'Admin';
Expand Down Expand Up @@ -272,21 +290,24 @@ END_DIE
sub load_extensions {
my ($self, $path, $top) = @_;

my $should_reload = 0;
unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
unshift @INC, $self->{prefix};
$should_reload = 1;
}

foreach my $rv ( $self->find_extensions($path) ) {
my ($file, $pkg) = @{$rv};
next if $self->{pathnames}{$pkg};

local $@;
my $new = eval { require $file; $pkg->can('new') };
my $new = eval { local $^W; require $file; $pkg->can('new') };
unless ( $new ) {
warn $@ if $@;
next;
}
$self->{pathnames}{$pkg} = delete $INC{$file};
$self->{pathnames}{$pkg} =
$should_reload ? delete $INC{$file} : $INC{$file};
push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
}

Expand Down Expand Up @@ -348,17 +369,24 @@ sub _caller {
return $call;
}

# Done in evals to avoid confusing Perl::MinimumVersion
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _read {
local *FH;
if ( $] >= 5.006 ) {
open( FH, '<', $_[0] ) or die "open($_[0]): $!";
} else {
open( FH, "< $_[0]" ) or die "open($_[0]): $!";
}
open( FH, '<', $_[0] ) or die "open($_[0]): $!";
my $string = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $string;
}
END_NEW
sub _read {
local *FH;
open( FH, "< $_[0]" ) or die "open($_[0]): $!";
my $string = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $string;
}
END_OLD

sub _readperl {
my $string = Module::Install::_read($_[0]);
Expand All @@ -379,18 +407,26 @@ sub _readpod {
return $string;
}

# Done in evals to avoid confusing Perl::MinimumVersion
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _write {
local *FH;
if ( $] >= 5.006 ) {
open( FH, '>', $_[0] ) or die "open($_[0]): $!";
} else {
open( FH, "> $_[0]" ) or die "open($_[0]): $!";
open( FH, '>', $_[0] ) or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
END_NEW
sub _write {
local *FH;
open( FH, "> $_[0]" ) or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
END_OLD

# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
Expand Down Expand Up @@ -427,4 +463,4 @@ sub _CLASS ($) {

1;

# Copyright 2008 - 2009 Adam Kennedy.
# Copyright 2008 - 2010 Adam Kennedy.

0 comments on commit 69f260f

Please sign in to comment.