lib/CPANPLUS/Module.pm

   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();