#define EXECF_SPAWN_NOWAIT 3
#if defined(PERL_OBJECT)
-#undef win32_get_stdlib
-#define win32_get_stdlib g_win32_get_stdlib
+#undef win32_get_privlib
+#define win32_get_privlib g_win32_get_privlib
#undef win32_get_sitelib
#define win32_get_sitelib g_win32_get_sitelib
#undef do_aspawn
static BOOL has_redirection(char *ptr);
static long filetime_to_clock(PFILETIME ft);
static BOOL filetime_from_time(PFILETIME ft, time_t t);
+static char * get_emd_part(char *leading, char *trailing, ...);
-
-char * w32_perlshell_tokens = Nullch;
-char ** w32_perlshell_vec;
-long w32_perlshell_items = -1;
-DWORD w32_platform = (DWORD)-1;
-char w32_perllib_root[MAX_PATH+1];
HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
-#ifndef __BORLANDC__
-long w32_num_children = 0;
-HANDLE w32_child_pids[MAXIMUM_WAIT_OBJECTS];
-#endif
-
-#ifndef FOPEN_MAX
-# if defined(_NSTREAM_)
-# define FOPEN_MAX _NSTREAM_
-# elsif defined(_NFILE_)
-# define FOPEN_MAX _NFILE_
-# elsif defined(_NFILE)
-# define FOPEN_MAX _NFILE
-# endif
-#endif
-
-#ifndef USE_CRT_POPEN
-int w32_popen_pids[FOPEN_MAX];
-#endif
+static DWORD w32_platform = (DWORD)-1;
#ifdef USE_THREADS
# ifdef USE_DECLSPEC_THREAD
__declspec(thread) char strerror_buffer[512];
__declspec(thread) char getlogin_buffer[128];
+__declspec(thread) char w32_perllib_root[MAX_PATH+1];
# ifdef HAVE_DES_FCRYPT
__declspec(thread) char crypt_buffer[30];
# endif
# else
# define strerror_buffer (thr->i.Wstrerror_buffer)
# define getlogin_buffer (thr->i.Wgetlogin_buffer)
+# define w32_perllib_root (thr->i.Ww32_perllib_root)
# define crypt_buffer (thr->i.Wcrypt_buffer)
# endif
#else
-char strerror_buffer[512];
-char getlogin_buffer[128];
+static char strerror_buffer[512];
+static char getlogin_buffer[128];
+static char w32_perllib_root[MAX_PATH+1];
# ifdef HAVE_DES_FCRYPT
-char crypt_buffer[30];
+static char crypt_buffer[30];
# endif
#endif
}
retval = RegQueryValueEx(handle, lpszValueName, 0, NULL, (PBYTE)*ptr, lpDataLen);
if (retval != ERROR_SUCCESS) {
- Safefree(ptr);
- ptr = NULL;
+ Safefree(*ptr);
+ *ptr = NULL;
}
}
RegCloseKey(handle);
return *ptr;
}
-char *
-win32_get_stdlib(char *pl)
-{
- static char szStdLib[] = "lib";
- int len = 0, newSize;
- char szBuffer[MAX_PATH+1];
- char szModuleName[MAX_PATH];
- int result;
- DWORD dwDataLen;
- char *lpPath = NULL;
+static char *
+get_emd_part(char *prev_path, char *trailing_path, ...)
+{
+ va_list ap;
+ char mod_name[MAX_PATH];
char *ptr;
-
- /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */
- sprintf(szBuffer, "%s-%s", szStdLib, pl);
- lpPath = GetRegStr(szBuffer, &lpPath, &dwDataLen);
- if (lpPath == NULL)
- lpPath = GetRegStr(szStdLib, &lpPath, &dwDataLen);
-
- /* $stdlib .= ";$EMD/../../lib" */
- GetModuleFileName(GetModuleHandle(NULL), szModuleName, sizeof(szModuleName));
- ptr = strrchr(szModuleName, '\\');
- if (ptr != NULL)
- {
+ char *optr;
+ char *strip;
+ int oldsize, newsize;
+
+ va_start(ap, trailing_path);
+ strip = va_arg(ap, char *);
+
+ GetModuleFileName(GetModuleHandle(NULL), mod_name, sizeof(mod_name));
+ ptr = strrchr(mod_name, '\\');
+ while (ptr && strip) {
+ /* look for directories to skip back */
+ optr = ptr;
*ptr = '\0';
- ptr = strrchr(szModuleName, '\\');
- if (ptr != NULL)
- {
- *ptr = '\0';
- ptr = strrchr(szModuleName, '\\');
+ ptr = strrchr(mod_name, '\\');
+ if (!ptr || stricmp(ptr+1, strip) != 0) {
+ *optr = '\\';
+ ptr = optr;
}
+ strip = va_arg(ap, char *);
}
- if (ptr == NULL)
- {
- ptr = szModuleName;
+ if (!ptr) {
+ ptr = mod_name;
+ *ptr++ = '.';
*ptr = '\\';
}
- strcpy(++ptr, szStdLib);
+ va_end(ap);
+ strcpy(++ptr, trailing_path);
- /* check that this path exists */
- GetCurrentDirectory(sizeof(szBuffer), szBuffer);
- result = SetCurrentDirectory(szModuleName);
- SetCurrentDirectory(szBuffer);
- if (result == 0)
- {
- GetModuleFileName(GetModuleHandle(NULL), szModuleName, sizeof(szModuleName));
- ptr = strrchr(szModuleName, '\\');
- if (ptr != NULL)
- strcpy(++ptr, szStdLib);
+ newsize = strlen(mod_name) + 1;
+ if (prev_path) {
+ oldsize = strlen(prev_path) + 1;
+ newsize += oldsize; /* includes plus 1 for ';' */
+ Renew(prev_path, newsize, char);
+ prev_path[oldsize] = ';';
+ strcpy(&prev_path[oldsize], mod_name);
}
-
- newSize = strlen(szModuleName) + 1;
- if (lpPath != NULL)
- {
- len = strlen(lpPath);
- newSize += len + 1; /* plus 1 for ';' */
- lpPath = Renew(lpPath, newSize, char);
+ else {
+ New(1311, prev_path, newsize, char);
+ strcpy(prev_path, mod_name);
}
- else
- New(1310, lpPath, newSize, char);
- if (lpPath != NULL)
- {
- if (len != 0)
- lpPath[len++] = ';';
- strcpy(&lpPath[len], szModuleName);
- }
- return lpPath;
+ return prev_path;
}
char *
-get_sitelib_part(char* lpRegStr, char* lpPathStr)
-{
- char szBuffer[MAX_PATH+1];
- char szModuleName[MAX_PATH];
- DWORD dwDataLen;
- int len = 0;
- int result;
- char *lpPath = NULL;
- char *ptr;
-
- lpPath = GetRegStr(lpRegStr, &lpPath, &dwDataLen);
-
- /* $sitelib .= ";$EMD/../../../<lpPathStr>" */
- GetModuleFileName(GetModuleHandle(NULL), szModuleName, sizeof(szModuleName));
- ptr = strrchr(szModuleName, '\\');
- if (ptr != NULL)
- {
- *ptr = '\0';
- ptr = strrchr(szModuleName, '\\');
- if (ptr != NULL)
- {
- *ptr = '\0';
- ptr = strrchr(szModuleName, '\\');
- if (ptr != NULL)
- {
- *ptr = '\0';
- ptr = strrchr(szModuleName, '\\');
- }
- }
- }
- if (ptr == NULL)
- {
- ptr = szModuleName;
- *ptr = '\\';
- }
- strcpy(++ptr, lpPathStr);
-
- /* check that this path exists */
- GetCurrentDirectory(sizeof(szBuffer), szBuffer);
- result = SetCurrentDirectory(szModuleName);
- SetCurrentDirectory(szBuffer);
+win32_get_privlib(char *pl)
+{
+ char *stdlib = "lib";
+ char buffer[MAX_PATH+1];
+ char *path = Nullch;
+ DWORD datalen;
- if (result)
- {
- int newSize = strlen(szModuleName) + 1;
- if (lpPath != NULL)
- {
- len = strlen(lpPath);
- newSize += len + 1; /* plus 1 for ';' */
- lpPath = Renew(lpPath, newSize, char);
- }
- else
- New(1311, lpPath, newSize, char);
+ /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */
+ sprintf(buffer, "%s-%s", stdlib, pl);
+ path = GetRegStr(buffer, &path, &datalen);
+ if (path == NULL)
+ path = GetRegStr(stdlib, &path, &datalen);
- if (lpPath != NULL)
- {
- if (len != 0)
- lpPath[len++] = ';';
- strcpy(&lpPath[len], szModuleName);
- }
- }
- return lpPath;
+ /* $stdlib .= ";$EMD/../../lib" */
+ return get_emd_part(path, stdlib, ARCHNAME, "bin", Nullch);
}
char *
win32_get_sitelib(char *pl)
{
- static char szSiteLib[] = "sitelib";
- char szRegStr[40];
- char szPathStr[MAX_PATH];
- char *lpPath1;
- char *lpPath2;
- int len, newSize;
+ char *sitelib = "sitelib";
+ char regstr[40];
+ char pathstr[MAX_PATH];
+ DWORD datalen;
+ char *path1 = Nullch;
+ char *path2 = Nullch;
+ int len, newsize;
/* $HKCU{"sitelib-$]"} || $HKLM{"sitelib-$]"} . ---; */
- sprintf(szRegStr, "%s-%s", szSiteLib, pl);
- sprintf(szPathStr, "site\\%s\\lib", pl);
- lpPath1 = get_sitelib_part(szRegStr, szPathStr);
+ sprintf(regstr, "%s-%s", sitelib, pl);
+ path1 = GetRegStr(regstr, &path1, &datalen);
+
+ /* $sitelib .=
+ * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/$]/lib"; */
+ sprintf(pathstr, "site\\%s\\lib", pl);
+ path1 = get_emd_part(path1, pathstr, ARCHNAME, "bin", pl, Nullch);
/* $HKCU{'sitelib'} || $HKLM{'sitelib'} . ---; */
- lpPath2 = get_sitelib_part(szSiteLib, "site\\lib");
- if (lpPath1 == NULL)
- return lpPath2;
+ path2 = GetRegStr(sitelib, &path2, &datalen);
- if (lpPath2 == NULL)
- return lpPath1;
+ /* $sitelib .=
+ * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/lib"; */
+ path2 = get_emd_part(path2, "site\\lib", ARCHNAME, "bin", pl, Nullch);
- len = strlen(lpPath1);
- newSize = len + strlen(lpPath2) + 2; /* plus one for ';' */
+ if (!path1)
+ return path2;
- lpPath1 = Renew(lpPath1, newSize, char);
- if (lpPath1 != NULL)
- {
- lpPath1[len++] = ';';
- strcpy(&lpPath1[len], lpPath2);
- }
- Safefree(lpPath2);
- return lpPath1;
+ if (!path2)
+ return path1;
+
+ len = strlen(path1);
+ newsize = len + strlen(path2) + 2; /* plus one for ';' */
+
+ Renew(path1, newsize, char);
+ path1[len++] = ';';
+ strcpy(&path1[len], path2);
+
+ Safefree(path2);
+ return path1;
}
DWORD needlen;
if (!curitem)
New(1305,curitem,curlen,char);
- if (!(needlen = GetEnvironmentVariable(name,curitem,curlen)))
- return Nullch;
- while (needlen > curlen) {
- Renew(curitem,needlen,char);
- curlen = needlen;
- needlen = GetEnvironmentVariable(name,curitem,curlen);
+
+ needlen = GetEnvironmentVariable(name,curitem,curlen);
+ if (needlen != 0) {
+ while (needlen > curlen) {
+ Renew(curitem,needlen,char);
+ curlen = needlen;
+ needlen = GetEnvironmentVariable(name,curitem,curlen);
+ }
}
- if (curitem == NULL)
+ else
{
- if (strcmp("PERL5DB", name) == 0)
+ /* allow any environment variables that begin with 'PERL5'
+ to be stored in the registry
+ */
+ if(curitem != NULL)
+ *curitem = '\0';
+
+ if (strncmp(name, "PERL5", 5) == 0) {
+ if (curitem != NULL) {
+ Safefree(curitem);
+ curitem = NULL;
+ }
curitem = GetRegStr(name, &curitem, &curlen);
+ }
}
+ if(curitem != NULL && *curitem == '\0')
+ return Nullch;
+
return curitem;
}
DllExport int
win32_wait(int *status)
{
-#ifdef __BORLANDC__
+#ifdef USE_RTL_WAIT
return wait(status);
#else
/* XXX this wait emulation only knows about processes
DllExport FILE*
win32_popen(const char *command, const char *mode)
{
-#ifdef USE_CRT_POPEN
+#ifdef USE_RTL_POPEN
return _popen(command, mode);
#else
int p[2];
/* close saved handle */
win32_close(oldfd);
- w32_popen_pids[p[parent]] = childpid;
+ sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
/* we have an fd, return a file stream */
return (win32_fdopen(p[parent], (char *)mode));
}
return (NULL);
-#endif /* USE_CRT_POPEN */
+#endif /* USE_RTL_POPEN */
}
/*
DllExport int
win32_pclose(FILE *pf)
{
-#ifdef USE_CRT_POPEN
+#ifdef USE_RTL_POPEN
return _pclose(pf);
#else
- int fd, childpid, status;
- fd = win32_fileno(pf);
- childpid = w32_popen_pids[fd];
+#ifndef USE_RTL_WAIT
+ int child;
+#endif
+
+ int childpid, status;
+ SV *sv;
+
+ sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE);
+ if (SvIOK(sv))
+ childpid = SvIVX(sv);
+ else
+ childpid = 0;
if (!childpid) {
errno = EBADF;
}
win32_fclose(pf);
- w32_popen_pids[fd] = 0;
+ SvIVX(sv) = 0;
+
+#ifndef USE_RTL_WAIT
+ for (child = 0 ; child < w32_num_children ; ++child) {
+ if (w32_child_pids[child] == (HANDLE)childpid) {
+ Copy(&w32_child_pids[child+1], &w32_child_pids[child],
+ (w32_num_children-child-1), HANDLE);
+ w32_num_children--;
+ break;
+ }
+ }
+#endif
/* wait for the child */
if (cwait(&status, childpid, WAIT_CHILD) == -1)
return (status);
#endif
-#endif /* USE_CRT_OPEN */
+#endif /* USE_RTL_POPEN */
}
DllExport int
{
int status;
+#ifndef USE_RTL_WAIT
+ if (mode == P_NOWAIT && w32_num_children >= MAXIMUM_WAIT_OBJECTS)
+ return -1;
+#endif
+
status = spawnvp(mode, cmdname, (char * const *) argv);
-#ifndef __BORLANDC__
+#ifndef USE_RTL_WAIT
/* XXX For the P_NOWAIT case, Borland RTL returns pinfo.dwProcessId
* while VC RTL returns pinfo.hProcess. For purposes of the custom
* implementation of win32_wait(), we assume the latter.
char *file = __FILE__;
dXSUB_SYS;
+ w32_perlshell_tokens = Nullch;
+ w32_perlshell_items = -1;
+ w32_fdpid = newAV(); /* XXX needs to be in Perl_win32_init()? */
+#ifndef USE_RTL_WAIT
+ w32_num_children = 0;
+#endif
+
/* these names are Activeware compatible */
newXS("Win32::GetCwd", w32_GetCwd, file);
newXS("Win32::SetCwd", w32_SetCwd, file);
#if !defined(_ALPHA_) && !defined(__GNUC__)
_control87(MCW_EM, MCW_EM);
#endif
- MALLOC_INIT;
+ MALLOC_INIT;
}
#ifdef USE_BINMODE_SCRIPTS
projects / p5sagit/p5-mst-13.2.git / blobdiff