X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2Fperlhost.h;h=3b6d11d99e7f2361a3f76cbaeef649eba212c25f;hb=bb81493d5a45ab2db637176c202a1469d2cd75b7;hp=7fcd5340b4f91aec452ee63431fd7ffd0b5656fa;hpb=39644a267dae6dfa935b1c1d39151eb399850949;p=p5sagit%2Fp5-mst-13.2.git diff --git a/win32/perlhost.h b/win32/perlhost.h index 7fcd534..3b6d11d 100644 --- a/win32/perlhost.h +++ b/win32/perlhost.h @@ -1,12 +1,14 @@ /* perlhost.h * - * (c) 1999 Microsoft Corporation. All rights reserved. + * (c) 1999 Microsoft Corporation. All rights reserved. * Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/ * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. */ +#define CHECK_HOST_INTERP + #ifndef ___PerlHost_H___ #define ___PerlHost_H___ @@ -15,22 +17,12 @@ #include "vmem.h" #include "vdir.h" -#if !defined(PERL_OBJECT) START_EXTERN_C -#endif 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); -#if !defined(PERL_OBJECT) END_EXTERN_C -#endif - -#ifdef PERL_OBJECT -extern int g_do_aspawn(void *vreally, void **vmark, void **vsp); -#define do_aspawn g_do_aspawn -#endif class CPerlHost { @@ -61,6 +53,7 @@ public: void PerlDestroy(void); /* IPerlMem */ + /* Locks provided but should be unnecessary as this is private pool */ inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); }; inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); }; inline void Free(void* ptr) { m_pVMem->Free(ptr); }; @@ -77,12 +70,32 @@ public: inline int IsLocked(void) { return m_pVMem->IsLocked(); }; /* IPerlMemShared */ + /* Locks used to serialize access to the pool */ + inline void GetLockShared(void) { m_pVMemShared->GetLock(); }; + inline void FreeLockShared(void) { m_pVMemShared->FreeLock(); }; + inline int IsLockedShared(void) { return m_pVMemShared->IsLocked(); }; inline void* MallocShared(size_t size) { - return m_pVMemShared->Malloc(size); + void *result; + GetLockShared(); + result = m_pVMemShared->Malloc(size); + FreeLockShared(); + return result; + }; + inline void* ReallocShared(void* ptr, size_t size) + { + void *result; + GetLockShared(); + result = m_pVMemShared->Realloc(ptr, size); + FreeLockShared(); + return result; + }; + inline void FreeShared(void* ptr) + { + GetLockShared(); + m_pVMemShared->Free(ptr); + FreeLockShared(); }; - inline void* ReallocShared(void* ptr, size_t size) { return m_pVMemShared->Realloc(ptr, size); }; - inline void FreeShared(void* ptr) { m_pVMemShared->Free(ptr); }; inline void* CallocShared(size_t num, size_t size) { size_t count = num*size; @@ -91,11 +104,14 @@ public: ZeroMemory(lpVoid, count); return lpVoid; }; - inline void GetLockShared(void) { m_pVMem->GetLock(); }; - inline void FreeLockShared(void) { m_pVMem->FreeLock(); }; - inline int IsLockedShared(void) { return m_pVMem->IsLocked(); }; /* IPerlMemParse */ + /* Assume something else is using locks to mangaging serialize + on a batch basis + */ + inline void GetLockParse(void) { m_pVMemParse->GetLock(); }; + inline void FreeLockParse(void) { m_pVMemParse->FreeLock(); }; + inline int IsLockedParse(void) { return m_pVMemParse->IsLocked(); }; inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); }; inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); }; inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); }; @@ -107,9 +123,6 @@ public: ZeroMemory(lpVoid, count); return lpVoid; }; - inline void GetLockParse(void) { m_pVMem->GetLock(); }; - inline void FreeLockParse(void) { m_pVMem->FreeLock(); }; - inline int IsLockedParse(void) { return m_pVMem->IsLocked(); }; /* IPerlEnv */ char *Getenv(const char *varname); @@ -198,29 +211,42 @@ protected: DWORD m_dwEnvCount; LPSTR* m_lppEnvList; + BOOL m_bTopLevel; // is this a toplevel host? static long num_hosts; public: inline int LastHost(void) { return num_hosts == 1L; }; + struct interpreter *host_perl; }; long CPerlHost::num_hosts = 0L; +extern "C" void win32_checkTLS(struct interpreter *host_perl); -#define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y)) +#define STRUCT2RAWPTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y)) +#ifdef CHECK_HOST_INTERP +inline CPerlHost* CheckInterp(CPerlHost *host) +{ + win32_checkTLS(host->host_perl); + return host; +} +#define STRUCT2PTR(x, y) CheckInterp(STRUCT2RAWPTR(x, y)) +#else +#define STRUCT2PTR(x, y) STRUCT2RAWPTR(x, y) +#endif inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl) { - return STRUCT2PTR(piPerl, m_hostperlMem); + return STRUCT2RAWPTR(piPerl, m_hostperlMem); } inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl) { - return STRUCT2PTR(piPerl, m_hostperlMemShared); + return STRUCT2RAWPTR(piPerl, m_hostperlMemShared); } inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl) { - return STRUCT2PTR(piPerl, m_hostperlMemParse); + return STRUCT2RAWPTR(piPerl, m_hostperlMemParse); } inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl) @@ -506,7 +532,7 @@ PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr) win32_get_child_IO(ptr); } -struct IPerlEnv perlEnv = +struct IPerlEnv perlEnv = { PerlEnvGetenv, PerlEnvPutenv, @@ -736,14 +762,14 @@ PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_lis return win32_vfprintf(pf, format, arglist); } -long +Off_t PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf) { return win32_ftell(pf); } int -PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, off_t offset, int origin) +PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, Off_t offset, int origin) { return win32_fseek(pf, offset, origin); } @@ -783,12 +809,12 @@ PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl) } int -PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags) +PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, intptr_t osfhandle, int flags) { return win32_open_osfhandle(osfhandle, flags); } -int +intptr_t PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum) { return win32_get_osfhandle(filenum); @@ -833,7 +859,7 @@ PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf) } #endif - /* it appears that the binmode is attached to the + /* it appears that the binmode is attached to the * file descriptor so binmode files will be handled * correctly */ @@ -846,7 +872,7 @@ PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf) return pfdup; } -struct IPerlStdIO perlStdIO = +struct IPerlStdIO perlStdIO = { PerlStdIOStdin, PerlStdIOStdout, @@ -913,9 +939,9 @@ PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t g } 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 @@ -943,7 +969,7 @@ PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper) } int -PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer) +PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, Stat_t *buffer) { return win32_fstat(handle, buffer); } @@ -966,14 +992,14 @@ PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname) return win32_link(oldname, newname); } -long -PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin) +Off_t +PerlLIOLseek(struct IPerlLIO* piPerl, int handle, Off_t offset, int origin) { return win32_lseek(handle, offset, origin); } int -PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer) +PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer) { return win32_stat(path, buffer); } @@ -1015,7 +1041,7 @@ PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode) } int -PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer) +PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer) { return win32_stat(path, buffer); } @@ -1248,7 +1274,7 @@ PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name) struct hostent* PerlSockGethostent(struct IPerlSock* piPerl) { - dTHXo; + dTHX; Perl_croak(aTHX_ "gethostent not implemented!\n"); return NULL; } @@ -1423,9 +1449,7 @@ PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol) int PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds) { - dTHXo; - Perl_croak(aTHX_ "socketpair not implemented!\n"); - return 0; + return Perl_my_socketpair(domain, type, protocol, fds); } int @@ -1575,7 +1599,7 @@ PerlProcKill(struct IPerlProc* piPerl, int pid, int sig) int PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig) { - dTHXo; + dTHX; Perl_croak(aTHX_ "killpg not implemented!\n"); return 0; } @@ -1589,11 +1613,19 @@ PerlProcPauseProc(struct IPerlProc* piPerl) PerlIO* PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode) { - dTHXo; + dTHX; PERL_FLUSHALL_FOR_CHILD; return win32_popen(command, mode); } +PerlIO* +PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args) +{ + dTHX; + PERL_FLUSHALL_FOR_CHILD; + return win32_popenlist(mode, narg, args); +} + int PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream) { @@ -1645,7 +1677,13 @@ PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags) Sighandler_t PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode) { - return signal(sig, subcode); + return win32_signal(sig, subcode); +} + +int +PerlProcGetTimeOfDay(struct IPerlProc* piPerl, struct timeval *t, void *z) +{ + return win32_gettimeofday(t, z); } #ifdef USE_ITHREADS @@ -1655,9 +1693,6 @@ win32_start_child(LPVOID arg) PerlInterpreter *my_perl = (PerlInterpreter*)arg; GV *tmpgv; int status; -#ifdef PERL_OBJECT - CPerlObj *pPerl = (CPerlObj*)my_perl; -#endif #ifdef PERL_SYNC_FORK static long sync_fork_id = 0; long id = ++sync_fork_id; @@ -1665,6 +1700,7 @@ win32_start_child(LPVOID arg) PERL_SET_THX(my_perl); + win32_checkTLS(my_perl); /* set $$ to pseudo id */ #ifdef PERL_SYNC_FORK @@ -1677,8 +1713,12 @@ win32_start_child(LPVOID arg) w32_pseudo_id = -pid; } #endif - if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) - sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id); + if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) { + SV *sv = GvSV(tmpgv); + SvREADONLY_off(sv); + sv_setiv(sv, -(IV)w32_pseudo_id); + SvREADONLY_on(sv); + } hv_clear(PL_pidstatus); /* push a zero on the stack (we are the child) */ @@ -1727,18 +1767,22 @@ restart: JMPENV_POP; /* XXX hack to avoid perl_destruct() freeing optree */ + win32_checkTLS(my_perl); PL_main_root = Nullop; } + 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) */ + win32_checkTLS(my_perl); perl_destruct(my_perl); + win32_checkTLS(my_perl); perl_free(my_perl); #ifdef PERL_SYNC_FORK @@ -1752,7 +1796,7 @@ restart: int PerlProcFork(struct IPerlProc* piPerl) { - dTHXo; + dTHX; #ifdef USE_ITHREADS DWORD id; HANDLE handle; @@ -1763,7 +1807,7 @@ PerlProcFork(struct IPerlProc* piPerl) return -1; } h = new CPerlHost(*(CPerlHost*)w32_internal_host); - PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHXo, 1, + PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 1, h->m_pHostperlMem, h->m_pHostperlMemShared, h->m_pHostperlMemParse, @@ -1775,9 +1819,10 @@ PerlProcFork(struct IPerlProc* piPerl) h->m_pHostperlProc ); new_perl->Isys_intern.internal_host = h; + h->host_perl = new_perl; # ifdef PERL_SYNC_FORK id = win32_start_child((LPVOID)new_perl); - PERL_SET_THX(aTHXo); + PERL_SET_THX(aTHX); # else # ifdef USE_RTL_THREAD_API handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child, @@ -1786,7 +1831,7 @@ PerlProcFork(struct IPerlProc* piPerl) handle = CreateThread(NULL, 0, win32_start_child, (LPVOID)new_perl, 0, &id); # endif - PERL_SET_THX(aTHXo); /* XXX perl_clone*() set TLS */ + PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */ if (!handle) { errno = EAGAIN; return -1; @@ -1825,19 +1870,6 @@ PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr) 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) { @@ -1845,15 +1877,9 @@ PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const c } int -PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp) -{ - return do_aspawn(vreally, vmark, vsp); -} - -int PerlProcLastHost(struct IPerlProc* piPerl) { - dTHXo; + dTHX; CPerlHost *h = (CPerlHost*)w32_internal_host; return h->LastHost(); } @@ -1889,11 +1915,10 @@ struct IPerlProc perlProc = PerlProcGetpid, PerlProcDynaLoader, PerlProcGetOSError, - PerlProcDoCmd, - PerlProcSpawn, PerlProcSpawnvp, - PerlProcASpawn, - PerlProcLastHost + PerlProcLastHost, + PerlProcPopenList, + PerlProcGetTimeOfDay }; @@ -1914,6 +1939,7 @@ CPerlHost::CPerlHost(void) m_dwEnvCount = 0; m_lppEnvList = NULL; + m_bTopLevel = TRUE; CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem)); CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared)); @@ -1963,6 +1989,7 @@ CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, m_dwEnvCount = 0; m_lppEnvList = NULL; + m_bTopLevel = FALSE; CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem)); CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared)); @@ -2019,6 +2046,7 @@ CPerlHost::CPerlHost(CPerlHost& host) m_dwEnvCount = 0; m_lppEnvList = NULL; + m_bTopLevel = FALSE; /* duplicate environment info */ LPSTR lpPtr; @@ -2029,7 +2057,7 @@ CPerlHost::CPerlHost(CPerlHost& host) CPerlHost::~CPerlHost(void) { -// Reset(); + Reset(); InterlockedDecrement(&num_hosts); delete m_pvDir; m_pVMemParse->Release(); @@ -2090,6 +2118,8 @@ lookup(const void *arg1, const void *arg2) LPSTR* CPerlHost::Lookup(LPCSTR lpStr) { + if (!lpStr) + return NULL; return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup); } @@ -2118,7 +2148,7 @@ compare(const void *arg1, const void *arg2) if(c1 != c2) { if(c1 < c2) return -1; // string 1 < string 2 - + return 1; // string 1 > string 2 } } @@ -2129,7 +2159,7 @@ compare(const void *arg1, const void *arg2) void CPerlHost::Add(LPCSTR lpStr) { - dTHXo; + dTHX; char szBuffer[1024]; LPSTR *lpPtr; int index, length = strlen(lpStr)+1; @@ -2141,20 +2171,24 @@ CPerlHost::Add(LPCSTR lpStr) // 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; } } @@ -2172,23 +2206,23 @@ CPerlHost::CalculateEnvironmentSpace(void) void CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr) { - dTHXo; + dTHX; Safefree(lpStr); } char* CPerlHost::GetChildDir(void) { - dTHXo; + dTHX; int length; char* ptr; New(0, ptr, MAX_PATH+1, char); if(ptr) { m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr); - length = strlen(ptr)-1; - if(length > 0) { - if((ptr[length] == '\\') || (ptr[length] == '/')) - ptr[length] = 0; + length = strlen(ptr); + if (length > 3) { + if ((ptr[length-1] == '\\') || (ptr[length-1] == '/')) + ptr[length-1] = 0; } } return ptr; @@ -2197,14 +2231,14 @@ CPerlHost::GetChildDir(void) void CPerlHost::FreeChildDir(char* pStr) { - dTHXo; + dTHX; Safefree(pStr); } LPSTR CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir) { - dTHXo; + dTHX; LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr; DWORD dwSize, dwEnvIndex; int nLength, compVal; @@ -2246,7 +2280,7 @@ CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir) lpStr += nLength; lpEnvPtr += nLength; } - else { + else { // determine which string to copy next compVal = compare(&lpEnvPtr, &lpLocalEnv); if(compVal < 0) { @@ -2272,11 +2306,12 @@ CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir) while(lpLocalEnv) { // still have environment overrides to add - // so copy the strings into place - strcpy(lpStr, lpLocalEnv); - nLength = strlen(lpLocalEnv) + 1; - lpStr += nLength; - lpEnvPtr += nLength; + // so copy the strings into place if not an override + char *ptr = strchr(lpLocalEnv, '='); + if(ptr && ptr[1]) { + strcpy(lpStr, lpLocalEnv); + lpStr += strlen(lpLocalEnv) + 1; + } lpLocalEnv = GetIndex(dwEnvIndex); } @@ -2293,22 +2328,25 @@ CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir) void CPerlHost::Reset(void) { - dTHXo; + 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 CPerlHost::Clearenv(void) { + dTHX; char ch; LPSTR lpPtr, lpStr, lpEnvPtr; - if(m_lppEnvList != NULL) { + if (m_lppEnvList != NULL) { /* set every entry to an empty string */ for(DWORD index = 0; index < m_dwEnvCount; ++index) { char* ptr = strchr(m_lppEnvList[index], '='); @@ -2331,6 +2369,8 @@ CPerlHost::Clearenv(void) ch = *++lpPtr; *lpPtr = 0; Add(lpStr); + if (m_bTopLevel) + (void)win32_putenv(lpStr); *lpPtr = ch; } lpStr += strlen(lpStr) + 1; @@ -2343,30 +2383,35 @@ CPerlHost::Clearenv(void) char* CPerlHost::Getenv(const char *varname) { - char* pEnv = Find(varname); - if(pEnv == NULL) { - pEnv = win32_getenv(varname); + dTHX; + if (!m_bTopLevel) { + char *pEnv = Find(varname); + if (pEnv && *pEnv) + return pEnv; } - else { - if(!*pEnv) - pEnv = 0; - } - - return pEnv; + return win32_getenv(varname); } int CPerlHost::Putenv(const char *envstring) { + dTHX; Add(envstring); + if (m_bTopLevel) + return win32_putenv(envstring); + return 0; } int CPerlHost::Chdir(const char *dirname) { - dTHXo; + dTHX; int ret; + if (!dirname) { + errno = ENOENT; + return -1; + } if (USING_WIDE()) { WCHAR wBuffer[MAX_PATH]; A2WHELPER(dirname, wBuffer, sizeof(wBuffer));