1#line 1 "inc/ExtUtils/AutoInstall.pm - /usr/local/lib/perl5/site_perl/5.8.1/ExtUtils/AutoInstall.pm" 2# $File: //member/autrijus/ExtUtils-AutoInstall/lib/ExtUtils/AutoInstall.pm $ 3# $Revision: #6 $ $Change: 8105 $ $DateTime: 2003/09/13 20:57:40 $ 4 5package ExtUtils::AutoInstall; 6$ExtUtils::AutoInstall::VERSION = '0.54'; 7 8use strict; 9 10use Cwd; 11use ExtUtils::MakeMaker (); 12 13#line 264 14 15# special map on pre-defined feature sets 16my %FeatureMap = ( 17 '' => 'Core Features', # XXX: deprecated 18 '-core' => 'Core Features', 19); 20 21# various lexical flags 22my (@Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS); 23my ($Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly); 24my ($PostambleActions, $PostambleUsed); 25 26$AcceptDefault = 1 unless -t STDIN; # non-interactive session 27_init(); 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 "failed!" . ($arg ? " (needs $arg)" : '') . "\n"; 146 push @required, $mod => $arg; 147 } 148 } 149 150 next unless @required; 151 152 my $mandatory = (($feature eq '-core' or $core_all) and $default); 153 154 if (!$SkipInstall and ($CheckOnly or _prompt( 155 qq{==> Do you wish to install the }. (@required / 2). 156 ($mandatory ? ' mandatory' : ' optional'). 157 qq{ module(s)?}, $default ? 'y' : 'n', 158 ) =~ /^[Yy]/)) { 159 push (@Missing, @required); 160 $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; 161 } 162 163 elsif (!$SkipInstall 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($conf->_get_build('base')); 286 287 # if we're root, set UNINST=1 to avoid trouble unless user asked for it. 288 my $makeflags = $conf->get_conf('makeflags') || ''; 289 if (UNIVERSAL::isa($makeflags, 'HASH')) { 290 # 0.03+ uses a hashref here 291 $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST}; 292 } 293 else { 294 # 0.02 and below uses a scalar 295 $makeflags = join(' ', split(' ', $makeflags), 'UNINST=1') 296 if ($makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' }); 297 } 298 $conf->set_conf(makeflags => $makeflags); 299 300 while (my ($key, $val) = splice(@config, 0, 2)) { 301 eval { $conf->set_conf($key, $val) }; 302 } 303 304 my $modtree = $cp->module_tree; 305 while (my ($pkg, $ver) = splice(@modules, 0, 2)) { 306 print "*** Installing $pkg...\n"; 307 308 MY::preinstall($pkg, $ver) or next if defined &MY::preinstall; 309 310 my $success; 311 my $obj = $modtree->{$pkg}; 312 313 if ($obj and defined(_version_check($obj->{version}, $ver))) { 314 my $pathname = $pkg; $pathname =~ s/::/\\W/; 315 316 foreach my $inc (grep { m/$pathname.pm/i } keys(%INC)) { 317 delete $INC{$inc}; 318 } 319 320 my $rv = $cp->install( modules => [ $obj->{module} ]); 321 322 if ($rv and ($rv->{$obj->{module}} or $rv->{ok})) { 323 print "*** $pkg successfully installed.\n"; 324 $success = 1; 325 } 326 else { 327 print "*** $pkg installation cancelled.\n"; 328 $success = 0; 329 } 330 331 $installed += $success; 332 } 333 else { 334 print << "."; 335*** Could not find a version $ver or above for $pkg; skipping. 336. 337 } 338 339 MY::postinstall($pkg, $ver, $success) if defined &MY::postinstall; 340 } 341 342 return $installed; 343} 344 345sub _install_cpan { 346 my @modules = @{+shift}; 347 my @config = @{+shift}; 348 my $installed = 0; 349 my %args; 350 351 require CPAN; CPAN::Config->load; 352 353 return unless _can_write(MM->catfile($CPAN::Config->{cpan_home}, 'sources')); 354 355 # if we're root, set UNINST=1 to avoid trouble unless user asked for it. 356 my $makeflags = $CPAN::Config->{make_install_arg} || ''; 357 $CPAN::Config->{make_install_arg} = join(' ', split(' ', $makeflags), 'UNINST=1') 358 if ($makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' }); 359 360 # don't show start-up info 361 $CPAN::Config->{inhibit_startup_message} = 1; 362 363 # set additional options 364 while (my ($opt, $arg) = splice(@config, 0, 2)) { 365 ($args{$opt} = $arg, next) 366 if $opt =~ /^force$/; # pseudo-option 367 $CPAN::Config->{$opt} = $arg; 368 } 369 370 while (my ($pkg, $ver) = splice(@modules, 0, 2)) { 371 MY::preinstall($pkg, $ver) or next if defined &MY::preinstall; 372 373 print "*** Installing $pkg...\n"; 374 375 my $obj = CPAN::Shell->expand(Module => $pkg); 376 my $success = 0; 377 378 if ($obj and defined(_version_check($obj->cpan_version, $ver))) { 379 my $pathname = $pkg; $pathname =~ s/::/\\W/; 380 381 foreach my $inc (grep { m/$pathname.pm/i } keys(%INC)) { 382 delete $INC{$inc}; 383 } 384 385 $obj->force('install') if $args{force}; 386 387 if ($obj->install eq 'YES') { 388 print "*** $pkg successfully installed.\n"; 389 $success = 1; 390 } 391 else { 392 print "*** $pkg installation failed.\n"; 393 $success = 0; 394 } 395 396 $installed += $success; 397 } 398 else { 399 print << "."; 400*** Could not find a version $ver or above for $pkg; skipping. 401. 402 } 403 404 MY::postinstall($pkg, $ver, $success) if defined &MY::postinstall; 405 } 406 407 return $installed; 408} 409 410sub _has_cpanplus { 411 return ( 412 $HasCPANPLUS = ( 413 $INC{'CPANPLUS/Config.pm'} or 414 _load('CPANPLUS::Shell::Default') 415 ) 416 ); 417} 418 419# make guesses on whether we're under the CPAN installation directory 420sub _under_cpan { 421 require Cwd; 422 require File::Spec; 423 424 my $cwd = File::Spec->canonpath(Cwd::cwd()); 425 my $cpan = File::Spec->canonpath($CPAN::Config->{cpan_home}); 426 427 return (index($cwd, $cpan) > -1); 428} 429 430sub _update_to { 431 my $class = __PACKAGE__; 432 my $ver = shift; 433 434 return if defined(_version_check(_load($class), $ver)); # no need to upgrade 435 436 if (_prompt( 437 "==> A newer version of $class ($ver) is required. Install?", 'y' 438 ) =~ /^[Nn]/) { 439 die "*** Please install $class $ver manually.\n"; 440 } 441 442 print << "."; 443*** Trying to fetch it from CPAN... 444. 445 446 # install ourselves 447 _load($class) and return $class->import(@_) 448 if $class->install([], $class, $ver); 449 450 print << '.'; exit 1; 451 452*** Cannot bootstrap myself. :-( Installation terminated. 453. 454} 455 456# check if we're connected to some host, using inet_aton 457sub _connected_to { 458 my $site = shift; 459 460 return ( 461 ( _load('Socket') and Socket::inet_aton($site) ) or _prompt(qq( 462*** Your host cannot resolve the domain name '$site', which 463 probably means the Internet connections are unavailable. 464==> Should we try to install the required module(s) anyway?), 'n' 465 ) =~ /^[Yy]/ 466 ); 467} 468 469# check if a directory is writable; may create it on demand 470sub _can_write { 471 my $path = shift; 472 mkdir ($path, 0755) unless -e $path; 473 474 require Config; 475 return 1 if -w $path and -w $Config::Config{sitelib}; 476 477 print << "."; 478*** You are not allowed to write to the directory '$path'; 479 the installation may fail due to insufficient permissions. 480. 481 482 if (eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(qq( 483==> Should we try to re-execute the autoinstall process with 'sudo'?), 'y' 484 ) =~ /^[Yy]/) { 485 # try to bootstrap ourselves from sudo 486 print << "."; 487*** Trying to re-execute the autoinstall process with 'sudo'... 488. 489 my $missing = join(',', @Missing); 490 my $config = join(',', 491 UNIVERSAL::isa($Config, 'HASH') ? %{$Config} : @{$Config} 492 ) if $Config; 493 494 return unless system('sudo', $^X, $0, "--config=$config", "--installdeps=$missing"); 495 496 print << "."; 497*** The 'sudo' command exited with error! Resuming... 498. 499 } 500 501 return _prompt(qq( 502==> Should we try to install the required module(s) anyway?), 'n' 503 ) =~ /^[Yy]/ 504} 505 506# load a module and return the version it reports 507sub _load { 508 my $mod = pop; # class/instance doesn't matter 509 my $file = $mod; 510 511 $file =~ s|::|/|g; 512 $file .= '.pm'; 513 514 local $@; 515 return eval { require $file; $mod->VERSION } || ($@ ? undef : 0); 516} 517 518# compare two versions, either use Sort::Versions or plain comparison 519sub _version_check { 520 my ($cur, $min) = @_; 521 return unless defined $cur; 522 523 $cur =~ s/\s+$//; 524 525 # check for version numbers that are not in decimal format 526 if (ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./) { 527 if ($version::VERSION or defined(_load('version'))) { 528 # use version.pm if it is installed. 529 return ((version->new($cur) >= version->new($min)) ? $cur : undef); 530 } 531 elsif ($Sort::Versions::VERSION or defined(_load('Sort::Versions'))) { 532 # use Sort::Versions as the sorting algorithm for a.b.c versions 533 return ((Sort::Versions::versioncmp($cur, $min) != -1) ? $cur : undef); 534 } 535 536 warn "Cannot reliably compare non-decimal formatted versions.\n". 537 "Please install version.pm or Sort::Versions.\n"; 538 } 539 540 # plain comparison 541 local $^W = 0; # shuts off 'not numeric' bugs 542 return ($cur >= $min ? $cur : undef); 543} 544 545# nothing; this usage is deprecated. 546sub main::PREREQ_PM { return {}; } 547 548sub _make_args { 549 my %args = @_; 550 551 $args{PREREQ_PM} = { %{$args{PREREQ_PM} || {} }, @Existing, @Missing } 552 if $UnderCPAN or $TestOnly; 553 554 if ($args{EXE_FILES}) { 555 require ExtUtils::Manifest; 556 my $manifest = ExtUtils::Manifest::maniread('MANIFEST'); 557 558 $args{EXE_FILES} = [ 559 grep { exists $manifest->{$_} } @{$args{EXE_FILES}} 560 ]; 561 } 562 563 $args{test}{TESTS} ||= 't/*.t'; 564 $args{test}{TESTS} = join(' ', grep { 565 !exists($DisabledTests{$_}) 566 } map { glob($_) } split(/\s+/, $args{test}{TESTS})); 567 568 my $missing = join(',', @Missing); 569 my $config = join(',', 570 UNIVERSAL::isa($Config, 'HASH') ? %{$Config} : @{$Config} 571 ) if $Config; 572 573 $PostambleActions = ( 574 $missing ? "\$(PERL) $0 --config=$config --installdeps=$missing" 575 : "\@\$(NOOP)" 576 ); 577 578 return %args; 579} 580 581# a wrapper to ExtUtils::MakeMaker::WriteMakefile 582sub Write { 583 require Carp; 584 Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; 585 586 if ($CheckOnly) { 587 print << "."; 588*** Makefile not written in check-only mode. 589. 590 return; 591 } 592 593 my %args = _make_args(@_); 594 595 no strict 'refs'; 596 597 $PostambleUsed = 0; 598 local *MY::postamble = \&postamble unless defined &MY::postamble; 599 ExtUtils::MakeMaker::WriteMakefile(%args); 600 601 print << "." unless $PostambleUsed; 602*** WARNING: Makefile written with customized MY::postamble() without 603 including contents from ExtUtils::AutoInstall::postamble() -- 604 auto installation features disabled. Please contact the author. 605. 606 607 return 1; 608} 609 610sub postamble { 611 $PostambleUsed = 1; 612 613 return << "."; 614 615config :: installdeps 616\t\@\$(NOOP) 617 618checkdeps :: 619\t\$(PERL) $0 --checkdeps 620 621installdeps :: 622\t$PostambleActions 623 624. 625 626} 627 6281; 629 630__END__ 631 632#line 910 633