package CPANPLUS::inc;
use strict;
use vars qw[$DEBUG $VERSION $ENABLE_INC_HOOK %LIMIT];
use File::Spec ();
use Config ();
### 5.6.1. nags about require + bareword otherwise ###
use lib ();
$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 = {
'File::Fetch' => '0.07',
#'File::Spec' => '0.82', # can't, need it ourselves...
'IPC::Run' => '0.80',
'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',
#'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 : 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";
};
### 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];
} );
}
}
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: