13 sub original_perl5opt { $ENV{PERL5OPT} };
14 sub original_perl5lib { $ENV{PERL5LIB} };
15 sub original_inc { @INC };
22 use vars qw[$DEBUG $VERSION $ENABLE_INC_HOOK %LIMIT $QUIET];
26 ### 5.6.1. nags about require + bareword otherwise ###
37 CPANPLUS::inc - runtime inclusion of privately bundled modules
41 ### set up CPANPLUS::inc to do it's thing ###
42 BEGIN { use CPANPLUS::inc };
44 ### enable debugging ###
45 use CPANPLUS::inc qw[DEBUG];
49 This module enables the use of the bundled modules in the
50 C<CPANPLUS/inc> directory of this package. These modules are bundled
51 to make sure C<CPANPLUS> is able to bootstrap itself. It will do the
56 =item Put a coderef at the beginning of C<@INC>
58 This allows us to decide which module to load, and where to find it.
59 For details on what we do, see the C<INTERESTING MODULES> section below.
60 Also see the C<CAVEATS> section.
62 =item Add the full path to the C<CPANPLUS/inc> directory to C<$ENV{PERL5LIB>.
64 This allows us to find our bundled modules even if we spawn off a new
65 process. Although it's not able to do the selective loading as the
66 coderef in C<@INC> could, it's a good fallback.
72 =head2 CPANPLUS::inc->inc_path()
74 Returns the full path to the C<CPANPLUS/inc> directory.
76 =head2 CPANPLUS::inc->my_path()
78 Returns the full path to be added to C<@INC> to load
79 C<CPANPLUS::inc> from.
81 =head2 CPANPLUS::inc->installer_path()
83 Returns the full path to the C<CPANPLUS/inc/installers> directory.
88 my $file = (join '/', split '::', __PACKAGE__) . $ext;
90 ### os specific file path, if you're not on unix
91 my $osfile = File::Spec->catfile( split('::', __PACKAGE__) ) . $ext;
93 ### this returns a unixy path, compensate if you're on non-unix
94 my $path = File::Spec->rel2abs(
95 File::Spec->catfile( split '/', $INC{$file} )
98 ### don't forget to quotemeta; win32 paths are special
99 my $qm_osfile = quotemeta $osfile;
100 my $path_to_me = $path; $path_to_me =~ s/$qm_osfile$//i;
101 my $path_to_inc = $path; $path_to_inc =~ s/$ext$//i;
102 my $path_to_installers = File::Spec->catdir( $path_to_inc, 'installers' );
104 sub inc_path { return $path_to_inc }
105 sub my_path { return $path_to_me }
106 sub installer_path { return $path_to_installers }
109 =head2 CPANPLUS::inc->original_perl5lib
111 Returns the value of $ENV{PERL5LIB} the way it was when C<CPANPLUS::inc>
114 =head2 CPANPLUS::inc->original_perl5opt
116 Returns the value of $ENV{PERL5OPT} the way it was when C<CPANPLUS::inc>
119 =head2 CPANPLUS::inc->original_inc
121 Returns the value of @INC the way it was when C<CPANPLUS::inc> got
124 =head2 CPANPLUS::inc->limited_perl5opt(@modules);
126 Returns a string you can assign to C<$ENV{PERL5OPT}> to have a limited
127 include facility from C<CPANPLUS::inc>. It will roughly look like:
129 -I/path/to/cpanplus/inc -MCPANPLUS::inc=module1,module2
133 { my $org_opt = $ENV{PERL5OPT};
134 my $org_lib = $ENV{PERL5LIB};
137 sub original_perl5opt { $org_opt || ''};
138 sub original_perl5lib { $org_lib || ''};
139 sub original_inc { @org_inc, __PACKAGE__->my_path };
141 sub limited_perl5opt {
143 my $lim = join ',', @_ or return;
145 ### -Icp::inc -Mcp::inc=mod1,mod2,mod3
146 my $opt = '-I' . __PACKAGE__->my_path . ' ' .
147 '-M' . __PACKAGE__ . "=$lim";
149 $opt .= $Config::Config{'path_sep'} .
150 CPANPLUS::inc->original_perl5opt
151 if CPANPLUS::inc->original_perl5opt;
157 =head2 CPANPLUS::inc->interesting_modules()
159 Returns a hashref with modules we're interested in, and the minimum
160 version we need to find.
162 It would looks something like this:
164 { File::Fetch => 0.06,
173 ### used to have 0.80, but not it was never released by coral
174 ### 0.79 *should* be good enough for now... asked coral to
175 ### release 0.80 on 10/3/2006
176 'IPC::Run' => '0.79',
177 'File::Fetch' => '0.07',
178 #'File::Spec' => '0.82', # can't, need it ourselves...
179 'IPC::Cmd' => '0.24',
180 'Locale::Maketext::Simple' => 0,
182 'Module::Load' => '0.10',
183 'Module::Load::Conditional' => '0.07',
184 'Params::Check' => '0.22',
185 'Term::UI' => '0.05',
186 'Archive::Extract' => '0.07',
187 'Archive::Tar' => '1.23',
188 'IO::Zlib' => '1.04',
189 'Object::Accessor' => '0.03',
190 'Module::CoreList' => '1.97',
191 'Module::Pluggable' => '2.4',
192 'Module::Loaded' => 0,
193 #'Config::Auto' => 0, # not yet, not using it yet
196 sub interesting_modules { return $map; }
200 =head1 INTERESTING MODULES
202 C<CPANPLUS::inc> doesn't even bother to try find and find a module
203 it's not interested in. A list of I<interesting modules> can be
204 obtained using the C<interesting_modules> method described above.
206 Note that all subclassed modules of an C<interesting module> will
207 also be attempted to be loaded, but a version will not be checked.
209 When it however does encounter a module it is interested in, it will
210 do the following things:
214 =item Loop over your @INC
216 And for every directory it finds there (skipping all non directories
217 -- see the C<CAVEATS> section), see if the module requested can be
220 =item Check the version on every suitable module found in @INC
222 After a list of modules has been gathered, the version of each of them
223 is checked to find the one with the highest version, and return that as
224 the module to C<use>.
226 This enables us to use a recent enough version from our own bundled
227 modules, but also to use a I<newer> module found in your path instead,
228 if it is present. Thus having access to bugfixed versions as they are
231 If for some reason no satisfactory version could be found, a warning
232 will be emitted. See the C<DEBUG> section for more details on how to
233 find out exactly what C<CPANPLUS::inc> is doing.
243 ### returns the path to a certain module we found
246 my $mod = shift or return;
248 ### find the directory
249 my $path = $Cache{$mod}->[0][2] or return;
251 ### probe them explicitly for a special file, because the
252 ### dir we found the file in vs our own paths may point to the
253 ### same location, but might not pass an 'eq' test.
255 ### it's our inc-path
256 return __PACKAGE__->inc_path
257 if -e File::Spec->catfile( $path, '.inc' );
259 ### it's our installer path
260 return __PACKAGE__->installer_path
261 if -e File::Spec->catfile( $path, '.installers' );
263 ### it's just some dir...
267 ### just a debug method
268 sub _show_cache { return \%Cache };
273 ### filter DEBUG, and toggle the global
274 map { $LIMIT{$_} = 1 }
275 grep { /DEBUG/ ? ++$DEBUG && 0 :
276 /QUIET/ ? ++$QUIET && 0 :
280 ### only load once ###
281 return 1 if $Loaded++;
283 ### first, add our own private dir to the end of @INC:
285 push @INC, __PACKAGE__->my_path, __PACKAGE__->inc_path,
286 __PACKAGE__->installer_path;
288 ### XXX stop doing this, there's no need for it anymore;
289 ### none of the shell outs need to have this set anymore
290 # ### add the path to this module to PERL5OPT in case
291 # ### we spawn off some programs...
292 # ### then add this module to be loaded in PERL5OPT...
294 # $ENV{'PERL5LIB'} .= $Config::Config{'path_sep'}
295 # . __PACKAGE__->my_path
296 # . $Config::Config{'path_sep'}
297 # . __PACKAGE__->inc_path;
299 # $ENV{'PERL5OPT'} = '-M'. __PACKAGE__ . ' '
300 # . ($ENV{'PERL5OPT'} || '');
304 ### next, find the highest version of a module that
305 ### we care about. very basic check, but will
306 ### have to do for now.
308 my $path = pop(); # path to the pm
309 my $module = $path or return; # copy of the path, to munge
310 my @parts = split qr!\\|/!, $path; # dirs + file name; could be
312 my $file = pop @parts; # just the file name
313 my $map = __PACKAGE__->interesting_modules;
315 ### translate file name to module name
316 ### could contain win32 paths delimiters
317 $module =~ s!/|\\!::!g; $module =~ s/\.pm//i;
319 my $check_version; my $try;
320 ### does it look like a module we care about?
321 my ($interesting) = grep { $module =~ /^$_/ } keys %$map;
322 ++$try if $interesting;
324 ### do we need to check the version too?
325 ++$check_version if exists $map->{$module};
327 ### we don't care ###
329 warn __PACKAGE__ .": Not interested in '$module'\n" if $DEBUG;
332 ### we're not allowed
333 } elsif ( $try and keys %LIMIT ) {
334 unless( grep { $module =~ /^$_/ } keys %LIMIT ) {
335 warn __PACKAGE__ .": Limits active, '$module' not allowed ".
336 "to be loaded" if $DEBUG;
341 ### found filehandles + versions ###
343 DIR: for my $dir (@INC) {
344 next DIR unless -d $dir;
346 ### get the full path to the module ###
347 my $pm = File::Spec->catfile( $dir, @parts, $file );
349 ### open the file if it exists ###
352 unless( open $fh, "$pm" ) {
353 warn __PACKAGE__ .": Could not open '$pm': $!\n"
359 ### XXX stolen from module::load::conditional ###
360 while (local $_ = <$fh> ) {
362 ### the following regexp comes from the
363 ### ExtUtils::MakeMaker documentation.
364 if ( /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ ) {
366 ### this will eval the version in to $VERSION if it
367 ### was declared as $VERSION in the module.
368 ### else the result will be in $res.
369 ### this is a fix on skud's Module::InstalledVersion
374 ### default to '0.0' if there REALLY is no version
375 ### all to satisfy warnings
376 $found = $VERSION || $res || '0.0';
378 ### found what we came for
383 ### no version defined at all? ###
386 warn __PACKAGE__ .": Found match for '$module' in '$dir' "
387 ."with version '$found'\n" if $DEBUG;
389 ### reset the position of the filehandle ###
392 ### store the found version + filehandle it came from ###
393 push @found, [ $found, $fh, $dir, $pm ];
396 } # done looping over all the dirs
398 ### nothing found? ###
400 warn __PACKAGE__ .": Unable to find any module named "
401 . "'$module'\n" if $DEBUG;
405 ### find highest version
406 ### or the one in the same dir as a base module already loaded
407 ### or otherwise, the one not bundled
408 ### or otherwise the newest
410 _vcmp($b->[0], $a->[0]) ||
411 ($Cache{$interesting}
412 ?($b->[2] eq $Cache{$interesting}->[0][2]) <=>
413 ($a->[2] eq $Cache{$interesting}->[0][2])
415 (($a->[2] eq __PACKAGE__->inc_path) <=>
416 ($b->[2] eq __PACKAGE__->inc_path)) ||
417 (-M $a->[3] <=> -M $b->[3])
420 warn __PACKAGE__ .": Best match for '$module' is found in "
421 ."'$sorted[0][2]' with version '$sorted[0][0]'\n"
424 if( $check_version and
425 not (_vcmp($sorted[0][0], $map->{$module}) >= 0)
427 warn __PACKAGE__ .": Cannot find high enough version for "
428 ."'$module' -- need '$map->{$module}' but "
429 ."only found '$sorted[0][0]'. Returning "
430 ."highest found version but this may cause "
431 ."problems\n" unless $QUIET;
434 ### right, so that damn )#$(*@#)(*@#@ Module::Build makes
435 ### assumptions about the environment (especially its own tests)
436 ### and blows up badly if it's loaded via CP::inc :(
437 ### so, if we find a newer version on disk (which would happen when
438 ### upgrading or having upgraded, just pretend we didn't find it,
439 ### let it be loaded via the 'normal' way.
440 ### can't even load the *proper* one via our CP::inc, as it will
441 ### get upset just over the fact it's loaded via a non-standard way
442 if( $module =~ /^Module::Build/ and
443 $sorted[0][2] ne __PACKAGE__->inc_path and
444 $sorted[0][2] ne __PACKAGE__->installer_path
446 warn __PACKAGE__ .": Found newer version of 'Module::Build::*' "
447 ."elsewhere in your path. Pretending to not "
448 ."have found it\n" if $DEBUG;
452 ### store what we found for this module
453 $Cache{$module} = \@sorted;
455 ### best matching filehandle ###
456 return $sorted[0][1];
461 ### XXX copied from C::I::Utils, so there's no circular require here!
464 s/_//g foreach $x, $y;
472 Since this module does C<Clever Things> to your search path, it might
473 be nice sometimes to figure out what it's doing, if things don't work
474 as expected. You can enable a debug trace by calling the module like
477 use CPANPLUS::inc 'DEBUG';
479 This will show you what C<CPANPLUS::inc> is doing, which might look
482 CPANPLUS::inc: Found match for 'Params::Check' in
483 '/opt/lib/perl5/site_perl/5.8.3' with version '0.07'
484 CPANPLUS::inc: Found match for 'Params::Check' in
485 '/my/private/lib/CPANPLUS/inc' with version '0.21'
486 CPANPLUS::inc: Best match for 'Params::Check' is found in
487 '/my/private/lib/CPANPLUS/inc' with version '0.21'
491 This module has 2 major caveats, that could lead to unexpected
492 behaviour. But currently I don't know how to fix them, Suggestions
497 =item On multiple C<use lib> calls, our coderef may not be the first in @INC
499 If this happens, although unlikely in most situations and not happening
500 when calling the shell directly, this could mean that a lower (too low)
501 versioned module is loaded, which might cause failures in the
504 =item Non-directories in @INC
506 Non-directories are right now skipped by CPANPLUS::inc. They could of
507 course lead us to newer versions of a module, but it's too tricky to
508 verify if they would. Therefor they are skipped. In the worst case
509 scenario we'll find the sufficing version bundled with CPANPLUS.
517 # c-indentation-style: bsd
519 # indent-tabs-mode: nil
521 # vim: expandtab shiftwidth=4: