lib/CPANPLUS/inc.pm

   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