package File::Spec;
use strict;
our $VERSION = '3.75';
$VERSION =~ tr/_//d;
my %module = (
MSWin32 => 'Win32',
os2 => 'OS2',
VMS => 'VMS',
NetWare => 'Win32', # Yes, File::Spec::Win32 works on NetWare.
symbian => 'Win32', # Yes, File::Spec::Win32 works on symbian.
dos => 'OS2', # Yes, File::Spec::OS2 works on DJGPP.
cygwin => 'Cygwin',
amigaos => 'AmigaOS');
my $module = $module{$^O} || 'Unix';
require "File/Spec/$module.pm";
our @ISA = ("File::Spec::$module");
1;
####
package File::Spec::Unix;
use strict;
use Cwd ();
our $VERSION = '3.75';
$VERSION =~ tr/_//d;
# ...
sub case_tolerant { 0 }
use constant _fn_case_tolerant => 0;
# ...
##
##
package File::Spec::Win32;
use strict;
use Cwd ();
require File::Spec::Unix;
our $VERSION = '3.75';
$VERSION =~ tr/_//d;
our @ISA = qw(File::Spec::Unix);
# ...
sub case_tolerant {
eval {
local @INC = @INC;
pop @INC if $INC[-1] eq '.';
require Win32API::File;
} or return 1;
my $drive = shift || "C:";
my $osFsType = "\0"x256;
my $osVolName = "\0"x256;
my $ouFsFlags = 0;
Win32API::File::GetVolumeInformation($drive, $osVolName, 256, [], [], $ouFsFlags, $osFsType, 256 );
if ($ouFsFlags & Win32API::File::FS_CASE_SENSITIVE()) { return 0; }
else { return 1; }
}
# ...
##
##
package File::Spec::Cygwin;
use strict;
require File::Spec::Unix;
our $VERSION = '3.75';
$VERSION =~ tr/_//d;
our @ISA = qw(File::Spec::Unix);
# ...
sub case_tolerant {
return 1 unless $^O eq 'cygwin'
and defined &Cygwin::mount_flags;
my $drive = shift;
if (! $drive) {
my @flags = split(/,/, Cygwin::mount_flags('/cygwin'));
my $prefix = pop(@flags);
if (! $prefix || $prefix eq 'cygdrive') {
$drive = '/cygdrive/c';
} elsif ($prefix eq '/') {
$drive = '/c';
} else {
$drive = "$prefix/c";
}
}
my $mntopts = Cygwin::mount_flags($drive);
if ($mntopts and ($mntopts =~ /,managed/)) {
return 0;
}
eval {
local @INC = @INC;
pop @INC if $INC[-1] eq '.';
require Win32API::File;
} or return 1;
my $osFsType = "\0"x256;
my $osVolName = "\0"x256;
my $ouFsFlags = 0;
Win32API::File::GetVolumeInformation($drive, $osVolName, 256, [], [], $ouFsFlags, $osFsType, 256 );
if ($ouFsFlags & Win32API::File::FS_CASE_SENSITIVE()) { return 0; }
else { return 1; }
}
# ...
##
##
package File::Spec::Functions;
# ...
our $VERSION = '3.75';
$VERSION =~ tr/_//d;
#...
my %udeps = (
# ...
case_tolerant => [],
# ...
);
foreach my $meth (@EXPORT, @EXPORT_OK) {
my $sub = File::Spec->can($meth);
no strict 'refs';
if (exists($udeps{$meth}) && $sub == File::Spec::Unix->can($meth) &&
!(grep {
File::Spec->can($_) != File::Spec::Unix->can($_)
} @{$udeps{$meth}}) &&
defined(&{"File::Spec::Unix::_fn_$meth"})) {
*{$meth} = \&{"File::Spec::Unix::_fn_$meth"};
} else {
*{$meth} = sub {&$sub('File::Spec', @_)};
}
}
# ...