Skip to content
GitLab
Commit 490c58f7 authored by Ruslan Zakirov's avatar Ruslan Zakirov
Browse files

update M::I

parent d47b88ca
Hide whitespace changes
Inline Side-by-side
META.yml
View file @ 490c58f7
......@@ -8,7 +8,7 @@ build_requires:
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
generated_by: 'Module::Install version 0.85'
generated_by: 'Module::Install version 1.01'
license: gpl2
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
......
inc/Module/AutoInstall.pm
View file @ 490c58f7
......@@ -18,7 +18,9 @@ my %FeatureMap = (
# various lexical flags
my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS );
my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly );
my (
$Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps
);
my ( $PostambleActions, $PostambleUsed );
# See if it's a testing or non-interactive session
......@@ -73,6 +75,9 @@ sub _init {
elsif ( $arg =~ /^--test(?:only)?$/ ) {
$TestOnly = 1;
}
elsif ( $arg =~ /^--all(?:deps)?$/ ) {
$AllDeps = 1;
}
}
}
......@@ -115,7 +120,12 @@ sub import {
)[0]
);
$UnderCPAN = _check_lock(1); # check for $UnderCPAN
# We want to know if we're under CPAN early to avoid prompting, but
# if we aren't going to try and install anything anyway then skip the
# check entirely since we don't want to have to load (and configure)
# an old CPAN just for a cosmetic message
$UnderCPAN = _check_lock(1) unless $SkipInstall;
while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
my ( @required, @tests, @skiptests );
......@@ -165,15 +175,24 @@ sub import {
}
# XXX: check for conflicts and uninstalls(!) them.
if (
defined( my $cur = _version_check( _load($mod), $arg ||= 0 ) ) )
my $cur = _load($mod);
if (_version_cmp ($cur, $arg) >= 0)
{
print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
push @Existing, $mod => $arg;
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
else {
print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
if (not defined $cur) # indeed missing
{
print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
}
else
{
# no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above
print "too old. ($cur < $arg)\n";
}
push @required, $mod => $arg;
}
}
......@@ -187,6 +206,7 @@ sub import {
and (
$CheckOnly
or ($mandatory and $UnderCPAN)
or $AllDeps
or _prompt(
qq{==> Auto-install the }
. ( @required / 2 )
......@@ -233,6 +253,17 @@ sub import {
# import to main::
no strict 'refs';
*{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
return (@Existing, @Missing);
}
sub _running_under {
my $thing = shift;
print <<"END_MESSAGE";
*** Since we're running under ${thing}, I'll just let it take care
of the dependency's installation later.
END_MESSAGE
return 1;
}
# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
......@@ -240,16 +271,24 @@ sub import {
sub _check_lock {
return unless @Missing or @_;
my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
print <<'END_MESSAGE';
return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS');
}
*** Since we're running under CPANPLUS, I'll just let it take care
of the dependency's installation later.
END_MESSAGE
return 1;
require CPAN;
if ($CPAN::VERSION > '1.89') {
if ($cpan_env) {
return _running_under('CPAN');
}
return; # CPAN.pm new enough, don't need to check further
}
_load_cpan();
# last ditch attempt, this -will- configure CPAN, very sorry
_load_cpan(1); # force initialize even though it's already loaded
# Find the CPAN lock-file
my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
......@@ -285,7 +324,7 @@ sub install {
while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
# grep out those already installed
if ( defined( _version_check( _load($pkg), $ver ) ) ) {
if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
push @installed, $pkg;
}
else {
......@@ -324,7 +363,7 @@ sub install {
# see if we have successfully installed them
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
if ( defined( _version_check( _load($pkg), $ver ) ) ) {
if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
push @installed, $pkg;
}
elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
......@@ -379,7 +418,7 @@ sub _install_cpanplus {
my $success;
my $obj = $modtree->{$pkg};
if ( $obj and defined( _version_check( $obj->{version}, $ver ) ) ) {
if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) {
my $pathname = $pkg;
$pathname =~ s/::/\\W/;
......@@ -472,7 +511,7 @@ sub _install_cpan {
my $obj = CPAN::Shell->expand( Module => $pkg );
my $success = 0;
if ( $obj and defined( _version_check( $obj->cpan_version, $ver ) ) ) {
if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) {
my $pathname = $pkg;
$pathname =~ s/::/\\W/;
......@@ -536,7 +575,7 @@ sub _update_to {
my $ver = shift;
return
if defined( _version_check( _load($class), $ver ) ); # no need to upgrade
if _version_cmp( _load($class), $ver ) >= 0; # no need to upgrade
if (
_prompt( "==> A newer version of $class ($ver) is required. Install?",
......@@ -633,9 +672,22 @@ sub _load {
# Load CPAN.pm and it's configuration
sub _load_cpan {
return if $CPAN::VERSION;
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 {
......@@ -645,9 +697,11 @@ sub _load_cpan {
}
# compare two versions, either use Sort::Versions or plain comparison
sub _version_check {
# return values same as <=>
sub _version_cmp {
my ( $cur, $min ) = @_;
return unless defined $cur;
return -1 unless defined $cur; # if 0 keep comparing
return 1 unless $min;
$cur =~ s/\s+$//;
......@@ -658,16 +712,13 @@ sub _version_check {
) {
# use version.pm if it is installed.
return (
( version->new($cur) >= version->new($min) ) ? $cur : undef );
return version->new($cur) <=> version->new($min);
}
elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
{
# use Sort::Versions as the sorting algorithm for a.b.c versions
return ( ( Sort::Versions::versioncmp( $cur, $min ) != -1 )
? $cur
: undef );
return Sort::Versions::versioncmp( $cur, $min );
}
warn "Cannot reliably compare non-decimal formatted versions.\n"
......@@ -676,7 +727,7 @@ sub _version_check {
# plain comparison
local $^W = 0; # shuts off 'not numeric' bugs
return ( $cur >= $min ? $cur : undef );
return $cur <=> $min;
}
# nothing; this usage is deprecated.
......@@ -766,4 +817,4 @@ END_MAKE
__END__
#line 1004
#line 1071
inc/Module/Install.pm
View file @ 490c58f7
......@@ -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 {
......@@ -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.85';
$VERSION = '1.01';
# Storage for the pseudo-singleton
$MAIN = undef;
......@@ -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:
......@@ -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).
......@@ -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.
......@@ -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;
......@@ -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
......@@ -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} ) {
......@@ -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"};
......@@ -214,12 +230,18 @@ sub preload {
sub new {
my ($class, %args) = @_;
delete $INC{'FindBin.pm'};
{
# to suppress the redefine warning
local $SIG{__WARN__} = sub {};
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';
......@@ -272,8 +294,10 @@ 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) ) {
......@@ -281,12 +305,13 @@ sub load_extensions {
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 );
}
......@@ -348,17 +373,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]);
......@@ -379,18 +411,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).
......@@ -427,4 +467,4 @@ sub _CLASS ($) {
1;
# Copyright 2008 - 2009 Adam Kennedy.
# Copyright 2008 - 2011 Adam Kennedy.
inc/Module/Install/AutoInstall.pm
View file @ 490c58f7
......@@ -2,13 +2,13 @@
package Module::Install::AutoInstall;
use strict;
use Module::Install::Base;
use Module::Install::Base ();
use vars qw{$VERSION $ISCORE @ISA};
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '0.85';
$VERSION = '1.01';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
sub AutoInstall { $_[0] }
......@@ -37,12 +37,33 @@ sub auto_install {
$self->include('Module::AutoInstall');
require Module::AutoInstall;
Module::AutoInstall->import(
my @features_require = Module::AutoInstall->import(
(@config ? (-config => \@config) : ()),
(@core ? (-core => \@core) : ()),
$self->features,
);
my %seen;
my @requires = map @$_, map @$_, grep ref, $self->requires;
while (my ($mod, $ver) = splice(@requires, 0, 2)) {
$seen{$mod}{$ver}++;
}
my @build_requires = map @$_, map @$_, grep ref, $self->build_requires;