lib/CPANPLUS/Dist/MM.pm

   1 package CPANPLUS::Dist::MM;
   2
   3 use strict;
   4 use vars    qw[@ISA $STATUS];
   5 @ISA =      qw[CPANPLUS::Dist];
   6
   7
   8 use CPANPLUS::Internals::Constants;
   9 use CPANPLUS::Internals::Constants::Report;
  10 use CPANPLUS::Error;
  11 use FileHandle;
  12 use Cwd;
  13
  14 use IPC::Cmd                    qw[run];
  15 use Params::Check               qw[check];
  16 use File::Basename              qw[dirname];
  17 use Module::Load::Conditional   qw[can_load check_install];
  18 use Locale::Maketext::Simple    Class => 'CPANPLUS', Style => 'gettext';
  19
  20 local $Params::Check::VERBOSE = 1;
  21
  22 =pod
  23
  24 =head1 NAME
  25
  26 CPANPLUS::Dist::MM
  27
  28 =head1 SYNOPSIS
  29
  30     my $mm = CPANPLUS::Dist->new(
  31                                 format  => 'makemaker',
  32                                 module  => $modobj,
  33                             );
  34     $mm->create;        # runs make && make test
  35     $mm->install;       # runs make install
  36
  37
  38 =head1 DESCRIPTION
  39
  40 C<CPANPLUS::Dist::MM> is a distribution class for MakeMaker related
  41 modules.
  42 Using this package, you can create, install and uninstall perl
  43 modules. It inherits from C<CPANPLUS::Dist>.
  44
  45 =head1 ACCESSORS
  46
  47 =over 4
  48
  49 =item parent()
  50
  51 Returns the C<CPANPLUS::Module> object that parented this object.
  52
  53 =item status()
  54
  55 Returns the C<Object::Accessor> object that keeps the status for
  56 this module.
  57
  58 =back
  59
  60 =head1 STATUS ACCESSORS
  61
  62 All accessors can be accessed as follows:
  63     $mm->status->ACCESSOR
  64
  65 =over 4
  66
  67 =item makefile ()
  68
  69 Location of the Makefile (or Build file).
  70 Set to 0 explicitly if something went wrong.
  71
  72 =item make ()
  73
  74 BOOL indicating if the C<make> (or C<Build>) command was successful.
  75
  76 =item test ()
  77
  78 BOOL indicating if the C<make test> (or C<Build test>) command was
  79 successful.
  80
  81 =item prepared ()
  82
  83 BOOL indicating if the C<prepare> call exited succesfully
  84 This gets set after C<perl Makefile.PL>
  85
  86 =item distdir ()
  87
  88 Full path to the directory in which the C<prepare> call took place,
  89 set after a call to C<prepare>.
  90
  91 =item created ()
  92
  93 BOOL indicating if the C<create> call exited succesfully. This gets
  94 set after C<make> and C<make test>.
  95
  96 =item installed ()
  97
  98 BOOL indicating if the module was installed. This gets set after
  99 C<make install> (or C<Build install>) exits successfully.
 100
 101 =item uninstalled ()
 102
 103 BOOL indicating if the module was uninstalled properly.
 104
 105 =item _create_args ()
 106
 107 Storage of the arguments passed to C<create> for this object. Used
 108 for recursive calls when satisfying prerequisites.
 109
 110 =item _install_args ()
 111
 112 Storage of the arguments passed to C<install> for this object. Used
 113 for recursive calls when satisfying prerequisites.
 114
 115 =back
 116
 117 =cut
 118
 119 =head1 METHODS
 120
 121 =head2 $bool = $dist->format_available();
 122
 123 Returns a boolean indicating whether or not you can use this package
 124 to create and install modules in your environment.
 125
 126 =cut
 127
 128 ### check if the format is available ###
 129 sub format_available {
 130     my $dist = shift;
 131
 132     ### we might be called as $class->format_available =/
 133     require CPANPLUS::Internals;
 134     my $cb   = CPANPLUS::Internals->_retrieve_id(
 135                     CPANPLUS::Internals->_last_id );
 136     my $conf = $cb->configure_object;
 137
 138     my $mod = "ExtUtils::MakeMaker";
 139     unless( can_load( modules => { $mod => 0.0 } ) ) {
 140         error( loc( "You do not have '%1' -- '%2' not available",
 141                     $mod, __PACKAGE__ ) );
 142         return;
 143     }
 144
 145     for my $pgm ( qw[make] ) {
 146         unless( $conf->get_program( $pgm ) ) {
 147             error(loc(
 148                 "You do not have '%1' in your path -- '%2' not available\n" .
 149                 "Please check your config entry for '%1'",
 150                 $pgm, __PACKAGE__ , $pgm
 151             ));
 152             return;
 153         }
 154     }
 155
 156     return 1;
 157 }
 158
 159 =pod $bool = $dist->init();
 160
 161 Sets up the C<CPANPLUS::Dist::MM> object for use.
 162 Effectively creates all the needed status accessors.
 163
 164 Called automatically whenever you create a new C<CPANPLUS::Dist> object.
 165
 166 =cut
 167
 168 sub init {
 169     my $dist    = shift;
 170     my $status  = $dist->status;
 171
 172     $status->mk_accessors(qw[makefile make test created installed uninstalled
 173                              bin_make _prepare_args _create_args _install_args]
 174                         );
 175
 176     return 1;
 177 }
 178
 179 =pod $bool = $dist->prepare([perl => '/path/to/perl', makemakerflags => 'EXTRA=FLAGS', force => BOOL, verbose => BOOL])
 180
 181 C<prepare> preps a distribution for installation. This means it will
 182 run C<perl Makefile.PL> and determine what prerequisites this distribution
 183 declared.
 184
 185 If you set C<force> to true, it will go over all the stages of the
 186 C<prepare> process again, ignoring any previously cached results.
 187
 188 When running C<perl Makefile.PL>, the environment variable
 189 C<PERL5_CPANPLUS_IS_EXECUTING> will be set to the full path of the
 190 C<Makefile.PL> that is being executed. This enables any code inside
 191 the C<Makefile.PL> to know that it is being installed via CPANPLUS.
 192
 193 Returns true on success and false on failure.
 194
 195 You may then call C<< $dist->create >> on the object to create the
 196 installable files.
 197
 198 =cut
 199
 200 sub prepare {
 201     ### just in case you already did a create call for this module object
 202     ### just via a different dist object
 203     my $dist = shift;
 204     my $self = $dist->parent;
 205
 206     ### we're also the cpan_dist, since we don't need to have anything
 207     ### prepared
 208     $dist    = $self->status->dist_cpan if      $self->status->dist_cpan;
 209     $self->status->dist_cpan( $dist )   unless  $self->status->dist_cpan;
 210
 211     my $cb   = $self->parent;
 212     my $conf = $cb->configure_object;
 213     my %hash = @_;
 214
 215     my $dir;
 216     unless( $dir = $self->status->extract ) {
 217         error( loc( "No dir found to operate on!" ) );
 218         return;
 219     }
 220
 221     my $args;
 222     my( $force, $verbose, $perl, $mmflags );
 223     {   local $Params::Check::ALLOW_UNKNOWN = 1;
 224         my $tmpl = {
 225             perl            => {    default => $^X, store => \$perl },
 226             makemakerflags  => {    default =>
 227                                         $conf->get_conf('makemakerflags'),
 228                                     store => \$mmflags },
 229             force           => {    default => $conf->get_conf('force'),
 230                                     store   => \$force },
 231             verbose         => {    default => $conf->get_conf('verbose'),
 232                                     store   => \$verbose },
 233         };
 234
 235         $args = check( $tmpl, \%hash ) or return;
 236     }
 237
 238     ### maybe we already ran a create on this object? ###
 239     return 1 if $dist->status->prepared && !$force;
 240
 241     ### store the arguments, so ->install can use them in recursive loops ###
 242     $dist->status->_prepare_args( $args );
 243
 244     ### chdir to work directory ###
 245     my $orig = cwd();
 246     unless( $cb->_chdir( dir => $dir ) ) {
 247         error( loc( "Could not chdir to build directory '%1'", $dir ) );
 248         return;
 249     }
 250
 251     my $fail;
 252     RUN: {
 253         ### don't run 'perl makefile.pl' again if there's a makefile already
 254         if( -e MAKEFILE->() && (-M MAKEFILE->() < -M $dir) && !$force ) {
 255             msg(loc("'%1' already exists, not running '%2 %3' again ".
 256                     " unless you force",
 257                     MAKEFILE->(), $perl, MAKEFILE_PL->() ), $verbose );
 258
 259         } else {
 260             unless( -e MAKEFILE_PL->() ) {
 261                 msg(loc("No '%1' found - attempting to generate one",
 262                         MAKEFILE_PL->() ), $verbose );
 263
 264                 $dist->write_makefile_pl(
 265                             verbose => $verbose,
 266                             force   => $force
 267                         );
 268
 269                 ### bail out if there's no makefile.pl ###
 270                 unless( -e MAKEFILE_PL->() ) {
 271                     error( loc( "Could not find '%1' - cannot continue",
 272                                 MAKEFILE_PL->() ) );
 273
 274                     ### mark that we screwed up ###
 275                     $dist->status->makefile(0);
 276                     $fail++; last RUN;
 277                 }
 278             }
 279
 280             ### you can turn off running this verbose by changing
 281             ### the config setting below, although it is really not
 282             ### recommended
 283             my $run_verbose = $verbose ||
 284                               $conf->get_conf('allow_build_interactivity') ||
 285                               0;
 286
 287             ### this makes MakeMaker use defaults if possible, according
 288             ### to schwern. See ticket 8047 for details.
 289             local $ENV{PERL_MM_USE_DEFAULT} = 1 unless $run_verbose;
 290
 291             ### turn off our PERL5OPT so no modules from CPANPLUS::inc get
 292             ### included in the makefile.pl -- it should build without
 293             ### also, modules that run in taint mode break if we leave
 294             ### our code ref in perl5opt
 295             ### XXX we've removed the ENV settings from cp::inc, so only need
 296             ### to reset the @INC
 297             #local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt || '';
 298
 299             ### make sure it's a string, so that mmflags that have more than
 300             ### one key value pair are passed as is, rather than as:
 301             ### perl Makefile.PL "key=val key=>val"
 302
 303
 304             #### XXX this needs to be the absolute path to the Makefile.PL
 305             ### since cpanp-run-perl uses 'do' to execute the file, and do()
 306             ### checks your @INC.. so, if there's _another_ makefile.pl in
 307             ### your @INC, it will execute that one...
 308             my $makefile_pl = $cb->_safe_path( path => MAKEFILE_PL->( $dir ) );
 309
 310             ### setting autoflush to true fixes issue from rt #8047
 311             ### XXX this means that we need to keep the path to CPANPLUS
 312             ### in @INC, stopping us from resolving dependencies on CPANPLUS
 313             ### at bootstrap time properly.
 314
 315             ### XXX this fails under ipc::run due to the extra quotes,
 316             ### but it works in ipc::open3. however, ipc::open3 doesn't work
 317             ### on win32/cygwin. XXX TODO get a windows box and sort this out
 318             # my $cmd =  qq[$perl -MEnglish -le ] .
 319             #            QUOTE_PERL_ONE_LINER->(
 320             #                qq[\$OUTPUT_AUTOFLUSH++,do(q($makefile_pl))]
 321             #            )
 322             #            . $mmflags;
 323
 324             # my $flush = OPT_AUTOFLUSH;
 325             # my $cmd     = "$perl $flush $makefile_pl $mmflags";
 326
 327             my $run_perl    = $conf->get_program('perlwrapper');
 328             my $cmd         = "$perl $run_perl $makefile_pl $mmflags";
 329
 330             ### set ENV var to tell underlying code this is what we're
 331             ### executing.
 332             my $captured;
 333             my $rv = do {
 334                 my $env = ENV_CPANPLUS_IS_EXECUTING;
 335                 local $ENV{$env} = $makefile_pl;
 336                 scalar run( command => $cmd,
 337                             buffer  => \$captured,
 338                             verbose => $run_verbose, # may be interactive
 339                         );
 340             };
 341
 342             unless( $rv ) {
 343                 error( loc( "Could not run '%1 %2': %3 -- cannot continue",
 344                             $perl, MAKEFILE_PL->(), $captured ) );
 345
 346                 $dist->status->makefile(0);
 347                 $fail++; last RUN;
 348             }
 349
 350             ### put the output on the stack, don't print it
 351             msg( $captured, 0 );
 352         }
 353
 354         ### so, nasty feature in Module::Build, that when a Makefile.PL
 355         ### is a disguised Build.PL, it generates a Build file, not a
 356         ### Makefile. this breaks everything :( see rt bug #19741
 357         if( not -e MAKEFILE->( $dir ) and -e BUILD_PL->( $dir ) ) {
 358             error(loc(
 359                     "We just ran '%1' without errors, but no '%2' is ".
 360                     "present. However, there is a '%3' file, so this may ".
 361                     "be related to bug #19741 in %4, which describes a ".
 362                     "fake '%5' which generates a '%6' file instead of a '%7'. ".
 363                     "You could try to work around this issue by setting '%8' ".
 364                     "to false and trying again. This will attempt to use the ".
 365                     "'%9' instead.",
 366                     "$^X ".MAKEFILE_PL->(), MAKEFILE->(), BUILD_PL->(),
 367                     'Module::Build', MAKEFILE_PL->(), 'Build', MAKEFILE->(),
 368                     'prefer_makefile', BUILD_PL->()
 369             ));
 370
 371             $fail++, last RUN;
 372         }
 373
 374         ### if we got here, we managed to make a 'makefile' ###
 375         $dist->status->makefile( MAKEFILE->($dir) );
 376
 377         ### start resolving prereqs ###
 378         my $prereqs = $self->status->prereqs;
 379
 380         ### a hashref of prereqs on success, undef on failure ###
 381         $prereqs    ||= $dist->_find_prereqs(
 382                                     verbose => $verbose,
 383                                     file    => $dist->status->makefile
 384                                 );
 385
 386         unless( $prereqs ) {
 387             error( loc( "Unable to scan '%1' for prereqs",
 388                         $dist->status->makefile ) );
 389
 390             $fail++; last RUN;
 391         }
 392     }
 393
 394         unless( $cb->_chdir( dir => $orig ) ) {
 395         error( loc( "Could not chdir back to start dir '%1'", $orig ) );
 396     }
 397
 398     ### save where we wrote this stuff -- same as extract dir in normal
 399     ### installer circumstances
 400     $dist->status->distdir( $self->status->extract );
 401
 402     return $dist->status->prepared( $fail ? 0 : 1);
 403 }
 404
 405 =pod
 406
 407 =head2 $href = $dist->_find_prereqs( file => '/path/to/Makefile', [verbose => BOOL])
 408
 409 Parses a C<Makefile> for C<PREREQ_PM> entries and distills from that
 410 any prerequisites mentioned in the C<Makefile>
 411
 412 Returns a hash with module-version pairs on success and false on
 413 failure.
 414
 415 =cut
 416
 417 sub _find_prereqs {
 418     my $dist = shift;
 419     my $self = $dist->parent;
 420     my $cb   = $self->parent;
 421     my $conf = $cb->configure_object;
 422     my %hash = @_;
 423
 424     my ($verbose, $file);
 425     my $tmpl = {
 426         verbose => { default => $conf->get_conf('verbose'), store => \$verbose },
 427         file    => { required => 1, allow => FILE_READABLE, store => \$file },
 428     };
 429
 430     my $args = check( $tmpl, \%hash ) or return;
 431
 432     my $fh = FileHandle->new();
 433     unless( $fh->open( $file ) ) {
 434         error( loc( "Cannot open '%1': %2", $file, $! ) );
 435         return;
 436     }
 437
 438     my %p;
 439     while( <$fh> ) {
 440         my ($found) = m|^[\#]\s+PREREQ_PM\s+=>\s+(.+)|;
 441
 442         next unless $found;
 443
 444         while( $found =~ m/(?:\s)([\w\:]+)=>(?:q\[(.*?)\],?|undef)/g ) {
 445             if( defined $p{$1} ) {
 446                 msg(loc("Warning: PREREQ_PM mentions '%1' more than once. " .
 447                         "Last mention wins.", $1 ), $verbose );
 448             }
 449
 450             $p{$1} = $cb->_version_to_number(version => $2);
 451         }
 452         last;
 453     }
 454
 455     my $href = $cb->_callbacks->filter_prereqs->( $cb, \%p );
 456
 457     $self->status->prereqs( $href );
 458
 459     ### just to make sure it's not the same reference ###
 460     return { %$href };
 461 }
 462
 463 =pod
 464
 465 =head2 $bool = $dist->create([perl => '/path/to/perl', make => '/path/to/make', makeflags => 'EXTRA=FLAGS', prereq_target => TARGET, skiptest => BOOL, force => BOOL, verbose => BOOL])
 466
 467 C<create> creates the files necessary for installation. This means
 468 it will run C<make> and C<make test>.  This will also scan for and
 469 attempt to satisfy any prerequisites the module may have.
 470
 471 If you set C<skiptest> to true, it will skip the C<make test> stage.
 472 If you set C<force> to true, it will go over all the stages of the
 473 C<make> process again, ignoring any previously cached results. It
 474 will also ignore a bad return value from C<make test> and still allow
 475 the operation to return true.
 476
 477 Returns true on success and false on failure.
 478
 479 You may then call C<< $dist->install >> on the object to actually
 480 install it.
 481
 482 =cut
 483
 484 sub create {
 485     ### just in case you already did a create call for this module object
 486     ### just via a different dist object
 487     my $dist = shift;
 488     my $self = $dist->parent;
 489
 490     ### we're also the cpan_dist, since we don't need to have anything
 491     ### prepared
 492     $dist    = $self->status->dist_cpan if      $self->status->dist_cpan;
 493     $self->status->dist_cpan( $dist )   unless  $self->status->dist_cpan;
 494
 495     my $cb   = $self->parent;
 496     my $conf = $cb->configure_object;
 497     my %hash = @_;
 498
 499     my $dir;
 500     unless( $dir = $self->status->extract ) {
 501         error( loc( "No dir found to operate on!" ) );
 502         return;
 503     }
 504
 505     my $args;
 506     my( $force, $verbose, $make, $makeflags, $skiptest, $prereq_target, $perl,
 507         $mmflags, $prereq_format, $prereq_build);
 508     {   local $Params::Check::ALLOW_UNKNOWN = 1;
 509         my $tmpl = {
 510             perl            => {    default => $^X, store => \$perl },
 511             force           => {    default => $conf->get_conf('force'),
 512                                     store   => \$force },
 513             verbose         => {    default => $conf->get_conf('verbose'),
 514                                     store   => \$verbose },
 515             make            => {    default => $conf->get_program('make'),
 516                                     store   => \$make },
 517             makeflags       => {    default => $conf->get_conf('makeflags'),
 518                                     store   => \$makeflags },
 519             skiptest        => {    default => $conf->get_conf('skiptest'),
 520                                     store   => \$skiptest },
 521             prereq_target   => {    default => '', store => \$prereq_target },
 522             ### don't set the default prereq format to 'makemaker' -- wrong!
 523             prereq_format   => {    #default => $self->status->installer_type,
 524                                     default => '',
 525                                     store   => \$prereq_format },
 526             prereq_build    => {    default => 0, store => \$prereq_build },
 527         };
 528
 529         $args = check( $tmpl, \%hash ) or return;
 530     }
 531
 532     ### maybe we already ran a create on this object? ###
 533     return 1 if $dist->status->created && !$force;
 534
 535     ### store the arguments, so ->install can use them in recursive loops ###
 536     $dist->status->_create_args( $args );
 537
 538     unless( $dist->status->prepared ) {
 539         error( loc( "You have not successfully prepared a '%2' distribution ".
 540                     "yet -- cannot create yet", __PACKAGE__ ) );
 541         return;
 542     }
 543
 544
 545     ### chdir to work directory ###
 546     my $orig = cwd();
 547     unless( $cb->_chdir( dir => $dir ) ) {
 548         error( loc( "Could not chdir to build directory '%1'", $dir ) );
 549         return;
 550     }
 551
 552     my $fail; my $prereq_fail; my $test_fail;
 553     RUN: {
 554         ### this will set the directory back to the start
 555         ### dir, so we must chdir /again/
 556         my $ok = $dist->_resolve_prereqs(
 557                             format          => $prereq_format,
 558                             verbose         => $verbose,
 559                             prereqs         => $self->status->prereqs,
 560                             target          => $prereq_target,
 561                             force           => $force,
 562                             prereq_build    => $prereq_build,
 563                     );
 564
 565         unless( $cb->_chdir( dir => $dir ) ) {
 566             error( loc( "Could not chdir to build directory '%1'", $dir ) );
 567             return;
 568         }
 569
 570         unless( $ok ) {
 571
 572             #### use $dist->flush to reset the cache ###
 573             error( loc( "Unable to satisfy prerequisites for '%1' " .
 574                         "-- aborting install", $self->module ) );
 575             $dist->status->make(0);
 576             $fail++; $prereq_fail++;
 577             last RUN;
 578         }
 579         ### end of prereq resolving ###
 580
 581         my $captured;
 582
 583         ### 'make' section ###
 584         if( -d BLIB->($dir) && (-M BLIB->($dir) < -M $dir) && !$force ) {
 585             msg(loc("Already ran '%1' for this module [%2] -- " .
 586                     "not running again unless you force",
 587                     $make, $self->module ), $verbose );
 588         } else {
 589             unless(scalar run(  command => [$make, $makeflags],
 590                                 buffer  => \$captured,
 591                                 verbose => $verbose )
 592             ) {
 593                 error( loc( "MAKE failed: %1 %2", $!, $captured ) );
 594                 $dist->status->make(0);
 595                 $fail++; last RUN;
 596             }
 597
 598             ### put the output on the stack, don't print it
 599             msg( $captured, 0 );
 600
 601             $dist->status->make(1);
 602
 603             ### add this directory to your lib ###
 604             $self->add_to_includepath();
 605
 606             ### dont bail out here, there's a conditional later on
 607             #last RUN if $skiptest;
 608         }
 609
 610         ### 'make test' section ###
 611         unless( $skiptest ) {
 612
 613             ### turn off our PERL5OPT so no modules from CPANPLUS::inc get
 614             ### included in make test -- it should build without
 615             ### also, modules that run in taint mode break if we leave
 616             ### our code ref in perl5opt
 617             ### XXX CPANPLUS::inc functionality is now obsolete.
 618             #local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt || '';
 619
 620             ### you can turn off running this verbose by changing
 621             ### the config setting below, although it is really not
 622             ### recommended
 623             my $run_verbose =
 624                         $verbose ||
 625                         $conf->get_conf('allow_build_interactivity') ||
 626                         0;
 627
 628             ### XXX need to add makeflags here too?
 629             ### yes, but they should really be split out -- see bug #4143
 630             if( scalar run(
 631                         command => [$make, 'test', $makeflags],
 632                         buffer  => \$captured,
 633                         verbose => $run_verbose,
 634             ) ) {
 635                 ### tests might pass because it doesn't have any tests defined
 636                 ### log this occasion non-verbosely, so our test reporter can
 637                 ### pick up on this
 638                 if ( NO_TESTS_DEFINED->( $captured ) ) {
 639                     msg( NO_TESTS_DEFINED->( $captured ), 0 )
 640                 } else {
 641                     msg( loc( "MAKE TEST passed: %2", $captured ), $verbose );
 642                 }
 643
 644                 $dist->status->test(1);
 645             } else {
 646                 error( loc( "MAKE TEST failed: %1 %2", $!, $captured ) );
 647
 648                 ### send out error report here? or do so at a higher level?
 649                 ### --higher level --kane.
 650                 $dist->status->test(0);
 651
 652                 ### mark specifically *test* failure.. so we dont
 653                 ### send success on force...
 654                 $test_fail++;
 655
 656                 if( !$force and !$cb->_callbacks->proceed_on_test_failure->(
 657                                       $self, $captured )
 658                 ) {
 659                     $fail++; last RUN;
 660                 }
 661             }
 662         }
 663     } #</RUN>
 664
 665     unless( $cb->_chdir( dir => $orig ) ) {
 666         error( loc( "Could not chdir back to start dir '%1'", $orig ) );
 667     }
 668
 669     ### send out test report?
 670     ### only do so if the failure is this module, not its prereq
 671     if( $conf->get_conf('cpantest') and not $prereq_fail) {
 672         $cb->_send_report(
 673             module  => $self,
 674             failed  => $test_fail || $fail,
 675             buffer  => CPANPLUS::Error->stack_as_string,
 676             verbose => $verbose,
 677             force   => $force,
 678         ) or error(loc("Failed to send test report for '%1'",
 679                     $self->module ) );
 680     }
 681
 682     return $dist->status->created( $fail ? 0 : 1);
 683 }
 684
 685 =pod
 686
 687 =head2 $bool = $dist->install([make => '/path/to/make',  makemakerflags => 'EXTRA=FLAGS', force => BOOL, verbose => BOOL])
 688
 689 C<install> runs the following command:
 690     make install
 691
 692 Returns true on success, false on failure.
 693
 694 =cut
 695
 696 sub install {
 697
 698     ### just in case you did the create with ANOTHER dist object linked
 699     ### to the same module object
 700     my $dist = shift();
 701     my $self = $dist->parent;
 702     $dist    = $self->status->dist_cpan if $self->status->dist_cpan;
 703
 704     my $cb   = $self->parent;
 705     my $conf = $cb->configure_object;
 706     my %hash = @_;
 707
 708
 709     unless( $dist->status->created ) {
 710         error(loc("You have not successfully created a '%2' distribution yet " .
 711                   "-- cannot install yet", __PACKAGE__ ));
 712         return;
 713     }
 714
 715     my $dir;
 716     unless( $dir = $self->status->extract ) {
 717         error( loc( "No dir found to operate on!" ) );
 718         return;
 719     }
 720
 721     my $args;
 722     my($force,$verbose,$make,$makeflags);
 723     {   local $Params::Check::ALLOW_UNKNOWN = 1;
 724         my $tmpl = {
 725             force       => {    default => $conf->get_conf('force'),
 726                                 store   => \$force },
 727             verbose     => {    default => $conf->get_conf('verbose'),
 728                                 store   => \$verbose },
 729             make        => {    default => $conf->get_program('make'),
 730                                 store   => \$make },
 731             makeflags   => {    default => $conf->get_conf('makeflags'),
 732                                 store   => \$makeflags },
 733         };
 734
 735         $args = check( $tmpl, \%hash ) or return;
 736     }
 737
 738     ### value set and false -- means failure ###
 739     if( defined $self->status->installed &&
 740         !$self->status->installed && !$force
 741     ) {
 742         error( loc( "Module '%1' has failed to install before this session " .
 743                     "-- aborting install", $self->module ) );
 744         return;
 745     }
 746
 747
 748     $dist->status->_install_args( $args );
 749
 750     my $orig = cwd();
 751     unless( $cb->_chdir( dir => $dir ) ) {
 752         error( loc( "Could not chdir to build directory '%1'", $dir ) );
 753         return;
 754     }
 755
 756     my $fail; my $captured;
 757
 758     ### 'make install' section ###
 759     ### XXX need makeflags here too?
 760     ### yes, but they should really be split out.. see bug #4143
 761     my $cmd     = [$make, 'install', $makeflags];
 762     my $sudo    = $conf->get_program('sudo');
 763     unshift @$cmd, $sudo if $sudo and $>;
 764
 765     $cb->flush('lib');
 766     unless(scalar run(  command => $cmd,
 767                         verbose => $verbose,
 768                         buffer  => \$captured,
 769     ) ) {
 770         error( loc( "MAKE INSTALL failed: %1 %2", $!, $captured ) );
 771         $fail++;
 772     }
 773
 774     ### put the output on the stack, don't print it
 775     msg( $captured, 0 );
 776
 777     unless( $cb->_chdir( dir => $orig ) ) {
 778         error( loc( "Could not chdir back to start dir '%1'", $orig ) );
 779     }
 780
 781     return $dist->status->installed( $fail ? 0 : 1 );
 782
 783 }
 784
 785 =pod
 786
 787 =head2 $bool = $dist->write_makefile_pl([force => BOOL, verbose => BOOL])
 788
 789 This routine can write a C<Makefile.PL> from the information in a
 790 module object. It is used to write a C<Makefile.PL> when the original
 791 author forgot it (!!).
 792
 793 Returns 1 on success and false on failure.
 794
 795 The file gets written to the directory the module's been extracted
 796 to.
 797
 798 =cut
 799
 800 sub write_makefile_pl {
 801     ### just in case you already did a call for this module object
 802     ### just via a different dist object
 803     my $dist = shift;
 804     my $self = $dist->parent;
 805     $dist    = $self->status->dist_cpan if      $self->status->dist_cpan;
 806     $self->status->dist_cpan( $dist )   unless  $self->status->dist_cpan;
 807
 808     my $cb   = $self->parent;
 809     my $conf = $cb->configure_object;
 810     my %hash = @_;
 811
 812     my $dir;
 813     unless( $dir = $self->status->extract ) {
 814         error( loc( "No dir found to operate on!" ) );
 815         return;
 816     }
 817
 818     my ($force, $verbose);
 819     my $tmpl = {
 820         force           => {    default => $conf->get_conf('force'),
 821                                 store => \$force },
 822         verbose         => {    default => $conf->get_conf('verbose'),
 823                                 store => \$verbose },
 824     };
 825
 826     my $args = check( $tmpl, \%hash ) or return;
 827
 828     my $file = MAKEFILE_PL->($dir);
 829     if( -s $file && !$force ) {
 830         msg(loc("Already created '%1' - not doing so again without force",
 831                 $file ), $verbose );
 832         return 1;
 833     }
 834
 835     ### due to a bug with AS perl 5.8.4 built 810 (and maybe others)
 836     ### opening files with content in them already does nasty things;
 837     ### seek to pos 0 and then print, but not truncating the file
 838     ### bug reported to activestate on 19 sep 2004:
 839     ### http://bugs.activestate.com/show_bug.cgi?id=34051
 840     unlink $file if $force;
 841
 842     my $fh = new FileHandle;
 843     unless( $fh->open( ">$file" ) ) {
 844         error( loc( "Could not create file '%1': %2", $file, $! ) );
 845         return;
 846     }
 847
 848     my $mf      = MAKEFILE_PL->();
 849     my $name    = $self->module;
 850     my $version = $self->version;
 851     my $author  = $self->author->author;
 852     my $href    = $self->status->prereqs;
 853     my $prereqs = join ",\n", map {
 854                                 (' ' x 25) . "'$_'\t=> '$href->{$_}'"
 855                             } keys %$href;
 856     $prereqs ||= ''; # just in case there are none;
 857
 858     print $fh qq|
 859     ### Auto-generated $mf by CPANPLUS ###
 860
 861     use ExtUtils::MakeMaker;
 862
 863     WriteMakefile(
 864         NAME        => '$name',
 865         VERSION     => '$version',
 866         AUTHOR      => '$author',
 867         PREREQ_PM   => {
 868 $prereqs
 869                     },
 870     );
 871     \n|;
 872
 873     $fh->close;
 874     return 1;
 875 }
 876
 877 sub dist_dir {
 878     ### just in case you already did a call for this module object
 879     ### just via a different dist object
 880     my $dist = shift;
 881     my $self = $dist->parent;
 882     $dist    = $self->status->dist_cpan if      $self->status->dist_cpan;
 883     $self->status->dist_cpan( $dist )   unless  $self->status->dist_cpan;
 884
 885     my $cb   = $self->parent;
 886     my $conf = $cb->configure_object;
 887     my %hash = @_;
 888
 889     my $make; my $verbose;
 890     {   local $Params::Check::ALLOW_UNKNOWN = 1;
 891         my $tmpl = {
 892             make    => {    default => $conf->get_program('make'),
 893                                     store => \$make },
 894             verbose => {    default => $conf->get_conf('verbose'),
 895                                     store   => \$verbose },
 896         };
 897
 898         check( $tmpl, \%hash ) or return;
 899     }
 900
 901
 902     my $dir;
 903     unless( $dir = $self->status->extract ) {
 904         error( loc( "No dir found to operate on!" ) );
 905         return;
 906     }
 907
 908     ### chdir to work directory ###
 909     my $orig = cwd();
 910     unless( $cb->_chdir( dir => $dir ) ) {
 911         error( loc( "Could not chdir to build directory '%1'", $dir ) );
 912         return;
 913     }
 914
 915     my $fail; my $distdir;
 916     TRY: {
 917         $dist->prepare( @_ ) or (++$fail, last TRY);
 918
 919
 920         my $captured;
 921             unless(scalar run(  command => [$make, 'distdir'],
 922                             buffer  => \$captured,
 923                             verbose => $verbose )
 924         ) {
 925             error( loc( "MAKE DISTDIR failed: %1 %2", $!, $captured ) );
 926             ++$fail, last TRY;
 927         }
 928
 929         ### /path/to/Foo-Bar-1.2/Foo-Bar-1.2
 930         $distdir = File::Spec->catdir( $dir, $self->package_name . '-' .
 931                                                 $self->package_version );
 932
 933         unless( -d $distdir ) {
 934             error(loc("Do not know where '%1' got created", 'distdir'));
 935             ++$fail, last TRY;
 936         }
 937     }
 938
 939     unless( $cb->_chdir( dir => $orig ) ) {
 940         error( loc( "Could not chdir to start directory '%1'", $orig ) );
 941         return;
 942     }
 943
 944     return if $fail;
 945     return $distdir;
 946 }
 947
 948
 949 1;
 950
 951 # Local variables:
 952 # c-indentation-style: bsd
 953 # c-basic-offset: 4
 954 # indent-tabs-mode: nil
 955 # End:
 956 # vim: expandtab shiftwidth=4: