This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
/cygdrive is configurable
authorJerry D. Hedden <jdhedden@cpan.org>
Mon, 1 Oct 2007 19:32:19 +0000 (15:32 -0400)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Tue, 2 Oct 2007 12:31:32 +0000 (12:31 +0000)
From: "Jerry D. Hedden" <jdhedden@cpan.org>
Message-ID: <1ff86f510710011632n175427fdx39e173372862526e@mail.gmail.com>

p4raw-id: //depot/perl@32006

README.cygwin
cygwin/cygwin.c
lib/File/Spec/Cygwin.pm
t/lib/cygwin.t

index 26ef229..356266f 100644 (file)
@@ -514,14 +514,15 @@ the first is always "binmode" or "textmode".
   system|user,binmode|textmode,exec,cygexec,cygdrive,mixed,
   notexec,managed,nosuid,devfs,proc,noumount
 
-If the argument is "/cygdrive", just the volume mount settings are returned.
+If the argument is "/cygdrive", then just the volume mount settings,
+and the cygdrive mount prefix are returned.
 
 User mounts override system mounts.
 
   $ perl -e 'print Cygwin::mount_flags "/usr/bin"'
   system,binmode,cygexec
   $ perl -e 'print Cygwin::mount_flags "/cygdrive"'
-  binmode,cygdrive
+  binmode,cygdrive,/cygdrive
 
 =item C<Cygwin::is_binmount>
 
index 8a1ef03..c3bec61 100644 (file)
@@ -292,28 +292,31 @@ XS(XS_Cygwin_mount_flags)
     char flags[260];
 
     if (items != 1)
-        Perl_croak(aTHX_ "Usage: Cygwin::mount_flags(mnt_dir)");
+        Perl_croak(aTHX_ "Usage: Cygwin::mount_flags(mnt_dir|'/cygwin')");
 
     pathname = SvPV_nolen(ST(0));
-    
-    /* TODO: check for cygdrive registry setting. use CW_GET_CYGDRIVE_INFO then
+
+    /* TODO: Check for cygdrive registry setting,
+     *       and then use CW_GET_CYGDRIVE_INFO
      */
     if (!strcmp(pathname, "/cygdrive")) {
        char user[260];
        char system[260];
        char user_flags[260];
        char system_flags[260];
+
        cygwin_internal (CW_GET_CYGDRIVE_INFO, user, system, user_flags,
                         system_flags);
-       if (strlen(system) > 0)
-           strcpy (flags, system_flags);
-       if (strlen(user) > 0)
-           strcpy(flags, user_flags);
-       if (strlen(flags) > 0)
-           strcat(flags, ",");
-       strcat(flags, "cygdrive");
+
+        if (strlen(user) > 0) {
+            sprintf(flags, "%s,cygdrive,%s", user_flags, user);
+        } else {
+            sprintf(flags, "%s,cygdrive,%s", system_flags, system);
+        }
+
        ST(0) = sv_2mortal(newSVpv(flags, 0));
        XSRETURN(1);
+
     } else {
        struct mntent *mnt;
        setmntent (0, 0);
index 5d89fe5..c5d8e9a 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '1.1_02';
+$VERSION = '1.1_03';
 
 @ISA = qw(File::Spec::Unix);
 
@@ -112,7 +112,18 @@ sub case_tolerant () {
   if ($^O ne 'cygwin') {
     return 1;
   }
-  my $drive = shift || "/cygdrive/c";
+  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;
index d92031d..096cb98 100644 (file)
@@ -9,7 +9,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 14;
+use Test::More tests => 16;
 
 is(Cygwin::winpid_to_pid(Cygwin::pid_to_winpid($$)), $$,
    "perl pid translates to itself");
@@ -51,6 +51,17 @@ my $rootmnt = Cygwin::mount_flags("/");
 ok($binmode ? ($rootmnt =~ /,binmode/) : ($rootmnt =~ /,textmode/), "check / mount_flags");
 is(Cygwin::mount_flags("/cygdrive") =~ /,cygdrive/,  1, "check cygdrive mount_flags");
 
+# Cygdrive mount prefix
+my @flags = split(/,/, Cygwin::mount_flags('/cygdrive'));
+my $prefix = pop(@flags);
+ok($prefix, "cygdrive mount prefix = " . (($prefix) ? $prefix : '<none>'));
+chomp(my $prefix2 = `df | grep -i '^c: ' | cut -d% -f2 | xargs`);
+$prefix2 =~ s/\/c$//i;
+if (! $prefix2) {
+    $prefix2 = '/';
+}
+is($prefix, $prefix2, 'cygdrive mount prefix');
+
 my @mnttbl = Cygwin::mount_table();
 ok(@mnttbl > 0, "non empty mount_table");
 for $i (@mnttbl) {