Add plain ~ expansion for Windows system in File::Glob

Previously in File::Glob, a plain ~ expansion will check
the $HOME environment variable, but that does not normally
exist on Windows systems. There is another variable that
holds the appropriate home path value, which is $USERPROFILE.

This adds a fallback to check $USERPROFILE when $HOME is
not there, the system does not support checking the password
file and the system is DOSISH.

diff --git a/ext/File-Glob/bsd_glob.c b/ext/File-Glob/bsd_glob.c
index f891d29..89d51af 100644 (file)
--- a/ext/File-Glob/bsd_glob.c
+++ b/ext/File-Glob/bsd_glob.c
@@ -457,6 +457,7 @@ globtilde(const Char *pattern, Char *patbuf, size_t patbuf_len, glob_t *pglob)
                /*
                 * handle a plain ~ or ~/ by expanding $HOME
                 * first and then trying the password file
+                * or $USERPROFILE on DOSISH systems
                 */
                if ((h = getenv("HOME")) == NULL) {
 #ifdef HAS_PASSWD
@@ -465,6 +466,14 @@ globtilde(const Char *pattern, Char *patbuf, size_t patbuf_len, glob_t *pglob)
                                return pattern;
                        else
                                h = pwd->pw_dir;
+#elif DOSISH
+                       /*
+                        * When no passwd file, fallback to the USERPROFILE
+                        * environment variable on DOSish systems.
+                        */
+                       if ((h = getenv("USERPROFILE")) == NULL) {
+                           return pattern;
+                       }
 #else
                         return pattern;
 #endif

diff --git a/ext/File-Glob/t/basic.t b/ext/File-Glob/t/basic.t
index ed83019..dffffc8 100644 (file)
--- a/ext/File-Glob/t/basic.t
+++ b/ext/File-Glob/t/basic.t
@@ -10,7 +10,7 @@ BEGIN {
     }
 }
 use strict;
-use Test::More tests => 15;
+use Test::More tests => 18;
 BEGIN {use_ok('File::Glob', ':glob')};
 use Cwd ();
 
@@ -68,6 +68,40 @@ SKIP: {
        is_deeply (\@a, [$home]);
     }
 }
+# check plain tilde expansion
+{
+    my $tilde_check = sub {
+    my @a = bsd_glob('~');
+
+    if (GLOB_ERROR) {
+        fail(GLOB_ERROR);
+    } else {
+        is_deeply (\@a, [$_[0]], join ' - ', 'tilde expansion', @_ > 1 ? $_[1] : ());
+    }
+    };
+    my $passwd_home = eval { (getpwuid($>))[7] };
+
+    {
+    local %ENV = %ENV;
+    delete $ENV{HOME};
+    delete $ENV{USERPROFILE};
+    $tilde_check->(defined $passwd_home ? $passwd_home : q{~}, 'no environment');
+    }
+
+    SKIP: {
+    skip 'MSWin32 only', 1 if $^O ne 'MSWin32';
+    local %ENV = %ENV;
+    delete $ENV{HOME};
+    $ENV{USERPROFILE} = 'sweet win32 home';
+    $tilde_check->(defined $passwd_home ? $passwd_home : $ENV{USERPROFILE}, 'USERPROFILE');
+    }
+
+    my $home = exists $ENV{HOME} ? $ENV{HOME}
+    : eval { getpwuid($>); 1 } ? (getpwuid($>))[7]
+    : $^O eq 'MSWin32' && exists $ENV{USERPROFILE} ? $ENV{USERPROFILE}
+    : q{~};
+    $tilde_check->($home);
+}
 
 # check backslashing
 # should return a list with one item, and not set ERROR