lib/CPANPLUS/Error.pm CPANPLUS
lib/CPANPLUS/FAQ.pod CPANPLUS
lib/CPANPLUS/Hacking.pod CPANPLUS
-lib/CPANPLUS/inc.pm CPANPLUS
lib/CPANPLUS/Internals/Constants.pm CPANPLUS
lib/CPANPLUS/Internals/Constants/Report.pm CPANPLUS
lib/CPANPLUS/Internals/Extract.pm CPANPLUS
lib/CPANPLUS/Shell/Default/Plugins/Source.pm CPANPLUS
lib/CPANPLUS/Shell/Default.pm CPANPLUS
lib/CPANPLUS/Shell.pm CPANPLUS
-lib/CPANPLUS/t/00_CPANPLUS-Inc.t CPANPLUS tests
lib/CPANPLUS/t/00_CPANPLUS-Internals-Utils.t CPANPLUS tests
lib/CPANPLUS/t/01_CPANPLUS-Configure.t CPANPLUS tests
lib/CPANPLUS/t/02_CPANPLUS-Internals.t CPANPLUS tests
use vars qw( @EXPORT @ISA $VERSION );
@EXPORT = qw( shell fetch get install );
@ISA = qw( Exporter );
- $VERSION = "0.86_06"; #have to hardcode or cpan.org gets unhappy
+ $VERSION = "0.86"; #have to hardcode or cpan.org gets unhappy
}
### purely for backward compatibility, so we can call it from the commandline:
my $tmpl = {
perl => { default => $^X, store => \$perl },
makemakerflags => { default =>
- $conf->get_conf('makemakerflags'),
+ $conf->get_conf('makemakerflags') || '',
store => \$mmflags },
force => { default => $conf->get_conf('force'),
store => \$force },
$args = check( $tmpl, \%hash ) or return;
}
- ### maybe we already ran a create on this object? ###
- return 1 if $dist->status->created && !$force;
-
+ ### maybe we already ran a create on this object?
+ ### make sure we add to include path again, just in case we came from
+ ### ->save_state, at which point we need to restore @INC/$PERL5LIB
+ if( $dist->status->created && !$force ) {
+ $self->add_to_includepath;
+ return 1;
+ }
+
### store the arguments, so ->install can use them in recursive loops ###
$dist->status->_create_args( $args );
CPANPLUS::Internals::Report
];
-$VERSION = "0.86_06";
+$VERSION = "0.86";
=pod
check( $tmpl, \%hash ) or return;
+ my $s = $Config{'path_sep'};
+
+ ### only add if it's not added yet
for my $lib (@$dirs) {
push @INC, $lib unless grep { $_ eq $lib } @INC;
- }
-
- { local $^W; ### it will be complaining if $ENV{PERL5LIB]
- ### is not defined (yet).
- $ENV{'PERL5LIB'} .= join '', map { $Config{'path_sep'} . $_ } @$dirs;
+ #
+ ### it will be complaining if $ENV{PERL5LIB] is not defined (yet).
+ local $^W;
+ $ENV{'PERL5LIB'} .= $s . $lib
+ unless $ENV{'PERL5LIB'} =~ qr|\Q$s$lib\E|;
}
return 1;
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 ($core) {
### if the package is newer than installed, then it's dual-lifed
- return if $self->version > $self->installed_version;
-
+ 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 $self->version >= $core;
+ return if $cb->_vcmp( $self->version, $core ) >= 0;
### otherwise, it's older than corelist, thus unsuitable.
return 1;
}
}
- my $dist = $type->new( module => $self ) or return;
-
- my $dist_cpan = $type eq $self->status->installer_type
- ? $dist
+ ### 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 );
- ### store the dists
- $self->status->dist_cpan( $dist_cpan );
- $self->status->dist( $dist );
+
+ $self->status->dist_cpan( $dist_cpan );
+ }
+
DIST: {
### first prepare the dist
### 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' ".
Returns a list of files used by this module, if it is installed.
-=cut
-
-sub files {
- return shift->_extutils_installed( @_, method => 'files' );
-}
-
-=pod
-
=head2 @list = $self->directory_tree ()
Returns a list of directories used by this module.
-=cut
-
-sub directory_tree {
- return shift->_extutils_installed( @_, method => 'directory_tree' );
-}
-
-=pod
-
=head2 @list = $self->packlist ()
Returns the C<ExtUtils::Packlist> object for this module.
-=cut
-
-sub packlist {
- return shift->_extutils_installed( @_, method => 'packlist' );
-}
-
-=pod
-
=head2 @list = $self->validate ()
Returns a list of files that are missing for this modules, but
=cut
-sub validate {
- return shift->_extutils_installed( method => 'validate' );
+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 $conf = $self->parent->configure_object();
+ 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);
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
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?
- push @libs, do {
- my $site = $Config::Config{sitelib};
- my $prefix = quotemeta $Config::Config{prefix};
- ### strip the prefix from the site dir
- $site =~ s/^$prefix//;
+ ### 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] ) {
- File::Spec->catdir( $lib, $site ),
- File::Spec->catdir( $lib, $site, $Config::Config{'archname'} );
- };
-
- ### the arch specific dir, ie:
- ### /opt/lib/perl5/site_perl/5.8.8/darwin-2level
- push @libs, File::Spec->catdir( $lib, $Config::Config{'archname'} );
-
- ### and just the standard dir
- push @libs, $lib;
+ ### 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;
$cb->_chdir( dir => $obj->status->extract ) or next;
- local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt;
+ #local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt;
if( system($shell) and $! ) {
print "Error executing your subshell '$shell': $!\n";
next;
BEGIN {
use vars qw[ $VERSION @ISA ];
@ISA = qw[ CPANPLUS::Shell::_Base::ReadLine ];
- $VERSION = "0.86_06";
+ $VERSION = "0.86";
}
load CPANPLUS::Shell;
+++ /dev/null
-package CPANPLUS::inc;
-
-=head1 NAME
-
-CPANPLUS::inc
-
-=head1 DESCRIPTION
-
-OBSOLETE
-
-=cut
-
-sub original_perl5opt { $ENV{PERL5OPT} };
-sub original_perl5lib { $ENV{PERL5LIB} };
-sub original_inc { @INC };
-
-1;
-
-__END__
-
-use strict;
-use vars qw[$DEBUG $VERSION $ENABLE_INC_HOOK %LIMIT $QUIET];
-use File::Spec ();
-use Config ();
-
-### 5.6.1. nags about require + bareword otherwise ###
-use lib ();
-
-$QUIET = 0;
-$DEBUG = 0;
-%LIMIT = ();
-
-=pod
-
-=head1 NAME
-
-CPANPLUS::inc - runtime inclusion of privately bundled modules
-
-=head1 SYNOPSIS
-
- ### set up CPANPLUS::inc to do its thing ###
- BEGIN { use CPANPLUS::inc };
-
- ### enable debugging ###
- use CPANPLUS::inc qw[DEBUG];
-
-=head1 DESCRIPTION
-
-This module enables the use of the bundled modules in the
-C<CPANPLUS/inc> directory of this package. These modules are bundled
-to make sure C<CPANPLUS> is able to bootstrap itself. It will do the
-following things:
-
-=over 4
-
-=item Put a coderef at the beginning of C<@INC>
-
-This allows us to decide which module to load, and where to find it.
-For details on what we do, see the C<INTERESTING MODULES> section below.
-Also see the C<CAVEATS> section.
-
-=item Add the full path to the C<CPANPLUS/inc> directory to C<$ENV{PERL5LIB>.
-
-This allows us to find our bundled modules even if we spawn off a new
-process. Although it's not able to do the selective loading as the
-coderef in C<@INC> could, it's a good fallback.
-
-=back
-
-=head1 METHODS
-
-=head2 CPANPLUS::inc->inc_path()
-
-Returns the full path to the C<CPANPLUS/inc> directory.
-
-=head2 CPANPLUS::inc->my_path()
-
-Returns the full path to be added to C<@INC> to load
-C<CPANPLUS::inc> from.
-
-=head2 CPANPLUS::inc->installer_path()
-
-Returns the full path to the C<CPANPLUS/inc/installers> directory.
-
-=cut
-
-{ my $ext = '.pm';
- my $file = (join '/', split '::', __PACKAGE__) . $ext;
-
- ### os specific file path, if you're not on unix
- my $osfile = File::Spec->catfile( split('::', __PACKAGE__) ) . $ext;
-
- ### this returns a unixy path, compensate if you're on non-unix
- my $path = File::Spec->rel2abs(
- File::Spec->catfile( split '/', $INC{$file} )
- );
-
- ### don't forget to quotemeta; win32 paths are special
- my $qm_osfile = quotemeta $osfile;
- my $path_to_me = $path; $path_to_me =~ s/$qm_osfile$//i;
- my $path_to_inc = $path; $path_to_inc =~ s/$ext$//i;
- my $path_to_installers = File::Spec->catdir( $path_to_inc, 'installers' );
-
- sub inc_path { return $path_to_inc }
- sub my_path { return $path_to_me }
- sub installer_path { return $path_to_installers }
-}
-
-=head2 CPANPLUS::inc->original_perl5lib
-
-Returns the value of $ENV{PERL5LIB} the way it was when C<CPANPLUS::inc>
-got loaded.
-
-=head2 CPANPLUS::inc->original_perl5opt
-
-Returns the value of $ENV{PERL5OPT} the way it was when C<CPANPLUS::inc>
-got loaded.
-
-=head2 CPANPLUS::inc->original_inc
-
-Returns the value of @INC the way it was when C<CPANPLUS::inc> got
-loaded.
-
-=head2 CPANPLUS::inc->limited_perl5opt(@modules);
-
-Returns a string you can assign to C<$ENV{PERL5OPT}> to have a limited
-include facility from C<CPANPLUS::inc>. It will roughly look like:
-
- -I/path/to/cpanplus/inc -MCPANPLUS::inc=module1,module2
-
-=cut
-
-{ my $org_opt = $ENV{PERL5OPT};
- my $org_lib = $ENV{PERL5LIB};
- my @org_inc = @INC;
-
- sub original_perl5opt { $org_opt || ''};
- sub original_perl5lib { $org_lib || ''};
- sub original_inc { @org_inc, __PACKAGE__->my_path };
-
- sub limited_perl5opt {
- my $pkg = shift;
- my $lim = join ',', @_ or return;
-
- ### -Icp::inc -Mcp::inc=mod1,mod2,mod3
- my $opt = '-I' . __PACKAGE__->my_path . ' ' .
- '-M' . __PACKAGE__ . "=$lim";
-
- $opt .= $Config::Config{'path_sep'} .
- CPANPLUS::inc->original_perl5opt
- if CPANPLUS::inc->original_perl5opt;
-
- return $opt;
- }
-}
-
-=head2 CPANPLUS::inc->interesting_modules()
-
-Returns a hashref with modules we're interested in, and the minimum
-version we need to find.
-
-It would looks something like this:
-
- { File::Fetch => 0.06,
- IPC::Cmd => 0.22,
- ....
- }
-
-=cut
-
-{
- my $map = {
- ### used to have 0.80, but not it was never released by coral
- ### 0.79 *should* be good enough for now... asked coral to
- ### release 0.80 on 10/3/2006
- 'IPC::Run' => '0.79',
- 'File::Fetch' => '0.07',
- #'File::Spec' => '0.82', # can't, need it ourselves...
- 'IPC::Cmd' => '0.24',
- 'Locale::Maketext::Simple' => 0,
- 'Log::Message' => 0,
- 'Module::Load' => '0.10',
- 'Module::Load::Conditional' => '0.07',
- 'Params::Check' => '0.22',
- 'Term::UI' => '0.05',
- 'Archive::Extract' => '0.07',
- 'Archive::Tar' => '1.23',
- 'IO::Zlib' => '1.04',
- 'Object::Accessor' => '0.03',
- 'Module::CoreList' => '1.97',
- 'Module::Pluggable' => '2.4',
- 'Module::Loaded' => 0,
- #'Config::Auto' => 0, # not yet, not using it yet
- };
-
- sub interesting_modules { return $map; }
-}
-
-
-=head1 INTERESTING MODULES
-
-C<CPANPLUS::inc> doesn't even bother to try find and find a module
-it's not interested in. A list of I<interesting modules> can be
-obtained using the C<interesting_modules> method described above.
-
-Note that all subclassed modules of an C<interesting module> will
-also be attempted to be loaded, but a version will not be checked.
-
-When it however does encounter a module it is interested in, it will
-do the following things:
-
-=over 4
-
-=item Loop over your @INC
-
-And for every directory it finds there (skipping all non directories
--- see the C<CAVEATS> section), see if the module requested can be
-found there.
-
-=item Check the version on every suitable module found in @INC
-
-After a list of modules has been gathered, the version of each of them
-is checked to find the one with the highest version, and return that as
-the module to C<use>.
-
-This enables us to use a recent enough version from our own bundled
-modules, but also to use a I<newer> module found in your path instead,
-if it is present. Thus having access to bugfixed versions as they are
-released.
-
-If for some reason no satisfactory version could be found, a warning
-will be emitted. See the C<DEBUG> section for more details on how to
-find out exactly what C<CPANPLUS::inc> is doing.
-
-=back
-
-=cut
-
-{ my $Loaded;
- my %Cache;
-
-
- ### returns the path to a certain module we found
- sub path_to {
- my $self = shift;
- my $mod = shift or return;
-
- ### find the directory
- my $path = $Cache{$mod}->[0][2] or return;
-
- ### probe them explicitly for a special file, because the
- ### dir we found the file in vs our own paths may point to the
- ### same location, but might not pass an 'eq' test.
-
- ### it's our inc-path
- return __PACKAGE__->inc_path
- if -e File::Spec->catfile( $path, '.inc' );
-
- ### it's our installer path
- return __PACKAGE__->installer_path
- if -e File::Spec->catfile( $path, '.installers' );
-
- ### it's just some dir...
- return $path;
- }
-
- ### just a debug method
- sub _show_cache { return \%Cache };
-
- sub import {
- my $pkg = shift;
-
- ### filter DEBUG, and toggle the global
- map { $LIMIT{$_} = 1 }
- grep { /DEBUG/ ? ++$DEBUG && 0 :
- /QUIET/ ? ++$QUIET && 0 :
- 1
- } @_;
-
- ### only load once ###
- return 1 if $Loaded++;
-
- ### first, add our own private dir to the end of @INC:
- {
- push @INC, __PACKAGE__->my_path, __PACKAGE__->inc_path,
- __PACKAGE__->installer_path;
-
- ### XXX stop doing this, there's no need for it anymore;
- ### none of the shell outs need to have this set anymore
-# ### add the path to this module to PERL5OPT in case
-# ### we spawn off some programs...
-# ### then add this module to be loaded in PERL5OPT...
-# { local $^W;
-# $ENV{'PERL5LIB'} .= $Config::Config{'path_sep'}
-# . __PACKAGE__->my_path
-# . $Config::Config{'path_sep'}
-# . __PACKAGE__->inc_path;
-#
-# $ENV{'PERL5OPT'} = '-M'. __PACKAGE__ . ' '
-# . ($ENV{'PERL5OPT'} || '');
-# }
- }
-
- ### next, find the highest version of a module that
- ### we care about. very basic check, but will
- ### have to do for now.
- lib->import( sub {
- my $path = pop(); # path to the pm
- my $module = $path or return; # copy of the path, to munge
- my @parts = split qr!\\|/!, $path; # dirs + file name; could be
- # win32 paths =/
- my $file = pop @parts; # just the file name
- my $map = __PACKAGE__->interesting_modules;
-
- ### translate file name to module name
- ### could contain win32 paths delimiters
- $module =~ s!/|\\!::!g; $module =~ s/\.pm//i;
-
- my $check_version; my $try;
- ### does it look like a module we care about?
- my ($interesting) = grep { $module =~ /^$_/ } keys %$map;
- ++$try if $interesting;
-
- ### do we need to check the version too?
- ++$check_version if exists $map->{$module};
-
- ### we don't care ###
- unless( $try ) {
- warn __PACKAGE__ .": Not interested in '$module'\n" if $DEBUG;
- return;
-
- ### we're not allowed
- } elsif ( $try and keys %LIMIT ) {
- unless( grep { $module =~ /^$_/ } keys %LIMIT ) {
- warn __PACKAGE__ .": Limits active, '$module' not allowed ".
- "to be loaded" if $DEBUG;
- return;
- }
- }
-
- ### found filehandles + versions ###
- my @found;
- DIR: for my $dir (@INC) {
- next DIR unless -d $dir;
-
- ### get the full path to the module ###
- my $pm = File::Spec->catfile( $dir, @parts, $file );
-
- ### open the file if it exists ###
- if( -e $pm ) {
- my $fh;
- unless( open $fh, "$pm" ) {
- warn __PACKAGE__ .": Could not open '$pm': $!\n"
- if $DEBUG;
- next DIR;
- }
-
- my $found;
- ### XXX stolen from module::load::conditional ###
- while (local $_ = <$fh> ) {
-
- ### the following regexp comes from the
- ### ExtUtils::MakeMaker documentation.
- if ( /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ ) {
-
- ### this will eval the version in to $VERSION if it
- ### was declared as $VERSION in the module.
- ### else the result will be in $res.
- ### this is a fix on skud's Module::InstalledVersion
-
- local $VERSION;
- my $res = eval $_;
-
- ### default to '0.0' if there REALLY is no version
- ### all to satisfy warnings
- $found = $VERSION || $res || '0.0';
-
- ### found what we came for
- last if $found;
- }
- }
-
- ### no version defined at all? ###
- $found ||= '0.0';
-
- warn __PACKAGE__ .": Found match for '$module' in '$dir' "
- ."with version '$found'\n" if $DEBUG;
-
- ### reset the position of the filehandle ###
- seek $fh, 0, 0;
-
- ### store the found version + filehandle it came from ###
- push @found, [ $found, $fh, $dir, $pm ];
- }
-
- } # done looping over all the dirs
-
- ### nothing found? ###
- unless (@found) {
- warn __PACKAGE__ .": Unable to find any module named "
- . "'$module'\n" if $DEBUG;
- return;
- }
-
- ### find highest version
- ### or the one in the same dir as a base module already loaded
- ### or otherwise, the one not bundled
- ### or otherwise the newest
- my @sorted = sort {
- _vcmp($b->[0], $a->[0]) ||
- ($Cache{$interesting}
- ?($b->[2] eq $Cache{$interesting}->[0][2]) <=>
- ($a->[2] eq $Cache{$interesting}->[0][2])
- : 0 ) ||
- (($a->[2] eq __PACKAGE__->inc_path) <=>
- ($b->[2] eq __PACKAGE__->inc_path)) ||
- (-M $a->[3] <=> -M $b->[3])
- } @found;
-
- warn __PACKAGE__ .": Best match for '$module' is found in "
- ."'$sorted[0][2]' with version '$sorted[0][0]'\n"
- if $DEBUG;
-
- if( $check_version and
- not (_vcmp($sorted[0][0], $map->{$module}) >= 0)
- ) {
- warn __PACKAGE__ .": Cannot find high enough version for "
- ."'$module' -- need '$map->{$module}' but "
- ."only found '$sorted[0][0]'. Returning "
- ."highest found version but this may cause "
- ."problems\n" unless $QUIET;
- };
-
- ### right, so that damn )#$(*@#)(*@#@ Module::Build makes
- ### assumptions about the environment (especially its own tests)
- ### and blows up badly if it's loaded via CP::inc :(
- ### so, if we find a newer version on disk (which would happen when
- ### upgrading or having upgraded, just pretend we didn't find it,
- ### let it be loaded via the 'normal' way.
- ### can't even load the *proper* one via our CP::inc, as it will
- ### get upset just over the fact it's loaded via a non-standard way
- if( $module =~ /^Module::Build/ and
- $sorted[0][2] ne __PACKAGE__->inc_path and
- $sorted[0][2] ne __PACKAGE__->installer_path
- ) {
- warn __PACKAGE__ .": Found newer version of 'Module::Build::*' "
- ."elsewhere in your path. Pretending to not "
- ."have found it\n" if $DEBUG;
- return;
- }
-
- ### store what we found for this module
- $Cache{$module} = \@sorted;
-
- ### best matching filehandle ###
- return $sorted[0][1];
- } );
- }
-}
-
-### XXX copied from C::I::Utils, so there's no circular require here!
-sub _vcmp {
- my ($x, $y) = @_;
- s/_//g foreach $x, $y;
- return $x <=> $y;
-}
-
-=pod
-
-=head1 DEBUG
-
-Since this module does C<Clever Things> to your search path, it might
-be nice sometimes to figure out what it's doing, if things don't work
-as expected. You can enable a debug trace by calling the module like
-this:
-
- use CPANPLUS::inc 'DEBUG';
-
-This will show you what C<CPANPLUS::inc> is doing, which might look
-something like this:
-
- CPANPLUS::inc: Found match for 'Params::Check' in
- '/opt/lib/perl5/site_perl/5.8.3' with version '0.07'
- CPANPLUS::inc: Found match for 'Params::Check' in
- '/my/private/lib/CPANPLUS/inc' with version '0.21'
- CPANPLUS::inc: Best match for 'Params::Check' is found in
- '/my/private/lib/CPANPLUS/inc' with version '0.21'
-
-=head1 CAVEATS
-
-This module has 2 major caveats, that could lead to unexpected
-behaviour. But currently I don't know how to fix them, Suggestions
-are much welcomed.
-
-=over 4
-
-=item On multiple C<use lib> calls, our coderef may not be the first in @INC
-
-If this happens, although unlikely in most situations and not happening
-when calling the shell directly, this could mean that a lower (too low)
-versioned module is loaded, which might cause failures in the
-application.
-
-=item Non-directories in @INC
-
-Non-directories are right now skipped by CPANPLUS::inc. They could of
-course lead us to newer versions of a module, but it's too tricky to
-verify if they would. Therefor they are skipped. In the worst case
-scenario we'll find the sufficing version bundled with CPANPLUS.
-
-
-=cut
-
-1;
-
-# Local variables:
-# c-indentation-style: bsd
-# c-basic-offset: 4
-# indent-tabs-mode: nil
-# End:
-# vim: expandtab shiftwidth=4:
-
+++ /dev/null
-### make sure we can find our conf.pl file
-BEGIN {
- use FindBin;
- require "$FindBin::Bin/inc/conf.pl";
-}
-
-use strict;
-use Test::More 'no_plan';
-
-my $Class = 'CPANPLUS::inc';
-use_ok( $Class );
-can_ok( $Class, qw[original_perl5opt original_perl5lib original_inc] );
-
-__END__
-
-# XXX CPANPLUS::inc functionality is obsolete, so it is removed
-
-my $Module = 'Params::Check';
-my $File = File::Spec->catfile(qw|Params Check.pm|);
-my $Ufile = 'Params/Check.pm';
-my $Boring = 'IO::File';
-my $Bfile = 'IO/File.pm';
-
-
-
-### now, first element should be a coderef ###
-my $code = $INC[0];
-is( ref $code, 'CODE', 'Coderef loaded in @INC' );
-
-### check interesting modules ###
-{ my $mods = CPANPLUS::inc->interesting_modules();
- ok( $mods, "Retrieved interesting modules list" );
- is( ref $mods, 'HASH', " It's a hashref" );
- ok( scalar(keys %$mods), " With some keys in it" );
- ok( $mods->{$Module}, " Found a module we care about" );
-}
-
-### checking include path ###
-SKIP: {
- my $path = CPANPLUS::inc->inc_path();
- ok( $path, "Retrieved include path" );
- ok( -d $path, " Include path is an actual directory" );
-
- ### XXX no more files are bundled this way, it's obsolete
- #skip "No files actually bundled in perl core", 1 if $ENV{PERL_CORE};
- #ok( -s File::Spec->catfile( $path, $File ),
- # " Found '$File' in include path" );
-
- ### we don't do this anymore
- #my $out = join '', `$^X -V`; my $qm_path = quotemeta $path;
- #like( $out, qr/$qm_path/s, " Path found in perl -V output" );
-}
-
-### back to the coderef ###
-### try a boring module ###
-{ local $CPANPLUS::inc::DEBUG = 1;
- my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" };
-
- my $rv = $code->($code, $Bfile);
- ok( !$rv, "Ignoring boring module" );
- ok( !$INC{$Bfile}, " Boring file not loaded" );
- like( $warnings, qr/CPANPLUS::inc: Not interested in '$Boring'/s,
- " Warned about boringness" );
-}
-
-### try to load a module with windows paths in it (bug [#11177])
-{ local $CPANPLUS::inc::DEBUG = 1;
- my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" };
-
- my $wfile = 'IO\File.pm';
- my $wmod = 'IO::File';
-
- my $rv = $code->($code, $wfile);
- ok( !$rv, "Ignoring boring win32 module" );
- ok( !$INC{$wfile}, " Boring win32 file not loaded" );
- like( $warnings, qr/CPANPLUS::inc: Not interested in '$wmod'/s,
- " Warned about boringness" );
-}
-
-### try an interesting module ###
-{ local $CPANPLUS::inc::DEBUG = 1;
- my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" };
-
- my $rv = $code->($code, $Ufile);
- ok( $rv, "Found interesting module" );
- ok( !$INC{$Ufile}, " Interesting file not loaded" );
- like( $warnings, qr/CPANPLUS::inc: Found match for '$Module'/,
- " Match noted in warnings" );
- like( $warnings, qr/CPANPLUS::inc: Best match for '$Module'/,
- " Best match noted in warnings" );
-
- my $contents = do { local $/; <$rv> };
- ok( $contents, " Read contents from filehandle" );
- like( $contents, qr/$Module/s,
- " Contents is from '$Module'" );
-}
-
-### now do some real loading ###
-{ use_ok($Module);
- ok( $INC{$Ufile}, " Regular use of '$Module'" );
-
- use_ok($Boring);
- ok( $INC{$Bfile}, " Regular use of '$Boring'" );
-}
-
-### check we didn't load our coderef anymore than needed ###
-{ my $amount = 5;
- for( 0..$amount ) { CPANPLUS::inc->import; };
-
- my $flag;
- map { $flag++ if ref $_ eq 'CODE' } @INC[0..$amount];
-
- my $ok = $amount + 1 == $flag ? 0 : 1;
- ok( $ok, "Only loaded coderef into \@INC $flag times");
-}
-
-### check limit funcionality
-{ local $CPANPLUS::inc::DEBUG = 1;
- my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" };
-
- ### so we can reload it
- delete $INC{$Ufile};
- delete $INC{$Bfile};
-
- ### limit to the loading of $Boring;
- CPANPLUS::inc->import( $Boring );
-
- ok( $CPANPLUS::inc::LIMIT{$Boring},
- "Limit to '$Boring' recorded" );
-
- ### try a boring file first
- { my $rv = $code->($code, $Bfile);
- ok( !$rv, " '$Boring' still not being loaded" );
- ok( !$INC{$Bfile}, ' Is not in %INC either' );
- }
-
- ### try an interesting one now
- { my $rv = $code->( $code, $Ufile );
- ok( !$rv, " '$Module' is not being loaded" );
- ok( !$INC{$Ufile}, ' Is not in %INC either' );
- like( $warnings, qr/CPANPLUS::inc: Limits active, '$Module'/s,
- " Warned about limits" );
- }
-
- ### reset limits, try again
- { local %CPANPLUS::inc::LIMIT;
- ok( !keys(%CPANPLUS::inc::LIMIT),
- " Limits removed" );
-
-
- my $rv = $code->( $code, $Ufile );
- ok( $rv, " '$Module' is being loaded" );
-
- use_ok( $Module );
- ok( $INC{$Ufile}, ' Present in %INC' );
- }
-}
-
-### test limited perl5opt, to include just a few modules
-{ my $dash_m = quotemeta '-MCPANPLUS::inc';
- my $dash_i = quotemeta '-I' . CPANPLUS::inc->my_path;
- my $orgopt = quotemeta CPANPLUS::inc->original_perl5opt;
-
- ### first try an empty string;
- { my $str = CPANPLUS::inc->limited_perl5opt;
- ok( !$str, "limited_perl5opt without args is empty" );
- }
-
- ### try with one 'modules'
- { my $str = CPANPLUS::inc->limited_perl5opt(qw[A]);
- ok( $str, "limted perl5opt set for 1 module" );
- like( $str, qr/$dash_m=A\b/,
- " -M set properly" );
- like( $str, qr/$dash_i/," -I set properly" );
- like( $str, qr/$orgopt/," Original opts preserved" );
- }
-
- ### try with more 'modules'
- { my $str = CPANPLUS::inc->limited_perl5opt(qw[A B C]);
- ok( $str, "limted perl5opt set for 3 modules" );
- like( $str, qr/$dash_m=A,B,C\b/,
- " -M set properly" );
- like( $str, qr/$dash_i/," -I set properly" );
- like( $str, qr/$orgopt/," Original opts preserved" );
- }
-}
-
-
-
-
" '$mod' loaded" );
}
+### add to inc path tests
+{ my $meth = '_add_to_includepath';
+ can_ok( $cb, $meth );
+
+ my $p5lib = $ENV{PERL5LIB} || '';
+ my $inc = "@INC";
+ ok( $cb->$meth( directories => [$$] ),
+ " CB->$meth( $$ )" );
+
+ my $new_p5lib = $ENV{PERL5LIB};
+ my $new_inc = "@INC";
+ isnt( $p5lib, $new_p5lib, " PERL5LIB is now: $new_p5lib" );
+ like( $new_p5lib, qr/$$/, " Matches $$" );
+
+ isnt( $inc, $new_inc, ' @INC is expanded with: ' . $$ );
+ like( $new_inc, qr/$$/, " Matches $$" );
+
+ ok( $cb->$meth( directories => [$$] ),
+ " CB->$meth( $$ ) again" );
+ is( "@INC", $new_inc, ' @INC unchanged' );
+ is( $new_p5lib, $ENV{PERL5LIB},
+ " PERL5LIB unchanged" );
+}
+
### callback registering tests ###
{ my $callback_map = {
### name default value
my $conf = gimme_conf();
my $cb = CPANPLUS::Backend->new( $conf );
my $File = 'Bar.pm';
-my $Verbose = @ARGV ? 1 : 0;
### if we need sudo that's no guarantee we can actually run it
### so set $noperms if sudo is required, as that may mean tests
$conf->set_conf( cpantest => 0 );
### Redirect errors to file ###
-*STDERR = output_handle() unless $Verbose;
+*STDERR = output_handle() unless $conf->get_conf('verbose');
### dont uncomment this, it screws up where STDOUT goes and makes
### test::harness create test counter mismatches
#*STDOUT = output_handle() unless @ARGV;
### for the same test-output counter mismatch, we disable verbose
### mode
-$conf->set_conf( verbose => $Verbose );
$conf->set_conf( allow_build_interactivity => 0 );
### start with fresh sources ###
my $ModName = TEST_CONF_MODULE;
my $ModPrereq = TEST_CONF_PREREQ;
-### divide by many -- possibly ~0 is unsigned, and we cause an overflow,
-### as happens to version.pm 0.7203 among others.
-my $HighVersion = ~0/1000;
+### pick a high number, but not ~0 as possibly ~0 is unsigned, and we cause
+### an overflow, as happens to version.pm 0.7203 among others.
+### ANOTHER bug in version.pm, this time for 64bit:
+### https://rt.cpan.org/Ticket/Display.html?id=45241
+### so just use a 'big number'(tm) and go from there.
+my $HighVersion = 1234567890;
my $Mod = $CB->module_tree($ModName);
my $int_ver = $CPANPLUS::Internals::VERSION;
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/01mailrc.txt.gz lib/CPANPLUS/t/dummy-CPAN/authors/01mailrc.txt.gz.packed
-Created at Tue Feb 24 22:22:00 2009
+Created at Sun Apr 26 20:33:20 2009
#########################################################################
__UU__
M'XL("%_EO$4``S`Q;6%I;')C+G1X=`!+S,E,+%9P#8T(5@`#)=>*DM"2S)QB
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz.packed
-Created at Tue Feb 24 22:22:00 2009
+Created at Sun Apr 26 20:33:20 2009
#########################################################################
__UU__
M'XL("!1%OT4"`T)U;F1L92U&;V\M0F%R+3`N,#$N=&%R`.V7:V_:,!2&^8I_
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.tar.gz.packed
-Created at Tue Feb 24 22:22:00 2009
+Created at Sun Apr 26 20:33:20 2009
#########################################################################
__UU__
M'XL(`#P*BD<``^V:;6_B1A"`\WE_Q214(I$.QQ@;)*<YE;M"$^E(JB37GG0]
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/perl5.005_03.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/perl5.005_03.tar.gz.packed
-Created at Tue Feb 24 22:22:00 2009
+Created at Sun Apr 26 20:33:20 2009
#########################################################################
__UU__
M'XL(`'3DO44``^W/,0J`,`Q`T1RE)Y"T-O4XXN"DB%2]OR(*NNC4[;_E#\F0
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/EUXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/EUXS/Foo-Bar-0.01.tar.gz.packed
-Created at Tue Feb 24 22:22:00 2009
+Created at Sun Apr 26 20:33:20 2009
#########################################################################
__UU__
M'XL("`DY34("`T9O;RU"87(M,"XP,2YT87(`[5IK3]M(%,U7YE=<H%5``A.;
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/MBNOXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/MBNOXS/Foo-Bar-0.01.tar.gz.packed
-Created at Tue Feb 24 22:22:00 2009
+Created at Sun Apr 26 20:33:20 2009
#########################################################################
__UU__
M'XL("-<X34(``T9O;RU"87(M,"XP,2YT87(`[9E;;]HP%,=Y]J<X+9722@-R
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/MBXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/MBXS/Foo-Bar-0.01.tar.gz.packed
-Created at Tue Feb 24 22:22:00 2009
+Created at Sun Apr 26 20:33:21 2009
#########################################################################
__UU__
M'XL("-\X34(``T9O;RU"87(M,"XP,2YT87(`[5K_3QI)%/=7YZ]XU39H(BN[
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/modules/02packages.details.txt.gz lib/CPANPLUS/t/dummy-CPAN/modules/02packages.details.txt.gz.packed
-Created at Tue Feb 24 22:22:00 2009
+Created at Sun Apr 26 20:33:21 2009
#########################################################################
__UU__
M'XL("-"H)4<``S`R<&%C:V%G97,N9&5T86EL<RYT>'0`G=-1;],P$`#@=_^*
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/modules/03modlist.data.gz lib/CPANPLUS/t/dummy-CPAN/modules/03modlist.data.gz.packed
-Created at Tue Feb 24 22:22:00 2009
+Created at Sun Apr 26 20:33:21 2009
#########################################################################
__UU__
M'XL("#'FO$4``S`S;6]D;&ES="YD871A`%U3_6O;,!#].?HKCBXC"20A=<@&
TEST_CONF_CPANPLUS_DIR,
'install'
)
- );
-
-### we might need this Some Day when we're installing into
-### our own sandbox. see t/20.t for details
-# use constant TEST_INSTALL_DIR => do {
-# my $dir = File::Spec->rel2abs( 'dummy-perl' );
-#
-# ### clean up paths if we are on win32
-# ### dirs with spaces will be.. bad :(
-# $^O eq 'MSWin32'
-# ? Win32::GetShortPathName( $dir )
-# : $dir;
-# };
-
-# use constant TEST_INSTALL_DIR_LIB
-# => File::Spec->catdir( TEST_INSTALL_DIR, 'lib' );
-# use constant TEST_INSTALL_DIR_BIN
-# => File::Spec->catdir( TEST_INSTALL_DIR, 'bin' );
-# use constant TEST_INSTALL_DIR_MAN1
-# => File::Spec->catdir( TEST_INSTALL_DIR, 'man', 'man1' );
-# use constant TEST_INSTALL_DIR_MAN3
-# => File::Spec->catdir( TEST_INSTALL_DIR, 'man', 'man3' );
-# use constant TEST_INSTALL_DIR_ARCH
-# => File::Spec->catdir( TEST_INSTALL_DIR, 'arch' );
-#
-# use constant TEST_INSTALL_EU_MM_FLAGS =>
-# ' INSTALLDIRS=site' .
-# ' INSTALLSITELIB=' . TEST_INSTALL_DIR_LIB .
-# ' INSTALLSITEARCH=' . TEST_INSTALL_DIR_ARCH . # .packlist
-# ' INSTALLARCHLIB=' . TEST_INSTALL_DIR_ARCH . # perllocal.pod
-# ' INSTALLSITEBIN=' . TEST_INSTALL_DIR_BIN .
-# ' INSTALLSCRIPT=' . TEST_INSTALL_DIR_BIN .
-# ' INSTALLSITEMAN1DIR=' . TEST_INSTALL_DIR_MAN1 .
-# ' INSTALLSITEMAN3DIR=' . TEST_INSTALL_DIR_MAN3;
-
+ );
sub dummy_cpan_dir {
### VMS needs this in directory format for rel2abs
projects / p5sagit/p5-mst-13.2.git / commitdiff