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