[MOBY-guts] biomoby commit
Eddie Kawas
kawas at dev.open-bio.org
Fri Aug 28 15:15:16 UTC 2009
kawas
Fri Aug 28 11:15:16 EDT 2009
Update of /home/repository/moby/moby-live/Perl/MOBY-Client/inc/Module
In directory dev.open-bio.org:/tmp/cvs-serv18457/MOBY-Client/inc/Module
Modified Files:
AutoInstall.pm Install.pm
Log Message:
updated the module::install inc modules.
moby-live/Perl/MOBY-Client/inc/Module AutoInstall.pm,1.1,1.2 Install.pm,1.2,1.3
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY-Client/inc/Module/AutoInstall.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- /home/repository/moby/moby-live/Perl/MOBY-Client/inc/Module/AutoInstall.pm 2008/02/21 00:14:33 1.1
+++ /home/repository/moby/moby-live/Perl/MOBY-Client/inc/Module/AutoInstall.pm 2009/08/28 15:15:15 1.2
@@ -18,7 +18,9 @@
# 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 @@
elsif ( $arg =~ /^--test(?:only)?$/ ) {
$TestOnly = 1;
}
+ elsif ( $arg =~ /^--all(?:deps)?$/ ) {
+ $AllDeps = 1;
+ }
}
}
@@ -115,6 +120,13 @@
)[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 @@
}
# 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 @@
!$SkipInstall
and (
$CheckOnly
+ or ($mandatory and $UnderCPAN)
+ or $AllDeps
or _prompt(
qq{==> Auto-install the }
. ( @required / 2 )
@@ -214,8 +237,6 @@
}
}
- $UnderCPAN = _check_lock(); # check for $UnderCPAN
-
if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) {
require Config;
print
@@ -234,21 +255,38 @@
*{'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 @@
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 @@
@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 @@
# 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 @@
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 @@
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 @@
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 @@
# 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 @@
}
# 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 @@
) {
# 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 @@
# 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 @@
if $Config;
$PostambleActions = (
- $missing
+ ($missing and not $UnderCPAN)
? "\$(PERL) $0 --config=$config --installdeps=$missing"
: "\$(NOECHO) \$(NOOP)"
);
@@ -746,7 +783,7 @@
sub postamble {
$PostambleUsed = 1;
- return << ".";
+ return <<"END_MAKE";
config :: installdeps
\t\$(NOECHO) \$(NOOP)
@@ -757,7 +794,7 @@
installdeps ::
\t$PostambleActions
-.
+END_MAKE
}
@@ -765,4 +802,4 @@
__END__
-#line 1003
+#line 1056
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY-Client/inc/Module/Install.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- /home/repository/moby/moby-live/Perl/MOBY-Client/inc/Module/Install.pm 2008/05/07 18:15:19 1.2
+++ /home/repository/moby/moby-live/Perl/MOBY-Client/inc/Module/Install.pm 2009/08/28 15:15:16 1.3
@@ -17,12 +17,10 @@
# 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,10 @@
# 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.72';
+ $VERSION = '0.91';
+
+ # Storage for the pseudo-singleton
+ $MAIN = undef;
*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA = __PACKAGE__;
@@ -69,15 +70,26 @@
# 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];
-Your installer $0 has a modification time in the future.
+ # 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).
This is known to create infinite loops in make.
Please correct this, then run $0 again.
END_DIE
+}
@@ -85,7 +97,7 @@
# 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.
@@ -121,12 +133,22 @@
$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')};
};
}
@@ -151,6 +173,9 @@
delete $INC{"$self->{file}"};
delete $INC{"$self->{path}.pm"};
+ # Save to the singleton
+ $MAIN = $self;
+
return 1;
}
@@ -164,8 +189,7 @@
my @exts = @{$self->{extensions}};
unless ( @exts ) {
- my $admin = $self->{admin};
- @exts = $admin->load_all_extensions;
+ @exts = $self->{admin}->load_all_extensions;
}
my %seen;
@@ -248,7 +272,7 @@
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};
}
@@ -312,7 +336,7 @@
#####################################################################
-# Utility Functions
+# Common Utility Functions
sub _caller {
my $depth = 0;
@@ -326,28 +350,81 @@
sub _read {
local *FH;
- open FH, "< $_[0]" or die "open($_[0]): $!";
- my $str = do { 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 $str;
+ 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;
- open FH, "> $_[0]" or die "open($_[0]): $!";
- foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" }
+ 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]): $!";
}
-sub _version {
+# _version is for processing module versions (eg, 1.03_05) not
+# Perl versions (eg, 5.8.1).
+sub _version ($) {
my $s = shift || 0;
- $s =~ s/^(\d+)\.?//;
+ 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;
+ 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.
More information about the MOBY-guts
mailing list