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 it's 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: