[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