1#line 1 2package ExtUtils::AutoInstall; 3$ExtUtils::AutoInstall::VERSION = '0.63'; 4 5use strict; 6use Cwd (); 7use ExtUtils::MakeMaker (); 8 9#line 311 10 11# special map on pre-defined feature sets 12my %FeatureMap = ( 13 '' => 'Core Features', # XXX: deprecated 14 '-core' => 'Core Features', 15); 16 17# various lexical flags 18my (@Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS); 19my ($Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly); 20my ($PostambleActions, $PostambleUsed); 21 22_accept_default(!-t STDIN); # see if it's a non-interactive session 23_init(); 24 25sub _accept_default { 26 $AcceptDefault = shift; 27} 28 29sub missing_modules { 30 return @Missing; 31} 32 33sub do_install { 34 __PACKAGE__->install( 35 [ UNIVERSAL::isa($Config, 'HASH') ? %{$Config} : @{$Config}], 36 @Missing, 37 ); 38} 39 40# initialize various flags, and/or perform install 41sub _init { 42 foreach my $arg (@ARGV, split(/[\s\t]+/, $ENV{PERL_EXTUTILS_AUTOINSTALL} || '')) { 43 if ($arg =~ /^--config=(.*)$/) { 44 $Config = [ split(',', $1) ]; 45 } 46 elsif ($arg =~ /^--installdeps=(.*)$/) { 47 __PACKAGE__->install($Config, @Missing = split(/,/, $1)); 48 exit 0; 49 } 50 elsif ($arg =~ /^--default(?:deps)?$/) { 51 $AcceptDefault = 1; 52 } 53 elsif ($arg =~ /^--check(?:deps)?$/) { 54 $CheckOnly = 1; 55 } 56 elsif ($arg =~ /^--skip(?:deps)?$/) { 57 $SkipInstall = 1; 58 } 59 elsif ($arg =~ /^--test(?:only)?$/) { 60 $TestOnly = 1; 61 } 62 } 63} 64 65# overrides MakeMaker's prompt() to automatically accept the default choice 66sub _prompt { 67 goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault; 68 69 my ($prompt, $default) = @_; 70 my $y = ($default =~ /^[Yy]/); 71 72 print $prompt, ' [', ($y ? 'Y' : 'y'), '/', ($y ? 'n' : 'N'), '] '; 73 print "$default\n"; 74 return $default; 75} 76 77# the workhorse 78sub import { 79 my $class = shift; 80 my @args = @_ or return; 81 my $core_all; 82 83 print "*** $class version ".$class->VERSION."\n"; 84 print "*** Checking for dependencies...\n"; 85 86 my $cwd = Cwd::cwd(); 87 88 $Config = []; 89 90 my $maxlen = length((sort { length($b) <=> length($a) } 91 grep { /^[^\-]/ } 92 map { ref($_) ? keys %{ref($_) eq 'HASH' ? $_ : +{@{$_}}} : '' } 93 map { +{@args}->{$_} } 94 grep { /^[^\-]/ or /^-core$/i } keys %{+{@args}})[0]); 95 96 while (my ($feature, $modules) = splice(@args, 0, 2)) { 97 my (@required, @tests, @skiptests); 98 my $default = 1; 99 my $conflict = 0; 100 101 if ($feature =~ m/^-(\w+)$/) { 102 my $option = lc($1); 103 104 # check for a newer version of myself 105 _update_to($modules, @_) and return if $option eq 'version'; 106 107 # sets CPAN configuration options 108 $Config = $modules if $option eq 'config'; 109 110 # promote every features to core status 111 $core_all = ($modules =~ /^all$/i) and next 112 if $option eq 'core'; 113 114 next unless $option eq 'core'; 115 } 116 117 print "[".($FeatureMap{lc($feature)} || $feature)."]\n"; 118 119 $modules = [ %{$modules} ] if UNIVERSAL::isa($modules, 'HASH'); 120 121 unshift @$modules, -default => &{shift(@$modules)} 122 if (ref($modules->[0]) eq 'CODE'); # XXX: bugward combatability 123 124 while (my ($mod, $arg) = splice(@$modules, 0, 2)) { 125 if ($mod =~ m/^-(\w+)$/) { 126 my $option = lc($1); 127 128 $default = $arg if ($option eq 'default'); 129 $conflict = $arg if ($option eq 'conflict'); 130 @tests = @{$arg} if ($option eq 'tests'); 131 @skiptests = @{$arg} if ($option eq 'skiptests'); 132 133 next; 134 } 135 136 printf("- %-${maxlen}s ...", $mod); 137 138 # XXX: check for conflicts and uninstalls(!) them. 139 if (defined(my $cur = _version_check(_load($mod), $arg ||= 0))) { 140 print "loaded. ($cur".($arg ? " >= $arg" : '').")\n"; 141 push @Existing, $mod => $arg; 142 $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; 143 } 144 else { 145 print "missing." . ($arg ? " (would need $arg)" : '') . "\n"; 146 push @required, $mod => $arg; 147 } 148 } 149 150 next unless @required; 151 152 my $mandatory = ($feature eq '-core' or $core_all); 153 154 if (!$SkipInstall and ($CheckOnly or _prompt( 155 qq{==> Auto-install the }. (@required / 2). 156 ($mandatory ? ' mandatory' : ' optional'). 157 qq{ module(s) from CPAN?}, $default ? 'y' : 'n', 158 ) =~ /^[Yy]/)) { 159 push (@Missing, @required); 160 $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; 161 } 162 163 elsif (!$SkipInstall and $default and $mandatory and _prompt( 164 qq{==> The module(s) are mandatory! Really skip?}, 'n', 165 ) =~ /^[Nn]/) { 166 push (@Missing, @required); 167 $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; 168 } 169 170 else { 171 $DisabledTests{$_} = 1 for map { glob($_) } @tests; 172 } 173 } 174 175 _check_lock(); # check for $UnderCPAN 176 177 if (@Missing and not ($CheckOnly or $UnderCPAN)) { 178 require Config; 179 print "*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n"; 180 # make an educated guess of whether we'll need root permission. 181 print " (You may need to do that as the 'root' user.)\n" if eval '$>'; 182 } 183 print "*** $class configuration finished.\n"; 184 185 chdir $cwd; 186 187 # import to main:: 188 no strict 'refs'; 189 *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main'; 190} 191 192# CPAN.pm is non-reentrant, so check if we're under it and have no CPANPLUS 193sub _check_lock { 194 return unless @Missing; 195 return if _has_cpanplus(); 196 197 require CPAN; CPAN::Config->load; 198 my $lock = MM->catfile($CPAN::Config->{cpan_home}, ".lock"); 199 200 if (-f $lock and open(LOCK, $lock) 201 and ($^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid()) 202 and ($CPAN::Config->{prerequisites_policy} || '') ne 'ignore' 203 ) { 204 print << '.'; 205 206*** Since we're running under CPAN, I'll just let it take care 207 of the dependency's installation later. 208. 209 $UnderCPAN = 1; 210 } 211 212 close LOCK; 213} 214 215sub install { 216 my $class = shift; 217 218 my $i; # used below to strip leading '-' from config keys 219 my @config = (map { s/^-// if ++$i; $_ } @{+shift}); 220 221 my (@modules, @installed); 222 while (my ($pkg, $ver) = splice(@_, 0, 2)) { 223 # grep out those already installed 224 if (defined(_version_check(_load($pkg), $ver))) { 225 push @installed, $pkg; 226 } 227 else { 228 push @modules, $pkg, $ver; 229 } 230 } 231 232 return @installed unless @modules; # nothing to do 233 234 print "*** Installing dependencies...\n"; 235 236 return unless _connected_to('cpan.org'); 237 238 my %args = @config; 239 my %failed; 240 local *FAILED; 241 if ($args{do_once} and open(FAILED, '.#autoinstall.failed')) { 242 while (<FAILED>) { chomp; $failed{$_}++ } 243 close FAILED; 244 245 my @newmod; 246 while (my ($k, $v) = splice(@modules, 0, 2)) { 247 push @newmod, ($k => $v) unless $failed{$k}; 248 } 249 @modules = @newmod; 250 } 251 252 if (_has_cpanplus()) { 253 _install_cpanplus(\@modules, \@config); 254 } 255 else { 256 _install_cpan(\@modules, \@config); 257 } 258 259 print "*** $class installation finished.\n"; 260 261 # see if we have successfully installed them 262 while (my ($pkg, $ver) = splice(@modules, 0, 2)) { 263 if (defined(_version_check(_load($pkg), $ver))) { 264 push @installed, $pkg; 265 } 266 elsif ($args{do_once} and open(FAILED, '>> .#autoinstall.failed')) { 267 print FAILED "$pkg\n"; 268 } 269 } 270 271 close FAILED if $args{do_once}; 272 273 return @installed; 274} 275 276sub _install_cpanplus { 277 my @modules = @{+shift}; 278 my @config = @{+shift}; 279 my $installed = 0; 280 281 require CPANPLUS::Backend; 282 my $cp = CPANPLUS::Backend->new; 283 my $conf = $cp->configure_object; 284 285 return unless _can_write( 286 $conf->can('conf') 287 ? $conf->get_conf('base') # 0.05x+ 288 : $conf->_get_build('base') # 0.04x 289 ); 290 291 # if we're root, set UNINST=1 to avoid trouble unless user asked for it. 292 my $makeflags = $conf->get_conf('makeflags') || ''; 293 if (UNIVERSAL::isa($makeflags, 'HASH')) { 294 # 0.03+ uses a hashref here 295 $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST}; 296 } 297 else { 298 # 0.02 and below uses a scalar 299 $makeflags = join(' ', split(' ', $makeflags), 'UNINST=1') 300 if ($makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' }); 301 } 302 $conf->set_conf(makeflags => $makeflags); 303 $conf->set_conf(prereqs => 1); 304 305 while (my ($key, $val) = splice(@config, 0, 2)) { 306 eval { $conf->set_conf($key, $val) }; 307 } 308 309 my $modtree = $cp->module_tree; 310 while (my ($pkg, $ver) = splice(@modules, 0, 2)) { 311 print "*** Installing $pkg...\n"; 312 313 MY::preinstall($pkg, $ver) or next if defined &MY::preinstall; 314 315 my $success; 316 my $obj = $modtree->{$pkg}; 317 318 if ($obj and defined(_version_check($obj->{version}, $ver))) { 319 my $pathname = $pkg; $pathname =~ s/::/\\W/; 320 321 foreach my $inc (grep { m/$pathname.pm/i } keys(%INC)) { 322 delete $INC{$inc}; 323 } 324 325 my $rv = $cp->install( modules => [ $obj->{module} ]); 326 327 if ($rv and ($rv->{$obj->{module}} or $rv->{ok})) { 328 print "*** $pkg successfully installed.\n"; 329 $success = 1; 330 } 331 else { 332 print "*** $pkg installation cancelled.\n"; 333 $success = 0; 334 } 335 336 $installed += $success; 337 } 338 else { 339 print << "."; 340*** Could not find a version $ver or above for $pkg; skipping. 341. 342 } 343 344 MY::postinstall($pkg, $ver, $success) if defined &MY::postinstall; 345 } 346 347 return $installed; 348} 349 350sub _install_cpan { 351 my @modules = @{+shift}; 352 my @config = @{+shift}; 353 my $installed = 0; 354 my %args; 355 356 require CPAN; CPAN::Config->load; 357 require Config; 358 359 return unless _can_write(MM->catfile($CPAN::Config->{cpan_home}, 'sources')) 360 and _can_write($Config::Config{sitelib}); 361 362 # if we're root, set UNINST=1 to avoid trouble unless user asked for it. 363 my $makeflags = $CPAN::Config->{make_install_arg} || ''; 364 $CPAN::Config->{make_install_arg} = join(' ', split(' ', $makeflags), 'UNINST=1') 365 if ($makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' }); 366 367 # don't show start-up info 368 $CPAN::Config->{inhibit_startup_message} = 1; 369 370 # set additional options 371 while (my ($opt, $arg) = splice(@config, 0, 2)) { 372 ($args{$opt} = $arg, next) 373 if $opt =~ /^force$/; # pseudo-option 374 $CPAN::Config->{$opt} = $arg; 375 } 376 377 local $CPAN::Config->{prerequisites_policy} = 'follow'; 378 379 while (my ($pkg, $ver) = splice(@modules, 0, 2)) { 380 MY::preinstall($pkg, $ver) or next if defined &MY::preinstall; 381 382 print "*** Installing $pkg...\n"; 383 384 my $obj = CPAN::Shell->expand(Module => $pkg); 385 my $success = 0; 386 387 if ($obj and defined(_version_check($obj->cpan_version, $ver))) { 388 my $pathname = $pkg; $pathname =~ s/::/\\W/; 389 390 foreach my $inc (grep { m/$pathname.pm/i } keys(%INC)) { 391 delete $INC{$inc}; 392 } 393 394 $obj->force('install') if $args{force}; 395 396 my $rv = $obj->install || eval { 397 $CPAN::META->instance( 398 'CPAN::Distribution', 399 $obj->cpan_file, 400 )->{install} if $CPAN::META 401 }; 402 403 if ($rv eq 'YES') { 404 print "*** $pkg successfully installed.\n"; 405 $success = 1; 406 } 407 else { 408 print "*** $pkg installation failed.\n"; 409 $success = 0; 410 } 411 412 $installed += $success; 413 } 414 else { 415 print << "."; 416*** Could not find a version $ver or above for $pkg; skipping. 417. 418 } 419 420 MY::postinstall($pkg, $ver, $success) if defined &MY::postinstall; 421 } 422 423 return $installed; 424} 425 426sub _has_cpanplus { 427 return ( 428 $HasCPANPLUS = ( 429 $INC{'CPANPLUS/Config.pm'} or 430 _load('CPANPLUS::Shell::Default') 431 ) 432 ); 433} 434 435# make guesses on whether we're under the CPAN installation directory 436sub _under_cpan { 437 require Cwd; 438 require File::Spec; 439 440 my $cwd = File::Spec->canonpath(Cwd::cwd()); 441 my $cpan = File::Spec->canonpath($CPAN::Config->{cpan_home}); 442 443 return (index($cwd, $cpan) > -1); 444} 445 446sub _update_to { 447 my $class = __PACKAGE__; 448 my $ver = shift; 449 450 return if defined(_version_check(_load($class), $ver)); # no need to upgrade 451 452 if (_prompt( 453 "==> A newer version of $class ($ver) is required. Install?", 'y' 454 ) =~ /^[Nn]/) { 455 die "*** Please install $class $ver manually.\n"; 456 } 457 458 print << "."; 459*** Trying to fetch it from CPAN... 460. 461 462 # install ourselves 463 _load($class) and return $class->import(@_) 464 if $class->install([], $class, $ver); 465 466 print << '.'; exit 1; 467 468*** Cannot bootstrap myself. :-( Installation terminated. 469. 470} 471 472# check if we're connected to some host, using inet_aton 473sub _connected_to { 474 my $site = shift; 475 476 return ( 477 ( _load('Socket') and Socket::inet_aton($site) ) or _prompt(qq( 478*** Your host cannot resolve the domain name '$site', which 479 probably means the Internet connections are unavailable. 480==> Should we try to install the required module(s) anyway?), 'n' 481 ) =~ /^[Yy]/ 482 ); 483} 484 485# check if a directory is writable; may create it on demand 486sub _can_write { 487 my $path = shift; 488 mkdir ($path, 0755) unless -e $path; 489 490 return 1 if -w $path; 491 492 print << "."; 493*** You are not allowed to write to the directory '$path'; 494 the installation may fail due to insufficient permissions. 495. 496 497 if (eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(qq( 498==> Should we try to re-execute the autoinstall process with 'sudo'?), 'y' 499 ) =~ /^[Yy]/) { 500 # try to bootstrap ourselves from sudo 501 print << "."; 502*** Trying to re-execute the autoinstall process with 'sudo'... 503. 504 my $missing = join(',', @Missing); 505 my $config = join(',', 506 UNIVERSAL::isa($Config, 'HASH') ? %{$Config} : @{$Config} 507 ) if $Config; 508 509 return unless system('sudo', $^X, $0, "--config=$config", "--installdeps=$missing"); 510 511 print << "."; 512*** The 'sudo' command exited with error! Resuming... 513. 514 } 515 516 return _prompt(qq( 517==> Should we try to install the required module(s) anyway?), 'n' 518 ) =~ /^[Yy]/ 519} 520 521# load a module and return the version it reports 522sub _load { 523 my $mod = pop; # class/instance doesn't matter 524 my $file = $mod; 525 526 $file =~ s|::|/|g; 527 $file .= '.pm'; 528 529 local $@; 530 return eval { require $file; $mod->VERSION } || ($@ ? undef : 0); 531} 532 533# compare two versions, either use Sort::Versions or plain comparison 534sub _version_check { 535 my ($cur, $min) = @_; 536 return unless defined $cur; 537 538 $cur =~ s/\s+$//; 539 540 # check for version numbers that are not in decimal format 541 if (ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./) { 542 if ($version::VERSION or defined(_load('version'))) { 543 # use version.pm if it is installed. 544 return ((version->new($cur) >= version->new($min)) ? $cur : undef); 545 } 546 elsif ($Sort::Versions::VERSION or defined(_load('Sort::Versions'))) { 547 # use Sort::Versions as the sorting algorithm for a.b.c versions 548 return ((Sort::Versions::versioncmp($cur, $min) != -1) ? $cur : undef); 549 } 550 551 warn "Cannot reliably compare non-decimal formatted versions.\n". 552 "Please install version.pm or Sort::Versions.\n"; 553 } 554 555 # plain comparison 556 local $^W = 0; # shuts off 'not numeric' bugs 557 return ($cur >= $min ? $cur : undef); 558} 559 560# nothing; this usage is deprecated. 561sub main::PREREQ_PM { return {}; } 562 563sub _make_args { 564 my %args = @_; 565 566 $args{PREREQ_PM} = { %{$args{PREREQ_PM} || {} }, @Existing, @Missing } 567 if $UnderCPAN or $TestOnly; 568 569 if ($args{EXE_FILES}) { 570 require ExtUtils::Manifest; 571 my $manifest = ExtUtils::Manifest::maniread('MANIFEST'); 572 573 $args{EXE_FILES} = [ 574 grep { exists $manifest->{$_} } @{$args{EXE_FILES}} 575 ]; 576 } 577 578 $args{test}{TESTS} ||= 't/*.t'; 579 $args{test}{TESTS} = join(' ', grep { 580 !exists($DisabledTests{$_}) 581 } map { glob($_) } split(/\s+/, $args{test}{TESTS})); 582 583 my $missing = join(',', @Missing); 584 my $config = join(',', 585 UNIVERSAL::isa($Config, 'HASH') ? %{$Config} : @{$Config} 586 ) if $Config; 587 588 $PostambleActions = ( 589 $missing ? "\$(PERL) $0 --config=$config --installdeps=$missing" 590 : "\@\$(NOOP)" 591 ); 592 593 return %args; 594} 595 596# a wrapper to ExtUtils::MakeMaker::WriteMakefile 597sub Write { 598 require Carp; 599 Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; 600 601 if ($CheckOnly) { 602 print << "."; 603*** Makefile not written in check-only mode. 604. 605 return; 606 } 607 608 my %args = _make_args(@_); 609 610 no strict 'refs'; 611 612 $PostambleUsed = 0; 613 local *MY::postamble = \&postamble unless defined &MY::postamble; 614 ExtUtils::MakeMaker::WriteMakefile(%args); 615 616 print << "." unless $PostambleUsed; 617*** WARNING: Makefile written with customized MY::postamble() without 618 including contents from ExtUtils::AutoInstall::postamble() -- 619 auto installation features disabled. Please contact the author. 620. 621 622 return 1; 623} 624 625sub postamble { 626 $PostambleUsed = 1; 627 628 return << "."; 629 630config :: installdeps 631\t\@\$(NOOP) 632 633checkdeps :: 634\t\$(PERL) $0 --checkdeps 635 636installdeps :: 637\t$PostambleActions 638 639. 640 641} 642 6431; 644 645__END__ 646 647#line 977 648