Fixes to allow win32 Perl to properly handle PERL5LIB.

On Windows Vista, 7 and 2008, the win32 API call
GetEnvironmentVariableA() does not return environment values
with string length of greater than 32766, even though
such variables are supported in the environment.

This consequently caused @INC not to be populated for
such values of PERL5LIB on those OSes, as reported in
RT #87322.

This commit reworks the code so that GetEnvironmentStrings()
is called if GetEnvironmentVariableA() indicates the requested
value is set in the environmtn.  The old fallback of consulting
the registry for variables beginning with "PERL" is retained, but
as a last-ditch fallback rather than the only recourse.

A new test file, t/win32/runenv.t has been added to validate
that the new behavior is working properly, as well as that
general environment variable handling is in accordance with
expectations, since t/run/runenv.t does not run on Win* platforms.
The new test file is essentially a non-forking clone of
t/run/runenv.t, with modifications to test cases to run properly
on Win* platforms, and with a new test case to test the new behavior.

1 files changed, 32 insertions, 4 deletions

diff --git a/win32/win32.c b/win32/win32.c
index cffd2b5bca..e67a7352be 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -1693,6 +1693,7 @@ win32_getenv(const char *name)
     dTHX;
     DWORD needlen;
     SV *curitem = NULL;
+    DWORD last_err;
 
     needlen = GetEnvironmentVariableA(name,NULL,0);
     if (needlen != 0) {
@@ -1705,10 +1706,37 @@ win32_getenv(const char *name)
         SvCUR_set(curitem, needlen);
     }
     else {
-	/* allow any environment variables that begin with 'PERL'
-	   to be stored in the registry */
-	if (strncmp(name, "PERL", 4) == 0)
-	    (void)get_regstr(name, &curitem);
+	last_err = GetLastError();
+	if (last_err == ERROR_NOT_ENOUGH_MEMORY) {
+	    /* It appears the variable is in the env, but the Win32 API
+	       doesn't have a canned way of getting it.  So we fall back to
+	       grabbing the whole env and pulling this value out if possible */
+	    char *envv = GetEnvironmentStrings();
+    	    char *cur = envv;
+    	    STRLEN len;
+    	    while (*cur) {
+		char *end = strchr(cur,'=');
+		if (end && end != cur) {
+		    *end = '\0';
+		    if (!strcmp(cur,name)) {
+			curitem = sv_2mortal(newSVpv(end+1,0));
+			*end = '=';
+			break;
+		    }
+	    	    *end = '=';
+	    	    cur = end + strlen(end+1)+2;
+		}
+		else if ((len = strlen(cur)))
+	    	    cur += len+1;
+    	    }
+    	    FreeEnvironmentStrings(envv);
+	}
+	else {
+	    /* last ditch: allow any environment variables that begin with 'PERL'
+	       to be obtained from the registry, if found there */
+	    if (strncmp(name, "PERL", 4) == 0)
+		(void)get_regstr(name, &curitem);
+	}
     }
     if (curitem && SvCUR(curitem))
 	return SvPVX(curitem);