From: Jos I. Boumans Date: Mon, 27 Apr 2009 15:32:08 +0000 (+0200) Subject: Update CPANPLUS to 0.86 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=20afcebf4582369ec1b02c71a51b74640d3224ad;p=p5sagit%2Fp5-mst-13.2.git Update CPANPLUS to 0.86 --- diff --git a/MANIFEST b/MANIFEST index 69084ba..81796a5 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1944,7 +1944,6 @@ lib/CPANPLUS/Dist/Sample.pm CPANPLUS 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 @@ -1973,7 +1972,6 @@ lib/CPANPLUS/Shell/Default/Plugins/Remote.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 diff --git a/lib/CPANPLUS.pm b/lib/CPANPLUS.pm index 906cbe0..c1d0377 100644 --- a/lib/CPANPLUS.pm +++ b/lib/CPANPLUS.pm @@ -13,7 +13,7 @@ BEGIN { 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: diff --git a/lib/CPANPLUS/Dist/MM.pm b/lib/CPANPLUS/Dist/MM.pm index 2fa1f0c..e8fe3cd 100644 --- a/lib/CPANPLUS/Dist/MM.pm +++ b/lib/CPANPLUS/Dist/MM.pm @@ -222,7 +222,7 @@ sub prepare { 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 }, @@ -565,9 +565,14 @@ sub create { $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 ); diff --git a/lib/CPANPLUS/Internals.pm b/lib/CPANPLUS/Internals.pm index 17b48c1..33628ef 100644 --- a/lib/CPANPLUS/Internals.pm +++ b/lib/CPANPLUS/Internals.pm @@ -42,7 +42,7 @@ use vars qw[@ISA $VERSION]; CPANPLUS::Internals::Report ]; -$VERSION = "0.86_06"; +$VERSION = "0.86"; =pod @@ -422,13 +422,16 @@ sub _add_to_includepath { 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; diff --git a/lib/CPANPLUS/Module.pm b/lib/CPANPLUS/Module.pm index b8949fe..67b78b8 100644 --- a/lib/CPANPLUS/Module.pm +++ b/lib/CPANPLUS/Module.pm @@ -436,19 +436,24 @@ L for more details. 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; @@ -777,15 +782,26 @@ sub dist { } } - 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 @@ -992,6 +1008,7 @@ sub install { ### 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' ". @@ -1504,38 +1521,14 @@ sub distributions { 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 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 @@ -1543,14 +1536,19 @@ are present in the .packlist file. =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); @@ -1580,6 +1578,24 @@ sub _extutils_installed { 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 @@ -1588,30 +1604,46 @@ sub _extutils_installed { 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; diff --git a/lib/CPANPLUS/Shell/Classic.pm b/lib/CPANPLUS/Shell/Classic.pm index 176548c..08c03bc 100644 --- a/lib/CPANPLUS/Shell/Classic.pm +++ b/lib/CPANPLUS/Shell/Classic.pm @@ -314,7 +314,7 @@ sub _shell { $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; diff --git a/lib/CPANPLUS/Shell/Default.pm b/lib/CPANPLUS/Shell/Default.pm index 668fbc7..8c4f810 100644 --- a/lib/CPANPLUS/Shell/Default.pm +++ b/lib/CPANPLUS/Shell/Default.pm @@ -26,7 +26,7 @@ local $Data::Dumper::Indent = 1; # for dumpering from ! BEGIN { use vars qw[ $VERSION @ISA ]; @ISA = qw[ CPANPLUS::Shell::_Base::ReadLine ]; - $VERSION = "0.86_06"; + $VERSION = "0.86"; } load CPANPLUS::Shell; diff --git a/lib/CPANPLUS/inc.pm b/lib/CPANPLUS/inc.pm deleted file mode 100644 index 2bcdc7c..0000000 --- a/lib/CPANPLUS/inc.pm +++ /dev/null @@ -1,522 +0,0 @@ -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 directory of this package. These modules are bundled -to make sure C 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 section below. -Also see the C section. - -=item Add the full path to the C 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 directory. - -=head2 CPANPLUS::inc->my_path() - -Returns the full path to be added to C<@INC> to load -C from. - -=head2 CPANPLUS::inc->installer_path() - -Returns the full path to the C 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 -got loaded. - -=head2 CPANPLUS::inc->original_perl5opt - -Returns the value of $ENV{PERL5OPT} the way it was when C -got loaded. - -=head2 CPANPLUS::inc->original_inc - -Returns the value of @INC the way it was when C 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. 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 doesn't even bother to try find and find a module -it's not interested in. A list of I can be -obtained using the C method described above. - -Note that all subclassed modules of an C 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 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. - -This enables us to use a recent enough version from our own bundled -modules, but also to use a I 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 section for more details on how to -find out exactly what C 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 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 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 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: - diff --git a/lib/CPANPLUS/t/00_CPANPLUS-Inc.t b/lib/CPANPLUS/t/00_CPANPLUS-Inc.t deleted file mode 100644 index cf78d61..0000000 --- a/lib/CPANPLUS/t/00_CPANPLUS-Inc.t +++ /dev/null @@ -1,190 +0,0 @@ -### 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" ); - } -} - - - - diff --git a/lib/CPANPLUS/t/02_CPANPLUS-Internals.t b/lib/CPANPLUS/t/02_CPANPLUS-Internals.t index f576174..84b78f3 100644 --- a/lib/CPANPLUS/t/02_CPANPLUS-Internals.t +++ b/lib/CPANPLUS/t/02_CPANPLUS-Internals.t @@ -73,6 +73,30 @@ is($cb->_id, $cb->_last_id, "Comparing ID's"); " '$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 diff --git a/lib/CPANPLUS/t/20_CPANPLUS-Dist-MM.t b/lib/CPANPLUS/t/20_CPANPLUS-Dist-MM.t index d3eb525..b4fd78d 100644 --- a/lib/CPANPLUS/t/20_CPANPLUS-Dist-MM.t +++ b/lib/CPANPLUS/t/20_CPANPLUS-Dist-MM.t @@ -22,7 +22,6 @@ use File::Spec (); 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 @@ -45,14 +44,13 @@ $cb->_callbacks->send_test_report( sub { 0 } ); $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 ### diff --git a/lib/CPANPLUS/t/40_CPANPLUS-Internals-Report.t b/lib/CPANPLUS/t/40_CPANPLUS-Internals-Report.t index 4e91bae..d7c2bd8 100644 --- a/lib/CPANPLUS/t/40_CPANPLUS-Internals-Report.t +++ b/lib/CPANPLUS/t/40_CPANPLUS-Internals-Report.t @@ -25,9 +25,12 @@ my $CB = CPANPLUS::Backend->new( $conf ); 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; diff --git a/lib/CPANPLUS/t/dummy-CPAN/authors/01mailrc.txt.gz.packed b/lib/CPANPLUS/t/dummy-CPAN/authors/01mailrc.txt.gz.packed index c25653f..0bcb0fa 100644 --- a/lib/CPANPLUS/t/dummy-CPAN/authors/01mailrc.txt.gz.packed +++ b/lib/CPANPLUS/t/dummy-CPAN/authors/01mailrc.txt.gz.packed @@ -10,7 +10,7 @@ To recreate it use the following command: 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 diff --git a/lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz.packed b/lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz.packed index 0272e71..bd58326 100644 --- a/lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz.packed +++ b/lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz.packed @@ -10,7 +10,7 @@ To recreate it use the following command: 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_ diff --git a/lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.tar.gz.packed b/lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.tar.gz.packed index 57be5f3..553cbd3 100644 --- a/lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.tar.gz.packed +++ b/lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.tar.gz.packed @@ -10,7 +10,7 @@ To recreate it use the following command: 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@;)*'0`G=-1;],P$`#@=_^* diff --git a/lib/CPANPLUS/t/dummy-CPAN/modules/03modlist.data.gz.packed b/lib/CPANPLUS/t/dummy-CPAN/modules/03modlist.data.gz.packed index 82ae9ac..df1d600 100644 --- a/lib/CPANPLUS/t/dummy-CPAN/modules/03modlist.data.gz.packed +++ b/lib/CPANPLUS/t/dummy-CPAN/modules/03modlist.data.gz.packed @@ -10,7 +10,7 @@ To recreate it use the following command: 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=<@& diff --git a/lib/CPANPLUS/t/inc/conf.pl b/lib/CPANPLUS/t/inc/conf.pl index c884fd8..1287ec9 100644 --- a/lib/CPANPLUS/t/inc/conf.pl +++ b/lib/CPANPLUS/t/inc/conf.pl @@ -102,41 +102,7 @@ use constant TEST_CONF_INSTALL_DIR => File::Spec->rel2abs( 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