[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/5.10.0/CPANPLUS/ -> Module.pm (source)

   1  package CPANPLUS::Module;
   2  
   3  use strict;
   4  use vars qw[@ISA];
   5  
   6  
   7  use CPANPLUS::Dist;
   8  use CPANPLUS::Error;
   9  use CPANPLUS::Module::Signature;
  10  use CPANPLUS::Module::Checksums;
  11  use CPANPLUS::Internals::Constants;
  12  
  13  use FileHandle;
  14  
  15  use Locale::Maketext::Simple    Class => 'CPANPLUS', Style => 'gettext';
  16  use IPC::Cmd                    qw[can_run run];
  17  use File::Find                  qw[find];
  18  use Params::Check               qw[check];
  19  use Module::Load::Conditional   qw[can_load check_install];
  20  
  21  $Params::Check::VERBOSE = 1;
  22  
  23  @ISA = qw[ CPANPLUS::Module::Signature CPANPLUS::Module::Checksums];
  24  
  25  =pod
  26  
  27  =head1 NAME
  28  
  29  CPANPLUS::Module
  30  
  31  =head1 SYNOPSIS
  32  
  33      ### get a module object from the CPANPLUS::Backend object
  34      my $mod = $cb->module_tree('Some::Module');
  35  
  36      ### accessors
  37      $mod->version;
  38      $mod->package;
  39  
  40      ### methods
  41      $mod->fetch;
  42      $mod->extract;
  43      $mod->install;
  44  
  45  
  46  =head1 DESCRIPTION
  47  
  48  C<CPANPLUS::Module> creates objects from the information in the
  49  source files. These can then be used to query and perform actions
  50  on, like fetching or installing.
  51  
  52  These objects should only be created internally. For C<fake> objects,
  53  there's the C<CPANPLUS::Module::Fake> class. To obtain a module object
  54  consult the C<CPANPLUS::Backend> documentation.
  55  
  56  =cut
  57  
  58  my $tmpl = {
  59      module      => { default => '', required => 1 },    # full module name
  60      version     => { default => '0.0' },                # version number
  61      path        => { default => '', required => 1 },    # extended path on the
  62                                                          # cpan mirror, like
  63                                                          # /author/id/K/KA/KANE
  64      comment     => { default => ''},                    # comment on module
  65      package     => { default => '', required => 1 },    # package name, like
  66                                                          # 'bar-baz-1.03.tgz'
  67      description => { default => '' },                   # description of the
  68                                                          # module
  69      dslip       => { default => EMPTY_DSLIP },          # dslip information
  70      _id         => { required => 1 },                   # id of the Internals
  71                                                          # parent object
  72      _status     => { no_override => 1 },                # stores status object
  73      author      => { default => '', required => 1,
  74                       allow => IS_AUTHOBJ },             # module author
  75      mtime       => { default => '' },
  76  };
  77  
  78  ### some of these will be resolved by wrapper functions that
  79  ### do Clever Things to find the actual value, so don't create
  80  ### an autogenerated sub for that just here, take an alternate
  81  ### name to allow for a wrapper
  82  {   my %rename = (
  83          dslip   => '_dslip'
  84      );
  85  
  86      ### autogenerate accessors ###
  87      for my $key ( keys %$tmpl ) {
  88          no strict 'refs';
  89        
  90          my $sub = $rename{$key} || $key;
  91        
  92          *{__PACKAGE__."::$sub"} = sub {
  93              $_[0]->{$key} = $_[1] if @_ > 1;
  94              return $_[0]->{$key};
  95          }
  96      }
  97  }
  98  
  99  
 100  =pod
 101  
 102  =head1 CLASS METHODS
 103  
 104  =head2 accessors ()
 105  
 106  Returns a list of all accessor methods to the object
 107  
 108  =cut
 109  
 110  ### *name is an alias, include it explicitly
 111  sub accessors { return ('name', keys %$tmpl) };
 112  
 113  =head1 ACCESSORS
 114  
 115  An objects of this class has the following accessors:
 116  
 117  =over 4
 118  
 119  =item name
 120  
 121  Name of the module.
 122  
 123  =item module
 124  
 125  Name of the module.
 126  
 127  =item version
 128  
 129  Version of the module. Defaults to '0.0' if none was provided.
 130  
 131  =item path
 132  
 133  Extended path on the mirror.
 134  
 135  =item comment
 136  
 137  Any comment about the module -- largely unused.
 138  
 139  =item package
 140  
 141  The name of the package.
 142  
 143  =item description
 144  
 145  Description of the module -- only registered modules have this.
 146  
 147  =item dslip
 148  
 149  The five character dslip string, that represents meta-data of the
 150  module -- again, only registered modules have this.
 151  
 152  =cut
 153  
 154  sub dslip {
 155      my $self    = shift;   
 156  
 157      ### if this module has relevant dslip info, return it
 158      return $self->_dslip if $self->_dslip ne EMPTY_DSLIP;
 159  
 160      ### if not, look at other modules in the same package,
 161      ### see if *they* have any dslip info
 162      for my $mod ( $self->contains ) {
 163          return $mod->_dslip if $mod->_dslip ne EMPTY_DSLIP;
 164      }
 165      
 166      ### ok, really no dslip info found, return the default
 167      return EMPTY_DSLIP;
 168  }
 169  
 170  
 171  =pod
 172  
 173  =item status
 174  
 175  The C<CPANPLUS::Module::Status> object associated with this object.
 176  (see below).
 177  
 178  =item author
 179  
 180  The C<CPANPLUS::Module::Author> object associated with this object.
 181  
 182  =item parent
 183  
 184  The C<CPANPLUS::Internals> object that spawned this module object.
 185  
 186  =back
 187  
 188  =cut
 189  
 190  ### Alias ->name to ->module, for human beings.
 191  *name = *module;
 192  
 193  sub parent {
 194      my $self = shift;
 195      my $obj  = CPANPLUS::Internals->_retrieve_id( $self->_id );
 196  
 197      return $obj;
 198  }
 199  
 200  =head1 STATUS ACCESSORS
 201  
 202  C<CPANPLUS> caches a lot of results from method calls and saves data
 203  it collected along the road for later reuse.
 204  
 205  C<CPANPLUS> uses this internally, but it is also available for the end
 206  user. You can get a status object by calling:
 207  
 208      $modobj->status
 209  
 210  You can then query the object as follows:
 211  
 212  =over 4
 213  
 214  =item installer_type
 215  
 216  The installer type used for this distribution. Will be one of
 217  'makemaker' or 'build'. This determines whether C<CPANPLUS::Dist::MM>
 218  or C<CPANPLUS::Dist::Build> will be used to build this distribution.
 219  
 220  =item dist_cpan
 221  
 222  The dist object used to do the CPAN-side of the installation. Either
 223  a C<CPANPLUS::Dist::MM> or C<CPANPLUS::Dist::Build> object.
 224  
 225  =item dist
 226  
 227  The custom dist object used to do the operating specific side of the
 228  installation, if you've chosen to use this. For example, if you've
 229  chosen to install using the C<ports> format, this may be a
 230  C<CPANPLUS::Dist::Ports> object.
 231  
 232  Undefined if you didn't specify a separate format to install through.
 233  
 234  =item prereqs
 235  
 236  A hashref of prereqs this distribution was found to have. Will look
 237  something like this:
 238  
 239      { Carp  => 0.01, strict => 0 }
 240  
 241  Might be undefined if the distribution didn't have any prerequisites.
 242  
 243  =item signature
 244  
 245  Flag indicating, if a signature check was done, whether it was OK or
 246  not.
 247  
 248  =item extract
 249  
 250  The directory this distribution was extracted to.
 251  
 252  =item fetch
 253  
 254  The location this distribution was fetched to.
 255  
 256  =item readme
 257  
 258  The text of this distributions README file.
 259  
 260  =item uninstall
 261  
 262  Flag indicating if an uninstall call was done successfully.
 263  
 264  =item created
 265  
 266  Flag indicating if the C<create> call to your dist object was done
 267  successfully.
 268  
 269  =item installed
 270  
 271  Flag indicating if the C<install> call to your dist object was done
 272  successfully.
 273  
 274  =item checksums
 275  
 276  The location of this distributions CHECKSUMS file.
 277  
 278  =item checksum_ok
 279  
 280  Flag indicating if the checksums check was done successfully.
 281  
 282  =item checksum_value
 283  
 284  The checksum value this distribution is expected to have
 285  
 286  =back
 287  
 288  =head1 METHODS
 289  
 290  =head2 $self = CPANPLUS::Module::new( OPTIONS )
 291  
 292  This method returns a C<CPANPLUS::Module> object. Normal users
 293  should never call this method directly, but instead use the
 294  C<CPANPLUS::Backend> to obtain module objects.
 295  
 296  This example illustrates a C<new()> call with all required arguments:
 297  
 298          CPANPLUS::Module->new(
 299              module  => 'Foo',
 300              path    => 'authors/id/A/AA/AAA',
 301              package => 'Foo-1.0.tgz',
 302              author  => $author_object,
 303              _id     => INTERNALS_OBJECT_ID,
 304          );
 305  
 306  Every accessor is also a valid option to pass to C<new>.
 307  
 308  Returns a module object on success and false on failure.
 309  
 310  =cut
 311  
 312  
 313  sub new {
 314      my($class, %hash) = @_;
 315  
 316      ### don't check the template for sanity
 317      ### -- we know it's good and saves a lot of performance
 318      local $Params::Check::SANITY_CHECK_TEMPLATE = 0;
 319  
 320      my $object  = check( $tmpl, \%hash ) or return;
 321  
 322      bless $object, $class;
 323  
 324      return $object;
 325  }
 326  
 327  ### only create status objects when they're actually asked for
 328  sub status {
 329      my $self = shift;
 330      return $self->_status if $self->_status;
 331      
 332      my $acc = Object::Accessor->new;
 333      $acc->mk_accessors( qw[ installer_type dist_cpan dist prereqs
 334                              signature extract fetch readme uninstall
 335                              created installed prepared checksums files
 336                              checksum_ok checksum_value _fetch_from] );
 337  
 338      $self->_status( $acc );
 339  
 340      return $self->_status;
 341  }
 342  
 343  
 344  ### flush the cache of this object ###
 345  sub _flush {
 346      my $self = shift;
 347      $self->status->mk_flush;
 348      return 1;
 349  }
 350  
 351  =head2 $mod->package_name
 352  
 353  Returns the name of the package a module is in. For C<Acme::Bleach>
 354  that might be C<Acme-Bleach>.
 355  
 356  =head2 $mod->package_version
 357  
 358  Returns the version of the package a module is in. For a module
 359  in the package C<Acme-Bleach-1.1.tar.gz> this would be C<1.1>.
 360  
 361  =head2 $mod->package_extension
 362  
 363  Returns the suffix added by the compression method of a package a
 364  certain module is in. For a module in C<Acme-Bleach-1.1.tar.gz>, this
 365  would be C<tar.gz>.
 366  
 367  =head2 $mod->package_is_perl_core
 368  
 369  Returns a boolean indicating of the package a particular module is in,
 370  is actually a core perl distribution.
 371  
 372  =head2 $mod->module_is_supplied_with_perl_core( [version => $]] )
 373  
 374  Returns a boolean indicating whether C<ANY VERSION> of this module
 375  was supplied with the current running perl's core package.
 376  
 377  =head2 $mod->is_bundle
 378  
 379  Returns a boolean indicating if the module you are looking at, is
 380  actually a bundle. Bundles are identified as modules whose name starts
 381  with C<Bundle::>.
 382  
 383  =head2 $mod->is_third_party
 384  
 385  Returns a boolean indicating whether the package is a known third-party 
 386  module (i.e. it's not provided by the standard Perl distribution and 
 387  is not available on the CPAN, but on a third party software provider).
 388  See L<Module::ThirdParty> for more details.
 389  
 390  =head2 $mod->third_party_information
 391  
 392  Returns a reference to a hash with more information about a third-party
 393  module. See the documentation about C<module_information()> in 
 394  L<Module::ThirdParty> for more details.
 395  
 396  =cut
 397  
 398  {   ### fetches the test reports for a certain module ###
 399      my %map = (
 400          name        => 0,
 401          version     => 1,
 402          extension   => 2,
 403      );        
 404      
 405      while ( my($type, $index) = each %map ) {
 406          my $name    = 'package_' . $type;
 407          
 408          no strict 'refs';
 409          *$name = sub {
 410              my $self = shift;
 411              my @res  = $self->parent->_split_package_string(     
 412                              package => $self->package 
 413                         );
 414       
 415              ### return the corresponding index from the result
 416              return $res[$index] if @res;
 417              return;
 418          };
 419      }        
 420  
 421      sub package_is_perl_core {
 422          my $self = shift;
 423  
 424          ### check if the package looks like a perl core package
 425          return 1 if $self->package_name eq PERL_CORE;
 426  
 427          my $core = $self->module_is_supplied_with_perl_core;
 428          ### ok, so it's found in the core, BUT it could be dual-lifed
 429          if ($core) {
 430              ### if the package is newer than installed, then it's dual-lifed
 431              return if $self->version > $self->installed_version;
 432  
 433              ### if the package is newer or equal to the corelist, 
 434              ### then it's dual-lifed
 435              return if $self->version >= $core;
 436  
 437              ### otherwise, it's older than corelist, thus unsuitable.
 438              return 1;
 439          }
 440  
 441          ### not in corelist, not a perl core package.
 442          return;
 443      }
 444  
 445      sub module_is_supplied_with_perl_core {
 446          my $self = shift;
 447          my $ver  = shift || $];
 448  
 449          ### check Module::CoreList to see if it's a core package
 450          require Module::CoreList;
 451          my $core = $Module::CoreList::version{ $ver }->{ $self->module };
 452  
 453          return $core;
 454      }
 455  
 456      ### make sure Bundle-Foo also gets flagged as bundle
 457      sub is_bundle {
 458          return shift->module =~ /^bundle(?:-|::)/i ? 1 : 0;
 459      }
 460  
 461      sub is_third_party {
 462          my $self = shift;
 463          
 464          return unless can_load( modules => { 'Module::ThirdParty' => 0 } );
 465          
 466          return Module::ThirdParty::is_3rd_party( $self->name );
 467      }
 468  
 469      sub third_party_information {
 470          my $self = shift;
 471  
 472          return unless $self->is_third_party; 
 473  
 474          return Module::ThirdParty::module_information( $self->name );
 475      }
 476  }
 477  
 478  =pod
 479  
 480  =head2 $clone = $self->clone
 481  
 482  Clones the current module object for tinkering with.
 483  It will have a clean C<CPANPLUS::Module::Status> object, as well as
 484  a fake C<CPANPLUS::Module::Author> object.
 485  
 486  =cut
 487  
 488  sub clone {
 489      my $self = shift;
 490  
 491      ### clone the object ###
 492      my %data;
 493      for my $acc ( grep !/status/, __PACKAGE__->accessors() ) {
 494          $data{$acc} = $self->$acc();
 495      }
 496  
 497      my $obj = CPANPLUS::Module::Fake->new( %data );
 498  
 499      return $obj;
 500  }
 501  
 502  =pod
 503  
 504  =head2 $where = $self->fetch
 505  
 506  Fetches the module from a CPAN mirror.
 507  Look at L<CPANPLUS::Internals::Fetch::_fetch()> for details on the
 508  options you can pass.
 509  
 510  =cut
 511  
 512  sub fetch {
 513      my $self = shift;
 514      my $cb   = $self->parent;
 515  
 516      ### custom args
 517      my %args            = ( module => $self );
 518  
 519      ### if a custom fetch location got specified before, add that here
 520      $args{fetch_from}   = $self->status->_fetch_from 
 521                              if $self->status->_fetch_from;
 522  
 523      my $where = $cb->_fetch( @_, %args ) or return;
 524  
 525      ### do an md5 check ###
 526      if( !$self->status->_fetch_from and 
 527          $cb->configure_object->get_conf('md5') and
 528          $self->package ne CHECKSUMS
 529      ) {
 530          unless( $self->_validate_checksum ) {
 531              error( loc( "Checksum error for '%1' -- will not trust package",
 532                          $self->package) );
 533              return;
 534          }
 535      }
 536  
 537      return $where;
 538  }
 539  
 540  =pod
 541  
 542  =head2 $path = $self->extract
 543  
 544  Extracts the fetched module.
 545  Look at L<CPANPLUS::Internals::Extract::_extract()> for details on
 546  the options you can pass.
 547  
 548  =cut
 549  
 550  sub extract {
 551      my $self = shift;
 552      my $cb   = $self->parent;
 553  
 554      unless( $self->status->fetch ) {
 555          error( loc( "You have not fetched '%1' yet -- cannot extract",
 556                      $self->module) );
 557          return;
 558      }
 559  
 560      return $cb->_extract( @_, module => $self );
 561  }
 562  
 563  =head2 $type = $self->get_installer_type([prefer_makefile => BOOL])
 564  
 565  Gets the installer type for this module. This may either be C<build> or
 566  C<makemaker>. If C<Module::Build> is unavailable or no installer type
 567  is available, it will fall back to C<makemaker>. If both are available,
 568  it will pick the one indicated by your config, or by the
 569  C<prefer_makefile> option you can pass to this function.
 570  
 571  Returns the installer type on success, and false on error.
 572  
 573  =cut
 574  
 575  sub get_installer_type {
 576      my $self = shift;
 577      my $cb   = $self->parent;
 578      my $conf = $cb->configure_object;
 579      my %hash = @_;
 580  
 581      my $prefer_makefile;
 582      my $tmpl = {
 583          prefer_makefile => { default => $conf->get_conf('prefer_makefile'),
 584                               store => \$prefer_makefile, allow => BOOLEANS },
 585      };
 586  
 587      check( $tmpl, \%hash ) or return;
 588  
 589      my $extract = $self->status->extract();
 590      unless( $extract ) {
 591          error(loc("Cannot determine installer type of unextracted module '%1'",
 592                    $self->module));
 593          return;
 594      }
 595  
 596  
 597      ### check if it's a makemaker or a module::build type dist ###
 598      my $found_build     = -e BUILD_PL->( $extract );
 599      my $found_makefile  = -e MAKEFILE_PL->( $extract );
 600  
 601      my $type;
 602      $type = INSTALLER_BUILD if !$prefer_makefile &&  $found_build;
 603      $type = INSTALLER_BUILD if  $found_build     && !$found_makefile;
 604      $type = INSTALLER_MM    if  $prefer_makefile &&  $found_makefile;
 605      $type = INSTALLER_MM    if  $found_makefile  && !$found_build;
 606  
 607      ### ok, so it's a 'build' installer, but you don't /have/ module build
 608      if( $type eq INSTALLER_BUILD and ( 
 609              not grep { $_ eq INSTALLER_BUILD } CPANPLUS::Dist->dist_types )
 610      ) {
 611          error( loc( "This module requires '%1' and '%2' to be installed, ".
 612                      "but you don't have it! Will fall back to ".
 613                      "'%3', but might not be able to install!",
 614                       'Module::Build', INSTALLER_BUILD, INSTALLER_MM ) );
 615          $type = INSTALLER_MM;
 616  
 617      ### ok, actually we found neither ###
 618      } elsif ( !$type ) {
 619          error( loc( "Unable to find '%1' or '%2' for '%3'; ".
 620                      "Will default to '%4' but might be unable ".
 621                      "to install!", BUILD_PL->(), MAKEFILE_PL->(),
 622                      $self->module, INSTALLER_MM ) );
 623          $type = INSTALLER_MM;
 624      }
 625  
 626      return $self->status->installer_type( $type ) if $type;
 627      return;
 628  }
 629  
 630  =pod
 631  
 632  =head2 $dist = $self->dist([target => 'prepare|create', format => DISTRIBUTION_TYPE, args => {key => val}]);
 633  
 634  Create a distribution object, ready to be installed.
 635  Distribution type defaults to your config settings
 636  
 637  The optional C<args> hashref is passed on to the specific distribution
 638  types' C<create> method after being dereferenced.
 639  
 640  Returns a distribution object on success, false on failure.
 641  
 642  See C<CPANPLUS::Dist> for details.
 643  
 644  =cut
 645  
 646  sub dist {
 647      my $self = shift;
 648      my $cb   = $self->parent;
 649      my $conf = $cb->configure_object;
 650      my %hash = @_;
 651  
 652      ### have you determined your installer type yet? if not, do it here,
 653      ### we need the info
 654      $self->get_installer_type unless $self->status->installer_type;
 655  
 656  
 657      my($type,$args,$target);
 658      my $tmpl = {
 659          format  => { default => $conf->get_conf('dist_type') ||
 660                                  $self->status->installer_type,
 661                       store   => \$type },
 662          target  => { default => TARGET_CREATE, store => \$target },                     
 663          args    => { default => {}, store => \$args },
 664      };
 665  
 666      check( $tmpl, \%hash ) or return;
 667  
 668      my $dist = CPANPLUS::Dist->new( 
 669                                  format => $type,
 670                                  module => $self
 671                              ) or return;
 672  
 673      my $dist_cpan = $type eq $self->status->installer_type
 674                          ? $dist
 675                          : CPANPLUS::Dist->new(
 676                                  format  => $self->status->installer_type,
 677                                  module  => $self,
 678                              );           
 679  
 680      ### store the dists
 681      $self->status->dist_cpan(   $dist_cpan );
 682      $self->status->dist(        $dist );
 683      
 684      DIST: {
 685          ### first prepare the dist
 686          $dist->prepare( %$args ) or return;
 687          $self->status->prepared(1);
 688  
 689          ### you just wanted us to prepare?
 690          last DIST if $target eq TARGET_PREPARE;
 691  
 692          $dist->create( %$args ) or return;
 693          $self->status->created(1);
 694      }
 695  
 696      return $dist;
 697  }
 698  
 699  =pod
 700  
 701  =head2 $bool = $mod->prepare( )
 702   
 703  Convenience method around C<install()> that prepares a module 
 704  without actually building it. This is equivalent to invoking C<install>
 705  with C<target> set to C<prepare>
 706  
 707  Returns true on success, false on failure.
 708  
 709  =cut
 710  
 711  sub prepare { 
 712      my $self = shift;
 713      return $self->install( @_, target => TARGET_PREPARE );
 714  }
 715  
 716  =head2 $bool = $mod->create( )
 717  
 718  Convenience method around C<install()> that creates a module. 
 719  This is equivalent to invoking C<install> with C<target> set to 
 720  C<create>
 721  
 722  Returns true on success, false on failure.
 723  
 724  =cut
 725  
 726  sub create { 
 727      my $self = shift;
 728      return $self->install( @_, target => TARGET_CREATE );
 729  }
 730  
 731  =head2 $bool = $mod->test( )
 732  
 733  Convenience wrapper around C<install()> that tests a module, without
 734  installing it.
 735  It's the equivalent to invoking C<install()> with C<target> set to
 736  C<create> and C<skiptest> set to C<0>.
 737  
 738  Returns true on success, false on failure.
 739  
 740  =cut
 741  
 742  sub test {
 743      my $self = shift;
 744      return $self->install( @_, target => TARGET_CREATE, skiptest => 0 );
 745  }
 746  
 747  =pod
 748  
 749  =head2 $bool = $self->install([ target => 'prepare|create|install', format => FORMAT_TYPE, extractdir => DIRECTORY, fetchdir => DIRECTORY, prefer_bin => BOOL, force => BOOL, verbose => BOOL, ..... ]);
 750  
 751  Installs the current module. This includes fetching it and extracting
 752  it, if this hasn't been done yet, as well as creating a distribution
 753  object for it.
 754  
 755  This means you can pass it more arguments than described above, which
 756  will be passed on to the relevant methods as they are called.
 757  
 758  See C<CPANPLUS::Internals::Fetch>, C<CPANPLUS::Internals::Extract> and
 759  C<CPANPLUS::Dist> for details.
 760  
 761  Returns true on success, false on failure.
 762  
 763  =cut
 764  
 765  sub install {
 766      my $self = shift;
 767      my $cb   = $self->parent;
 768      my $conf = $cb->configure_object;
 769      my %hash = @_;
 770  
 771      my $args; my $target; my $format;
 772      {   ### so we can use the rest of the args to the create calls etc ###
 773          local $Params::Check::NO_DUPLICATES = 1;
 774          local $Params::Check::ALLOW_UNKNOWN = 1;
 775  
 776          ### targets 'dist' and 'test' are now completely ignored ###
 777          my $tmpl = {
 778                          ### match this allow list with Dist->_resolve_prereqs
 779              target     => { default => TARGET_INSTALL, store => \$target,
 780                              allow   => [TARGET_PREPARE, TARGET_CREATE,
 781                                          TARGET_INSTALL] },
 782              force      => { default => $conf->get_conf('force'), },
 783              verbose    => { default => $conf->get_conf('verbose'), },
 784              format     => { default => $conf->get_conf('dist_type'),
 785                                  store => \$format },
 786          };
 787  
 788          $args = check( $tmpl, \%hash ) or return;
 789      }
 790  
 791  
 792      ### if this target isn't 'install', we will need to at least 'create' 
 793      ### every prereq, so it can build
 794      ### XXX prereq_target of 'prepare' will do weird things here, and is
 795      ### not supported.
 796      $args->{'prereq_target'} ||= TARGET_CREATE if $target ne TARGET_INSTALL;
 797  
 798      ### check if it's already upto date ###
 799      if( $target eq TARGET_INSTALL and !$args->{'force'} and
 800          !$self->package_is_perl_core() and         # separate rules apply
 801          ( $self->status->installed() or $self->is_uptodate ) and
 802          !INSTALL_VIA_PACKAGE_MANAGER->($format)
 803      ) {
 804          msg(loc("Module '%1' already up to date, won't install without force",
 805                  $self->module), $args->{'verbose'} );
 806          return $self->status->installed(1);
 807      }
 808  
 809      # if it's a non-installable core package, abort the install.
 810      if( $self->package_is_perl_core() ) {
 811          # if the installed is newer, say so.
 812          if( $self->installed_version > $self->version ) {
 813              error(loc("The core Perl %1 module '%2' (%3) is more ".
 814                        "recent than the latest release on CPAN (%4). ".
 815                        "Aborting install.",
 816                        $], $self->module, $self->installed_version,
 817                        $self->version ) );
 818          # if the installed matches, say so.
 819          } elsif( $self->installed_version == $self->version ) {
 820              error(loc("The core Perl %1 module '%2' (%3) can only ".
 821                        "be installed by Perl itself. ".
 822                        "Aborting install.",
 823                        $], $self->module, $self->installed_version ) );
 824          # otherwise, the installed is older; say so.
 825          } else {
 826              error(loc("The core Perl %1 module '%2' can only be ".
 827                        "upgraded from %3 to %4 by Perl itself (%5). ".
 828                        "Aborting install.",
 829                        $], $self->module, $self->installed_version,
 830                        $self->version, $self->package ) );
 831          }
 832          return;
 833      
 834      ### it might be a known 3rd party module
 835      } elsif ( $self->is_third_party ) {
 836          my $info = $self->third_party_information;
 837          error(loc(
 838              "%1 is a known third-party module.\n\n".
 839              "As it isn't available on the CPAN, CPANPLUS can't install " .
 840              "it automatically. Therefore you need to install it manually " .
 841              "before proceeding.\n\n".
 842              "%2 is part of %3, published by %4, and should be available ".
 843              "for download at the following address:\n\t%5",
 844              $self->name, $self->name, $info->{name}, $info->{author},
 845              $info->{url}
 846          ));
 847          
 848          return;
 849      }
 850  
 851      ### fetch it if need be ###
 852      unless( $self->status->fetch ) {
 853          my $params;
 854          for (qw[prefer_bin fetchdir]) {
 855              $params->{$_} = $args->{$_} if exists $args->{$_};
 856          }
 857          for (qw[force verbose]) {
 858              $params->{$_} = $args->{$_} if defined $args->{$_};
 859          }
 860          $self->fetch( %$params ) or return;
 861      }
 862  
 863      ### extract it if need be ###
 864      unless( $self->status->extract ) {
 865          my $params;
 866          for (qw[prefer_bin extractdir]) {
 867              $params->{$_} = $args->{$_} if exists $args->{$_};
 868          }
 869          for (qw[force verbose]) {
 870              $params->{$_} = $args->{$_} if defined $args->{$_};
 871          }
 872          $self->extract( %$params ) or return;
 873      }
 874  
 875      $format ||= $self->status->installer_type;
 876  
 877      unless( $format ) {
 878          error( loc( "Don't know what installer to use; " .
 879                      "Couldn't find either '%1' or '%2' in the extraction " .
 880                      "directory '%3' -- will be unable to install",
 881                      BUILD_PL->(), MAKEFILE_PL->(), $self->status->extract ) );
 882  
 883          $self->status->installed(0);
 884          return;
 885      }
 886  
 887  
 888      ### do SIGNATURE checks? ###
 889      if( $conf->get_conf('signature') ) {
 890          unless( $self->check_signature( verbose => $args->{verbose} ) ) {
 891              error( loc( "Signature check failed for module '%1' ".
 892                          "-- Not trusting this module, aborting install",
 893                          $self->module ) );
 894              $self->status->signature(0);
 895              
 896              ### send out test report on broken sig
 897              if( $conf->get_conf('cpantest') ) {
 898                  $cb->_send_report( 
 899                      module  => $self,
 900                      failed  => 1,
 901                      buffer  => CPANPLUS::Error->stack_as_string,
 902                      verbose => $args->{verbose},
 903                      force   => $args->{force},
 904                  ) or error(loc("Failed to send test report for '%1'",
 905                       $self->module ) );
 906              }  
 907              
 908              return;
 909  
 910          } else {
 911              ### signature OK ###
 912              $self->status->signature(1);
 913          }
 914      }
 915  
 916      ### a target of 'create' basically means not to run make test ###
 917      ### eh, no it /doesn't/.. skiptest => 1 means skiptest => 1.
 918      #$args->{'skiptest'} = 1 if $target eq 'create';
 919  
 920      ### bundle rules apply ###
 921      if( $self->is_bundle ) {
 922          ### check what we need to install ###
 923          my @prereqs = $self->bundle_modules();
 924          unless( @prereqs ) {
 925              error( loc( "Bundle '%1' does not specify any modules to install",
 926                          $self->module ) );
 927  
 928              ### XXX mark an error here? ###
 929          }
 930      }
 931  
 932      my $dist = $self->dist( format  => $format, 
 933                              target  => $target, 
 934                              args    => $args );
 935      unless( $dist ) {
 936          error( loc( "Unable to create a new distribution object for '%1' " .
 937                      "-- cannot continue", $self->module ) );
 938          return;
 939      }
 940  
 941      return 1 if $target ne TARGET_INSTALL;
 942  
 943      my $ok = $dist->install( %$args ) ? 1 : 0;
 944  
 945      $self->status->installed($ok);
 946  
 947      return 1 if $ok;
 948      return;
 949  }
 950  
 951  =pod @list = $self->bundle_modules()
 952  
 953  Returns a list of module objects the Bundle specifies.
 954  
 955  This requires you to have extracted the bundle already, using the
 956  C<extract()> method.
 957  
 958  Returns false on error.
 959  
 960  =cut
 961  
 962  sub bundle_modules {
 963      my $self = shift;
 964      my $cb   = $self->parent;
 965  
 966      unless( $self->is_bundle ) {
 967          error( loc("'%1' is not a bundle", $self->module ) );
 968          return;
 969      }
 970  
 971      my $dir;
 972      unless( $dir = $self->status->extract ) {
 973          error( loc("Don't know where '%1' was extracted to", $self->module ) );
 974          return;
 975      }
 976  
 977      my @files;
 978      find( {
 979          wanted      => sub { push @files, File::Spec->rel2abs($_) if /\.pm/i; },
 980          no_chdir    => 1,
 981      }, $dir );
 982  
 983      my $prereqs = {}; my @list; my $seen = {};
 984      for my $file ( @files ) {
 985          my $fh = FileHandle->new($file)
 986                      or( error(loc("Could not open '%1' for reading: %2",
 987                          $file,$!)), next );
 988  
 989          my $flag;
 990          while(<$fh>) {
 991              ### quick hack to read past the header of the file ###
 992              last if $flag && m|^=head|i;
 993  
 994              ### from perldoc cpan:
 995              ### =head1 CONTENTS
 996              ### In this pod section each line obeys the format
 997              ### Module_Name [Version_String] [- optional text]
 998              $flag = 1 if m|^=head1 CONTENTS|i;
 999  
1000              if ($flag && /^(?!=)(\S+)\s*(\S+)?/) {
1001                  my $module  = $1;
1002                  my $version = $2 || '0';
1003  
1004                  my $obj = $cb->module_tree($module);
1005  
1006                  unless( $obj ) {
1007                      error(loc("Cannot find bundled module '%1'", $module),
1008                            loc("-- it does not seem to exist") );
1009                      next;
1010                  }
1011  
1012                  ### make sure we list no duplicates ###
1013                  unless( $seen->{ $obj->module }++ ) {
1014                      push @list, $obj;
1015                      $prereqs->{ $module } =
1016                          $cb->_version_to_number( version => $version );
1017                  }
1018              }
1019          }
1020      }
1021  
1022      ### store the prereqs we just found ###
1023      $self->status->prereqs( $prereqs );
1024  
1025      return @list;
1026  }
1027  
1028  =pod
1029  
1030  =head2 $text = $self->readme
1031  
1032  Fetches the readme belonging to this module and stores it under
1033  C<< $obj->status->readme >>. Returns the readme as a string on
1034  success and returns false on failure.
1035  
1036  =cut
1037  
1038  sub readme {
1039      my $self = shift;
1040      my $conf = $self->parent->configure_object;    
1041  
1042      ### did we already dl the readme once? ###
1043      return $self->status->readme() if $self->status->readme();
1044  
1045      ### this should be core ###
1046      return unless can_load( modules     => { FileHandle => '0.0' },
1047                              verbose     => 1,
1048                          );
1049  
1050      ### get a clone of the current object, with a fresh status ###
1051      my $obj  = $self->clone or return;
1052  
1053      ### munge the package name
1054      my $pkg = README->( $obj );
1055      $obj->package($pkg);
1056  
1057      my $file;
1058      {   ### disable checksum fetches on readme downloads
1059          
1060          my $tmp = $conf->get_conf( 'md5' );
1061          $conf->set_conf( md5 => 0 );
1062          
1063          $file = $obj->fetch;
1064  
1065          $conf->set_conf( md5 => $tmp );
1066  
1067          return unless $file;
1068      }
1069  
1070      ### read the file into a scalar, to store in the original object ###
1071      my $fh = new FileHandle;
1072      unless( $fh->open($file) ) {
1073          error( loc( "Could not open file '%1': %2", $file, $! ) );
1074          return;
1075      }
1076  
1077      my $in;
1078      { local $/; $in = <$fh> };
1079      $fh->close;
1080  
1081      return $self->status->readme( $in );
1082  }
1083  
1084  =pod
1085  
1086  =head2 $version = $self->installed_version()
1087  
1088  Returns the currently installed version of this module, if any.
1089  
1090  =head2 $where = $self->installed_file()
1091  
1092  Returns the location of the currently installed file of this module,
1093  if any.
1094  
1095  =head2 $bool = $self->is_uptodate([version => VERSION_NUMBER])
1096  
1097  Returns a boolean indicating if this module is uptodate or not.
1098  
1099  =cut
1100  
1101  ### uptodate/installed functions
1102  {   my $map = {             # hashkey,      alternate rv
1103          installed_version   => ['version',  0 ],
1104          installed_file      => ['file',     ''],
1105          is_uptodate         => ['uptodate', 0 ],
1106      };
1107  
1108      while( my($method, $aref) = each %$map ) {
1109          my($key,$alt_rv) = @$aref;
1110  
1111          no strict 'refs';
1112          *$method = sub {
1113              ### never use the @INC hooks to find installed versions of
1114              ### modules -- they're just there in case they're not on the
1115              ### perl install, but the user shouldn't trust them for *other*
1116              ### modules!
1117              ### XXX CPANPLUS::inc is now obsolete, so this should not
1118              ### be needed anymore
1119              #local @INC = CPANPLUS::inc->original_inc;
1120  
1121              my $self = shift;
1122              
1123              ### make sure check_install is not looking in %INC, as
1124              ### that may contain some of our sneakily loaded modules
1125              ### that aren't installed as such. -- kane
1126              local $Module::Load::Conditional::CHECK_INC_HASH = 0;
1127              my $href = check_install(
1128                              module  => $self->module,
1129                              version => $self->version,
1130                              @_,
1131                          );
1132  
1133              return $href->{$key} || $alt_rv;
1134          }
1135      }
1136  }
1137  
1138  
1139  
1140  =pod
1141  
1142  =head2 $href = $self->details()
1143  
1144  Returns a hashref with key/value pairs offering more information about
1145  a particular module. For example, for C<Time::HiRes> it might look like
1146  this:
1147  
1148      Author                  Jarkko Hietaniemi (jhi@iki.fi)
1149      Description             High resolution time, sleep, and alarm
1150      Development Stage       Released
1151      Installed File          /usr/local/perl/lib/Time/Hires.pm
1152      Interface Style         plain Functions, no references used
1153      Language Used           C and perl, a C compiler will be needed
1154      Package                 Time-HiRes-1.65.tar.gz
1155      Public License          Unknown
1156      Support Level           Developer
1157      Version Installed       1.52
1158      Version on CPAN         1.65
1159  
1160  =cut
1161  
1162  sub details {
1163      my $self = shift;
1164      my $conf = $self->parent->configure_object();
1165      my $cb   = $self->parent;
1166      my %hash = @_;
1167  
1168      my $res = {
1169          Author              => loc("%1 (%2)",   $self->author->author(),
1170                                                  $self->author->email() ),
1171          Package             => $self->package,
1172          Description         => $self->description     || loc('None given'),
1173          'Version on CPAN'   => $self->version,
1174      };
1175  
1176      ### check if we have the module installed
1177      ### if so, add version have and version on cpan
1178      $res->{'Version Installed'} = $self->installed_version
1179                                      if $self->installed_version;
1180      $res->{'Installed File'} = $self->installed_file if $self->installed_file;
1181  
1182      my $i = 0;
1183      for my $item( split '', $self->dslip ) {
1184          $res->{ $cb->_dslip_defs->[$i]->[0] } =
1185                  $cb->_dslip_defs->[$i]->[1]->{$item} || loc('Unknown');
1186          $i++;
1187      }
1188  
1189      return $res;
1190  }
1191  
1192  =head2 @list = $self->contains()
1193  
1194  Returns a list of module objects that represent the modules also 
1195  present in the package of this module.
1196  
1197  For example, for C<Archive::Tar> this might return:
1198  
1199      Archive::Tar
1200      Archive::Tar::Constant
1201      Archive::Tar::File
1202  
1203  =cut
1204  
1205  sub contains {
1206      my $self = shift;
1207      my $cb   = $self->parent;
1208      my $pkg  = $self->package;
1209  
1210      my @mods = $cb->search( type => 'package', allow => [qr/^$pkg$/] );
1211      
1212      return @mods;
1213  }
1214  
1215  =pod
1216  
1217  =head2 @list_of_hrefs = $self->fetch_report()
1218  
1219  This function queries the CPAN testers database at
1220  I<http://testers.cpan.org/> for test results of specified module
1221  objects, module names or distributions.
1222  
1223  Look at L<CPANPLUS::Internals::Report::_query_report()> for details on
1224  the options you can pass and the return value to expect.
1225  
1226  =cut
1227  
1228  sub fetch_report {
1229      my $self    = shift;
1230      my $cb      = $self->parent;
1231  
1232      return $cb->_query_report( @_, module => $self );
1233  }
1234  
1235  =pod
1236  
1237  =head2 $bool = $self->uninstall([type => [all|man|prog])
1238  
1239  This function uninstalls the specified module object.
1240  
1241  You can install 2 types of files, either C<man> pages or C<prog>ram
1242  files. Alternately you can specify C<all> to uninstall both (which
1243  is the default).
1244  
1245  Returns true on success and false on failure.
1246  
1247  Do note that this does an uninstall via the so-called C<.packlist>,
1248  so if you used a module installer like say, C<ports> or C<apt>, you
1249  should not use this, but use your package manager instead.
1250  
1251  =cut
1252  
1253  sub uninstall {
1254      my $self = shift;
1255      my $conf = $self->parent->configure_object();
1256      my %hash = @_;
1257  
1258      my ($type,$verbose);
1259      my $tmpl = {
1260          type    => { default => 'all', allow => [qw|man prog all|],
1261                          store => \$type },
1262          verbose => { default => $conf->get_conf('verbose'),
1263                          store => \$verbose },
1264          force   => { default => $conf->get_conf('force') },
1265      };
1266  
1267      ### XXX add a warning here if your default install dist isn't
1268      ### makefile or build -- that means you are using a package manager
1269      ### and this will not do what you think!
1270  
1271      my $args = check( $tmpl, \%hash ) or return;
1272  
1273      if( $conf->get_conf('dist_type') and (
1274          ($conf->get_conf('dist_type') ne INSTALLER_BUILD) or
1275          ($conf->get_conf('dist_type') ne INSTALLER_MM))
1276      ) {
1277          msg(loc("You have a default installer type set (%1) ".
1278                  "-- you should probably use that package manager to " .
1279                  "uninstall modules", $conf->get_conf('dist_type')), $verbose);
1280      }
1281  
1282      ### check if we even have the module installed -- no point in continuing
1283      ### otherwise
1284      unless( $self->installed_version ) {
1285          error( loc( "Module '%1' is not installed, so cannot uninstall",
1286                      $self->module ) );
1287          return;
1288      }
1289  
1290                                                  ### nothing to uninstall ###
1291      my $files   = $self->files( type => $type )             or return;
1292      my $dirs    = $self->directory_tree( type => $type )    or return;
1293      my $sudo    = $conf->get_program('sudo');
1294  
1295      ### just in case there's no file; M::B doensn't provide .packlists yet ###
1296      my $pack    = $self->packlist;
1297      $pack       = $pack->[0]->packlist_file() if $pack;
1298  
1299      ### first remove the files, then the dirs if they are empty ###
1300      my $flag = 0;
1301      for my $file( @$files, $pack ) {
1302          next unless defined $file && -f $file;
1303  
1304          msg(loc("Unlinking '%1'", $file), $verbose);
1305  
1306          my @cmd = ($^X, "-eunlink+q[$file]");
1307          unshift @cmd, $sudo if $sudo;
1308  
1309          my $buffer;
1310          unless ( run(   command => \@cmd,
1311                          verbose => $verbose,
1312                          buffer  => \$buffer )
1313          ) {
1314              error(loc("Failed to unlink '%1': '%2'",$file, $buffer));
1315              $flag++;
1316          }
1317      }
1318  
1319      for my $dir ( sort @$dirs ) {
1320          local *DIR;
1321          open DIR, $dir or next;
1322          my @count = readdir(DIR);
1323          close DIR;
1324  
1325          next unless @count == 2;    # . and ..
1326  
1327          msg(loc("Removing '%1'", $dir), $verbose);
1328  
1329          ### this fails on my win2k machines.. it indeed leaves the
1330          ### dir, but it's not a critical error, since the files have
1331          ### been removed. --kane
1332          #unless( rmdir $dir ) {
1333          #    error( loc( "Could not remove '%1': %2", $dir, $! ) )
1334          #        unless $^O eq 'MSWin32';
1335          #}
1336          
1337          my @cmd = ($^X, "-ermdir+q[$dir]");
1338          unshift @cmd, $sudo if $sudo;
1339          
1340          my $buffer;
1341          unless ( run(   command => \@cmd,
1342                          verbose => $verbose,
1343                          buffer  => \$buffer )
1344          ) {
1345              error(loc("Failed to rmdir '%1': %2",$dir,$buffer));
1346              $flag++;
1347          }
1348      }
1349  
1350      $self->status->uninstall(!$flag);
1351      $self->status->installed( $flag ? 1 : undef);
1352  
1353      return !$flag;
1354  }
1355  
1356  =pod
1357  
1358  =head2 @modobj = $self->distributions()
1359  
1360  Returns a list of module objects representing all releases for this
1361  module on success, false on failure.
1362  
1363  =cut
1364  
1365  sub distributions {
1366      my $self = shift;
1367      my %hash = @_;
1368  
1369      my @list = $self->author->distributions( %hash, module => $self ) or return;
1370  
1371      ### it's another release then by the same author ###
1372      return grep { $_->package_name eq $self->package_name } @list;
1373  }
1374  
1375  =pod
1376  
1377  =head2 @list = $self->files ()
1378  
1379  Returns a list of files used by this module, if it is installed.
1380  
1381  =cut
1382  
1383  sub files {
1384      return shift->_extutils_installed( @_, method => 'files' );
1385  }
1386  
1387  =pod
1388  
1389  =head2 @list = $self->directory_tree ()
1390  
1391  Returns a list of directories used by this module.
1392  
1393  =cut
1394  
1395  sub directory_tree {
1396      return shift->_extutils_installed( @_, method => 'directory_tree' );
1397  }
1398  
1399  =pod
1400  
1401  =head2 @list = $self->packlist ()
1402  
1403  Returns the C<ExtUtils::Packlist> object for this module.
1404  
1405  =cut
1406  
1407  sub packlist {
1408      return shift->_extutils_installed( @_, method => 'packlist' );
1409  }
1410  
1411  =pod
1412  
1413  =head2 @list = $self->validate ()
1414  
1415  Returns a list of files that are missing for this modules, but
1416  are present in the .packlist file.
1417  
1418  =cut
1419  
1420  sub validate {
1421      return shift->_extutils_installed( method => 'validate' );
1422  }
1423  
1424  ### generic method to call an ExtUtils::Installed method ###
1425  sub _extutils_installed {
1426      my $self = shift;
1427      my $conf = $self->parent->configure_object();
1428      my %hash = @_;
1429  
1430      my ($verbose,$type,$method);
1431      my $tmpl = {
1432          verbose => {    default     => $conf->get_conf('verbose'),
1433                          store       => \$verbose, },
1434          type    => {    default     => 'all',
1435                          allow       => [qw|prog man all|],
1436                          store       => \$type, },
1437          method  => {    required    => 1,
1438                          store       => \$method,
1439                          allow       => [qw|files directory_tree packlist
1440                                          validate|],
1441                      },
1442      };
1443  
1444      my $args = check( $tmpl, \%hash ) or return;
1445  
1446      ### old versions of cygwin + perl < 5.8 are buggy here. bail out if we
1447      ### find we're being used by them
1448      {   my $err = ON_OLD_CYGWIN;
1449          if($err) { error($err); return };
1450      }
1451  
1452      return unless can_load(
1453                          modules     => { 'ExtUtils::Installed' => '0.0' },
1454                          verbose     => $verbose,
1455                      );
1456  
1457      my $inst;
1458      unless( $inst = ExtUtils::Installed->new() ) {
1459          error( loc("Could not create an '%1' object", 'ExtUtils::Installed' ) );
1460  
1461          ### in case it's being used directly... ###
1462          return;
1463      }
1464  
1465  
1466      {   ### EU::Installed can die =/
1467          my @files;
1468          eval { @files = $inst->$method( $self->module, $type ) };
1469  
1470          if( $@ ) {
1471              chomp $@;
1472              error( loc("Could not get '%1' for '%2': %3",
1473                          $method, $self->module, $@ ) );
1474              return;
1475          }
1476  
1477          return wantarray ? @files : \@files;
1478      }
1479  }
1480  
1481  =head2 $bool = $self->add_to_includepath;
1482  
1483  Adds the current modules path to C<@INC> and C<$PERL5LIB>. This allows
1484  you to add the module from it's build dir to your path.
1485  
1486  You can reset C<@INC> and C<$PERL5LIB> to it's original state when you
1487  started the program, by calling:
1488  
1489      $self->parent->flush('lib');
1490      
1491  =cut
1492  
1493  sub add_to_includepath {
1494      my $self = shift;
1495      my $cb   = $self->parent;
1496      
1497      if( my $dir = $self->status->extract ) {
1498          
1499              $cb->_add_to_includepath(
1500                      directories => [
1501                          File::Spec->catdir(BLIB->($dir), LIB),
1502                          File::Spec->catdir(BLIB->($dir), ARCH),
1503                          BLIB->($dir),
1504                      ]
1505              ) or return;
1506          
1507      } else {
1508          error(loc(  "No extract dir registered for '%1' -- can not add ".
1509                      "add builddir to search path!", $self->module ));
1510          return;
1511      }
1512  
1513      return 1;
1514  
1515  }
1516  
1517  =pod
1518  
1519  =head2 $path = $self->best_path_to_module_build();
1520  
1521  B<OBSOLETE>
1522  
1523  If a newer version of Module::Build is found in your path, it will
1524  return this C<special> path. If the newest version of C<Module::Build>
1525  is found in your regular C<@INC>, the method will return false. This
1526  indicates you do not need to add a special directory to your C<@INC>.
1527  
1528  Note that this is only relevant if you're building your own
1529  C<CPANPLUS::Dist::*> plugin -- the built-in dist types already have
1530  this taken care of.
1531  
1532  =cut
1533  
1534  ### make sure we're always running 'perl Build.PL' and friends
1535  ### against the highest version of module::build available
1536  sub best_path_to_module_build {
1537      my $self = shift;
1538  
1539      ### Since M::B will actually shell out and run the Build.PL, we must
1540      ### make sure it refinds the proper version of M::B in the path.
1541      ### that may be either in our cp::inc or in site_perl, or even a
1542      ### new M::B being installed.
1543      ### don't add anything else here, as that might screw up prereq checks
1544  
1545      ### XXX this might be needed for Dist::MM too, if a makefile.pl is
1546      ###    masquerading as a Build.PL
1547  
1548      ### did we find the most recent module::build in our installer path?
1549  
1550      ### XXX can't do changes to @INC, they're being ignored by
1551      ### new_from_context when writing a Build script. see ticket:
1552      ### #8826 Module::Build ignores changes to @INC when writing Build
1553      ### from new_from_context
1554      ### XXX applied schwern's patches (as seen on CPANPLUS::Devel 10/12/04)
1555      ### and upped the version to 0.26061 of the bundled version, and things
1556      ### work again
1557  
1558      ### this functionality is now obsolete -- prereqs should be installed
1559      ### and we no longer use the CPANPLUS::inc magic.. so comment this out.
1560  #     require Module::Build;
1561  #     if( CPANPLUS::inc->path_to('Module::Build') and (
1562  #         CPANPLUS::inc->path_to('Module::Build') eq
1563  #         CPANPLUS::inc->installer_path )
1564  #     ) {
1565  # 
1566  #         ### if the module being installed is *not* Module::Build
1567  #         ### itself -- as that would undoubtedly be newer -- add
1568  #         ### the path to the installers to @INC
1569  #         ### if it IS module::build itself, add 'lib' to its path,
1570  #         ### as the Build.PL would do as well, but the API doesn't.
1571  #         ### this makes self updates possible
1572  #         return $self->module eq 'Module::Build'
1573  #                         ? 'lib'
1574  #                         : CPANPLUS::inc->installer_path;
1575  #     }
1576  
1577      ### otherwise, the path was found through a 'normal' way of
1578      ### scanning @INC.
1579      return;
1580  }
1581  
1582  =pod
1583  
1584  =head1 BUG REPORTS
1585  
1586  Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.
1587  
1588  =head1 AUTHOR
1589  
1590  This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
1591  
1592  =head1 COPYRIGHT
1593  
1594  The CPAN++ interface (of which this module is a part of) is copyright (c) 
1595  2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved.
1596  
1597  This library is free software; you may redistribute and/or modify it 
1598  under the same terms as Perl itself.
1599  
1600  =cut
1601  
1602  # Local variables:
1603  # c-indentation-style: bsd
1604  # c-basic-offset: 4
1605  # indent-tabs-mode: nil
1606  # End:
1607  # vim: expandtab shiftwidth=4:
1608  
1609  1;
1610  
1611  __END__
1612  
1613  todo:
1614  reports();


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1