—————package
CPANPLUS::inc;
use
strict;
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: