summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/CPANPLUS/Module.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPANPLUS/Module.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/CPANPLUS/Module.pm1839
1 files changed, 0 insertions, 1839 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Module.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Module.pm
deleted file mode 100644
index 4eda894629a..00000000000
--- a/Master/tlpkg/tlperl/lib/CPANPLUS/Module.pm
+++ /dev/null
@@ -1,1839 +0,0 @@
-package CPANPLUS::Module;
-use deprecate;
-
-use strict;
-use vars qw[@ISA $VERSION];
-$VERSION = "0.9135";
-
-use CPANPLUS::Dist;
-use CPANPLUS::Error;
-use CPANPLUS::Module::Signature;
-use CPANPLUS::Module::Checksums;
-use CPANPLUS::Internals::Constants;
-
-use FileHandle;
-
-use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
-use IPC::Cmd qw[can_run run];
-use File::Find qw[find];
-use Params::Check qw[check];
-use File::Basename qw[dirname];
-use Module::Load::Conditional qw[can_load check_install];
-
-$Params::Check::VERBOSE = 1;
-
-@ISA = qw[ CPANPLUS::Module::Signature CPANPLUS::Module::Checksums];
-
-=pod
-
-=head1 NAME
-
-CPANPLUS::Module - CPAN module objects for CPANPLUS
-
-=head1 SYNOPSIS
-
- ### get a module object from the CPANPLUS::Backend object
- my $mod = $cb->module_tree('Some::Module');
-
- ### accessors
- $mod->version;
- $mod->package;
-
- ### methods
- $mod->fetch;
- $mod->extract;
- $mod->install;
-
-
-=head1 DESCRIPTION
-
-C<CPANPLUS::Module> creates objects from the information in the
-source files. These can then be used to query and perform actions
-on, like fetching or installing.
-
-These objects should only be created internally. For C<fake> objects,
-there's the C<CPANPLUS::Module::Fake> class. To obtain a module object
-consult the C<CPANPLUS::Backend> documentation.
-
-=cut
-
-my $tmpl = {
- module => { default => '', required => 1 }, # full module name
- version => { default => '0.0' }, # version number
- path => { default => '', required => 1 }, # extended path on the
- # cpan mirror, like
- # /author/id/K/KA/KANE
- comment => { default => ''}, # comment on module
- package => { default => '', required => 1 }, # package name, like
- # 'bar-baz-1.03.tgz'
- description => { default => '' }, # description of the
- # module
- dslip => { default => EMPTY_DSLIP }, # dslip information
- _id => { required => 1 }, # id of the Internals
- # parent object
- _status => { no_override => 1 }, # stores status object
- author => { default => '', required => 1,
- allow => IS_AUTHOBJ }, # module author
- mtime => { default => '' },
-};
-
-### some of these will be resolved by wrapper functions that
-### do Clever Things to find the actual value, so don't create
-### an autogenerated sub for that just here, take an alternate
-### name to allow for a wrapper
-{ my %rename = (
- dslip => '_dslip'
- );
-
- ### autogenerate accessors ###
- for my $key ( keys %$tmpl ) {
- no strict 'refs';
-
- my $sub = $rename{$key} || $key;
-
- *{__PACKAGE__."::$sub"} = sub {
- $_[0]->{$key} = $_[1] if @_ > 1;
- return $_[0]->{$key};
- }
- }
-}
-
-
-=pod
-
-=head1 CLASS METHODS
-
-=head2 accessors ()
-
-Returns a list of all accessor methods to the object
-
-=cut
-
-### *name is an alias, include it explicitly
-sub accessors { return ('name', keys %$tmpl) };
-
-=head1 ACCESSORS
-
-An objects of this class has the following accessors:
-
-=over 4
-
-=item name
-
-Name of the module.
-
-=item module
-
-Name of the module.
-
-=item version
-
-Version of the module. Defaults to '0.0' if none was provided.
-
-=item path
-
-Extended path on the mirror.
-
-=item comment
-
-Any comment about the module -- largely unused.
-
-=item package
-
-The name of the package.
-
-=item description
-
-Description of the module -- only registered modules have this.
-
-=item dslip
-
-The five character dslip string, that represents meta-data of the
-module -- again, only registered modules have this.
-
-=cut
-
-sub dslip {
- my $self = shift;
-
- ### if this module has relevant dslip info, return it
- return $self->_dslip if $self->_dslip ne EMPTY_DSLIP;
-
- ### if not, look at other modules in the same package,
- ### see if *they* have any dslip info
- for my $mod ( $self->contains ) {
- return $mod->_dslip if $mod->_dslip ne EMPTY_DSLIP;
- }
-
- ### ok, really no dslip info found, return the default
- return EMPTY_DSLIP;
-}
-
-
-=pod
-
-=item status
-
-The C<CPANPLUS::Module::Status> object associated with this object.
-(see below).
-
-=item author
-
-The C<CPANPLUS::Module::Author> object associated with this object.
-
-=item parent
-
-The C<CPANPLUS::Internals> object that spawned this module object.
-
-=back
-
-=cut
-
-### Alias ->name to ->module, for human beings.
-*name = *module;
-
-sub parent {
- my $self = shift;
- my $obj = CPANPLUS::Internals->_retrieve_id( $self->_id );
-
- return $obj;
-}
-
-=head1 STATUS ACCESSORS
-
-C<CPANPLUS> caches a lot of results from method calls and saves data
-it collected along the road for later reuse.
-
-C<CPANPLUS> uses this internally, but it is also available for the end
-user. You can get a status object by calling:
-
- $modobj->status
-
-You can then query the object as follows:
-
-=over 4
-
-=item installer_type
-
-The installer type used for this distribution. Will be one of
-'makemaker' or 'build'. This determines whether C<CPANPLUS::Dist::MM>
-or C<CPANPLUS::Dist::Build> will be used to build this distribution.
-
-=item dist_cpan
-
-The dist object used to do the CPAN-side of the installation. Either
-a C<CPANPLUS::Dist::MM> or C<CPANPLUS::Dist::Build> object.
-
-=item dist
-
-The custom dist object used to do the operating specific side of the
-installation, if you've chosen to use this. For example, if you've
-chosen to install using the C<ports> format, this may be a
-C<CPANPLUS::Dist::Ports> object.
-
-Undefined if you didn't specify a separate format to install through.
-
-=item prereqs | requires
-
-A hashref of prereqs this distribution was found to have. Will look
-something like this:
-
- { Carp => 0.01, strict => 0 }
-
-Might be undefined if the distribution didn't have any prerequisites.
-
-=item configure_requires
-
-Like prereqs, but these are necessary to be installed before the
-build process can even begin.
-
-=item signature
-
-Flag indicating, if a signature check was done, whether it was OK or
-not.
-
-=item extract
-
-The directory this distribution was extracted to.
-
-=item fetch
-
-The location this distribution was fetched to.
-
-=item readme
-
-The text of this distributions README file.
-
-=item uninstall
-
-Flag indicating if an uninstall call was done successfully.
-
-=item created
-
-Flag indicating if the C<create> call to your dist object was done
-successfully.
-
-=item installed
-
-Flag indicating if the C<install> call to your dist object was done
-successfully.
-
-=item checksums
-
-The location of this distributions CHECKSUMS file.
-
-=item checksum_ok
-
-Flag indicating if the checksums check was done successfully.
-
-=item checksum_value
-
-The checksum value this distribution is expected to have
-
-=back
-
-=head1 METHODS
-
-=head2 $self = CPANPLUS::Module->new( OPTIONS )
-
-This method returns a C<CPANPLUS::Module> object. Normal users
-should never call this method directly, but instead use the
-C<CPANPLUS::Backend> to obtain module objects.
-
-This example illustrates a C<new()> call with all required arguments:
-
- CPANPLUS::Module->new(
- module => 'Foo',
- path => 'authors/id/A/AA/AAA',
- package => 'Foo-1.0.tgz',
- author => $author_object,
- _id => INTERNALS_OBJECT_ID,
- );
-
-Every accessor is also a valid option to pass to C<new>.
-
-Returns a module object on success and false on failure.
-
-=cut
-
-
-sub new {
- my($class, %hash) = @_;
-
- ### don't check the template for sanity
- ### -- we know it's good and saves a lot of performance
- local $Params::Check::SANITY_CHECK_TEMPLATE = 0;
-
- my $object = check( $tmpl, \%hash ) or return;
-
- bless $object, $class;
-
- return $object;
-}
-
-### only create status objects when they're actually asked for
-sub status {
- my $self = shift;
- return $self->_status if $self->_status;
-
- my $acc = Object::Accessor->new;
- $acc->mk_accessors( qw[ installer_type dist_cpan dist prereqs
- signature extract fetch readme uninstall
- created installed prepared checksums files
- checksum_ok checksum_value _fetch_from
- configure_requires
- ] );
-
- ### create an alias from 'requires' to 'prereqs', so it's more in
- ### line with 'configure_requires';
- $acc->mk_aliases( requires => 'prereqs' );
-
- $self->_status( $acc );
-
- return $self->_status;
-}
-
-
-### flush the cache of this object ###
-sub _flush {
- my $self = shift;
- $self->status->mk_flush;
- return 1;
-}
-
-=head2 $mod->package_name( [$package_string] )
-
-Returns the name of the package a module is in. For C<Acme::Bleach>
-that might be C<Acme-Bleach>.
-
-=head2 $mod->package_version( [$package_string] )
-
-Returns the version of the package a module is in. For a module
-in the package C<Acme-Bleach-1.1.tar.gz> this would be C<1.1>.
-
-=head2 $mod->package_extension( [$package_string] )
-
-Returns the suffix added by the compression method of a package a
-certain module is in. For a module in C<Acme-Bleach-1.1.tar.gz>, this
-would be C<tar.gz>.
-
-=head2 $mod->package_is_perl_core
-
-Returns a boolean indicating of the package a particular module is in,
-is actually a core perl distribution.
-
-=head2 $mod->module_is_supplied_with_perl_core( [version => $]] )
-
-Returns a boolean indicating whether C<ANY VERSION> of this module
-was supplied with the current running perl's core package.
-
-=head2 $mod->is_bundle
-
-Returns a boolean indicating if the module you are looking at, is
-actually a bundle. Bundles are identified as modules whose name starts
-with C<Bundle::>.
-
-=head2 $mod->is_autobundle;
-
-Returns a boolean indicating if the module you are looking at, is
-actually an autobundle as generated by C<< $cb->autobundle >>.
-
-=head2 $mod->is_third_party
-
-Returns a boolean indicating whether the package is a known third-party
-module (i.e. it's not provided by the standard Perl distribution and
-is not available on the CPAN, but on a third party software provider).
-See L<Module::ThirdParty> for more details.
-
-=head2 $mod->third_party_information
-
-Returns a reference to a hash with more information about a third-party
-module. See the documentation about C<module_information()> in
-L<Module::ThirdParty> for more details.
-
-=cut
-
-{ ### fetches the test reports for a certain module ###
- my %map = (
- name => 0,
- version => 1,
- extension => 2,
- );
-
- while ( my($type, $index) = each %map ) {
- my $name = 'package_' . $type;
-
- no strict 'refs';
- *$name = sub {
- my $self = shift;
- my $val = shift || $self->package;
- my @res = $self->parent->_split_package_string( package => $val );
-
- ### return the corresponding index from the result
- return $res[$index] if @res;
- return;
- };
- }
-
- sub package_is_perl_core {
- my $self = shift;
- my $cb = $self->parent;
-
- ### check if the package looks like a perl core package
- return 1 if $self->package_name eq PERL_CORE;
-
- ### address #44562: ::Module->package_is_perl_code : problem comparing
- ### version strings -- use $cb->_vcmp to avoid warnings when version
- ### have _ in them
-
- my $core = $self->module_is_supplied_with_perl_core;
- ### ok, so it's found in the core, BUT it could be dual-lifed
- if (defined $core) {
- ### if the package is newer than installed, then it's dual-lifed
- return if $cb->_vcmp($self->version, $self->installed_version) > 0;
-
- ### if the package is newer or equal to the corelist,
- ### then it's dual-lifed
- return if $cb->_vcmp( $self->version, $core ) >= 0;
-
- ### otherwise, it's older than corelist, thus unsuitable.
- return 1;
- }
-
- ### not in corelist, not a perl core package.
- return;
- }
-
- sub module_is_supplied_with_perl_core {
- my $self = shift;
- my $ver = shift || $];
-
- ### allow it to be called as a package function as well like:
- ### CPANPLUS::Module::module_is_supplied_with_perl_core('Config')
- ### so that we can check the status of modules that aren't released
- ### to CPAN, but are part of the core.
- my $name = ref $self ? $self->module : $self;
-
- ### check Module::CoreList to see if it's a core package
- require Module::CoreList;
-
- ### Address #41157: Module::module_is_supplied_with_perl_core()
- ### broken for perl 5.10: Module::CoreList's version key for the
- ### hash has a different number of trailing zero than $] aka
- ### $PERL_VERSION.
-
- my $core;
-
- if ( exists $Module::CoreList::version{ 0+$ver }->{ $name } ) {
- $core = $Module::CoreList::version{ 0+$ver }->{ $name };
- $core = 0 unless $core;
- }
- return $core;
- }
-
- ### make sure Bundle-Foo also gets flagged as bundle
- sub is_bundle {
- my $self = shift;
-
- ### cpan'd bundle
- return 1 if $self->module =~ /^bundle(?:-|::)/i;
-
- ### autobundle
- return 1 if $self->is_autobundle;
-
- ### neither
- return;
- }
-
- ### full path to a generated autobundle
- sub is_autobundle {
- my $self = shift;
- my $conf = $self->parent->configure_object;
- my $prefix = $conf->_get_build('autobundle_prefix');
-
- return 1 if $self->module eq $prefix;
- return;
- }
-
- sub is_third_party {
- my $self = shift;
-
- return unless can_load( modules => { 'Module::ThirdParty' => 0 } );
-
- return Module::ThirdParty::is_3rd_party( $self->name );
- }
-
- sub third_party_information {
- my $self = shift;
-
- return unless $self->is_third_party;
-
- return Module::ThirdParty::module_information( $self->name );
- }
-}
-
-=pod
-
-=head2 $clone = $self->clone
-
-Clones the current module object for tinkering with.
-It will have a clean C<CPANPLUS::Module::Status> object, as well as
-a fake C<CPANPLUS::Module::Author> object.
-
-=cut
-
-{ ### accessors dont change during run time, so only compute once
- my @acc = grep !/status/, __PACKAGE__->accessors();
-
- sub clone {
- my $self = shift;
-
- ### clone the object ###
- my %data = map { $_ => $self->$_ } @acc;
-
- my $obj = CPANPLUS::Module::Fake->new( %data );
-
- return $obj;
- }
-}
-
-=pod
-
-=head2 $where = $self->fetch
-
-Fetches the module from a CPAN mirror.
-Look at L<CPANPLUS::Internals::Fetch::_fetch()> for details on the
-options you can pass.
-
-=cut
-
-sub fetch {
- my $self = shift;
- my $cb = $self->parent;
-
- ### custom args
- my %args = ( module => $self );
-
- ### if a custom fetch location got specified before, add that here
- $args{fetch_from} = $self->status->_fetch_from
- if $self->status->_fetch_from;
-
- my $where = $cb->_fetch( @_, %args ) or return;
-
- ### do an md5 check ###
- if( !$self->status->_fetch_from and
- $cb->configure_object->get_conf('md5') and
- $self->package ne CHECKSUMS
- ) {
- unless( $self->_validate_checksum ) {
- error( loc( "Checksum error for '%1' -- will not trust package",
- $self->package) );
- return;
- }
- }
-
- return $where;
-}
-
-=pod
-
-=head2 $path = $self->extract
-
-Extracts the fetched module.
-Look at L<CPANPLUS::Internals::Extract::_extract()> for details on
-the options you can pass.
-
-=cut
-
-sub extract {
- my $self = shift;
- my $cb = $self->parent;
-
- unless( $self->status->fetch ) {
- error( loc( "You have not fetched '%1' yet -- cannot extract",
- $self->module) );
- return;
- }
-
- ### can't extract these, so just use the basedir for the file
- if( $self->is_autobundle ) {
-
- ### this is expected to be set after an extract call
- $self->get_installer_type;
-
- return $self->status->extract( dirname( $self->status->fetch ) );
- }
-
- return $cb->_extract( @_, module => $self );
-}
-
-=head2 $type = $self->get_installer_type([prefer_makefile => BOOL])
-
-Gets the installer type for this module. This may either be C<build> or
-C<makemaker>. If C<Module::Build> is unavailable or no installer type
-is available, it will fall back to C<makemaker>. If both are available,
-it will pick the one indicated by your config, or by the
-C<prefer_makefile> option you can pass to this function.
-
-Returns the installer type on success, and false on error.
-
-=cut
-
-sub get_installer_type {
- my $self = shift;
- my $cb = $self->parent;
- my $conf = $cb->configure_object;
- my %hash = @_;
-
- my ($prefer_makefile,$verbose);
- my $tmpl = {
- prefer_makefile => { default => $conf->get_conf('prefer_makefile'),
- store => \$prefer_makefile, allow => BOOLEANS },
- verbose => { default => $conf->get_conf('verbose'),
- store => \$verbose },
- };
-
- check( $tmpl, \%hash ) or return;
-
- my $type;
-
- ### autobundles use their own installer, so return that
- if( $self->is_autobundle ) {
- $type = INSTALLER_AUTOBUNDLE;
-
- } else {
- my $extract = $self->status->extract();
- unless( $extract ) {
- error(loc(
- "Cannot determine installer type of unextracted module '%1'",
- $self->module
- ));
- return;
- }
-
- ### check if it's a makemaker or a module::build type dist ###
- my $found_build = -e BUILD_PL->( $extract );
- my $found_makefile = -e MAKEFILE_PL->( $extract );
-
- $type = INSTALLER_BUILD if !$prefer_makefile && $found_build;
- $type = INSTALLER_BUILD if $found_build && !$found_makefile;
- $type = INSTALLER_MM if $prefer_makefile && $found_makefile;
- $type = INSTALLER_MM if $found_makefile && !$found_build;
- # Special case Module::Build to always use INSTALLER_MM
- $type = INSTALLER_MM if $self->package =~ m{^Module-Build-\d};
-
- }
-
- ### ok, so it's a 'build' installer, but you don't /have/ module build
- ### XXX duplicated from CPANPLUS::Selfupdate. fix somehow?
- if( $type and $type eq INSTALLER_BUILD and (
- not CPANPLUS::Dist->has_dist_type( INSTALLER_BUILD )
- or not $cb->module_tree( INSTALLER_BUILD )
- ->is_uptodate( version => '0.60' )
- ) ) {
-
- ### XXX this is for recording purposes only. We *have* to install
- ### these before even creating a dist object, or we'll get an error
- ### saying 'no such dist type';
- ### XXX duplicated from CPANPLUS::Selfupdate. fix somehow?
- my $href = $self->status->configure_requires || {};
- my $deps = { INSTALLER_BUILD, '0.60', %$href };
-
- $self->status->configure_requires( $deps );
-
- msg(loc("This module requires '%1' and '%2' to be installed first. ".
- "Adding these modules to your prerequisites list",
- 'Module::Build', INSTALLER_BUILD
- ), $verbose );
-
-
- ### ok, actually we found neither ###
- } elsif ( !$type ) {
- error( loc( "Unable to find '%1' or '%2' for '%3'; ".
- "Will default to '%4' but might be unable ".
- "to install!", BUILD_PL->(), MAKEFILE_PL->(),
- $self->module, INSTALLER_MM ) );
- $type = INSTALLER_MM;
- }
-
- return $self->status->installer_type( $type ) if $type;
- return;
-}
-
-=pod
-
-=head2 $dist = $self->dist([target => 'prepare|create', format => DISTRIBUTION_TYPE, args => {key => val}]);
-
-Create a distribution object, ready to be installed.
-Distribution type defaults to your config settings
-
-The optional C<args> hashref is passed on to the specific distribution
-types' C<create> method after being dereferenced.
-
-Returns a distribution object on success, false on failure.
-
-See C<CPANPLUS::Dist> for details.
-
-=cut
-
-sub dist {
- my $self = shift;
- my $cb = $self->parent;
- my $conf = $cb->configure_object;
- my %hash = @_;
-
- ### have you determined your installer type yet? if not, do it here,
- ### we need the info
- $self->get_installer_type unless $self->status->installer_type;
-
- my($type,$args,$target);
- my $tmpl = {
- format => { default => $conf->get_conf('dist_type') ||
- $self->status->installer_type,
- store => \$type },
- target => { default => TARGET_CREATE, store => \$target },
- args => { default => {}, store => \$args },
- };
-
- check( $tmpl, \%hash ) or return;
-
- ### ok, check for $type. Do we have it?
- unless( CPANPLUS::Dist->has_dist_type( $type ) ) {
-
- ### ok, we don't have it. Is it C::D::Build? if so we can install the
- ### whole thing now
- ### XXX we _could_ do this for any type we dont have actually...
- if( $type eq INSTALLER_BUILD ) {
- msg(loc("Bootstrapping installer '%1'", $type));
-
- ### don't propagate the format, it's the one we're trying to
- ### bootstrap, so it'll be an infinite loop if we do
-
- $cb->module_tree( $type )->install( target => $target, %$args ) or
- do {
- error(loc("Could not bootstrap installer '%1' -- ".
- "can not continue", $type));
- return;
- };
-
- ### re-scan for available modules now
- CPANPLUS::Dist->rescan_dist_types;
-
- unless( CPANPLUS::Dist->has_dist_type( $type ) ) {
- error(loc("Newly installed installer type '%1' should be ".
- "available, but is not! -- aborting", $type));
- return;
- } else {
- msg(loc("Installer '%1' successfully bootstrapped", $type));
- }
-
- ### some other plugin you dont have. Abort
- } else {
- error(loc("Installer type '%1' not found. Please verify your ".
- "installation -- aborting", $type ));
- return;
- }
- }
-
- ### make sure we don't overwrite it, just in case we came
- ### back from a ->save_state. This allows restoration to
- ### work correctly
- my( $dist, $dist_cpan );
-
- unless( $dist = $self->status->dist ) {
- $dist = $type->new( module => $self ) or return;
- $self->status->dist( $dist );
- }
-
- unless( $dist_cpan = $self->status->dist_cpan ) {
-
- $dist_cpan = $type eq $self->status->installer_type
- ? $self->status->dist
- : $self->status->installer_type->new( module => $self );
-
-
- $self->status->dist_cpan( $dist_cpan );
- }
-
-
- DIST: {
- ### just wanted the $dist object?
- last DIST if $target eq TARGET_INIT;
-
- ### first prepare the dist
- $dist->prepare( %$args ) or return;
- $self->status->prepared(1);
-
- ### you just wanted us to prepare?
- last DIST if $target eq TARGET_PREPARE;
-
- $dist->create( %$args ) or return;
- $self->status->created(1);
- }
-
- return $dist;
-}
-
-=pod
-
-=head2 $bool = $mod->prepare( )
-
-Convenience method around C<install()> that prepares a module
-without actually building it. This is equivalent to invoking C<install>
-with C<target> set to C<prepare>
-
-Returns true on success, false on failure.
-
-=cut
-
-sub prepare {
- my $self = shift;
- return $self->install( @_, target => TARGET_PREPARE );
-}
-
-=head2 $bool = $mod->create( )
-
-Convenience method around C<install()> that creates a module.
-This is equivalent to invoking C<install> with C<target> set to
-C<create>
-
-Returns true on success, false on failure.
-
-=cut
-
-sub create {
- my $self = shift;
- return $self->install( @_, target => TARGET_CREATE );
-}
-
-=head2 $bool = $mod->test( )
-
-Convenience wrapper around C<install()> that tests a module, without
-installing it.
-It's the equivalent to invoking C<install()> with C<target> set to
-C<create> and C<skiptest> set to C<0>.
-
-Returns true on success, false on failure.
-
-=cut
-
-sub test {
- my $self = shift;
- return $self->install( @_, target => TARGET_CREATE, skiptest => 0 );
-}
-
-=pod
-
-=head2 $bool = $self->install([ target => 'init|prepare|create|install', format => FORMAT_TYPE, extractdir => DIRECTORY, fetchdir => DIRECTORY, prefer_bin => BOOL, force => BOOL, verbose => BOOL, ..... ]);
-
-Installs the current module. This includes fetching it and extracting
-it, if this hasn't been done yet, as well as creating a distribution
-object for it.
-
-This means you can pass it more arguments than described above, which
-will be passed on to the relevant methods as they are called.
-
-See C<CPANPLUS::Internals::Fetch>, C<CPANPLUS::Internals::Extract> and
-C<CPANPLUS::Dist> for details.
-
-Returns true on success, false on failure.
-
-=cut
-
-sub install {
- my $self = shift;
- my $cb = $self->parent;
- my $conf = $cb->configure_object;
- my %hash = @_;
-
- my $args; my $target; my $format;
- { ### so we can use the rest of the args to the create calls etc ###
- local $Params::Check::NO_DUPLICATES = 1;
- local $Params::Check::ALLOW_UNKNOWN = 1;
-
- ### targets 'dist' and 'test' are now completely ignored ###
- my $tmpl = {
- ### match this allow list with Dist->_resolve_prereqs
- target => { default => TARGET_INSTALL, store => \$target,
- allow => [TARGET_PREPARE, TARGET_CREATE,
- TARGET_INSTALL, TARGET_INIT ] },
- force => { default => $conf->get_conf('force'), },
- verbose => { default => $conf->get_conf('verbose'), },
- format => { default => $conf->get_conf('dist_type'),
- store => \$format },
- };
-
- $args = check( $tmpl, \%hash ) or return;
- }
-
-
- ### if this target isn't 'install', we will need to at least 'create'
- ### every prereq, so it can build
- ### XXX prereq_target of 'prepare' will do weird things here, and is
- ### not supported.
- $args->{'prereq_target'} ||= TARGET_CREATE if $target ne TARGET_INSTALL;
-
- ### check if it's already upto date ###
- if( $target eq TARGET_INSTALL and !$args->{'force'} and
- !$self->package_is_perl_core() and # separate rules apply
- ( $self->status->installed() or $self->is_uptodate ) and
- !INSTALL_VIA_PACKAGE_MANAGER->($format)
- ) {
- msg(loc("Module '%1' already up to date, won't install without force",
- $self->module), $args->{'verbose'} );
- return $self->status->installed(1);
- }
-
- # if it's a non-installable core package, abort the install.
- if( $self->package_is_perl_core() ) {
- # if the installed is newer, say so.
- if( $self->installed_version > $self->version ) {
- error(loc("The core Perl %1 module '%2' (%3) is more ".
- "recent than the latest release on CPAN (%4). ".
- "Aborting install.",
- $], $self->module, $self->installed_version,
- $self->version ) );
- # if the installed matches, say so.
- } elsif( $self->installed_version == $self->version ) {
- error(loc("The core Perl %1 module '%2' (%3) can only ".
- "be installed by Perl itself. ".
- "Aborting install.",
- $], $self->module, $self->installed_version ) );
- # otherwise, the installed is older; say so.
- } else {
- error(loc("The core Perl %1 module '%2' can only be ".
- "upgraded from %3 to %4 by Perl itself (%5). ".
- "Aborting install.",
- $], $self->module, $self->installed_version,
- $self->version, $self->package ) );
- }
- return;
-
- ### it might be a known 3rd party module
- } elsif ( $self->is_third_party ) {
- my $info = $self->third_party_information;
- error(loc(
- "%1 is a known third-party module.\n\n".
- "As it isn't available on the CPAN, CPANPLUS can't install " .
- "it automatically. Therefore you need to install it manually " .
- "before proceeding.\n\n".
- "%2 is part of %3, published by %4, and should be available ".
- "for download at the following address:\n\t%5",
- $self->name, $self->name, $info->{name}, $info->{author},
- $info->{url}
- ));
-
- return;
- }
-
- ### fetch it if need be ###
- unless( $self->status->fetch ) {
- my $params;
- for (qw[prefer_bin fetchdir]) {
- $params->{$_} = $args->{$_} if exists $args->{$_};
- }
- for (qw[force verbose]) {
- $params->{$_} = $args->{$_} if defined $args->{$_};
- }
- $self->fetch( %$params ) or return;
- }
-
- ### extract it if need be ###
- unless( $self->status->extract ) {
- my $params;
- for (qw[prefer_bin extractdir]) {
- $params->{$_} = $args->{$_} if exists $args->{$_};
- }
- for (qw[force verbose]) {
- $params->{$_} = $args->{$_} if defined $args->{$_};
- }
- $self->extract( %$params ) or return;
- }
-
- $args->{'prereq_format'} = $format if $format;
- $format ||= $self->status->installer_type;
-
- unless( $format ) {
- error( loc( "Don't know what installer to use; " .
- "Couldn't find either '%1' or '%2' in the extraction " .
- "directory '%3' -- will be unable to install",
- BUILD_PL->(), MAKEFILE_PL->(), $self->status->extract ) );
-
- $self->status->installed(0);
- return;
- }
-
-
- ### do SIGNATURE checks? ###
- ### XXX check status and not recheck EVERY time?
- if( $conf->get_conf('signature') ) {
- unless( $self->check_signature( verbose => $args->{verbose} ) ) {
- error( loc( "Signature check failed for module '%1' ".
- "-- Not trusting this module, aborting install",
- $self->module ) );
- $self->status->signature(0);
-
- ### send out test report on broken sig
- if( $conf->get_conf('cpantest') ) {
- $cb->_send_report(
- module => $self,
- failed => 1,
- buffer => CPANPLUS::Error->stack_as_string,
- verbose => $args->{verbose},
- force => $args->{force},
- ) or error(loc("Failed to send test report for '%1'",
- $self->module ) );
- }
-
- return;
-
- } else {
- ### signature OK ###
- $self->status->signature(1);
- }
- }
-
- ### a target of 'create' basically means not to run make test ###
- ### eh, no it /doesn't/.. skiptest => 1 means skiptest => 1.
- #$args->{'skiptest'} = 1 if $target eq 'create';
-
- ### bundle rules apply ###
- if( $self->is_bundle ) {
- ### check what we need to install ###
- my @prereqs = $self->bundle_modules();
- unless( @prereqs ) {
- error( loc( "Bundle '%1' does not specify any modules to install",
- $self->module ) );
-
- ### XXX mark an error here? ###
- }
- }
-
- my $dist = $self->dist( format => $format,
- target => $target,
- args => $args );
- unless( $dist ) {
- error( loc( "Unable to create a new distribution object for '%1' " .
- "-- cannot continue", $self->module ) );
- return;
- }
-
- return 1 if $target ne TARGET_INSTALL;
-
- my $ok = $dist->install( %$args ) ? 1 : 0;
-
- $self->status->installed($ok);
-
- return 1 if $ok;
- return;
-}
-
-=pod @list = $self->bundle_modules()
-
-Returns a list of module objects the Bundle specifies.
-
-This requires you to have extracted the bundle already, using the
-C<extract()> method.
-
-Returns false on error.
-
-=cut
-
-sub bundle_modules {
- my $self = shift;
- my $cb = $self->parent;
-
- unless( $self->is_bundle ) {
- error( loc("'%1' is not a bundle", $self->module ) );
- return;
- }
-
- my @files;
-
- ### autobundles are special files generated by CPANPLUS. If we can
- ### read the file, we can determine the prereqs
- if( $self->is_autobundle ) {
- my $where;
- unless( $where = $self->status->fetch ) {
- error(loc("Don't know where '%1' was fetched to", $self->package));
- return;
- }
-
- push @files, $where
-
- ### regular bundle::* upload
- } else {
- my $dir;
- unless( $dir = $self->status->extract ) {
- error(loc("Don't know where '%1' was extracted to", $self->module));
- return;
- }
-
- find( {
- wanted => sub { push @files, File::Spec->rel2abs($_) if /\.pm/i },
- no_chdir => 1,
- }, $dir );
- }
-
- my $prereqs = {}; my @list; my $seen = {};
- for my $file ( @files ) {
- my $fh = FileHandle->new($file)
- or( error(loc("Could not open '%1' for reading: %2",
- $file,$!)), next );
-
- my $flag;
- while( local $_ = <$fh> ) {
- ### quick hack to read past the header of the file ###
- last if $flag && m|^=head|i;
-
- ### from perldoc cpan:
- ### =head1 CONTENTS
- ### In this pod section each line obeys the format
- ### Module_Name [Version_String] [- optional text]
- $flag = 1 if m|^=head1 CONTENTS|i;
-
- if ($flag && /^(?!=)(\S+)\s*(\S+)?/) {
- my $module = $1;
- my $version = $cb->_version_to_number( version => $2 );
-
- my $obj = $cb->module_tree($module);
-
- unless( $obj ) {
- error(loc("Cannot find bundled module '%1'", $module),
- loc("-- it does not seem to exist") );
- next;
- }
-
- ### make sure we list no duplicates ###
- unless( $seen->{ $obj->module }++ ) {
- push @list, $obj;
- $prereqs->{ $module } =
- $cb->_version_to_number( version => $version );
- }
- }
- }
- }
-
- ### store the prereqs we just found ###
- $self->status->prereqs( $prereqs );
-
- return @list;
-}
-
-=pod
-
-=head2 $text = $self->readme
-
-Fetches the readme belonging to this module and stores it under
-C<< $obj->status->readme >>. Returns the readme as a string on
-success and returns false on failure.
-
-=cut
-
-sub readme {
- my $self = shift;
- my $conf = $self->parent->configure_object;
-
- ### did we already dl the readme once? ###
- return $self->status->readme() if $self->status->readme();
-
- ### this should be core ###
- return unless can_load( modules => { FileHandle => '0.0' },
- verbose => 1,
- );
-
- ### get a clone of the current object, with a fresh status ###
- my $obj = $self->clone or return;
-
- ### munge the package name
- my $pkg = README->( $obj );
- $obj->package($pkg);
-
- my $file;
- { ### disable checksum fetches on readme downloads
-
- my $tmp = $conf->get_conf( 'md5' );
- $conf->set_conf( md5 => 0 );
-
- $file = $obj->fetch;
-
- $conf->set_conf( md5 => $tmp );
-
- return unless $file;
- }
-
- ### read the file into a scalar, to store in the original object ###
- my $fh = new FileHandle;
- unless( $fh->open($file) ) {
- error( loc( "Could not open file '%1': %2", $file, $! ) );
- return;
- }
-
- my $in = do{ local $/; <$fh> };
- $fh->close;
-
- return $self->status->readme( $in );
-}
-
-=pod
-
-=head2 $version = $self->installed_version()
-
-Returns the currently installed version of this module, if any.
-
-=head2 $where = $self->installed_file()
-
-Returns the location of the currently installed file of this module,
-if any.
-
-=head2 $dir = $self->installed_dir()
-
-Returns the directory (or more accurately, the C<@INC> handle) from
-which this module was loaded, if any.
-
-=head2 $bool = $self->is_uptodate([version => VERSION_NUMBER])
-
-Returns a boolean indicating if this module is uptodate or not.
-
-=cut
-
-### uptodate/installed functions
-{ my $map = { # hashkey, alternate rv
- installed_version => ['version', 0 ],
- installed_file => ['file', ''],
- installed_dir => ['dir', ''],
- is_uptodate => ['uptodate', 0 ],
- };
-
- while( my($method, $aref) = each %$map ) {
- my($key,$alt_rv) = @$aref;
-
- no strict 'refs';
- *$method = sub {
- ### never use the @INC hooks to find installed versions of
- ### modules -- they're just there in case they're not on the
- ### perl install, but the user shouldn't trust them for *other*
- ### modules!
- ### XXX CPANPLUS::inc is now obsolete, so this should not
- ### be needed anymore
- #local @INC = CPANPLUS::inc->original_inc;
-
- my $self = shift;
-
- ### make sure check_install is not looking in %INC, as
- ### that may contain some of our sneakily loaded modules
- ### that aren't installed as such. -- kane
- local $Module::Load::Conditional::CHECK_INC_HASH = 0;
- ### this should all that is required for deprecated core modules
- local $Module::Load::Conditional::DEPRECATED = 1;
- my $href = check_install(
- module => $self->module,
- version => $self->version,
- @_,
- );
-
- ### Don't trust modules which are the result of @INC hooks
- ### FatPacker uses this trickery and it causes WTF moments
- return $alt_rv if defined $href->{dir} && ref $href->{dir};
-
- return $href->{$key} || $alt_rv;
- }
- }
-}
-
-
-
-=pod
-
-=head2 $href = $self->details()
-
-Returns a hashref with key/value pairs offering more information about
-a particular module. For example, for C<Time::HiRes> it might look like
-this:
-
- Author Jarkko Hietaniemi (jhi@iki.fi)
- Description High resolution time, sleep, and alarm
- Development Stage Released
- Installed File /usr/local/perl/lib/Time/Hires.pm
- Interface Style plain Functions, no references used
- Language Used C and perl, a C compiler will be needed
- Package Time-HiRes-1.65.tar.gz
- Public License Unknown
- Support Level Developer
- Version Installed 1.52
- Version on CPAN 1.65
-
-=cut
-
-sub details {
- my $self = shift;
- my $conf = $self->parent->configure_object();
- my $cb = $self->parent;
- my %hash = @_;
-
- my $res = {
- Author => loc("%1 (%2)", $self->author->author(),
- $self->author->email() ),
- Package => $self->package,
- Description => $self->description || loc('None given'),
- 'Version on CPAN' => $self->version,
- };
-
- ### check if we have the module installed
- ### if so, add version have and version on cpan
- $res->{'Version Installed'} = $self->installed_version
- if $self->installed_version;
- $res->{'Installed File'} = $self->installed_file if $self->installed_file;
-
- my $i = 0;
- for my $item( split '', $self->dslip ) {
- $res->{ $cb->_dslip_defs->[$i]->[0] } =
- $cb->_dslip_defs->[$i]->[1]->{$item} || loc('Unknown');
- $i++;
- }
-
- return $res;
-}
-
-=head2 @list = $self->contains()
-
-Returns a list of module objects that represent the modules also
-present in the package of this module.
-
-For example, for C<Archive::Tar> this might return:
-
- Archive::Tar
- Archive::Tar::Constant
- Archive::Tar::File
-
-=cut
-
-sub contains {
- my $self = shift;
- my $cb = $self->parent;
- my $pkg = $self->package;
-
- my @mods = $cb->search( type => 'package', allow => [qr/^$pkg$/] );
-
- return @mods;
-}
-
-=pod
-
-=head2 @list_of_hrefs = $self->fetch_report()
-
-This function queries the CPAN testers database at
-I<http://testers.cpan.org/> for test results of specified module
-objects, module names or distributions.
-
-Look at L<CPANPLUS::Internals::Report::_query_report()> for details on
-the options you can pass and the return value to expect.
-
-=cut
-
-sub fetch_report {
- my $self = shift;
- my $cb = $self->parent;
-
- return $cb->_query_report( @_, module => $self );
-}
-
-=pod
-
-=head2 $bool = $self->uninstall([type => [all|man|prog])
-
-This function uninstalls the specified module object.
-
-You can install 2 types of files, either C<man> pages or C<prog>ram
-files. Alternately you can specify C<all> to uninstall both (which
-is the default).
-
-Returns true on success and false on failure.
-
-Do note that this does an uninstall via the so-called C<.packlist>,
-so if you used a module installer like say, C<ports> or C<apt>, you
-should not use this, but use your package manager instead.
-
-=cut
-
-sub uninstall {
- my $self = shift;
- my $conf = $self->parent->configure_object();
- my %hash = @_;
-
- my ($type,$verbose);
- my $tmpl = {
- type => { default => 'all', allow => [qw|man prog all|],
- store => \$type },
- verbose => { default => $conf->get_conf('verbose'),
- store => \$verbose },
- force => { default => $conf->get_conf('force') },
- };
-
- ### XXX add a warning here if your default install dist isn't
- ### makefile or build -- that means you are using a package manager
- ### and this will not do what you think!
-
- my $args = check( $tmpl, \%hash ) or return;
-
- if( $conf->get_conf('dist_type') and (
- ($conf->get_conf('dist_type') ne INSTALLER_BUILD) or
- ($conf->get_conf('dist_type') ne INSTALLER_MM))
- ) {
- msg(loc("You have a default installer type set (%1) ".
- "-- you should probably use that package manager to " .
- "uninstall modules", $conf->get_conf('dist_type')), $verbose);
- }
-
- ### check if we even have the module installed -- no point in continuing
- ### otherwise
- unless( $self->installed_version ) {
- error( loc( "Module '%1' is not installed, so cannot uninstall",
- $self->module ) );
- return;
- }
-
- ### nothing to uninstall ###
- my $files = $self->files( type => $type ) or return;
- my $dirs = $self->directory_tree( type => $type ) or return;
- my $sudo = $conf->get_program('sudo');
-
- ### just in case there's no file; M::B doesn't provide .packlists yet ###
- my $pack = $self->packlist;
- $pack = $pack->[0]->packlist_file() if $pack;
-
- ### first remove the files, then the dirs if they are empty ###
- my $flag = 0;
- for my $file( @$files, $pack ) {
- next unless defined $file && -f $file;
-
- msg(loc("Unlinking '%1'", $file), $verbose);
-
- my @cmd = ($^X, "-eunlink+q[$file]");
- unshift @cmd, $sudo if $sudo;
-
- my $buffer;
- unless ( run( command => \@cmd,
- verbose => $verbose,
- buffer => \$buffer )
- ) {
- error(loc("Failed to unlink '%1': '%2'",$file, $buffer));
- $flag++;
- }
- }
-
- for my $dir ( sort @$dirs ) {
- local *DIR;
- opendir DIR, $dir or next;
- my @count = readdir(DIR);
- close DIR;
-
- next unless @count == 2; # . and ..
-
- msg(loc("Removing '%1'", $dir), $verbose);
-
- ### this fails on my win2k machines.. it indeed leaves the
- ### dir, but it's not a critical error, since the files have
- ### been removed. --kane
- #unless( rmdir $dir ) {
- # error( loc( "Could not remove '%1': %2", $dir, $! ) )
- # unless $^O eq 'MSWin32';
- #}
-
- my @cmd = ($^X, "-e", "rmdir q[$dir]");
- unshift @cmd, $sudo if $sudo;
-
- my $buffer;
- unless ( run( command => \@cmd,
- verbose => $verbose,
- buffer => \$buffer )
- ) {
- error(loc("Failed to rmdir '%1': %2",$dir,$buffer));
- $flag++;
- }
- }
-
- $self->status->uninstall(!$flag);
- $self->status->installed( $flag ? 1 : undef);
-
- return !$flag;
-}
-
-=pod
-
-=head2 @modobj = $self->distributions()
-
-Returns a list of module objects representing all releases for this
-module on success, false on failure.
-
-=cut
-
-sub distributions {
- my $self = shift;
- my %hash = @_;
-
- my @list = $self->author->distributions( %hash, module => $self ) or return;
-
- ### it's another release then by the same author ###
- return grep { $_->package_name eq $self->package_name } @list;
-}
-
-=pod
-
-=head2 @list = $self->files ()
-
-Returns a list of files used by this module, if it is installed.
-
-=head2 @list = $self->directory_tree ()
-
-Returns a list of directories used by this module.
-
-=head2 @list = $self->packlist ()
-
-Returns the C<ExtUtils::Packlist> object for this module.
-
-=head2 @list = $self->validate ()
-
-Returns a list of files that are missing for this modules, but
-are present in the .packlist file.
-
-=cut
-
-for my $sub (qw[files directory_tree packlist validate]) {
- no strict 'refs';
- *$sub = sub {
- return shift->_extutils_installed( @_, method => $sub );
- }
-}
-
-### generic method to call an ExtUtils::Installed method ###
-sub _extutils_installed {
- my $self = shift;
- my $cb = $self->parent;
- my $conf = $cb->configure_object;
- my $home = $cb->_home_dir; # may be needed to fix up prefixes
- my %hash = @_;
-
- my ($verbose,$type,$method);
- my $tmpl = {
- verbose => { default => $conf->get_conf('verbose'),
- store => \$verbose, },
- type => { default => 'all',
- allow => [qw|prog man all|],
- store => \$type, },
- method => { required => 1,
- store => \$method,
- allow => [qw|files directory_tree packlist
- validate|],
- },
- };
-
- my $args = check( $tmpl, \%hash ) or return;
-
- ### old versions of cygwin + perl < 5.8 are buggy here. bail out if we
- ### find we're being used by them
- { my $err = ON_OLD_CYGWIN;
- if($err) { error($err); return };
- }
-
- return unless can_load(
- modules => { 'ExtUtils::Installed' => '0.0' },
- verbose => $verbose,
- );
-
- my @config_names = (
- ### lib
- { lib => 'privlib', # perl-only
- arch => 'archlib', # compiled code
- prefix => 'prefix', # prefix to both
- },
- ### site
- { lib => 'sitelib',
- arch => 'sitearch',
- prefix => 'siteprefix',
- },
- ### vendor
- { lib => 'vendorlib',
- arch => 'vendorarch',
- prefix => 'vendorprefix',
- },
- );
-
- ### search in your regular @INC, and anything you added to your config.
- ### this lets EU::Installed find .packlists that are *not* in the standard
- ### compiled in @INC path. Requires EU::I 1.42 or up. this addresses #33438
- ### make sure the archname path is also added, as that's where the .packlist
- ### files are written
- my @libs;
- for my $lib ( @{ $conf->get_conf('lib') } ) {
- require Config;
-
- ### and just the standard dir
- push @libs, $lib;
-
- ### figure out what an MM prefix expands to. Basically, it's the
- ### site install target from %Config, ie: /opt/lib/perl5/site_perl/5.8.8
- ### minus the site wide prefix, ie: /opt
- ### this lets users add the dir they have set as their EU::MM PREFIX
- ### to our 'lib' config and it Just Works
- ### the arch specific dir, ie:
- ### /opt/lib/perl5/site_perl/5.8.8/darwin-2level
- ### XXX is this the right thing to do?
-
- ### we add all 6 dir combos for prefixes:
- ### /foo/lib
- ### /foo/lib/arch
- ### /foo/site/lib
- ### /foo/site/lib/arch
- ### /foo/vendor/lib
- ### /foo/vendor/lib/arch
- for my $href ( @config_names ) {
- for my $key ( qw[lib arch] ) {
-
- ### look up the config value -- use EXP for the EXPANDED
- ### version, so no ~ etc are found in there
- my $dir = $Config::Config{ $href->{ $key } .'exp' } or next;
- my $prefix = $Config::Config{ $href->{prefix} };
-
- ### prefix may be relative to home, and contain a ~
- ### if so, fix it up.
- $prefix =~ s/^~/$home/;
-
- ### remove the prefix from it, so we can append to our $lib
- $dir =~ s/^\Q$prefix\E//;
-
- ### do the appending
- push @libs, File::Spec->catdir( $lib, $dir );
-
- }
- }
- }
-
- my $inst;
- unless( $inst = ExtUtils::Installed->new( extra_libs => \@libs ) ) {
- error( loc("Could not create an '%1' object", 'ExtUtils::Installed' ) );
-
- ### in case it's being used directly... ###
- return;
- }
-
-
- { ### EU::Installed can die =/
- my @files;
- eval { @files = $inst->$method( $self->module, $type ) };
-
- if( $@ ) {
- chomp $@;
- error( loc("Could not get '%1' for '%2': %3",
- $method, $self->module, $@ ) );
- return;
- }
-
- return wantarray ? @files : \@files;
- }
-}
-
-=head2 $bool = $self->add_to_includepath;
-
-Adds the current modules path to C<@INC> and C<$PERL5LIB>. This allows
-you to add the module from its build dir to your path.
-
-It also adds the current modules C<bin> and/or C<script> paths to
-the PATH.
-
-You can reset C<$PATH>, C<@INC> and C<$PERL5LIB> to their original state when you
-started the program, by calling:
-
- $self->parent->flush('lib');
-
-=cut
-
-sub add_to_includepath {
- my $self = shift;
- my $cb = $self->parent;
-
- if( my $dir = $self->status->extract ) {
-
- $cb->_add_to_includepath(
- directories => [
- File::Spec->catdir(BLIB->($dir), LIB),
- File::Spec->catdir(BLIB->($dir), ARCH),
- BLIB->($dir),
- ]
- ) or return;
-
- $cb->_add_to_path(
- directories => [
- File::Spec->catdir(BLIB->($dir), SCRIPT),
- File::Spec->catdir(BLIB->($dir), BIN),
- ]
- ) or return;
-
- } else {
- error(loc( "No extract dir registered for '%1' -- can not add ".
- "add builddir to search path!", $self->module ));
- return;
- }
-
- return 1;
-
-}
-
-=pod
-
-=head2 $path = $self->best_path_to_module_build();
-
-B<OBSOLETE>
-
-If a newer version of Module::Build is found in your path, it will
-return this C<special> path. If the newest version of C<Module::Build>
-is found in your regular C<@INC>, the method will return false. This
-indicates you do not need to add a special directory to your C<@INC>.
-
-Note that this is only relevant if you're building your own
-C<CPANPLUS::Dist::*> plugin -- the built-in dist types already have
-this taken care of.
-
-=cut
-
-### make sure we're always running 'perl Build.PL' and friends
-### against the highest version of module::build available
-sub best_path_to_module_build {
- my $self = shift;
-
- ### Since M::B will actually shell out and run the Build.PL, we must
- ### make sure it refinds the proper version of M::B in the path.
- ### that may be either in our cp::inc or in site_perl, or even a
- ### new M::B being installed.
- ### don't add anything else here, as that might screw up prereq checks
-
- ### XXX this might be needed for Dist::MM too, if a makefile.pl is
- ### masquerading as a Build.PL
-
- ### did we find the most recent module::build in our installer path?
-
- ### XXX can't do changes to @INC, they're being ignored by
- ### new_from_context when writing a Build script. see ticket:
- ### #8826 Module::Build ignores changes to @INC when writing Build
- ### from new_from_context
- ### XXX applied schwern's patches (as seen on CPANPLUS::Devel 10/12/04)
- ### and upped the version to 0.26061 of the bundled version, and things
- ### work again
-
- ### this functionality is now obsolete -- prereqs should be installed
- ### and we no longer use the CPANPLUS::inc magic.. so comment this out.
-# require Module::Build;
-# if( CPANPLUS::inc->path_to('Module::Build') and (
-# CPANPLUS::inc->path_to('Module::Build') eq
-# CPANPLUS::inc->installer_path )
-# ) {
-#
-# ### if the module being installed is *not* Module::Build
-# ### itself -- as that would undoubtedly be newer -- add
-# ### the path to the installers to @INC
-# ### if it IS module::build itself, add 'lib' to its path,
-# ### as the Build.PL would do as well, but the API doesn't.
-# ### this makes self updates possible
-# return $self->module eq 'Module::Build'
-# ? 'lib'
-# : CPANPLUS::inc->installer_path;
-# }
-
- ### otherwise, the path was found through a 'normal' way of
- ### scanning @INC.
- return;
-}
-
-=pod
-
-=head1 BUG REPORTS
-
-Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.
-
-=head1 AUTHOR
-
-This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
-
-=head1 COPYRIGHT
-
-The CPAN++ interface (of which this module is a part of) is copyright (c)
-2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved.
-
-This library is free software; you may redistribute and/or modify it
-under the same terms as Perl itself.
-
-=cut
-
-# Local variables:
-# c-indentation-style: bsd
-# c-basic-offset: 4
-# indent-tabs-mode: nil
-# End:
-# vim: expandtab shiftwidth=4:
-
-1;
-
-__END__
-
-todo:
-reports();
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-22 05:34:38 +0000