cpan/CPANPLUS/lib/CPANPLUS/Dist/MM.pm

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