* License or the Artistic License, as specified in the README file.
*/
+#ifndef UNDER_CE
#define CHECK_HOST_INTERP
+#endif
#ifndef ___PerlHost_H___
#define ___PerlHost_H___
+#ifndef UNDER_CE
#include <signal.h>
+#endif
#include "iperlsys.h"
#include "vmem.h"
#include "vdir.h"
+#ifndef WC_NO_BEST_FIT_CHARS
+# define WC_NO_BEST_FIT_CHARS 0x00000400
+#endif
+
START_EXTERN_C
extern char * g_win32_get_privlib(const char *pl);
extern char * g_win32_get_sitelib(const char *pl);
extern char * g_win32_get_vendorlib(const char *pl);
extern char * g_getlogin(void);
-extern int do_spawn2(char *cmd, int exectype);
END_EXTERN_C
class CPerlHost
FILE*
PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
{
+#ifndef UNDER_CE
FILE* pfdup;
fpos_t pos;
char mode[3];
fsetpos(pfdup, &pos);
}
return pfdup;
+#else
+ return 0;
+#endif
}
struct IPerlStdIO perlStdIO =
}
int
-PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
+PerlLIOChsize(struct IPerlLIO* piPerl, int handle, Off_t size)
{
- return chsize(handle, size);
+ return win32_chsize(handle, size);
}
int
}
int
-PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
+PerlLIOUtime(struct IPerlLIO* piPerl, const char *filename, struct utimbuf *times)
{
return win32_utime(filename, times);
}
}
DIR*
-PerlDirOpen(struct IPerlDir* piPerl, char *filename)
+PerlDirOpen(struct IPerlDir* piPerl, const char *filename)
{
return win32_opendir(filename);
}
int
PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
{
- dTHX;
- Perl_croak(aTHX_ "killpg not implemented!\n");
- return 0;
+ return win32_kill(pid, -sig);
}
int
return win32_signal(sig, subcode);
}
+int
+PerlProcGetTimeOfDay(struct IPerlProc* piPerl, struct timeval *t, void *z)
+{
+ return win32_gettimeofday(t, z);
+}
+
#ifdef USE_ITHREADS
static THREAD_RET_TYPE
win32_start_child(LPVOID arg)
PerlInterpreter *my_perl = (PerlInterpreter*)arg;
GV *tmpgv;
int status;
+ HWND parent_message_hwnd;
#ifdef PERL_SYNC_FORK
static long sync_fork_id = 0;
long id = ++sync_fork_id;
sv_setiv(sv, -(IV)w32_pseudo_id);
SvREADONLY_on(sv);
}
+#ifdef PERL_USES_PL_PIDSTATUS
hv_clear(PL_pidstatus);
+#endif
+
+ /* create message window and tell parent about it */
+ parent_message_hwnd = w32_message_hwnd;
+ w32_message_hwnd = win32_create_message_window();
+ if (parent_message_hwnd != NULL)
+ PostMessage(parent_message_hwnd, WM_USER_MESSAGE, w32_pseudo_id, (LONG)w32_message_hwnd);
/* push a zero on the stack (we are the child) */
{
PL_curstash = PL_defstash;
if (PL_endav && !PL_minus_c)
call_list(oldscope, PL_endav);
- status = STATUS_NATIVE_EXPORT;
+ status = STATUS_EXIT;
break;
case 3:
if (PL_restartop) {
win32_checkTLS(my_perl);
/* close the std handles to avoid fd leaks */
{
- do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
- do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE);
- do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE);
+ do_close(PL_stdingv, FALSE);
+ do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE); /* PL_stdoutgv - ISAGN */
+ do_close(PL_stderrgv, FALSE);
}
/* destroy everything (waits for any pseudo-forked children) */
id = win32_start_child((LPVOID)new_perl);
PERL_SET_THX(aTHX);
# else
+ if (w32_message_hwnd == INVALID_HANDLE_VALUE)
+ w32_message_hwnd = win32_create_message_window();
+ new_perl->Isys_intern.message_hwnd = w32_message_hwnd;
+ w32_pseudo_child_message_hwnds[w32_num_pseudo_children] =
+ (w32_message_hwnd == NULL) ? (HWND)NULL : (HWND)INVALID_HANDLE_VALUE;
# ifdef USE_RTL_THREAD_API
handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
(void*)new_perl, 0, (unsigned*)&id);
win32_str_os_error(sv, dwErr);
}
-BOOL
-PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
-{
- do_spawn2(cmd, EXECF_EXEC);
- return FALSE;
-}
-
-int
-PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
-{
- return do_spawn2(cmds, EXECF_SPAWN);
-}
-
int
PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
{
}
int
-PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
-{
- return do_aspawn(vreally, vmark, vsp);
-}
-
-int
PerlProcLastHost(struct IPerlProc* piPerl)
{
dTHX;
PerlProcGetpid,
PerlProcDynaLoader,
PerlProcGetOSError,
- PerlProcDoCmd,
- PerlProcSpawn,
PerlProcSpawnvp,
- PerlProcASpawn,
PerlProcLastHost,
- PerlProcPopenList
+ PerlProcPopenList,
+ PerlProcGetTimeOfDay
};
CPerlHost::~CPerlHost(void)
{
-// Reset();
+ Reset();
InterlockedDecrement(&num_hosts);
delete m_pvDir;
m_pVMemParse->Release();
LPSTR*
CPerlHost::Lookup(LPCSTR lpStr)
{
+#ifdef UNDER_CE
+ if (!m_lppEnvList || !m_dwEnvCount)
+ return NULL;
+#endif
+ if (!lpStr)
+ return NULL;
return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
}
// replacing ?
lpPtr = Lookup(szBuffer);
- if(lpPtr != NULL) {
- Renew(*lpPtr, length, char);
+ if (lpPtr != NULL) {
+ // must allocate things via host memory allocation functions
+ // rather than perl's Renew() et al, as the perl interpreter
+ // may either not be initialized enough when we allocate these,
+ // or may already be dead when we go to free these
+ *lpPtr = (char*)Realloc(*lpPtr, length * sizeof(char));
strcpy(*lpPtr, lpStr);
}
else {
- ++m_dwEnvCount;
- Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
- New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
- if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
- strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
- qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
+ m_lppEnvList = (LPSTR*)Realloc(m_lppEnvList, (m_dwEnvCount+1) * sizeof(LPSTR));
+ if (m_lppEnvList) {
+ m_lppEnvList[m_dwEnvCount] = (char*)Malloc(length * sizeof(char));
+ if (m_lppEnvList[m_dwEnvCount] != NULL) {
+ strcpy(m_lppEnvList[m_dwEnvCount], lpStr);
+ ++m_dwEnvCount;
+ qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
+ }
}
- else
- --m_dwEnvCount;
}
}
CPerlHost::GetChildDir(void)
{
dTHX;
- int length;
char* ptr;
- New(0, ptr, MAX_PATH+1, char);
- if(ptr) {
- m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
- length = strlen(ptr);
- if (length > 3) {
- if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
- ptr[length-1] = 0;
- }
+ size_t length;
+
+ Newx(ptr, MAX_PATH+1, char);
+ m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
+ length = strlen(ptr);
+ if (length > 3) {
+ if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
+ ptr[length-1] = 0;
}
return ptr;
}
// add the additional space used by changes made to the environment
dwSize += CalculateEnvironmentSpace();
- New(1, lpStr, dwSize, char);
+ Newx(lpStr, dwSize, char);
lpPtr = lpStr;
if(lpStr != NULL) {
// build the local environment
dTHX;
if(m_lppEnvList != NULL) {
for(DWORD index = 0; index < m_dwEnvCount; ++index) {
- Safefree(m_lppEnvList[index]);
+ Free(m_lppEnvList[index]);
m_lppEnvList[index] = NULL;
}
}
m_dwEnvCount = 0;
+ Free(m_lppEnvList);
+ m_lppEnvList = NULL;
}
void
errno = ENOENT;
return -1;
}
- if (USING_WIDE()) {
- WCHAR wBuffer[MAX_PATH];
- A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
- ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
- }
- else
- ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
+ ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
if(ret < 0) {
errno = ENOENT;
}