Skip to content
GitLab
Commit d127842c authored by Kevin Falcone's avatar Kevin Falcone
Browse files

upgrade Module::Install

parent 44838161
Hide whitespace changes
Inline Side-by-side
inc/Module/AutoInstall.pm
View file @ d127842c
......@@ -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,6 +120,13 @@ sub import {
)[0]
);
# 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 );
my $default = 1;
......@@ -163,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;
}
}
......@@ -184,6 +205,8 @@ sub import {
!$SkipInstall
and (
$CheckOnly
or ($mandatory and $UnderCPAN)
or $AllDeps
or _prompt(
qq{==> Auto-install the }
. ( @required / 2 )
......@@ -214,8 +237,6 @@ sub import {
}
}
$UnderCPAN = _check_lock(); # check for $UnderCPAN
if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) {
require Config;
print
......@@ -234,21 +255,38 @@ sub import {
*{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
}
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;
# if we are, then we simply let it taking care of our dependencies
sub _check_lock {
return unless @Missing;
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" );
......@@ -284,7 +322,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 {
......@@ -313,7 +351,7 @@ sub install {
@modules = @newmod;
}
if ( _has_cpanplus() ) {
if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) {
_install_cpanplus( \@modules, \@config );
} else {
_install_cpan( \@modules, \@config );
......@@ -323,7 +361,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' ) ) {
......@@ -378,7 +416,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/;
......@@ -471,7 +509,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/;
......@@ -535,7 +573,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?",
......@@ -632,7 +670,7 @@ 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 ) {
# Newer versions of CPAN have a HandleConfig module
......@@ -644,9 +682,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+$//;
......@@ -657,16 +697,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"
......@@ -675,7 +712,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.
......@@ -706,7 +743,7 @@ sub _make_args {
if $Config;
$PostambleActions = (
$missing
($missing and not $UnderCPAN)
? "\$(PERL) $0 --config=$config --installdeps=$missing"
: "\$(NOECHO) \$(NOOP)"
);
......@@ -746,7 +783,7 @@ sub Write {
sub postamble {
$PostambleUsed = 1;
return << ".";
return <<"END_MAKE";
config :: installdeps
\t\$(NOECHO) \$(NOOP)
......@@ -757,7 +794,7 @@ checkdeps ::
installdeps ::
\t$PostambleActions
.
END_MAKE
}
......@@ -765,4 +802,4 @@ installdeps ::
__END__
#line 1003
#line 1056
inc/Module/Install.pm
View file @ d127842c
......@@ -17,12 +17,10 @@ package Module::Install;
# 3. The ./inc/ version of Module::Install loads
# }
BEGIN {
require 5.004;
}
use 5.005;
use strict 'vars';
use vars qw{$VERSION};
use vars qw{$VERSION $MAIN};
BEGIN {
# All Module::Install core packages now require synchronised versions.
# This will be used to ensure we don't accidentally load old or
......@@ -30,7 +28,14 @@ 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.70';
$VERSION = '0.91';
# Storage for the pseudo-singleton
$MAIN = undef;
*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA = __PACKAGE__;
}
......@@ -65,15 +70,26 @@ END_DIE
# 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 and (stat($0))[9] > time ) { die <<"END_DIE" }
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 }
Your installer $0 has a modification time in the future.
# 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).
This is known to create infinite loops in make.
Please correct this, then run $0 again.
END_DIE
}
......@@ -81,7 +97,7 @@ 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 or -f 'Build.PL' ) { die <<"END_DIE" }
if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
Module::Install no longer supports Build.PL.
......@@ -95,14 +111,20 @@ 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));
use Cwd ();
use File::Find ();
use File::Path ();
use FindBin;
*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA = __PACKAGE__;
sub autoload {
my $self = shift;
my $who = $self->_caller;
......@@ -111,12 +133,22 @@ sub autoload {
$sym->{$cwd} = sub {
my $pwd = Cwd::cwd();
if ( my $code = $sym->{$pwd} ) {
# delegate back to parent dirs
# Delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
}
$$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
my $method = $1;
if ( uc($method) eq $method ) {
# Do nothing
return;
} elsif ( $method =~ /^_/ and $self->can($method) ) {
# Dispatch to the root M:I class
return $self->$method(@_);
}
# Dispatch to the appropriate plugin
unshift @_, ( $self, $1 );
goto &{$self->can('call')} unless uc($1) eq $1;
goto &{$self->can('call')};
};
}
......@@ -141,12 +173,14 @@ sub import {
delete $INC{"$self->{file}"};
delete $INC{"$self->{path}.pm"};
# Save to the singleton
$MAIN = $self;
return 1;
}
sub preload {
my ($self) = @_;
my $self = shift;
unless ( $self->{extensions} ) {
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
......@@ -155,8 +189,7 @@ sub preload {
my @exts = @{$self->{extensions}};
unless ( @exts ) {
my $admin = $self->{admin};
@exts = $admin->load_all_extensions;
@exts = $self->{admin}->load_all_extensions;
}
my %seen;
......@@ -202,6 +235,7 @@ sub new {
$args{path} =~ s!::!/!g;
}
$args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
$args{wrote} = 0;
bless( \%args, $class );
}
......@@ -238,7 +272,7 @@ END_DIE
sub load_extensions {
my ($self, $path, $top) = @_;
unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) {
unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
unshift @INC, $self->{prefix};
}
......@@ -277,9 +311,9 @@ sub find_extensions {
# correctly. Otherwise, root through the file to locate the case-preserved
# version of the package name.
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!";
my $in_pod = 0;
while ( <PKGFILE> ) {
my $content = Module::Install::_read($subpath . '.pm');
my $in_pod = 0;
foreach ( split //, $content ) {
$in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/); # skip pod text
......@@ -289,7 +323,6 @@ sub find_extensions {
last;
}
}
close PKGFILE;
}
push @found, [ $file, $pkg ];
......@@ -298,6 +331,13 @@ sub find_extensions {
@found;
}
#####################################################################
# Common Utility Functions
sub _caller {
my $depth = 0;
my $call = caller($depth);
......@@ -308,6 +348,83 @@ sub _caller {
return $call;
}
sub _read {
local *FH;
if ( $] >= 5.006 ) {
open( FH, '<', $_[0] ) or die "open($_[0]): $!";
} else {
open( FH, "< $_[0]" ) or die "open($_[0]): $!";
}
my $string = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $string;
}
sub _readperl {
my $string = Module::Install::_read($_[0]);
$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
$string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
$string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
return $string;
}
sub _readpod {
my $string = Module::Install::_read($_[0]);
$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
return $string if $_[0] =~ /\.pod\z/;
$string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
$string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
$string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
$string =~ s/^\n+//s;
return $string;
}
sub _write {
local *FH;
if ( $] >= 5.006 ) {
open( FH, '>', $_[0] ) or die "open($_[0]): $!";
} else {
open( FH, "> $_[0]" ) or die "open($_[0]): $!";
}
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub _version ($) {
my $s = shift || 0;
my $d =()= $s =~ /(\.)/g;
if ( $d >= 2 ) {
# Normalise multipart versions
$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
}
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map {
$_ . '0' x (3 - length $_)
} $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
sub _cmp ($$) {
_version($_[0]) <=> _version($_[1]);
}
# Cloned from Params::Util::_CLASS
sub _CLASS ($) {
(
defined $_[0]
and
! ref $_[0]
and
$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
) ? $_[0] : undef;
}
1;
# Copyright 2008 Adam Kennedy.
# Copyright 2008 - 2009 Adam Kennedy.
inc/Module/Install/AutoInstall.pm
View file @ d127842c
......@@ -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.68';
$VERSION = '0.91';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
sub AutoInstall { $_[0] }
......
inc/Module/Install/Base.pm
View file @ d127842c
#line 1
package Module::Install::Base;
$VERSION = '0.70';
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
$VERSION = '0.91';
}
# Suspend handler for "redefined" warnings
BEGIN {
......@@ -9,52 +13,56 @@ BEGIN {
$SIG{__WARN__} = sub { $w };
}
### This is the ONLY module that shouldn't have strict on
# use strict;
#line 41
#line 42
sub new {
my ($class, %args) = @_;
foreach my $method ( qw(call load) ) {
*{"$class\::$method"} = sub {
shift()->_top->$method(@_);
} unless defined &{"$class\::$method"};
}
bless( \%args, $class );
my $class = shift;
unless ( defined &{"${class}::call"} ) {
*{"${class}::call"} = sub { shift->_top->call(@_) };
}
unless ( defined &{"${class}::load"} ) {
*{"${class}::load"} = sub { shift->_top->load(@_) };
}
bless { @_ }, $class;
}
#line 61
sub AUTOLOAD {
my $self = shift;
local $@;
my $autoload = eval { $self->_top->autoload } or return;
goto &$autoload;
local $@;
my $func = eval { shift->_top->autoload } or return;
goto &$func;
}
#line 76
#line 75
sub _top { $_[0]->{_top} }
sub _top {
$_[0]->{_top};
}
#line 89
#line 90
sub admin {
$_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new;
$_[0]->_top->{admin}
or
Module::Install::Base::FakeAdmin->new;
}
#line 106
sub is_admin {