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