#include "EXTERN.h"
#include "perl.h"
-#include "patchlevel.h"
-
#define NO_XSLOCKS
#ifdef PERL_OBJECT
extern CPerlObj* pPerl;
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, ...);
-static void remove_dead_process(HANDLE deceased);
+static void remove_dead_process(long deceased);
+static long find_pid(int pid);
+static char * qualified_path(const char *cmd);
HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
+char w32_module_name[MAX_PATH+1];
static DWORD w32_platform = (DWORD)-1;
#ifdef USE_THREADS
va_start(ap, trailing_path);
strip = va_arg(ap, char *);
- sprintf(base, "%5.3f", (double) 5 + ((double) PATCHLEVEL / (double) 1000));
-
- GetModuleFileName((HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
- ? GetModuleHandle(NULL) : w32_perldll_handle),
- mod_name, sizeof(mod_name));
- ptr = strrchr(mod_name, '\\');
+ sprintf(base, "%5.3f",
+ (double)PERL_REVISION + ((double)PERL_VERSION / (double)1000));
+
+ if (!*w32_module_name) {
+ GetModuleFileName((HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
+ ? GetModuleHandle(NULL)
+ : w32_perldll_handle),
+ w32_module_name, sizeof(w32_module_name));
+
+ /* try to get full path to binary (which may be mangled when perl is
+ * run from a 16-bit app) */
+ /*PerlIO_printf(PerlIO_stderr(), "Before %s\n", w32_module_name);*/
+ (void)win32_longpath(w32_module_name);
+ /*PerlIO_printf(PerlIO_stderr(), "After %s\n", w32_module_name);*/
+
+ /* normalize to forward slashes */
+ ptr = w32_module_name;
+ while (*ptr) {
+ if (*ptr == '\\')
+ *ptr = '/';
+ ++ptr;
+ }
+ }
+ strcpy(mod_name, w32_module_name);
+ ptr = strrchr(mod_name, '/');
while (ptr && strip) {
/* look for directories to skip back */
optr = ptr;
*ptr = '\0';
- ptr = strrchr(mod_name, '\\');
+ ptr = strrchr(mod_name, '/');
if (!ptr || stricmp(ptr+1, strip) != 0) {
- if(!(*strip == '5' && *(ptr+1) == '5' && strncmp(strip, base, 5) == 0
- && strncmp(ptr+1, base, 5) == 0)) {
- *optr = '\\';
+ if(!(*strip == '5' && *(ptr+1) == '5'
+ && strncmp(strip, base, 5) == 0
+ && strncmp(ptr+1, base, 5) == 0))
+ {
+ *optr = '/';
ptr = optr;
}
}
if (!ptr) {
ptr = mod_name;
*ptr++ = '.';
- *ptr = '\\';
+ *ptr = '/';
}
va_end(ap);
strcpy(++ptr, trailing_path);
/* $sitelib .=
* ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/$]/lib"; */
- sprintf(pathstr, "site\\%s\\lib", pl);
+ sprintf(pathstr, "site/%s/lib", pl);
path1 = get_emd_part(path1, pathstr, ARCHNAME, "bin", pl, Nullch);
/* $HKCU{'sitelib'} || $HKLM{'sitelib'} . ---; */
/* $sitelib .=
* ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/lib"; */
- path2 = get_emd_part(path2, "site\\lib", ARCHNAME, "bin", pl, Nullch);
+ path2 = get_emd_part(path2, "site/lib", ARCHNAME, "bin", pl, Nullch);
if (!path1)
return path2;
#define fixcmd(x)
#endif
fixcmd(cmd);
- win32_fflush(stdout);
- win32_fflush(stderr);
+ PERL_FLUSHALL_FOR_CHILD;
return win32_popen(cmd, mode);
}
int status;
int flag = P_WAIT;
int index = 0;
- STRLEN n_a;
if (sp <= mark)
return -1;
}
while (++mark <= sp) {
- if (*mark && (str = SvPV(*mark, n_a)))
+ if (*mark && (str = SvPV_nolen(*mark)))
argv[index++] = str;
else
argv[index++] = "";
argv[index++] = 0;
status = win32_spawnvp(flag,
- (const char*)(really ? SvPV(really,n_a) : argv[0]),
+ (const char*)(really ? SvPV_nolen(really) : argv[0]),
(const char* const*)argv);
if (status < 0 && (errno == ENOEXEC || errno == ENOENT)) {
argv[sh_items] = w32_perlshell_vec[sh_items];
status = win32_spawnvp(flag,
- (const char*)(really ? SvPV(really,n_a) : argv[0]),
+ (const char*)(really ? SvPV_nolen(really) : argv[0]),
(const char* const*)argv);
}
/* Create the search pattern */
strcpy(scanname, filename);
- if (scanname[len-1] != '/' && scanname[len-1] != '\\')
+
+ /* bare drive name means look in cwd for drive */
+ if (len == 2 && isALPHA(scanname[0]) && scanname[1] == ':') {
+ scanname[len++] = '.';
+ scanname[len++] = '/';
+ }
+ else if (scanname[len-1] != '/' && scanname[len-1] != '\\') {
scanname[len++] = '/';
+ }
scanname[len++] = '*';
scanname[len] = '\0';
return 0;
}
-static void
-remove_dead_process(HANDLE deceased)
+static long
+find_pid(int pid)
{
-#ifndef USE_RTL_WAIT
- int child;
+ long child;
for (child = 0 ; child < w32_num_children ; ++child) {
- if (w32_child_pids[child] == deceased) {
- Copy(&w32_child_pids[child+1], &w32_child_pids[child],
- (w32_num_children-child-1), HANDLE);
- w32_num_children--;
- break;
- }
+ if (w32_child_pids[child] == pid)
+ return child;
+ }
+ return -1;
+}
+
+static void
+remove_dead_process(long child)
+{
+ if (child >= 0) {
+ CloseHandle(w32_child_handles[child]);
+ Copy(&w32_child_handles[child+1], &w32_child_handles[child],
+ (w32_num_children-child-1), HANDLE);
+ Copy(&w32_child_pids[child+1], &w32_child_pids[child],
+ (w32_num_children-child-1), DWORD);
+ w32_num_children--;
}
-#endif
}
DllExport int
win32_kill(int pid, int sig)
{
-#ifdef USE_RTL_WAIT
- HANDLE hProcess= OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
-#else
- HANDLE hProcess = (HANDLE) pid;
-#endif
-
- if (hProcess == NULL) {
- croak("kill process failed!\n");
- }
- else {
- if (!TerminateProcess(hProcess, sig))
- croak("kill process failed!\n");
+ HANDLE hProcess;
+ hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
+ if (hProcess && TerminateProcess(hProcess, sig))
CloseHandle(hProcess);
-
- /* WaitForMultipleObjects() on a pid that was killed returns error
- * so if we know the pid is gone we remove it from process list */
- remove_dead_process(hProcess);
+ else {
+ errno = EINVAL;
+ return -1;
}
return 0;
}
win32_stat(const char *path, struct stat *buffer)
{
char t[MAX_PATH+1];
- const char *p = path;
int l = strlen(path);
int res;
if (l > 1) {
switch(path[l - 1]) {
+ /* FindFirstFile() and stat() are buggy with a trailing
+ * backslash, so change it to a forward slash :-( */
case '\\':
- case '/':
- if (path[l - 2] != ':') {
- strncpy(t, path, l - 1);
- t[l - 1] = 0;
- p = t;
- };
+ strncpy(t, path, l-1);
+ t[l - 1] = '/';
+ t[l] = '\0';
+ path = t;
+ break;
+ /* FindFirstFile() is buggy with "x:", so add a dot :-( */
+ case ':':
+ if (l == 2 && isALPHA(path[0])) {
+ t[0] = path[0]; t[1] = ':'; t[2] = '.'; t[3] = '\0';
+ l = 3;
+ path = t;
+ }
+ break;
}
}
- res = stat(p,buffer);
+ res = stat(path,buffer);
if (res < 0) {
/* CRT is buggy on sharenames, so make sure it really isn't.
* XXX using GetFileAttributesEx() will enable us to set
* buffer->st_*time (but note that's not available on the
* Windows of 1995) */
- DWORD r = GetFileAttributes(p);
+ DWORD r = GetFileAttributes(path);
if (r != 0xffffffff && (r & FILE_ATTRIBUTE_DIRECTORY)) {
- buffer->st_mode |= S_IFDIR | S_IREAD;
+ /* buffer may still contain old garbage since stat() failed */
+ Zero(buffer, 1, struct stat);
+ buffer->st_mode = S_IFDIR | S_IREAD;
errno = 0;
if (!(r & FILE_ATTRIBUTE_READONLY))
buffer->st_mode |= S_IWRITE | S_IEXEC;
}
}
else {
- if (l == 3 && path[l-2] == ':'
- && (path[l-1] == '\\' || path[l-1] == '/'))
+ if (l == 3 && isALPHA(path[0]) && path[1] == ':'
+ && (path[2] == '\\' || path[2] == '/'))
{
/* The drive can be inaccessible, some _stat()s are buggy */
if (!GetVolumeInformation(path,NULL,0,NULL,NULL,NULL,NULL,0)) {
return res;
}
+/* Find the longname of a given path. path is destructively modified.
+ * It should have space for at least MAX_PATH characters. */
+DllExport char *
+win32_longpath(char *path)
+{
+ WIN32_FIND_DATA fdata;
+ HANDLE fhand;
+ char tmpbuf[MAX_PATH+1];
+ char *tmpstart = tmpbuf;
+ char *start = path;
+ char sep;
+ if (!path)
+ return Nullch;
+
+ /* drive prefix */
+ if (isALPHA(path[0]) && path[1] == ':' &&
+ (path[2] == '/' || path[2] == '\\'))
+ {
+ start = path + 2;
+ *tmpstart++ = path[0];
+ *tmpstart++ = ':';
+ }
+ /* UNC prefix */
+ else if ((path[0] == '/' || path[0] == '\\') &&
+ (path[1] == '/' || path[1] == '\\'))
+ {
+ start = path + 2;
+ *tmpstart++ = '/';
+ *tmpstart++ = '/';
+ /* copy machine name */
+ while (*start && *start != '/' && *start != '\\')
+ *tmpstart++ = *start++;
+ if (*start) {
+ *tmpstart++ = '/';
+ start++;
+ /* copy share name */
+ while (*start && *start != '/' && *start != '\\')
+ *tmpstart++ = *start++;
+ }
+ }
+ sep = *start++;
+ if (sep == '/' || sep == '\\')
+ *tmpstart++ = '/';
+ *tmpstart = '\0';
+ while (sep) {
+ /* walk up to slash */
+ while (*start && *start != '/' && *start != '\\')
+ ++start;
+
+ /* discard doubled slashes */
+ while (*start && (start[1] == '/' || start[1] == '\\'))
+ ++start;
+ sep = *start;
+
+ /* stop and find full name of component */
+ *start = '\0';
+ fhand = FindFirstFile(path,&fdata);
+ if (fhand != INVALID_HANDLE_VALUE) {
+ strcpy(tmpstart, fdata.cFileName);
+ tmpstart += strlen(fdata.cFileName);
+ if (sep)
+ *tmpstart++ = '/';
+ *tmpstart = '\0';
+ *start++ = sep;
+ FindClose(fhand);
+ }
+ else {
+ /* failed a step, just return without side effects */
+ /*PerlIO_printf(PerlIO_stderr(), "Failed to find %s\n", path);*/
+ *start = sep;
+ return Nullch;
+ }
+ }
+ strcpy(path,tmpbuf);
+ return path;
+}
+
#ifndef USE_WIN32_RTL_ENV
DllExport char *
}
DllExport int
+win32_uname(struct utsname *name)
+{
+ struct hostent *hep;
+ STRLEN nodemax = sizeof(name->nodename)-1;
+ OSVERSIONINFO osver;
+
+ memset(&osver, 0, sizeof(OSVERSIONINFO));
+ osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
+ if (GetVersionEx(&osver)) {
+ /* sysname */
+ switch (osver.dwPlatformId) {
+ case VER_PLATFORM_WIN32_WINDOWS:
+ strcpy(name->sysname, "Windows");
+ break;
+ case VER_PLATFORM_WIN32_NT:
+ strcpy(name->sysname, "Windows NT");
+ break;
+ case VER_PLATFORM_WIN32s:
+ strcpy(name->sysname, "Win32s");
+ break;
+ default:
+ strcpy(name->sysname, "Win32 Unknown");
+ break;
+ }
+
+ /* release */
+ sprintf(name->release, "%d.%d",
+ osver.dwMajorVersion, osver.dwMinorVersion);
+
+ /* version */
+ sprintf(name->version, "Build %d",
+ osver.dwPlatformId == VER_PLATFORM_WIN32_NT
+ ? osver.dwBuildNumber : (osver.dwBuildNumber & 0xffff));
+ if (osver.szCSDVersion[0]) {
+ char *buf = name->version + strlen(name->version);
+ sprintf(buf, " (%s)", osver.szCSDVersion);
+ }
+ }
+ else {
+ *name->sysname = '\0';
+ *name->version = '\0';
+ *name->release = '\0';
+ }
+
+ /* nodename */
+ hep = win32_gethostbyname("localhost");
+ if (hep) {
+ STRLEN len = strlen(hep->h_name);
+ if (len <= nodemax) {
+ strcpy(name->nodename, hep->h_name);
+ }
+ else {
+ strncpy(name->nodename, hep->h_name, nodemax);
+ name->nodename[nodemax] = '\0';
+ }
+ }
+ else {
+ DWORD sz = nodemax;
+ if (!GetComputerName(name->nodename, &sz))
+ *name->nodename = '\0';
+ }
+
+ /* machine (architecture) */
+ {
+ SYSTEM_INFO info;
+ char *arch;
+ GetSystemInfo(&info);
+
+#ifdef __BORLANDC__
+ switch (info.u.s.wProcessorArchitecture) {
+#else
+ switch (info.wProcessorArchitecture) {
+#endif
+ case PROCESSOR_ARCHITECTURE_INTEL:
+ arch = "x86"; break;
+ case PROCESSOR_ARCHITECTURE_MIPS:
+ arch = "mips"; break;
+ case PROCESSOR_ARCHITECTURE_ALPHA:
+ arch = "alpha"; break;
+ case PROCESSOR_ARCHITECTURE_PPC:
+ arch = "ppc"; break;
+ default:
+ arch = "unknown"; break;
+ }
+ strcpy(name->machine, arch);
+ }
+ return 0;
+}
+
+DllExport int
win32_waitpid(int pid, int *status, int flags)
{
- int rc;
+ int retval = -1;
if (pid == -1)
- return win32_wait(status);
+ return win32_wait(status);
else {
- rc = cwait(status, pid, WAIT_CHILD);
- /* cwait() returns "correctly" on Borland */
+ long child = find_pid(pid);
+ if (child >= 0) {
+ HANDLE hProcess = w32_child_handles[child];
+ DWORD waitcode = WaitForSingleObject(hProcess, INFINITE);
+ if (waitcode != WAIT_FAILED) {
+ if (GetExitCodeProcess(hProcess, &waitcode)) {
+ *status = (int)((waitcode & 0xff) << 8);
+ retval = (int)w32_child_pids[child];
+ remove_dead_process(child);
+ return retval;
+ }
+ }
+ else
+ errno = ECHILD;
+ }
+ else {
+ retval = cwait(status, pid, WAIT_CHILD);
+ /* cwait() returns "correctly" on Borland */
#ifndef __BORLANDC__
- if (status)
- *status *= 256;
+ if (status)
+ *status *= 256;
#endif
- remove_dead_process((HANDLE)pid);
+ }
}
- return rc >= 0 ? pid : rc;
+ return retval >= 0 ? pid : retval;
}
DllExport int
win32_wait(int *status)
{
-#ifdef USE_RTL_WAIT
- return wait(status);
-#else
/* XXX this wait emulation only knows about processes
* spawned via win32_spawnvp(P_NOWAIT, ...).
*/
/* if a child exists, wait for it to die */
waitcode = WaitForMultipleObjects(w32_num_children,
- w32_child_pids,
+ w32_child_handles,
FALSE,
INFINITE);
if (waitcode != WAIT_FAILED) {
i = waitcode - WAIT_ABANDONED_0;
else
i = waitcode - WAIT_OBJECT_0;
- if (GetExitCodeProcess(w32_child_pids[i], &exitcode) ) {
- CloseHandle(w32_child_pids[i]);
+ if (GetExitCodeProcess(w32_child_handles[i], &exitcode) ) {
*status = (int)((exitcode & 0xff) << 8);
retval = (int)w32_child_pids[i];
- Copy(&w32_child_pids[i+1], &w32_child_pids[i],
- (w32_num_children-i-1), HANDLE);
- w32_num_children--;
+ remove_dead_process(i);
return retval;
}
}
FAILED:
errno = GetLastError();
return -1;
-
-#endif
}
static UINT timerid = 0;
win32_fclose(pf);
SvIVX(sv) = 0;
- remove_dead_process((HANDLE)childpid);
+ if (win32_waitpid(childpid, &status, 0) == -1)
+ return -1;
- /* wait for the child */
- if (cwait(&status, childpid, WAIT_CHILD) == -1)
- return (-1);
- /* cwait() returns "correctly" on Borland */
-#ifndef __BORLANDC__
- status *= 256;
-#endif
- return (status);
+ return status;
#endif /* USE_RTL_POPEN */
}
return chdir(dir);
}
+static char *
+create_command_line(const char* command, const char * const *args)
+{
+ int index;
+ char *cmd, *ptr, *arg;
+ STRLEN len = strlen(command) + 1;
+
+ for (index = 0; (ptr = (char*)args[index]) != NULL; ++index)
+ len += strlen(ptr) + 1;
+
+ New(1310, cmd, len, char);
+ ptr = cmd;
+ strcpy(ptr, command);
+
+ for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
+ ptr += strlen(ptr);
+ *ptr++ = ' ';
+ strcpy(ptr, arg);
+ }
+
+ return cmd;
+}
+
+static char *
+qualified_path(const char *cmd)
+{
+ char *pathstr;
+ char *fullcmd, *curfullcmd;
+ STRLEN cmdlen = 0;
+ int has_slash = 0;
+
+ if (!cmd)
+ return Nullch;
+ fullcmd = (char*)cmd;
+ while (*fullcmd) {
+ if (*fullcmd == '/' || *fullcmd == '\\')
+ has_slash++;
+ fullcmd++;
+ cmdlen++;
+ }
+
+ /* look in PATH */
+ pathstr = win32_getenv("PATH");
+ New(0, fullcmd, MAX_PATH+1, char);
+ curfullcmd = fullcmd;
+
+ while (1) {
+ DWORD res;
+
+ /* start by appending the name to the current prefix */
+ strcpy(curfullcmd, cmd);
+ curfullcmd += cmdlen;
+
+ /* if it doesn't end with '.', or has no extension, try adding
+ * a trailing .exe first */
+ if (cmd[cmdlen-1] != '.'
+ && (cmdlen < 4 || cmd[cmdlen-4] != '.'))
+ {
+ strcpy(curfullcmd, ".exe");
+ res = GetFileAttributes(fullcmd);
+ if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY))
+ return fullcmd;
+ *curfullcmd = '\0';
+ }
+
+ /* that failed, try the bare name */
+ res = GetFileAttributes(fullcmd);
+ if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY))
+ return fullcmd;
+
+ /* quit if no other path exists, or if cmd already has path */
+ if (!pathstr || !*pathstr || has_slash)
+ break;
+
+ /* skip leading semis */
+ while (*pathstr == ';')
+ pathstr++;
+
+ /* build a new prefix from scratch */
+ curfullcmd = fullcmd;
+ while (*pathstr && *pathstr != ';') {
+ if (*pathstr == '"') { /* foo;"baz;etc";bar */
+ pathstr++; /* skip initial '"' */
+ while (*pathstr && *pathstr != '"') {
+ if (curfullcmd-fullcmd < MAX_PATH-cmdlen-5)
+ *curfullcmd++ = *pathstr;
+ pathstr++;
+ }
+ if (*pathstr)
+ pathstr++; /* skip trailing '"' */
+ }
+ else {
+ if (curfullcmd-fullcmd < MAX_PATH-cmdlen-5)
+ *curfullcmd++ = *pathstr;
+ pathstr++;
+ }
+ }
+ if (*pathstr)
+ pathstr++; /* skip trailing semi */
+ if (curfullcmd > fullcmd /* append a dir separator */
+ && curfullcmd[-1] != '/' && curfullcmd[-1] != '\\')
+ {
+ *curfullcmd++ = '\\';
+ }
+ }
+GIVE_UP:
+ Safefree(fullcmd);
+ return Nullch;
+}
+
+/* XXX this needs to be made more compatible with the spawnvp()
+ * provided by the various RTLs. In particular, searching for
+ * *.{com,bat,cmd} files (as done by the RTLs) is unimplemented.
+ * This doesn't significantly affect perl itself, because we
+ * always invoke things using PERL5SHELL if a direct attempt to
+ * spawn the executable fails.
+ *
+ * XXX splitting and rejoining the commandline between do_aspawn()
+ * and win32_spawnvp() could also be avoided.
+ */
+
DllExport int
win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
{
- int status;
+#ifdef USE_RTL_SPAWNVP
+ return spawnvp(mode, cmdname, (char * const *)argv);
+#else
+ DWORD ret;
+ STARTUPINFO StartupInfo;
+ PROCESS_INFORMATION ProcessInformation;
+ DWORD create = 0;
+
+ char *cmd = create_command_line(cmdname, strcmp(cmdname, argv[0]) == 0
+ ? &argv[1] : argv);
+ char *fullcmd = Nullch;
+
+ switch(mode) {
+ case P_NOWAIT: /* asynch + remember result */
+ if (w32_num_children >= MAXIMUM_WAIT_OBJECTS) {
+ errno = EAGAIN;
+ ret = -1;
+ goto RETVAL;
+ }
+ /* FALL THROUGH */
+ case P_WAIT: /* synchronous execution */
+ break;
+ default: /* invalid mode */
+ errno = EINVAL;
+ ret = -1;
+ goto RETVAL;
+ }
+ memset(&StartupInfo,0,sizeof(StartupInfo));
+ StartupInfo.cb = sizeof(StartupInfo);
+ StartupInfo.wShowWindow = SW_SHOWDEFAULT;
+
+RETRY:
+ if (!CreateProcess(cmdname, /* search PATH to find executable */
+ cmd, /* executable, and its arguments */
+ NULL, /* process attributes */
+ NULL, /* thread attributes */
+ TRUE, /* inherit handles */
+ create, /* creation flags */
+ NULL, /* inherit environment */
+ NULL, /* inherit cwd */
+ &StartupInfo,
+ &ProcessInformation))
+ {
+ /* initial NULL argument to CreateProcess() does a PATH
+ * search, but it always first looks in the directory
+ * where the current process was started, which behavior
+ * is undesirable for backward compatibility. So we
+ * jump through our own hoops by picking out the path
+ * we really want it to use. */
+ if (!fullcmd) {
+ fullcmd = qualified_path(cmdname);
+ if (fullcmd) {
+ cmdname = fullcmd;
+ goto RETRY;
+ }
+ }
+ errno = ENOENT;
+ ret = -1;
+ goto RETVAL;
+ }
-#ifndef USE_RTL_WAIT
- if (mode == P_NOWAIT && w32_num_children >= MAXIMUM_WAIT_OBJECTS)
- return -1;
-#endif
+ if (mode == P_NOWAIT) {
+ /* asynchronous spawn -- store handle, return PID */
+ w32_child_handles[w32_num_children] = ProcessInformation.hProcess;
+ ret = w32_child_pids[w32_num_children] = ProcessInformation.dwProcessId;
+ ++w32_num_children;
+ }
+ else {
+ WaitForSingleObject(ProcessInformation.hProcess, INFINITE);
+ GetExitCodeProcess(ProcessInformation.hProcess, &ret);
+ CloseHandle(ProcessInformation.hProcess);
+ }
- status = spawnvp(mode, cmdname, (char * const *) argv);
-#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.
- */
- if (mode == P_NOWAIT && status >= 0)
- w32_child_pids[w32_num_children++] = (HANDLE)status;
+ CloseHandle(ProcessInformation.hThread);
+RETVAL:
+ Safefree(cmd);
+ Safefree(fullcmd);
+ return (int)ret;
#endif
- return status;
}
DllExport int
* then it worked, set PV valid,
* else leave it 'undef'
*/
- if (SvCUR(sv))
- SvPOK_on(sv);
EXTEND(SP,1);
- ST(0) = sv;
- XSRETURN(1);
+ if (SvCUR(sv)) {
+ SvPOK_on(sv);
+ ST(0) = sv;
+ XSRETURN(1);
+ }
+ XSRETURN_UNDEF;
}
static
XS(w32_SetCwd)
{
dXSARGS;
- STRLEN n_a;
if (items != 1)
croak("usage: Win32::SetCurrentDirectory($cwd)");
- if (SetCurrentDirectory(SvPV(ST(0),n_a)))
+ if (SetCurrentDirectory(SvPV_nolen(ST(0))))
XSRETURN_YES;
XSRETURN_NO;
dXSARGS;
char ix = 'C';
char root[] = "_:\\";
+
+ EXTEND(SP,1);
while (ix <= 'Z') {
root[0] = ix++;
if (GetDriveType(root) == 1) {
XS(w32_GetLastError)
{
dXSARGS;
+ EXTEND(SP,1);
XSRETURN_IV(GetLastError());
}
static
+XS(w32_SetLastError)
+{
+ dXSARGS;
+ if (items != 1)
+ croak("usage: Win32::SetLastError($error)");
+ SetLastError(SvIV(ST(0)));
+ XSRETURN_EMPTY;
+}
+
+static
XS(w32_LoginName)
{
dXSARGS;
char *name = getlogin_buffer;
DWORD size = sizeof(getlogin_buffer);
+ EXTEND(SP,1);
if (GetUserName(name,&size)) {
/* size includes NULL */
- ST(0) = sv_2mortal(newSVpv(name,size-1));
+ ST(0) = sv_2mortal(newSVpvn(name,size-1));
XSRETURN(1);
}
XSRETURN_UNDEF;
dXSARGS;
char name[MAX_COMPUTERNAME_LENGTH+1];
DWORD size = sizeof(name);
+ EXTEND(SP,1);
if (GetComputerName(name,&size)) {
/* size does NOT include NULL :-( */
- ST(0) = sv_2mortal(newSVpv(name,size));
+ ST(0) = sv_2mortal(newSVpvn(name,size));
XSRETURN(1);
}
XSRETURN_UNDEF;
/* mingw32 (and Win95) don't have NetWksta*(), so do it the old way */
char name[256];
DWORD size = sizeof(name);
+ EXTEND(SP,1);
if (GetUserName(name,&size)) {
char sid[1024];
DWORD sidlen = sizeof(sid);
char dname[256];
DWORD dnamelen = sizeof(dname);
PWKSTA_INFO_100 pwi;
+ EXTEND(SP,1);
if (NERR_Success == NetWkstaGetInfo(NULL, 100, (LPBYTE*)&pwi)) {
if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_langroup,
DWORD flags, filecomplen;
if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
&flags, fsname, sizeof(fsname))) {
- if (GIMME == G_ARRAY) {
- XPUSHs(sv_2mortal(newSVpv(fsname,0)));
+ if (GIMME_V == G_ARRAY) {
+ XPUSHs(sv_2mortal(newSVpvn(fsname,strlen(fsname))));
XPUSHs(sv_2mortal(newSViv(flags)));
XPUSHs(sv_2mortal(newSViv(filecomplen)));
PUTBACK;
return;
}
+ EXTEND(SP,1);
XSRETURN_PV(fsname);
}
- XSRETURN_UNDEF;
+ XSRETURN_EMPTY;
}
static
osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
if (GetVersionEx(&osver)) {
- XPUSHs(newSVpv(osver.szCSDVersion, 0));
+ XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion)));
XPUSHs(newSViv(osver.dwMajorVersion));
XPUSHs(newSViv(osver.dwMinorVersion));
XPUSHs(newSViv(osver.dwBuildNumber));
PUTBACK;
return;
}
- XSRETURN_UNDEF;
+ XSRETURN_EMPTY;
}
static
XS(w32_IsWinNT)
{
dXSARGS;
+ EXTEND(SP,1);
XSRETURN_IV(IsWinNT());
}
XS(w32_IsWin95)
{
dXSARGS;
+ EXTEND(SP,1);
XSRETURN_IV(IsWin95());
}
PROCESS_INFORMATION stProcInfo;
STARTUPINFO stStartInfo;
BOOL bSuccess = FALSE;
- STRLEN n_a;
if (items != 3)
croak("usage: Win32::Spawn($cmdName, $args, $PID)");
- cmd = SvPV(ST(0),n_a);
- args = SvPV(ST(1), n_a);
+ cmd = SvPV_nolen(ST(0));
+ args = SvPV_nolen(ST(1));
memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */
stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */
XS(w32_GetTickCount)
{
dXSARGS;
- XSRETURN_IV(GetTickCount());
+ DWORD msec = GetTickCount();
+ EXTEND(SP,1);
+ if ((IV)msec > 0)
+ XSRETURN_IV(msec);
+ XSRETURN_NV(msec);
}
static
if (len) {
SvCUR_set(shortpath,len);
ST(0) = shortpath;
+ XSRETURN(1);
}
- else
- ST(0) = &PL_sv_undef;
- XSRETURN(1);
+ XSRETURN_UNDEF;
+}
+
+static
+XS(w32_GetFullPathName)
+{
+ dXSARGS;
+ SV *filename;
+ SV *fullpath;
+ char *filepart;
+ DWORD len;
+
+ if (items != 1)
+ croak("usage: Win32::GetFullPathName($filename)");
+
+ filename = ST(0);
+ fullpath = sv_mortalcopy(filename);
+ SvUPGRADE(fullpath, SVt_PV);
+ do {
+ len = GetFullPathName(SvPVX(filename),
+ SvLEN(fullpath),
+ SvPVX(fullpath),
+ &filepart);
+ } while (len >= SvLEN(fullpath) && sv_grow(fullpath,len+1));
+ if (len) {
+ if (GIMME_V == G_ARRAY) {
+ EXTEND(SP,1);
+ XST_mPV(1,filepart);
+ len = filepart - SvPVX(fullpath);
+ items = 2;
+ }
+ SvCUR_set(fullpath,len);
+ ST(0) = fullpath;
+ XSRETURN(items);
+ }
+ XSRETURN_EMPTY;
+}
+
+static
+XS(w32_GetLongPathName)
+{
+ dXSARGS;
+ SV *path;
+ char tmpbuf[MAX_PATH+1];
+ char *pathstr;
+ STRLEN len;
+
+ if (items != 1)
+ croak("usage: Win32::GetLongPathName($pathname)");
+
+ path = ST(0);
+ pathstr = SvPV(path,len);
+ strcpy(tmpbuf, pathstr);
+ pathstr = win32_longpath(tmpbuf);
+ if (pathstr) {
+ ST(0) = sv_2mortal(newSVpvn(pathstr, strlen(pathstr)));
+ XSRETURN(1);
+ }
+ XSRETURN_EMPTY;
}
static
XSRETURN_YES;
}
+static
+XS(w32_CopyFile)
+{
+ dXSARGS;
+ if (items != 3)
+ croak("usage: Win32::CopyFile($from, $to, $overwrite)");
+ if (CopyFile(SvPV_nolen(ST(0)), SvPV_nolen(ST(1)), !SvTRUE(ST(2))))
+ XSRETURN_YES;
+ XSRETURN_NO;
+}
+
void
Perl_init_os_extras()
{
w32_perlshell_tokens = Nullch;
w32_perlshell_items = -1;
w32_fdpid = newAV(); /* XXX needs to be in Perl_win32_init()? */
-#ifndef USE_RTL_WAIT
+ New(1313, w32_children, 1, child_tab);
w32_num_children = 0;
-#endif
/* these names are Activeware compatible */
newXS("Win32::GetCwd", w32_GetCwd, file);
newXS("Win32::SetCwd", w32_SetCwd, file);
newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
newXS("Win32::GetLastError", w32_GetLastError, file);
+ newXS("Win32::SetLastError", w32_SetLastError, file);
newXS("Win32::LoginName", w32_LoginName, file);
newXS("Win32::NodeName", w32_NodeName, file);
newXS("Win32::DomainName", w32_DomainName, file);
newXS("Win32::Spawn", w32_Spawn, file);
newXS("Win32::GetTickCount", w32_GetTickCount, file);
newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
+ newXS("Win32::GetFullPathName", w32_GetFullPathName, file);
+ newXS("Win32::GetLongPathName", w32_GetLongPathName, file);
+ newXS("Win32::CopyFile", w32_CopyFile, file);
newXS("Win32::Sleep", w32_Sleep, file);
/* XXX Bloat Alert! The following Activeware preloads really
projects / p5sagit/p5-mst-13.2.git / blobdiff