[Summary view] [Print] [Text view]

   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 = MAKEFILE_PL->( $cb->_safe_path( path => $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: