| 16 | 16 |
# 3. The ./inc/ version of Module::Install loads
|
| 17 | 17 |
# }
|
| 18 | 18 |
|
| 19 | |
use 5.005;
|
|
19 |
use 5.006;
|
| 20 | 20 |
use strict 'vars';
|
| 21 | 21 |
use Cwd ();
|
| 22 | 22 |
use File::Find ();
|
|
| 30 | 30 |
# This is not enforced yet, but will be some time in the next few
|
| 31 | 31 |
# releases once we can make sure it won't clash with custom
|
| 32 | 32 |
# Module::Install extensions.
|
| 33 | |
$VERSION = '1.06';
|
|
33 |
$VERSION = '1.19';
|
| 34 | 34 |
|
| 35 | 35 |
# Storage for the pseudo-singleton
|
| 36 | 36 |
$MAIN = undef;
|
|
| 155 | 155 |
sub autoload {
|
| 156 | 156 |
my $self = shift;
|
| 157 | 157 |
my $who = $self->_caller;
|
| 158 | |
my $cwd = Cwd::cwd();
|
|
158 |
my $cwd = Cwd::getcwd();
|
| 159 | 159 |
my $sym = "${who}::AUTOLOAD";
|
| 160 | 160 |
$sym->{$cwd} = sub {
|
| 161 | |
my $pwd = Cwd::cwd();
|
|
161 |
my $pwd = Cwd::getcwd();
|
| 162 | 162 |
if ( my $code = $sym->{$pwd} ) {
|
| 163 | 163 |
# Delegate back to parent dirs
|
| 164 | 164 |
goto &$code unless $cwd eq $pwd;
|
|
| 238 | 238 |
|
| 239 | 239 |
# ignore the prefix on extension modules built from top level.
|
| 240 | 240 |
my $base_path = Cwd::abs_path($FindBin::Bin);
|
| 241 | |
unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
|
|
241 |
unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) {
|
| 242 | 242 |
delete $args{prefix};
|
| 243 | 243 |
}
|
| 244 | 244 |
return $args{_self} if $args{_self};
|
|
245 |
|
|
246 |
$base_path = VMS::Filespec::unixify($base_path) if $^O eq 'VMS';
|
| 245 | 247 |
|
| 246 | 248 |
$args{dispatch} ||= 'Admin';
|
| 247 | 249 |
$args{prefix} ||= 'inc';
|
|
| 321 | 323 |
my ($self, $path) = @_;
|
| 322 | 324 |
|
| 323 | 325 |
my @found;
|
| 324 | |
File::Find::find( sub {
|
|
326 |
File::Find::find( {no_chdir => 1, wanted => sub {
|
| 325 | 327 |
my $file = $File::Find::name;
|
| 326 | 328 |
return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
|
| 327 | 329 |
my $subpath = $1;
|
|
| 335 | 337 |
# correctly. Otherwise, root through the file to locate the case-preserved
|
| 336 | 338 |
# version of the package name.
|
| 337 | 339 |
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
|
| 338 | |
my $content = Module::Install::_read($subpath . '.pm');
|
|
340 |
my $content = Module::Install::_read($File::Find::name);
|
| 339 | 341 |
my $in_pod = 0;
|
| 340 | |
foreach ( split //, $content ) {
|
|
342 |
foreach ( split /\n/, $content ) {
|
| 341 | 343 |
$in_pod = 1 if /^=\w/;
|
| 342 | 344 |
$in_pod = 0 if /^=cut/;
|
| 343 | 345 |
next if ($in_pod || /^=cut/); # skip pod text
|
|
| 350 | 352 |
}
|
| 351 | 353 |
|
| 352 | 354 |
push @found, [ $file, $pkg ];
|
| 353 | |
}, $path ) if -d $path;
|
|
355 |
}}, $path ) if -d $path;
|
| 354 | 356 |
|
| 355 | 357 |
@found;
|
| 356 | 358 |
}
|
|
| 372 | 374 |
return $call;
|
| 373 | 375 |
}
|
| 374 | 376 |
|
| 375 | |
# Done in evals to avoid confusing Perl::MinimumVersion
|
| 376 | |
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
|
| 377 | 377 |
sub _read {
|
| 378 | 378 |
local *FH;
|
| 379 | 379 |
open( FH, '<', $_[0] ) or die "open($_[0]): $!";
|
|
380 |
binmode FH;
|
| 380 | 381 |
my $string = do { local $/; <FH> };
|
| 381 | 382 |
close FH or die "close($_[0]): $!";
|
| 382 | 383 |
return $string;
|
| 383 | 384 |
}
|
| 384 | |
END_NEW
|
| 385 | |
sub _read {
|
| 386 | |
local *FH;
|
| 387 | |
open( FH, "< $_[0]" ) or die "open($_[0]): $!";
|
| 388 | |
my $string = do { local $/; <FH> };
|
| 389 | |
close FH or die "close($_[0]): $!";
|
| 390 | |
return $string;
|
| 391 | |
}
|
| 392 | |
END_OLD
|
| 393 | 385 |
|
| 394 | 386 |
sub _readperl {
|
| 395 | 387 |
my $string = Module::Install::_read($_[0]);
|
|
| 410 | 402 |
return $string;
|
| 411 | 403 |
}
|
| 412 | 404 |
|
| 413 | |
# Done in evals to avoid confusing Perl::MinimumVersion
|
| 414 | |
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
|
| 415 | 405 |
sub _write {
|
| 416 | 406 |
local *FH;
|
| 417 | 407 |
open( FH, '>', $_[0] ) or die "open($_[0]): $!";
|
|
408 |
binmode FH;
|
| 418 | 409 |
foreach ( 1 .. $#_ ) {
|
| 419 | 410 |
print FH $_[$_] or die "print($_[0]): $!";
|
| 420 | 411 |
}
|
| 421 | 412 |
close FH or die "close($_[0]): $!";
|
| 422 | 413 |
}
|
| 423 | |
END_NEW
|
| 424 | |
sub _write {
|
| 425 | |
local *FH;
|
| 426 | |
open( FH, "> $_[0]" ) or die "open($_[0]): $!";
|
| 427 | |
foreach ( 1 .. $#_ ) {
|
| 428 | |
print FH $_[$_] or die "print($_[0]): $!";
|
| 429 | |
}
|
| 430 | |
close FH or die "close($_[0]): $!";
|
| 431 | |
}
|
| 432 | |
END_OLD
|
| 433 | 414 |
|
| 434 | 415 |
# _version is for processing module versions (eg, 1.03_05) not
|
| 435 | 416 |
# Perl versions (eg, 5.8.1).
|
| 436 | |
sub _version ($) {
|
|
417 |
sub _version {
|
| 437 | 418 |
my $s = shift || 0;
|
| 438 | 419 |
my $d =()= $s =~ /(\.)/g;
|
| 439 | 420 |
if ( $d >= 2 ) {
|
|
| 449 | 430 |
return $l + 0;
|
| 450 | 431 |
}
|
| 451 | 432 |
|
| 452 | |
sub _cmp ($$) {
|
|
433 |
sub _cmp {
|
| 453 | 434 |
_version($_[1]) <=> _version($_[2]);
|
| 454 | 435 |
}
|
| 455 | 436 |
|
| 456 | 437 |
# Cloned from Params::Util::_CLASS
|
| 457 | |
sub _CLASS ($) {
|
|
438 |
sub _CLASS {
|
| 458 | 439 |
(
|
| 459 | 440 |
defined $_[0]
|
| 460 | 441 |
and
|