[Summary view] [Print] [Text view]

   1  package CPANPLUS::Dist::Build;
   2  
   3  use strict;
   4  use vars    qw[@ISA $STATUS $VERSION];
   5  @ISA =      qw[CPANPLUS::Dist];
   6  
   7  use CPANPLUS::inc;
   8  use CPANPLUS::Internals::Constants;
   9  
  10  ### these constants were exported by CPANPLUS::Internals::Constants
  11  ### in previous versions.. they do the same though. If we want to have
  12  ### a normal 'use' here, up the dependency to CPANPLUS 0.056 or higher
  13  BEGIN { 
  14      require CPANPLUS::Dist::Build::Constants;
  15      CPANPLUS::Dist::Build::Constants->import()
  16          if not __PACKAGE__->can('BUILD') && __PACKAGE__->can('BUILD_DIR');
  17  }
  18  
  19  use CPANPLUS::Error;
  20  
  21  use Config;
  22  use FileHandle;
  23  use Cwd;
  24  
  25  use IPC::Cmd                    qw[run];
  26  use Params::Check               qw[check];
  27  use Module::Load::Conditional   qw[can_load check_install];
  28  use Locale::Maketext::Simple    Class => 'CPANPLUS', Style => 'gettext';
  29  
  30  local $Params::Check::VERBOSE = 1;
  31  
  32  $VERSION = '0.06_02';
  33  
  34  =pod
  35  
  36  =head1 NAME
  37  
  38  CPANPLUS::Dist::Build
  39  
  40  =head1 SYNOPSIS
  41  
  42      my $build = CPANPLUS::Dist->new(
  43                                  format  => 'CPANPLUS::Dist::Build',
  44                                  module  => $modobj,
  45                              );
  46                              
  47      $build->prepare;    # runs Module::Build->new_from_context;                            
  48      $build->create;     # runs build && build test
  49      $build->install;    # runs build install
  50  
  51  
  52  =head1 DESCRIPTION
  53  
  54  C<CPANPLUS::Dist::Build> is a distribution class for C<Module::Build>
  55  related modules.
  56  Using this package, you can create, install and uninstall perl
  57  modules. It inherits from C<CPANPLUS::Dist>.
  58  
  59  Normal users won't have to worry about the interface to this module,
  60  as it functions transparently as a plug-in to C<CPANPLUS> and will 
  61  just C<Do The Right Thing> when it's loaded.
  62  
  63  =head1 ACCESSORS
  64  
  65  =over 4
  66  
  67  =item parent()
  68  
  69  Returns the C<CPANPLUS::Module> object that parented this object.
  70  
  71  =item status()
  72  
  73  Returns the C<Object::Accessor> object that keeps the status for
  74  this module.
  75  
  76  =back
  77  
  78  =head1 STATUS ACCESSORS
  79  
  80  All accessors can be accessed as follows:
  81      $build->status->ACCESSOR
  82  
  83  =over 4
  84  
  85  =item build_pl ()
  86  
  87  Location of the Build file.
  88  Set to 0 explicitly if something went wrong.
  89  
  90  =item build ()
  91  
  92  BOOL indicating if the C<Build> command was successful.
  93  
  94  =item test ()
  95  
  96  BOOL indicating if the C<Build test> command was successful.
  97  
  98  =item prepared ()
  99  
 100  BOOL indicating if the C<prepare> call exited succesfully
 101  This gets set after C<perl Build.PL>
 102  
 103  =item distdir ()
 104  
 105  Full path to the directory in which the C<prepare> call took place,
 106  set after a call to C<prepare>. 
 107  
 108  =item created ()
 109  
 110  BOOL indicating if the C<create> call exited succesfully. This gets
 111  set after C<Build> and C<Build test>.
 112  
 113  =item installed ()
 114  
 115  BOOL indicating if the module was installed. This gets set after
 116  C<Build install> exits successfully.
 117  
 118  =item uninstalled ()
 119  
 120  BOOL indicating if the module was uninstalled properly.
 121  
 122  =item _create_args ()
 123  
 124  Storage of the arguments passed to C<create> for this object. Used
 125  for recursive calls when satisfying prerequisites.
 126  
 127  =item _install_args ()
 128  
 129  Storage of the arguments passed to C<install> for this object. Used
 130  for recursive calls when satisfying prerequisites.
 131  
 132  =item _mb_object ()
 133  
 134  Storage of the C<Module::Build> object we used for this installation.
 135  
 136  =back
 137  
 138  =cut
 139  
 140  
 141  =head1 METHODS
 142  
 143  =head2 $bool = CPANPLUS::Dist::Build->format_available();
 144  
 145  Returns a boolean indicating whether or not you can use this package
 146  to create and install modules in your environment.
 147  
 148  =cut
 149  
 150  ### check if the format is available ###
 151  sub format_available {
 152      my $mod = "Module::Build";
 153      unless( can_load( modules => { $mod => '0.2611' } ) ) {
 154          error( loc( "You do not have '%1' -- '%2' not available",
 155                      $mod, __PACKAGE__ ) );
 156          return;
 157      }
 158  
 159      return 1;
 160  }
 161  
 162  
 163  =head2 $bool = $dist->init();
 164  
 165  Sets up the C<CPANPLUS::Dist::Build> object for use.
 166  Effectively creates all the needed status accessors.
 167  
 168  Called automatically whenever you create a new C<CPANPLUS::Dist> object.
 169  
 170  =cut
 171  
 172  sub init {
 173      my $dist    = shift;
 174      my $status  = $dist->status;
 175  
 176      $status->mk_accessors(qw[build_pl build test created installed uninstalled
 177                               _create_args _install_args _prepare_args
 178                               _mb_object _buildflags
 179                              ]);
 180  
 181      ### just in case 'format_available' didn't get called
 182      require Module::Build;
 183  
 184      return 1;
 185  }
 186  
 187  =pod
 188  
 189  =head2 $bool = $dist->prepare([perl => '/path/to/perl', buildflags => 'EXTRA=FLAGS', force => BOOL, verbose => BOOL])
 190  
 191  C<prepare> prepares a distribution, running C<Module::Build>'s 
 192  C<new_from_context> method, and establishing any prerequisites this
 193  distribution has.
 194  
 195  When running C<< Module::Build->new_from_context >>, the environment 
 196  variable C<PERL5_CPANPLUS_IS_EXECUTING> will be set to the full path 
 197  of the C<Build.PL> that is being executed. This enables any code inside
 198  the C<Build.PL> to know that it is being installed via CPANPLUS.
 199  
 200  After a succcesfull C<prepare> you may call C<create> to create the
 201  distribution, followed by C<install> to actually install it.
 202  
 203  Returns true on success and false on failure.
 204  
 205  =cut
 206  
 207  sub prepare {
 208      ### just in case you already did a create call for this module object
 209      ### just via a different dist object
 210      my $dist = shift;
 211      my $self = $dist->parent;
 212  
 213      ### we're also the cpan_dist, since we don't need to have anything
 214      ### prepared from another installer
 215      $dist    = $self->status->dist_cpan if      $self->status->dist_cpan;
 216      $self->status->dist_cpan( $dist )   unless  $self->status->dist_cpan;
 217  
 218      my $cb   = $self->parent;
 219      my $conf = $cb->configure_object;
 220      my %hash = @_;
 221  
 222      my $dir;
 223      unless( $dir = $self->status->extract ) {
 224          error( loc( "No dir found to operate on!" ) );
 225          return;
 226      }
 227  
 228      my $args;
 229      my( $force, $verbose, $buildflags, $perl);
 230      {   local $Params::Check::ALLOW_UNKNOWN = 1;
 231          my $tmpl = {
 232              force           => {    default => $conf->get_conf('force'),
 233                                      store   => \$force },
 234              verbose         => {    default => $conf->get_conf('verbose'),
 235                                      store   => \$verbose },
 236              perl            => {    default => $^X, store => \$perl },
 237              buildflags      => {    default => $conf->get_conf('buildflags'),
 238                                      store   => \$buildflags },
 239          };
 240  
 241          $args = check( $tmpl, \%hash ) or return;
 242      }
 243  
 244      return 1 if $dist->status->prepared && !$force;
 245  
 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      ### by now we've loaded module::build, and we're using the API, so
 256      ### it's safe to remove CPANPLUS::inc from our inc path, especially
 257      ### because it can trip up tests run under taint (just like EU::MM).
 258      ### turn off our PERL5OPT so no modules from CPANPLUS::inc get
 259      ### included in make test -- it should build without.
 260      ### also, modules that run in taint mode break if we leave
 261      ### our code ref in perl5opt
 262      ### XXX we've removed the ENV settings from cp::inc, so only need
 263      ### to reset the @INC
 264      #local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt;
 265      #local $ENV{PERL5LIB} = CPANPLUS::inc->original_perl5lib;
 266      local @INC           = CPANPLUS::inc->original_inc;
 267  
 268      ### this will generate warnings under anything lower than M::B 0.2606
 269      my %buildflags = $dist->_buildflags_as_hash( $buildflags );
 270      $dist->status->_buildflags( $buildflags );
 271  
 272      my $fail;
 273      RUN: {
 274          # Wrap the exception that may be thrown here (should likely be
 275          # done at a much higher level).
 276          my $mb = eval { 
 277              my $env = 'ENV_CPANPLUS_IS_EXECUTING';
 278              local $ENV{$env} = BUILD_PL->( $dir );
 279              Module::Build->new_from_context( %buildflags ) 
 280          };
 281          if( !$mb or $@ ) {
 282              error(loc("Could not create Module::Build object: %1","$@"));
 283              $fail++; last RUN;
 284          }
 285  
 286          $dist->status->_mb_object( $mb );
 287  
 288          $self->status->prereqs( $dist->_find_prereqs( verbose => $verbose ) );
 289  
 290      }
 291      
 292      ### send out test report? ###
 293      if( $fail and $conf->get_conf('cpantest') ) {
 294             $cb->_send_report( 
 295              module  => $self,
 296              failed  => $fail,
 297              buffer  => CPANPLUS::Error->stack_as_string,
 298              verbose => $verbose,
 299              force   => $force,
 300          ) or error(loc("Failed to send test report for '%1'",
 301                      $self->module ) );
 302      }
 303  
 304      unless( $cb->_chdir( dir => $orig ) ) {
 305          error( loc( "Could not chdir back to start dir '%1'", $orig ) );
 306      }
 307  
 308      ### save where we wrote this stuff -- same as extract dir in normal
 309      ### installer circumstances
 310      $dist->status->distdir( $self->status->extract );
 311  
 312      return $dist->status->prepared( $fail ? 0 : 1 );
 313  }
 314  
 315  sub _find_prereqs {
 316      my $dist = shift;
 317      my $mb   = $dist->status->_mb_object;
 318      my $self = $dist->parent;
 319      my $cb   = $self->parent;
 320  
 321      my $prereqs = {};
 322      foreach my $type ('requires', 'build_requires') {
 323        my $p = $mb->$type() || {};
 324        $prereqs->{$_} = $p->{$_} foreach keys %$p;
 325      }
 326  
 327      ### allows for a user defined callback to filter the prerequisite
 328      ### list as they see fit, to remove (or add) any prereqs they see
 329      ### fit. The default installed callback will return the hashref in
 330      ### an unmodified form
 331      ### this callback got added after cpanplus 0.0562, so use a 'can'
 332      ### to find out if it's supported. For older versions, we'll just
 333      ### return the hashref as is ourselves.
 334      my $href    = $cb->_callbacks->can('filter_prereqs')
 335                      ? $cb->_callbacks->filter_prereqs->( $cb, $prereqs )
 336                      : $prereqs;
 337  
 338      $self->status->prereqs( $href );
 339  
 340      ### make sure it's not the same ref
 341      return { %$href };
 342  }
 343  
 344  sub prereq_satisfied {
 345    # Return true if this prereq is satisfied.  Return false if it's
 346    # not.  Also issue an error if the latest CPAN version doesn't
 347    # satisfy it.
 348    
 349    my ($dist, %args) = @_;
 350    my $mb   = $dist->status->_mb_object;
 351    my $cb   = $dist->parent->parent;
 352    my $mod = $args{modobj}->module;
 353    
 354    my $status = $mb->check_installed_status($mod, $args{version});
 355    return 1 if $status->{ok};
 356    
 357    # Check the latest version from the CPAN index
 358    {
 359      no strict 'refs';
 360      local ${$mod . '::VERSION'} = $args{modobj}->version;
 361      $status = $mb->check_installed_status($mod, $args{version});
 362    }
 363    unless( $status->{ok} ) {
 364      error(loc("This distribution depends on $mod, but the latest version of $mod on CPAN ".
 365            "doesn't satisfy the specific version dependency ($args{version}). ".
 366            "Please try to resolve this dependency manually."));
 367    }
 368    
 369    return 0;
 370  }
 371  
 372  =pod
 373  
 374  =head2 $dist->create([perl => '/path/to/perl', buildflags => 'EXTRA=FLAGS', prereq_target => TARGET, force => BOOL, verbose => BOOL, skiptest => BOOL])
 375  
 376  C<create> preps a distribution for installation. This means it will
 377  run C<Build> and C<Build test>, via the C<Module::Build> API.
 378  This will also satisfy any prerequisites the module may have.
 379  
 380  If you set C<skiptest> to true, it will skip the C<Build test> stage.
 381  If you set C<force> to true, it will go over all the stages of the
 382  C<Build> process again, ignoring any previously cached results. It
 383  will also ignore a bad return value from C<Build test> and still allow
 384  the operation to return true.
 385  
 386  Returns true on success and false on failure.
 387  
 388  You may then call C<< $dist->install >> on the object to actually
 389  install it.
 390  
 391  =cut
 392  
 393  sub create {
 394      ### just in case you already did a create call for this module object
 395      ### just via a different dist object
 396      my $dist = shift;
 397      my $self = $dist->parent;
 398  
 399      ### we're also the cpan_dist, since we don't need to have anything
 400      ### prepared from another installer
 401      $dist    = $self->status->dist_cpan if      $self->status->dist_cpan;
 402      $self->status->dist_cpan( $dist )   unless  $self->status->dist_cpan;
 403  
 404      my $cb   = $self->parent;
 405      my $conf = $cb->configure_object;
 406      my $mb   = $dist->status->_mb_object;
 407      my %hash = @_;
 408  
 409      my $dir;
 410      unless( $dir = $self->status->extract ) {
 411          error( loc( "No dir found to operate on!" ) );
 412          return;
 413      }
 414  
 415      my $args;
 416      my( $force, $verbose, $buildflags, $skiptest, $prereq_target,
 417          $perl, $prereq_format, $prereq_build);
 418      {   local $Params::Check::ALLOW_UNKNOWN = 1;
 419          my $tmpl = {
 420              force           => {    default => $conf->get_conf('force'),
 421                                      store   => \$force },
 422              verbose         => {    default => $conf->get_conf('verbose'),
 423                                      store   => \$verbose },
 424              perl            => {    default => $^X, store => \$perl },
 425              buildflags      => {    default => $conf->get_conf('buildflags'),
 426                                      store   => \$buildflags },
 427              skiptest        => {    default => $conf->get_conf('skiptest'),
 428                                      store   => \$skiptest },
 429              prereq_target   => {    default => '', store => \$prereq_target },
 430              ### don't set the default format to 'build' -- that is wrong!
 431              prereq_format   => {    #default => $self->status->installer_type,
 432                                      default => '',
 433                                      store   => \$prereq_format },
 434              prereq_build    => {    default => 0, store => \$prereq_build },                                    
 435          };
 436  
 437          $args = check( $tmpl, \%hash ) or return;
 438      }
 439  
 440      return 1 if $dist->status->created && !$force;
 441  
 442      $dist->status->_create_args( $args );
 443  
 444      ### is this dist prepared?
 445      unless( $dist->status->prepared ) {
 446          error( loc( "You have not successfully prepared a '%2' distribution ".
 447                      "yet -- cannot create yet", __PACKAGE__ ) );
 448          return;
 449      }
 450  
 451      ### chdir to work directory ###
 452      my $orig = cwd();
 453      unless( $cb->_chdir( dir => $dir ) ) {
 454          error( loc( "Could not chdir to build directory '%1'", $dir ) );
 455          return;
 456      }
 457  
 458      ### by now we've loaded module::build, and we're using the API, so
 459      ### it's safe to remove CPANPLUS::inc from our inc path, especially
 460      ### because it can trip up tests run under taint (just like EU::MM).
 461      ### turn off our PERL5OPT so no modules from CPANPLUS::inc get
 462      ### included in make test -- it should build without.
 463      ### also, modules that run in taint mode break if we leave
 464      ### our code ref in perl5opt
 465      ### XXX we've removed the ENV settings from cp::inc, so only need
 466      ### to reset the @INC
 467      #local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt;
 468      #local $ENV{PERL5LIB} = CPANPLUS::inc->original_perl5lib;
 469      local @INC           = CPANPLUS::inc->original_inc;
 470  
 471      ### but do it *before* the new_from_context, as M::B seems
 472      ### to be actually running the file...
 473      ### an unshift in the block seems to be ignored.. somehow...
 474      #{   my $lib = $self->best_path_to_module_build;
 475      #    unshift @INC, $lib if $lib;
 476      #}
 477      unshift @INC, $self->best_path_to_module_build
 478                  if $self->best_path_to_module_build;
 479  
 480      ### this will generate warnings under anything lower than M::B 0.2606
 481      my %buildflags = $dist->_buildflags_as_hash( $buildflags );
 482      $dist->status->_buildflags( $buildflags );
 483  
 484      my $fail; my $prereq_fail; my $test_fail;
 485      RUN: {
 486  
 487          ### this will set the directory back to the start
 488          ### dir, so we must chdir /again/
 489          my $ok = $dist->_resolve_prereqs(
 490                          force           => $force,
 491                          format          => $prereq_format,
 492                          verbose         => $verbose,
 493                          prereqs         => $self->status->prereqs,
 494                          target          => $prereq_target,
 495                          prereq_build    => $prereq_build,
 496                      );
 497  
 498          unless( $cb->_chdir( dir => $dir ) ) {
 499              error( loc( "Could not chdir to build directory '%1'", $dir ) );
 500              return;
 501          }
 502  
 503          unless( $ok ) {
 504              #### use $dist->flush to reset the cache ###
 505              error( loc( "Unable to satisfy prerequisites for '%1' " .
 506                          "-- aborting install", $self->module ) );
 507              $dist->status->build(0);
 508              $fail++; $prereq_fail++;
 509              last RUN;
 510          }
 511  
 512          eval { $mb->dispatch('build', %buildflags) };
 513          if( $@ ) {
 514              error(loc("Could not run '%1': %2", 'Build', "$@"));
 515              $dist->status->build(0);
 516              $fail++; last RUN;
 517          }
 518  
 519          $dist->status->build(1);
 520  
 521          ### add this directory to your lib ###
 522          $cb->_add_to_includepath(
 523              directories => [ BLIB_LIBDIR->( $self->status->extract ) ]
 524          );
 525  
 526          ### this buffer will not include what tests failed due to a 
 527          ### M::B/Test::Harness bug. Reported as #9793 with patch 
 528          ### against 0.2607 on 26/1/2005
 529          unless( $skiptest ) {
 530              eval { $mb->dispatch('test', %buildflags) };
 531              if( $@ ) {
 532                  error(loc("Could not run '%1': %2", 'Build test', "$@"));
 533  
 534                  ### mark specifically *test* failure.. so we dont
 535                  ### send success on force...
 536                  $test_fail++;
 537  
 538                  if( !$force and !$cb->_callbacks->proceed_on_test_failure->(
 539                                        $self, $@ ) 
 540                  ) {
 541                      $dist->status->test(0);                 
 542                      $fail++; last RUN;     
 543                  }
 544                  
 545              } else {
 546                  $dist->status->test(1);
 547              }
 548          } else {
 549              msg(loc("Tests skipped"), $verbose);
 550          }            
 551      }
 552  
 553      unless( $cb->_chdir( dir => $orig ) ) {
 554          error( loc( "Could not chdir back to start dir '%1'", $orig ) );
 555      }
 556  
 557      ### send out test report? ###
 558      if( $conf->get_conf('cpantest') and not $prereq_fail ) {
 559          $cb->_send_report(
 560              module          => $self,
 561              failed          => $test_fail || $fail,
 562              buffer          => CPANPLUS::Error->stack_as_string,
 563              verbose         => $verbose,
 564              force           => $force,
 565              tests_skipped   => $skiptest,
 566          ) or error(loc("Failed to send test report for '%1'",
 567                      $self->module ) );
 568      }
 569  
 570      return $dist->status->created( $fail ? 0 : 1 );
 571  }
 572  
 573  =head2 $dist->install([verbose => BOOL, perl => /path/to/perl])
 574  
 575  Actually installs the created dist.
 576  
 577  Returns true on success and false on failure.
 578  
 579  =cut
 580  
 581  sub install {
 582      ### just in case you already did a create call for this module object
 583      ### just via a different dist object
 584      my $dist = shift;
 585      my $self = $dist->parent;
 586  
 587      ### we're also the cpan_dist, since we don't need to have anything
 588      ### prepared from another installer
 589      $dist    = $self->status->dist_cpan if $self->status->dist_cpan;
 590      my $mb   = $dist->status->_mb_object;
 591  
 592      my $cb   = $self->parent;
 593      my $conf = $cb->configure_object;
 594      my %hash = @_;
 595  
 596      
 597      my $verbose; my $perl; my $force;
 598      {   local $Params::Check::ALLOW_UNKNOWN = 1;
 599          my $tmpl = {
 600              verbose => { default => $conf->get_conf('verbose'),
 601                           store   => \$verbose },
 602              force   => { default => $conf->get_conf('force'),
 603                           store   => \$force },
 604              perl    => { default => $^X, store   => \$perl },
 605          };
 606      
 607          my $args = check( $tmpl, \%hash ) or return;
 608          $dist->status->_install_args( $args );
 609      }
 610  
 611      my $dir;
 612      unless( $dir = $self->status->extract ) {
 613          error( loc( "No dir found to operate on!" ) );
 614          return;
 615      }
 616  
 617      my $orig = cwd();
 618  
 619      unless( $cb->_chdir( dir => $dir ) ) {
 620          error( loc( "Could not chdir to build directory '%1'", $dir ) );
 621          return;
 622      }
 623  
 624      ### value set and false -- means failure ###
 625      if( defined $self->status->installed && 
 626          !$self->status->installed && !$force
 627      ) {
 628          error( loc( "Module '%1' has failed to install before this session " .
 629                      "-- aborting install", $self->module ) );
 630          return;
 631      }
 632  
 633      my $fail;
 634      my $buildflags = $dist->status->_buildflags;
 635      ### hmm, how is this going to deal with sudo?
 636      ### for now, check effective uid, if it's not root,
 637      ### shell out, otherwise use the method
 638      if( $> ) {
 639  
 640          ### don't worry about loading the right version of M::B anymore
 641          ### the 'new_from_context' already added the 'right' path to
 642          ### M::B at the top of the build.pl
 643          ### On VMS, flags need to be quoted
 644          my $flag    = ON_VMS ? '"install"' : 'install';
 645          my $cmd     = [$perl, BUILD->($dir), $flag, $buildflags];
 646          my $sudo    = $conf->get_program('sudo');
 647          unshift @$cmd, $sudo if $sudo;
 648  
 649  
 650          my $buffer;
 651          unless( scalar run( command => $cmd,
 652                              buffer  => \$buffer,
 653                              verbose => $verbose )
 654          ) {
 655              error(loc("Could not run '%1': %2", 'Build install', $buffer));
 656              $fail++;
 657          }
 658      } else {
 659          my %buildflags = $dist->_buildflags_as_hash($buildflags);
 660  
 661          eval { $mb->dispatch('install', %buildflags) };
 662          if( $@ ) {
 663              error(loc("Could not run '%1': %2", 'Build install', "$@"));
 664              $fail++;
 665          }
 666      }
 667  
 668  
 669      unless( $cb->_chdir( dir => $orig ) ) {
 670          error( loc( "Could not chdir back to start dir '%1'", $orig ) );
 671      }
 672  
 673      return $dist->status->installed( $fail ? 0 : 1 );
 674  }
 675  
 676  ### returns the string 'foo=bar zot=quux' as (foo => bar, zot => quux)
 677  sub _buildflags_as_hash {
 678      my $self    = shift;
 679      my $flags   = shift or return;
 680  
 681      my @argv    = Module::Build->split_like_shell($flags);
 682      my ($argv)  = Module::Build->read_args(@argv);
 683  
 684      return %$argv;
 685  }
 686  
 687  
 688  sub dist_dir {
 689      ### just in case you already did a create call for this module object
 690      ### just via a different dist object
 691      my $dist = shift;
 692      my $self = $dist->parent;
 693  
 694      ### we're also the cpan_dist, since we don't need to have anything
 695      ### prepared from another installer
 696      $dist    = $self->status->dist_cpan if $self->status->dist_cpan;
 697      my $mb   = $dist->status->_mb_object;
 698  
 699      my $cb   = $self->parent;
 700      my $conf = $cb->configure_object;
 701      my %hash = @_;
 702  
 703      
 704      my $dir;
 705      unless( $dir = $self->status->extract ) {
 706          error( loc( "No dir found to operate on!" ) );
 707          return;
 708      }
 709      
 710      ### chdir to work directory ###
 711      my $orig = cwd();
 712      unless( $cb->_chdir( dir => $dir ) ) {
 713          error( loc( "Could not chdir to build directory '%1'", $dir ) );
 714          return;
 715      }
 716  
 717      my $fail; my $distdir;
 718      TRY: {    
 719          $dist->prepare( @_ ) or (++$fail, last TRY);
 720  
 721  
 722          eval { $mb->dispatch('distdir') };
 723          if( $@ ) {
 724              error(loc("Could not run '%1': %2", 'Build distdir', "$@"));
 725              ++$fail, last TRY;
 726          }
 727  
 728          ### /path/to/Foo-Bar-1.2/Foo-Bar-1.2
 729          $distdir = File::Spec->catdir( $dir, $self->package_name . '-' .
 730                                                  $self->package_version );
 731  
 732          unless( -d $distdir ) {
 733              error(loc("Do not know where '%1' got created", 'distdir'));
 734              ++$fail, last TRY;
 735          }
 736      }
 737  
 738      unless( $cb->_chdir( dir => $orig ) ) {
 739          error( loc( "Could not chdir to start directory '%1'", $orig ) );
 740          return;
 741      }
 742  
 743      return if $fail;
 744      return $distdir;
 745  }    
 746  
 747  =head1 KNOWN ISSUES
 748  
 749  Below are some of the known issues with Module::Build, that we hope 
 750  the authors will resolve at some point, so we can make full use of
 751  Module::Build's power. 
 752  The number listed is the bug number on C<rt.cpan.org>.
 753  
 754  =over 4
 755  
 756  =item * Module::Build can not be upgraded using its own API (#13169)
 757  
 758  This is due to the fact that the Build file insists on adding a path
 759  to C<@INC> which force the loading of the C<not yet installed>
 760  Module::Build when it shells out to run it's own build procedure:
 761  
 762  =item * Module::Build does not provide access to install history (#9793)
 763  
 764  C<Module::Build> runs the create, test and install procedures in it's
 765  own processes, but does not provide access to any diagnostic messages of
 766  those processes. As an end result, we can not offer these diagnostic 
 767  messages when, for example, reporting automated build failures to sites
 768  like C<testers.cpan.org>.
 769  
 770  =back
 771  
 772  =head1 AUTHOR
 773  
 774  Originally by Jos Boumans E<lt>kane@cpan.orgE<gt>.  Brought to working
 775  condition and currently maintained by Ken Williams E<lt>kwilliams@cpan.orgE<gt>.
 776  
 777  =head1 COPYRIGHT
 778  
 779  The CPAN++ interface (of which this module is a part of) is
 780  copyright (c) 2001, 2002, 2003, 2004, 2005 Jos Boumans E<lt>kane@cpan.orgE<gt>.
 781  All rights reserved.
 782  
 783  This library is free software;
 784  you may redistribute and/or modify it under the same
 785  terms as Perl itself.
 786  
 787  =cut
 788  
 789  1;
 790  
 791  # Local variables:
 792  # c-indentation-style: bsd
 793  # c-basic-offset: 4
 794  # indent-tabs-mode: nil
 795  # End:
 796  # vim: expandtab shiftwidth=4: