inc/Module/AutoInstall.pm

   1 #line 1
   2 package Module::AutoInstall;
   3
   4 use strict;
   5 use Cwd                 ();
   6 use File::Spec          ();
   7 use ExtUtils::MakeMaker ();
   8
   9 use vars qw{$VERSION};
  10 BEGIN {
  11         $VERSION = '1.18';
  12 }
  13
  14 # special map on pre-defined feature sets
  15 my %FeatureMap = (
  16     ''      => 'Core Features',    # XXX: deprecated
  17     '-core' => 'Core Features',
  18 );
  19
  20 # various lexical flags
  21 my ( @Missing, @Existing,  %DisabledTests, $UnderCPAN, $InstallDepsTarget, $HasCPANPLUS );
  22 my (
  23     $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps,
  24     $UpgradeDeps
  25 );
  26 my ( $PostambleActions, $PostambleActionsNoTest, $PostambleActionsUpgradeDeps,
  27     $PostambleActionsUpgradeDepsNoTest, $PostambleActionsListDeps,
  28     $PostambleActionsListAllDeps, $PostambleUsed, $NoTest);
  29
  30 # See if it's a testing or non-interactive session
  31 _accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN );
  32 _init();
  33
  34 sub _accept_default {
  35     $AcceptDefault = shift;
  36 }
  37
  38 sub _installdeps_target {
  39     $InstallDepsTarget = shift;
  40 }
  41
  42 sub missing_modules {
  43     return @Missing;
  44 }
  45
  46 sub do_install {
  47     __PACKAGE__->install(
  48         [
  49             $Config
  50             ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
  51             : ()
  52         ],
  53         @Missing,
  54     );
  55 }
  56
  57 # initialize various flags, and/or perform install
  58 sub _init {
  59     foreach my $arg (
  60         @ARGV,
  61         split(
  62             /[\s\t]+/,
  63             $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || ''
  64         )
  65       )
  66     {
  67         if ( $arg =~ /^--config=(.*)$/ ) {
  68             $Config = [ split( ',', $1 ) ];
  69         }
  70         elsif ( $arg =~ /^--installdeps=(.*)$/ ) {
  71             __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
  72             exit 0;
  73         }
  74         elsif ( $arg =~ /^--upgradedeps=(.*)$/ ) {
  75             $UpgradeDeps = 1;
  76             __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
  77             exit 0;
  78         }
  79         elsif ( $arg =~ /^--default(?:deps)?$/ ) {
  80             $AcceptDefault = 1;
  81         }
  82         elsif ( $arg =~ /^--check(?:deps)?$/ ) {
  83             $CheckOnly = 1;
  84         }
  85         elsif ( $arg =~ /^--skip(?:deps)?$/ ) {
  86             $SkipInstall = 1;
  87         }
  88         elsif ( $arg =~ /^--test(?:only)?$/ ) {
  89             $TestOnly = 1;
  90         }
  91         elsif ( $arg =~ /^--all(?:deps)?$/ ) {
  92             $AllDeps = 1;
  93         }
  94     }
  95 }
  96
  97 # overrides MakeMaker's prompt() to automatically accept the default choice
  98 sub _prompt {
  99     goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
 100
 101     my ( $prompt, $default ) = @_;
 102     my $y = ( $default =~ /^[Yy]/ );
 103
 104     print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] ';
 105     print "$default\n";
 106     return $default;
 107 }
 108
 109 # the workhorse
 110 sub import {
 111     my $class = shift;
 112     my @args  = @_ or return;
 113     my $core_all;
 114
 115     print "*** $class version " . $class->VERSION . "\n";
 116     print "*** Checking for Perl dependencies...\n";
 117
 118     my $cwd = Cwd::getcwd();
 119
 120     $Config = [];
 121
 122     my $maxlen = length(
 123         (
 124             sort   { length($b) <=> length($a) }
 125               grep { /^[^\-]/ }
 126               map  {
 127                 ref($_)
 128                   ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
 129                   : ''
 130               }
 131               map { +{@args}->{$_} }
 132               grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
 133         )[0]
 134     );
 135
 136     # We want to know if we're under CPAN early to avoid prompting, but
 137     # if we aren't going to try and install anything anyway then skip the
 138     # check entirely since we don't want to have to load (and configure)
 139     # an old CPAN just for a cosmetic message
 140
 141     $UnderCPAN = _check_lock(1) unless $SkipInstall || $InstallDepsTarget;
 142
 143     while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
 144         my ( @required, @tests, @skiptests );
 145         my $default  = 1;
 146         my $conflict = 0;
 147
 148         if ( $feature =~ m/^-(\w+)$/ ) {
 149             my $option = lc($1);
 150
 151             # check for a newer version of myself
 152             _update_to( $modules, @_ ) and return if $option eq 'version';
 153
 154             # sets CPAN configuration options
 155             $Config = $modules if $option eq 'config';
 156
 157             # promote every features to core status
 158             $core_all = ( $modules =~ /^all$/i ) and next
 159               if $option eq 'core';
 160
 161             next unless $option eq 'core';
 162         }
 163
 164         print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n";
 165
 166         $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
 167
 168         unshift @$modules, -default => &{ shift(@$modules) }
 169           if ( ref( $modules->[0] ) eq 'CODE' );    # XXX: bugward compatibility
 170
 171         while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
 172             if ( $mod =~ m/^-(\w+)$/ ) {
 173                 my $option = lc($1);
 174
 175                 $default   = $arg    if ( $option eq 'default' );
 176                 $conflict  = $arg    if ( $option eq 'conflict' );
 177                 @tests     = @{$arg} if ( $option eq 'tests' );
 178                 @skiptests = @{$arg} if ( $option eq 'skiptests' );
 179
 180                 next;
 181             }
 182
 183             printf( "- %-${maxlen}s ...", $mod );
 184
 185             if ( $arg and $arg =~ /^\D/ ) {
 186                 unshift @$modules, $arg;
 187                 $arg = 0;
 188             }
 189
 190             # XXX: check for conflicts and uninstalls(!) them.
 191             my $cur = _version_of($mod);
 192             if (_version_cmp ($cur, $arg) >= 0)
 193             {
 194                 print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
 195                 push @Existing, $mod => $arg;
 196                 $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
 197             }
 198             else {
 199                 if (not defined $cur)   # indeed missing
 200                 {
 201                     print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
 202                 }
 203                 else
 204                 {
 205                     # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above
 206                     print "too old. ($cur < $arg)\n";
 207                 }
 208
 209                 push @required, $mod => $arg;
 210             }
 211         }
 212
 213         next unless @required;
 214
 215         my $mandatory = ( $feature eq '-core' or $core_all );
 216
 217         if (
 218             !$SkipInstall
 219             and (
 220                 $CheckOnly
 221                 or ($mandatory and $UnderCPAN)
 222                 or $AllDeps
 223                 or $InstallDepsTarget
 224                 or _prompt(
 225                     qq{==> Auto-install the }
 226                       . ( @required / 2 )
 227                       . ( $mandatory ? ' mandatory' : ' optional' )
 228                       . qq{ module(s) from CPAN?},
 229                     $default ? 'y' : 'n',
 230                 ) =~ /^[Yy]/
 231             )
 232           )
 233         {
 234             push( @Missing, @required );
 235             $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
 236         }
 237
 238         elsif ( !$SkipInstall
 239             and $default
 240             and $mandatory
 241             and
 242             _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
 243             =~ /^[Nn]/ )
 244         {
 245             push( @Missing, @required );
 246             $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
 247         }
 248
 249         else {
 250             $DisabledTests{$_} = 1 for map { glob($_) } @tests;
 251         }
 252     }
 253
 254     if ( @Missing and not( $CheckOnly or $UnderCPAN) ) {
 255         require Config;
 256         my $make = $Config::Config{make};
 257         if ($InstallDepsTarget) {
 258             print
 259 "*** To install dependencies type '$make installdeps' or '$make installdeps_notest'.\n";
 260         }
 261         else {
 262             print
 263 "*** Dependencies will be installed the next time you type '$make'.\n";
 264         }
 265
 266         # make an educated guess of whether we'll need root permission.
 267         print "    (You may need to do that as the 'root' user.)\n"
 268           if eval '$>';
 269     }
 270     print "*** $class configuration finished.\n";
 271
 272     chdir $cwd;
 273
 274     # import to main::
 275     no strict 'refs';
 276     *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
 277
 278     return (@Existing, @Missing);
 279 }
 280
 281 sub _running_under {
 282     my $thing = shift;
 283     print <<"END_MESSAGE";
 284 *** Since we're running under ${thing}, I'll just let it take care
 285     of the dependency's installation later.
 286 END_MESSAGE
 287     return 1;
 288 }
 289
 290 # Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
 291 # if we are, then we simply let it taking care of our dependencies
 292 sub _check_lock {
 293     return unless @Missing or @_;
 294
 295     if ($ENV{PERL5_CPANM_IS_RUNNING}) {
 296         return _running_under('cpanminus');
 297     }
 298
 299     my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
 300
 301     if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
 302         return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS');
 303     }
 304
 305     require CPAN;
 306
 307     if ($CPAN::VERSION > '1.89') {
 308         if ($cpan_env) {
 309             return _running_under('CPAN');
 310         }
 311         return; # CPAN.pm new enough, don't need to check further
 312     }
 313
 314     # last ditch attempt, this -will- configure CPAN, very sorry
 315
 316     _load_cpan(1); # force initialize even though it's already loaded
 317
 318     # Find the CPAN lock-file
 319     my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
 320     return unless -f $lock;
 321
 322     # Check the lock
 323     local *LOCK;
 324     return unless open(LOCK, $lock);
 325
 326     if (
 327             ( $^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid() )
 328         and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore'
 329     ) {
 330         print <<'END_MESSAGE';
 331
 332 *** Since we're running under CPAN, I'll just let it take care
 333     of the dependency's installation later.
 334 END_MESSAGE
 335         return 1;
 336     }
 337
 338     close LOCK;
 339     return;
 340 }
 341
 342 sub install {
 343     my $class = shift;
 344
 345     my $i;    # used below to strip leading '-' from config keys
 346     my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
 347
 348         my ( @modules, @installed, @modules_to_upgrade );
 349         while (my ($pkg, $ver) = splice(@_, 0, 2)) {
 350
 351                 # grep out those already installed
 352                 if (_version_cmp(_version_of($pkg), $ver) >= 0) {
 353                         push @installed, $pkg;
 354                         if ($UpgradeDeps) {
 355                                 push @modules_to_upgrade, $pkg, $ver;
 356                         }
 357                 }
 358                 else {
 359                         push @modules, $pkg, $ver;
 360                 }
 361         }
 362
 363         if ($UpgradeDeps) {
 364                 push @modules, @modules_to_upgrade;
 365                 @installed          = ();
 366                 @modules_to_upgrade = ();
 367         }
 368
 369     return @installed unless @modules;  # nothing to do
 370     return @installed if _check_lock(); # defer to the CPAN shell
 371
 372     print "*** Installing dependencies...\n";
 373
 374     return unless _connected_to('cpan.org');
 375
 376     my %args = @config;
 377     my %failed;
 378     local *FAILED;
 379     if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) {
 380         while (<FAILED>) { chomp; $failed{$_}++ }
 381         close FAILED;
 382
 383         my @newmod;
 384         while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) {
 385             push @newmod, ( $k => $v ) unless $failed{$k};
 386         }
 387         @modules = @newmod;
 388     }
 389
 390     if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) {
 391         _install_cpanplus( \@modules, \@config );
 392     } else {
 393         _install_cpan( \@modules, \@config );
 394     }
 395
 396     print "*** $class installation finished.\n";
 397
 398     # see if we have successfully installed them
 399     while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
 400         if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) {
 401             push @installed, $pkg;
 402         }
 403         elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
 404             print FAILED "$pkg\n";
 405         }
 406     }
 407
 408     close FAILED if $args{do_once};
 409
 410     return @installed;
 411 }
 412
 413 sub _install_cpanplus {
 414     my @modules   = @{ +shift };
 415     my @config    = _cpanplus_config( @{ +shift } );
 416     my $installed = 0;
 417
 418     require CPANPLUS::Backend;
 419     my $cp   = CPANPLUS::Backend->new;
 420     my $conf = $cp->configure_object;
 421
 422     return unless $conf->can('conf') # 0.05x+ with "sudo" support
 423                or _can_write($conf->_get_build('base'));  # 0.04x
 424
 425     # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
 426     my $makeflags = $conf->get_conf('makeflags') || '';
 427     if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) {
 428         # 0.03+ uses a hashref here
 429         $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
 430
 431     } else {
 432         # 0.02 and below uses a scalar
 433         $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
 434           if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
 435
 436     }
 437     $conf->set_conf( makeflags => $makeflags );
 438     $conf->set_conf( prereqs   => 1 );
 439
 440
 441
 442     while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) {
 443         $conf->set_conf( $key, $val );
 444     }
 445
 446     my $modtree = $cp->module_tree;
 447     while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
 448         print "*** Installing $pkg...\n";
 449
 450         MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
 451
 452         my $success;
 453         my $obj = $modtree->{$pkg};
 454
 455         if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) {
 456             my $pathname = $pkg;
 457             $pathname =~ s/::/\\W/;
 458
 459             foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
 460                 delete $INC{$inc};
 461             }
 462
 463             my $rv = $cp->install( modules => [ $obj->{module} ] );
 464
 465             if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) {
 466                 print "*** $pkg successfully installed.\n";
 467                 $success = 1;
 468             } else {
 469                 print "*** $pkg installation cancelled.\n";
 470                 $success = 0;
 471             }
 472
 473             $installed += $success;
 474         } else {
 475             print << ".";
 476 *** Could not find a version $ver or above for $pkg; skipping.
 477 .
 478         }
 479
 480         MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
 481     }
 482
 483     return $installed;
 484 }
 485
 486 sub _cpanplus_config {
 487         my @config = ();
 488         while ( @_ ) {
 489                 my ($key, $value) = (shift(), shift());
 490                 if ( $key eq 'prerequisites_policy' ) {
 491                         if ( $value eq 'follow' ) {
 492                                 $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL();
 493                         } elsif ( $value eq 'ask' ) {
 494                                 $value = CPANPLUS::Internals::Constants::PREREQ_ASK();
 495                         } elsif ( $value eq 'ignore' ) {
 496                                 $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE();
 497                         } else {
 498                                 die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
 499                         }
 500                         push @config, 'prereqs', $value;
 501                 } elsif ( $key eq 'force' ) {
 502                     push @config, $key, $value;
 503                 } elsif ( $key eq 'notest' ) {
 504                     push @config, 'skiptest', $value;
 505                 } else {
 506                         die "*** Cannot convert option $key to CPANPLUS version.\n";
 507                 }
 508         }
 509         return @config;
 510 }
 511
 512 sub _install_cpan {
 513     my @modules   = @{ +shift };
 514     my @config    = @{ +shift };
 515     my $installed = 0;
 516     my %args;
 517
 518     _load_cpan();
 519     require Config;
 520
 521     if (CPAN->VERSION < 1.80) {
 522         # no "sudo" support, probe for writableness
 523         return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) )
 524                   and _can_write( $Config::Config{sitelib} );
 525     }
 526
 527     # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
 528     my $makeflags = $CPAN::Config->{make_install_arg} || '';
 529     $CPAN::Config->{make_install_arg} =
 530       join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
 531       if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
 532
 533     # don't show start-up info
 534     $CPAN::Config->{inhibit_startup_message} = 1;
 535
 536     # set additional options
 537     while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
 538         ( $args{$opt} = $arg, next )
 539           if $opt =~ /^(?:force|notest)$/;    # pseudo-option
 540         $CPAN::Config->{$opt} = $opt eq 'urllist' ? [$arg] : $arg;
 541     }
 542
 543     if ($args{notest} && (not CPAN::Shell->can('notest'))) {
 544         die "Your version of CPAN is too old to support the 'notest' pragma";
 545     }
 546
 547     local $CPAN::Config->{prerequisites_policy} = 'follow';
 548
 549     while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
 550         MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
 551
 552         print "*** Installing $pkg...\n";
 553
 554         my $obj     = CPAN::Shell->expand( Module => $pkg );
 555         my $success = 0;
 556
 557         if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) {
 558             my $pathname = $pkg;
 559             $pathname =~ s/::/\\W/;
 560
 561             foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
 562                 delete $INC{$inc};
 563             }
 564
 565             my $rv = do {
 566                 if ($args{force}) {
 567                     CPAN::Shell->force( install => $pkg )
 568                 } elsif ($args{notest}) {
 569                     CPAN::Shell->notest( install => $pkg )
 570                 } else {
 571                     CPAN::Shell->install($pkg)
 572                 }
 573             };
 574
 575             $rv ||= eval {
 576                 $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
 577                   ->{install}
 578                   if $CPAN::META;
 579             };
 580
 581             if ( $rv eq 'YES' ) {
 582                 print "*** $pkg successfully installed.\n";
 583                 $success = 1;
 584             }
 585             else {
 586                 print "*** $pkg installation failed.\n";
 587                 $success = 0;
 588             }
 589
 590             $installed += $success;
 591         }
 592         else {
 593             print << ".";
 594 *** Could not find a version $ver or above for $pkg; skipping.
 595 .
 596         }
 597
 598         MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
 599     }
 600
 601     return $installed;
 602 }
 603
 604 sub _has_cpanplus {
 605     return (
 606         $HasCPANPLUS = (
 607             $INC{'CPANPLUS/Config.pm'}
 608               or _load('CPANPLUS::Shell::Default')
 609         )
 610     );
 611 }
 612
 613 # make guesses on whether we're under the CPAN installation directory
 614 sub _under_cpan {
 615     require Cwd;
 616     require File::Spec;
 617
 618     my $cwd  = File::Spec->canonpath( Cwd::getcwd() );
 619     my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
 620
 621     return ( index( $cwd, $cpan ) > -1 );
 622 }
 623
 624 sub _update_to {
 625     my $class = __PACKAGE__;
 626     my $ver   = shift;
 627
 628     return
 629       if _version_cmp( _version_of($class), $ver ) >= 0;  # no need to upgrade
 630
 631     if (
 632         _prompt( "==> A newer version of $class ($ver) is required. Install?",
 633             'y' ) =~ /^[Nn]/
 634       )
 635     {
 636         die "*** Please install $class $ver manually.\n";
 637     }
 638
 639     print << ".";
 640 *** Trying to fetch it from CPAN...
 641 .
 642
 643     # install ourselves
 644     _load($class) and return $class->import(@_)
 645       if $class->install( [], $class, $ver );
 646
 647     print << '.'; exit 1;
 648
 649 *** Cannot bootstrap myself. :-( Installation terminated.
 650 .
 651 }
 652
 653 # check if we're connected to some host, using inet_aton
 654 sub _connected_to {
 655     my $site = shift;
 656
 657     return (
 658         ( _load('Socket') and Socket::inet_aton($site) ) or _prompt(
 659             qq(
 660 *** Your host cannot resolve the domain name '$site', which
 661     probably means the Internet connections are unavailable.
 662 ==> Should we try to install the required module(s) anyway?), 'n'
 663           ) =~ /^[Yy]/
 664     );
 665 }
 666
 667 # check if a directory is writable; may create it on demand
 668 sub _can_write {
 669     my $path = shift;
 670     mkdir( $path, 0755 ) unless -e $path;
 671
 672     return 1 if -w $path;
 673
 674     print << ".";
 675 *** You are not allowed to write to the directory '$path';
 676     the installation may fail due to insufficient permissions.
 677 .
 678
 679     if (
 680         eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(
 681             qq(
 682 ==> Should we try to re-execute the autoinstall process with 'sudo'?),
 683             ((-t STDIN) ? 'y' : 'n')
 684         ) =~ /^[Yy]/
 685       )
 686     {
 687
 688         # try to bootstrap ourselves from sudo
 689         print << ".";
 690 *** Trying to re-execute the autoinstall process with 'sudo'...
 691 .
 692         my $missing = join( ',', @Missing );
 693         my $config = join( ',',
 694             UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
 695           if $Config;
 696
 697         return
 698           unless system( 'sudo', $^X, $0, "--config=$config",
 699             "--installdeps=$missing" );
 700
 701         print << ".";
 702 *** The 'sudo' command exited with error!  Resuming...
 703 .
 704     }
 705
 706     return _prompt(
 707         qq(
 708 ==> Should we try to install the required module(s) anyway?), 'n'
 709     ) =~ /^[Yy]/;
 710 }
 711
 712 # load a module and return the version it reports
 713 sub _load {
 714     my $mod  = pop; # method/function doesn't matter
 715     my $file = $mod;
 716     $file =~ s|::|/|g;
 717     $file .= '.pm';
 718     local $@;
 719     return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
 720 }
 721
 722 # report version without loading a module
 723 sub _version_of {
 724     my $mod = pop; # method/function doesn't matter
 725     my $file = $mod;
 726     $file =~ s|::|/|g;
 727     $file .= '.pm';
 728     foreach my $dir ( @INC ) {
 729         next if ref $dir;
 730         my $path = File::Spec->catfile($dir, $file);
 731         next unless -e $path;
 732         require ExtUtils::MM_Unix;
 733         return ExtUtils::MM_Unix->parse_version($path);
 734     }
 735     return undef;
 736 }
 737
 738 # Load CPAN.pm and it's configuration
 739 sub _load_cpan {
 740     return if $CPAN::VERSION and $CPAN::Config and not @_;
 741     require CPAN;
 742
 743     # CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to
 744     #    CPAN::HandleConfig->load. CPAN reports that the redirection
 745     #    is deprecated in a warning printed at the user.
 746
 747     # CPAN-1.81 expects CPAN::HandleConfig->load, does not have
 748     #   $CPAN::HandleConfig::VERSION but cannot handle
 749     #   CPAN::Config->load
 750
 751     # Which "versions expect CPAN::Config->load?
 752
 753     if ( $CPAN::HandleConfig::VERSION
 754         || CPAN::HandleConfig->can('load')
 755     ) {
 756         # Newer versions of CPAN have a HandleConfig module
 757         CPAN::HandleConfig->load;
 758     } else {
 759         # Older versions had the load method in Config directly
 760         CPAN::Config->load;
 761     }
 762 }
 763
 764 # compare two versions, either use Sort::Versions or plain comparison
 765 # return values same as <=>
 766 sub _version_cmp {
 767     my ( $cur, $min ) = @_;
 768     return -1 unless defined $cur;  # if 0 keep comparing
 769     return 1 unless $min;
 770
 771     $cur =~ s/\s+$//;
 772
 773     # check for version numbers that are not in decimal format
 774     if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) {
 775         if ( ( $version::VERSION or defined( _load('version') )) and
 776              version->can('new')
 777             ) {
 778
 779             # use version.pm if it is installed.
 780             return version->new($cur) <=> version->new($min);
 781         }
 782         elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
 783         {
 784
 785             # use Sort::Versions as the sorting algorithm for a.b.c versions
 786             return Sort::Versions::versioncmp( $cur, $min );
 787         }
 788
 789         warn "Cannot reliably compare non-decimal formatted versions.\n"
 790           . "Please install version.pm or Sort::Versions.\n";
 791     }
 792
 793     # plain comparison
 794     local $^W = 0;    # shuts off 'not numeric' bugs
 795     return $cur <=> $min;
 796 }
 797
 798 # nothing; this usage is deprecated.
 799 sub main::PREREQ_PM { return {}; }
 800
 801 sub _make_args {
 802     my %args = @_;
 803
 804     $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing }
 805       if $UnderCPAN or $TestOnly;
 806
 807     if ( $args{EXE_FILES} and -e 'MANIFEST' ) {
 808         require ExtUtils::Manifest;
 809         my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
 810
 811         $args{EXE_FILES} =
 812           [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ];
 813     }
 814
 815     $args{test}{TESTS} ||= 't/*.t';
 816     $args{test}{TESTS} = join( ' ',
 817         grep { !exists( $DisabledTests{$_} ) }
 818           map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
 819
 820     my $missing = join( ',', @Missing );
 821     my $config =
 822       join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
 823       if $Config;
 824
 825     $PostambleActions = (
 826         ($missing and not $UnderCPAN)
 827         ? "\$(PERL) $0 --config=$config --installdeps=$missing"
 828         : "\$(NOECHO) \$(NOOP)"
 829     );
 830
 831     my $deps_list = join( ',', @Missing, @Existing );
 832
 833     $PostambleActionsUpgradeDeps =
 834         "\$(PERL) $0 --config=$config --upgradedeps=$deps_list";
 835
 836     my $config_notest =
 837       join( ',', (UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config}),
 838           'notest', 1 )
 839       if $Config;
 840
 841     $PostambleActionsNoTest = (
 842         ($missing and not $UnderCPAN)
 843         ? "\$(PERL) $0 --config=$config_notest --installdeps=$missing"
 844         : "\$(NOECHO) \$(NOOP)"
 845     );
 846
 847     $PostambleActionsUpgradeDepsNoTest =
 848         "\$(PERL) $0 --config=$config_notest --upgradedeps=$deps_list";
 849
 850     $PostambleActionsListDeps =
 851         '@$(PERL) -le "print for @ARGV" '
 852             . join(' ', map $Missing[$_], grep $_ % 2 == 0, 0..$#Missing);
 853
 854     my @all = (@Missing, @Existing);
 855
 856     $PostambleActionsListAllDeps =
 857         '@$(PERL) -le "print for @ARGV" '
 858             . join(' ', map $all[$_], grep $_ % 2 == 0, 0..$#all);
 859
 860     return %args;
 861 }
 862
 863 # a wrapper to ExtUtils::MakeMaker::WriteMakefile
 864 sub Write {
 865     require Carp;
 866     Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
 867
 868     if ($CheckOnly) {
 869         print << ".";
 870 *** Makefile not written in check-only mode.
 871 .
 872         return;
 873     }
 874
 875     my %args = _make_args(@_);
 876
 877     no strict 'refs';
 878
 879     $PostambleUsed = 0;
 880     local *MY::postamble = \&postamble unless defined &MY::postamble;
 881     ExtUtils::MakeMaker::WriteMakefile(%args);
 882
 883     print << "." unless $PostambleUsed;
 884 *** WARNING: Makefile written with customized MY::postamble() without
 885     including contents from Module::AutoInstall::postamble() --
 886     auto installation features disabled.  Please contact the author.
 887 .
 888
 889     return 1;
 890 }
 891
 892 sub postamble {
 893     $PostambleUsed = 1;
 894     my $fragment;
 895
 896     $fragment .= <<"AUTO_INSTALL" if !$InstallDepsTarget;
 897
 898 config :: installdeps
 899 \t\$(NOECHO) \$(NOOP)
 900 AUTO_INSTALL
 901
 902     $fragment .= <<"END_MAKE";
 903
 904 checkdeps ::
 905 \t\$(PERL) $0 --checkdeps
 906
 907 installdeps ::
 908 \t$PostambleActions
 909
 910 installdeps_notest ::
 911 \t$PostambleActionsNoTest
 912
 913 upgradedeps ::
 914 \t$PostambleActionsUpgradeDeps
 915
 916 upgradedeps_notest ::
 917 \t$PostambleActionsUpgradeDepsNoTest
 918
 919 listdeps ::
 920 \t$PostambleActionsListDeps
 921
 922 listalldeps ::
 923 \t$PostambleActionsListAllDeps
 924
 925 END_MAKE
 926
 927     return $fragment;
 928 }
 929
 930 1;
 931
 932 __END__
 933
 934 #line 1197