From: Reini Urban <rurban@x-ray.at>
Date: Tue, 14 Aug 2007 08:45:34 +0000 (+0200)
Subject: CYG07-File-Spec-case_tolerant
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=efa159bc522e3471f3ab132c384ad0ce9d768b61;p=p5sagit%2Fp5-mst-13.2.git

CYG07-File-Spec-case_tolerant
Message-Id: <46C14F8E.9080402@x-ray.at>

p4raw-id: //depot/perl@31709
---

diff --git a/lib/File/Spec/Cygwin.pm b/lib/File/Spec/Cygwin.pm
index e2744f0..62186c1 100644
--- a/lib/File/Spec/Cygwin.pm
+++ b/lib/File/Spec/Cygwin.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '1.1_01';
+$VERSION = '1.1_02';
 
 @ISA = qw(File::Spec::Unix);
 
@@ -84,6 +84,8 @@ from the following list:
 
     $ENV{TMPDIR}
     /tmp
+    $ENV{'TMP'}
+    $ENV{'TEMP'}
     C:/temp
 
 Since Perl 5.8.0, if running under taint mode, and if the environment
@@ -94,23 +96,38 @@ variables are tainted, they are not used.
 my $tmpdir;
 sub tmpdir {
     return $tmpdir if defined $tmpdir;
-    $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp", 'C:/temp' );
+    $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp", $ENV{'TMP'}, $ENV{'TEMP'}, 'C:/temp' );
 }
 
 =item case_tolerant
 
-Override Unix. Cygwin is always case-tolerant, indicating that it is not
-significant when comparing file specifications.
+Override Unix. Cygwin case-tolerance depends on managed mount settings and
+as with MsWin32 on GetVolumeInformation() $ouFsFlags == FS_CASE_SENSITIVE,
+indicating the case significance when comparing file specifications.
+Default: 1
 
 =cut
 
-sub case_tolerant () { 1 }
+sub case_tolerant () {
+  my $drive = shift || "C:";
+  my $mntopts = Cygwin::mount_flags($drive);
+  if ($mntopts and ($mntopts =~ /,managed/)) {
+    return 0;
+  }
+  eval { 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; }
+}
 
 =back
 
 =head1 COPYRIGHT
 
-Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
+Copyright (c) 2004,2007 by the Perl 5 Porters.  All rights reserved.
 
 This program is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.
diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm
index 9bfcb18..eba2171 100644
--- a/lib/File/Spec/Win32.pm
+++ b/lib/File/Spec/Win32.pm
@@ -77,13 +77,35 @@ sub tmpdir {
 			      '/'  );
 }
 
-sub case_tolerant {
-    return 1;
+=item case_tolerant
+
+MSWin32 case-tolerance depends on GetVolumeInformation() $ouFsFlags == FS_CASE_SENSITIVE,
+indicating the case significance when comparing file specifications.
+Since XP FS_CASE_SENSITIVE is effectively disabled for the NT subsubsystem.
+See http://cygwin.com/ml/cygwin/2007-07/msg00891.html
+Default: 1
+
+=cut
+
+sub case_tolerant () {
+  eval { require Win32API::File; } or return 1;
+  my $drive = shift or "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; }
 }
 
+=item file_name_is_absolute
+
+As of right now, this returns 2 if the path is absolute with a
+volume, 1 if it's absolute with no volume, 0 otherwise.
+
+=cut
+
 sub file_name_is_absolute {
-    # As of right now, this returns 2 if the path is absolute with a
-    # volume, 1 if it's absolute with no volume, 0 otherwise.
 
     my ($self,$file) = @_;
 
@@ -341,7 +363,7 @@ Novell NetWare inherits its File::Spec behaviour from File::Spec::Win32.
 
 =head1 COPYRIGHT
 
-Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
+Copyright (c) 2004,2007 by the Perl 5 Porters.  All rights reserved.
 
 This program is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.