[perl5.git] / lib / CPANPLUS / inc.pm

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:
Commit	Line	Data
6aaee015 RGS	1	package CPANPLUS::inc;
	2
	3	=head1 NAME
	4
	5	CPANPLUS::inc
	6
	7	=head1 DESCRIPTION
	8
	9	OBSOLETE
	10
	11	=cut
	12
	13	sub original_perl5opt { $ENV{PERL5OPT} };
	14	sub original_perl5lib { $ENV{PERL5LIB} };
	15	sub original_inc { @INC };
	16
	17	1;
	18
	19	__END__
	20
	21	use strict;
	22	use vars qw[$DEBUG $VERSION $ENABLE_INC_HOOK %LIMIT $QUIET];
	23	use File::Spec ();
	24	use Config ();
	25
	26	### 5.6.1. nags about require + bareword otherwise ###
	27	use lib ();
	28
	29	$QUIET = 0;
	30	$DEBUG = 0;
	31	%LIMIT = ();
	32
	33	=pod
	34
	35	=head1 NAME
	36
	37	CPANPLUS::inc - runtime inclusion of privately bundled modules
	38
	39	=head1 SYNOPSIS
	40
	41	### set up CPANPLUS::inc to do it's thing ###
	42	BEGIN { use CPANPLUS::inc };
	43
	44	### enable debugging ###
	45	use CPANPLUS::inc qw[DEBUG];
	46
	47	=head1 DESCRIPTION
	48
	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
	52	following things:
	53
	54	=over 4
	55
	56	=item Put a coderef at the beginning of C<@INC>
	57
	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.
	61
	62	=item Add the full path to the C<CPANPLUS/inc> directory to C<$ENV{PERL5LIB>.
	63
	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.
67
68	=back
69
70	=head1 METHODS
71
72	=head2 CPANPLUS::inc->inc_path()
73
74	Returns the full path to the C<CPANPLUS/inc> directory.
75
76	=head2 CPANPLUS::inc->my_path()
77
78	Returns the full path to be added to C<@INC> to load
79	C<CPANPLUS::inc> from.
80
81	=head2 CPANPLUS::inc->installer_path()
82
83	Returns the full path to the C<CPANPLUS/inc/installers> directory.
84
85	=cut
86
87	{ my $ext = '.pm';
88	my $file = (join '/', split '::', __PACKAGE__) . $ext;
89
90	### os specific file path, if you're not on unix
91	my $osfile = File::Spec->catfile( split('::', __PACKAGE__) ) . $ext;
92
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} )
96	);
97
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' );
103
104	sub inc_path { return $path_to_inc }
105	sub my_path { return $path_to_me }
106	sub installer_path { return $path_to_installers }
107	}
108
109	=head2 CPANPLUS::inc->original_perl5lib
110
111	Returns the value of $ENV{PERL5LIB} the way it was when C<CPANPLUS::inc>
112	got loaded.
113
114	=head2 CPANPLUS::inc->original_perl5opt
115
116	Returns the value of $ENV{PERL5OPT} the way it was when C<CPANPLUS::inc>
117	got loaded.
118
119	=head2 CPANPLUS::inc->original_inc
120
121	Returns the value of @INC the way it was when C<CPANPLUS::inc> got
122	loaded.
123
124	=head2 CPANPLUS::inc->limited_perl5opt(@modules);
125
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:
128
129	-I/path/to/cpanplus/inc -MCPANPLUS::inc=module1,module2
130
131	=cut
132
133	{ my $org_opt = $ENV{PERL5OPT};
134	my $org_lib = $ENV{PERL5LIB};
135	my @org_inc = @INC;
136
137	sub original_perl5opt { $org_opt \|\| ''};
138	sub original_perl5lib { $org_lib \|\| ''};
139	sub original_inc { @org_inc, __PACKAGE__->my_path };
140
141	sub limited_perl5opt {
142	my $pkg = shift;
143	my $lim = join ',', @_ or return;
144
145	### -Icp::inc -Mcp::inc=mod1,mod2,mod3
146	my $opt = '-I' . __PACKAGE__->my_path . ' ' .
147	'-M' . __PACKAGE__ . "=$lim";
148
149	$opt .= $Config::Config{'path_sep'} .
150	CPANPLUS::inc->original_perl5opt
151	if CPANPLUS::inc->original_perl5opt;
152
153	return $opt;
154	}
155	}
156
157	=head2 CPANPLUS::inc->interesting_modules()
158
159	Returns a hashref with modules we're interested in, and the minimum
160	version we need to find.
161
162	It would looks something like this:
163
164	{ File::Fetch => 0.06,
165	IPC::Cmd => 0.22,
166	....
167	}
168
169	=cut
170
171	{
172	my $map = {
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,
181	'Log::Message' => 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
194	};
195
196	sub interesting_modules { return $map; }
197	}
198
199
200	=head1 INTERESTING MODULES
201
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.
205
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.
208
209	When it however does encounter a module it is interested in, it will
210	do the following things:
211
212	=over 4
213
214	=item Loop over your @INC
215
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
218	found there.
219
220	=item Check the version on every suitable module found in @INC
221
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>.
225
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
229	released.
230
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.
234
235	=back
236
237	=cut
238
239	{ my $Loaded;
240	my %Cache;
241
242
243	### returns the path to a certain module we found
244	sub path_to {
245	my $self = shift;
246	my $mod = shift or return;
247
248	### find the directory
249	my $path = $Cache{$mod}->[0][2] or return;
250
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.
254
255	### it's our inc-path
256	return __PACKAGE__->inc_path
257	if -e File::Spec->catfile( $path, '.inc' );
258
259	### it's our installer path
260	return __PACKAGE__->installer_path
261	if -e File::Spec->catfile( $path, '.installers' );
262
263	### it's just some dir...
264	return $path;
265	}
266
267	### just a debug method
268	sub _show_cache { return \%Cache };
269
270	sub import {
271	my $pkg = shift;
272
273	### filter DEBUG, and toggle the global
274	map { $LIMIT{$_} = 1 }
275	grep { /DEBUG/ ? ++$DEBUG && 0 :
276	/QUIET/ ? ++$QUIET && 0 :
277	1
278	} @_;
279
280	### only load once ###
281	return 1 if $Loaded++;
282
283	### first, add our own private dir to the end of @INC:
284	{
285	push @INC, __PACKAGE__->my_path, __PACKAGE__->inc_path,
286	__PACKAGE__->installer_path;
287
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...
293	# { local $^W;
294	# $ENV{'PERL5LIB'} .= $Config::Config{'path_sep'}
295	# . __PACKAGE__->my_path
296	# . $Config::Config{'path_sep'}
297	# . __PACKAGE__->inc_path;
298	#
299	# $ENV{'PERL5OPT'} = '-M'. __PACKAGE__ . ' '
300	# . ($ENV{'PERL5OPT'} \|\| '');
301	# }
302	}
303
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.
307	lib->import( sub {
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
311	# win32 paths =/
312	my $file = pop @parts; # just the file name
313	my $map = __PACKAGE__->interesting_modules;
314
315	### translate file name to module name
316	### could contain win32 paths delimiters
317	$module =~ s!/\|\\!::!g; $module =~ s/\.pm//i;
318
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;
323
324	### do we need to check the version too?
325	++$check_version if exists $map->{$module};
326
327	### we don't care ###
328	unless( $try ) {
329	warn __PACKAGE__ .": Not interested in '$module'\n" if $DEBUG;
330	return;
331
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;
337	return;
338	}
339	}
340
341	### found filehandles + versions ###
342	my @found;
343	DIR: for my $dir (@INC) {
344	next DIR unless -d $dir;
345
346	### get the full path to the module ###
347	my $pm = File::Spec->catfile( $dir, @parts, $file );
348
349	### open the file if it exists ###
350	if( -e $pm ) {
351	my $fh;
352	unless( open $fh, "$pm" ) {
353	warn __PACKAGE__ .": Could not open '$pm': $!\n"
354	if $DEBUG;
355	next DIR;
356	}
357
358	my $found;
359	### XXX stolen from module::load::conditional ###
360	while (local $_ = <$fh> ) {
361
362	### the following regexp comes from the
363	### ExtUtils::MakeMaker documentation.
364	if ( /([\$])(([\w\:\'])\bVERSION)\b.*\=/ ) {
365
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
370
371	local $VERSION;
372	my $res = eval $_;
373
374	### default to '0.0' if there REALLY is no version
375	### all to satisfy warnings
376	$found = $VERSION \|\| $res \|\| '0.0';
377
378	### found what we came for
379	last if $found;
380	}
381	}
382
383	### no version defined at all? ###
384	$found \|\|= '0.0';
385
386	warn __PACKAGE__ .": Found match for '$module' in '$dir' "
387	."with version '$found'\n" if $DEBUG;
388
389	### reset the position of the filehandle ###
390	seek $fh, 0, 0;
391
392	### store the found version + filehandle it came from ###
393	push @found, [ $found, $fh, $dir, $pm ];
394	}
395
396	} # done looping over all the dirs
397
398	### nothing found? ###
399	unless (@found) {
400	warn __PACKAGE__ .": Unable to find any module named "
401	. "'$module'\n" if $DEBUG;
402	return;
403	}
404
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
409	my @sorted = sort {
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])
414	: 0 ) \|\|
415	(($a->[2] eq __PACKAGE__->inc_path) <=>
416	($b->[2] eq __PACKAGE__->inc_path)) \|\|
417	(-M $a->[3] <=> -M $b->[3])
418	} @found;
419
420	warn __PACKAGE__ .": Best match for '$module' is found in "
421	."'$sorted[0][2]' with version '$sorted[0][0]'\n"
422	if $DEBUG;
423
424	if( $check_version and
425	not (_vcmp($sorted[0][0], $map->{$module}) >= 0)
426	) {
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;
432	};
433
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
445	) {
446	warn __PACKAGE__ .": Found newer version of 'Module::Build::*' "
447	."elsewhere in your path. Pretending to not "
448	."have found it\n" if $DEBUG;
449	return;
450	}
451
452	### store what we found for this module
453	$Cache{$module} = \@sorted;
454
455	### best matching filehandle ###
456	return $sorted[0][1];
457	} );
458	}
459	}
460
461	### XXX copied from C::I::Utils, so there's no circular require here!
462	sub _vcmp {
463	my ($x, $y) = @_;
464	s/_//g foreach $x, $y;
465	return $x <=> $y;
466	}
467
468	=pod
469
470	=head1 DEBUG
471
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
475	this:
476
477	use CPANPLUS::inc 'DEBUG';
478
479	This will show you what C<CPANPLUS::inc> is doing, which might look
480	something like this:
481
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'
488
489	=head1 CAVEATS
490
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
493	are much welcomed.
494
495	=over 4
496
497	=item On multiple C<use lib> calls, our coderef may not be the first in @INC
498
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
502	application.
503
504	=item Non-directories in @INC
505
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.
510
511
512	=cut
513
514	1;
515
516	# Local variables:
517	# c-indentation-style: bsd
518	# c-basic-offset: 4
519	# indent-tabs-mode: nil
520	# End:
521	# vim: expandtab shiftwidth=4:
522