3 * (c) 1999 Microsoft Corporation. All rights reserved.
4 * Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/
6 * You may distribute under the terms of either the GNU General Public
7 * License or the Artistic License, as specified in the README file.
10 #ifndef ___PerlHost_H___
11 #define ___PerlHost_H___
17 #if !defined(PERL_OBJECT)
20 extern char * g_win32_get_privlib(char *pl);
21 extern char * g_win32_get_sitelib(char *pl);
22 extern char * g_getlogin(void);
23 extern int do_spawn2(char *cmd, int exectype);
24 #if !defined(PERL_OBJECT)
29 extern int g_do_aspawn(void *vreally, void **vmark, void **vsp);
30 #define do_aspawn g_do_aspawn
37 CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
38 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
39 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
40 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
41 struct IPerlProc** ppProc);
42 CPerlHost(CPerlHost& host);
45 static CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl);
46 static CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl);
47 static CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl);
48 static CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl);
49 static CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl);
50 static CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl);
51 static CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl);
52 static CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl);
53 static CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl);
55 BOOL PerlCreate(void);
56 int PerlParse(int argc, char** argv, char** env);
58 void PerlDestroy(void);
61 inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
62 inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
63 inline void Free(void* ptr) { m_pVMem->Free(ptr); };
64 inline void* Calloc(size_t num, size_t size)
66 size_t count = num*size;
67 void* lpVoid = Malloc(count);
69 ZeroMemory(lpVoid, count);
72 inline void GetLock(void) { m_pVMem->GetLock(); };
73 inline void FreeLock(void) { m_pVMem->FreeLock(); };
74 inline int IsLocked(void) { return m_pVMem->IsLocked(); };
77 inline void* MallocShared(size_t size)
79 return m_pVMemShared->Malloc(size);
81 inline void* ReallocShared(void* ptr, size_t size) { return m_pVMemShared->Realloc(ptr, size); };
82 inline void FreeShared(void* ptr) { m_pVMemShared->Free(ptr); };
83 inline void* CallocShared(size_t num, size_t size)
85 size_t count = num*size;
86 void* lpVoid = MallocShared(count);
88 ZeroMemory(lpVoid, count);
91 inline void GetLockShared(void) { m_pVMem->GetLock(); };
92 inline void FreeLockShared(void) { m_pVMem->FreeLock(); };
93 inline int IsLockedShared(void) { return m_pVMem->IsLocked(); };
96 inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
97 inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
98 inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
99 inline void* CallocParse(size_t num, size_t size)
101 size_t count = num*size;
102 void* lpVoid = MallocParse(count);
104 ZeroMemory(lpVoid, count);
107 inline void GetLockParse(void) { m_pVMem->GetLock(); };
108 inline void FreeLockParse(void) { m_pVMem->FreeLock(); };
109 inline int IsLockedParse(void) { return m_pVMem->IsLocked(); };
112 char *Getenv(const char *varname);
113 int Putenv(const char *envstring);
114 inline char *Getenv(const char *varname, unsigned long *len)
117 char *e = Getenv(varname);
122 void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
123 void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
124 char* GetChildDir(void);
125 void FreeChildDir(char* pStr);
129 inline LPSTR GetIndex(DWORD &dwIndex)
131 if(dwIndex < m_dwEnvCount)
134 return m_lppEnvList[dwIndex-1];
140 LPSTR Find(LPCSTR lpStr);
141 void Add(LPCSTR lpStr);
143 LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
144 void FreeLocalEnvironmentStrings(LPSTR lpStr);
145 LPSTR* Lookup(LPCSTR lpStr);
146 DWORD CalculateEnvironmentSpace(void);
151 virtual int Chdir(const char *dirname);
155 void Exit(int status);
156 void _Exit(int status);
157 int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
158 int Execv(const char *cmdname, const char *const *argv);
159 int Execvp(const char *cmdname, const char *const *argv);
161 inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
162 inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
163 inline VDir* GetDir(void) { return m_pvDir; };
167 struct IPerlMem m_hostperlMem;
168 struct IPerlMem m_hostperlMemShared;
169 struct IPerlMem m_hostperlMemParse;
170 struct IPerlEnv m_hostperlEnv;
171 struct IPerlStdIO m_hostperlStdIO;
172 struct IPerlLIO m_hostperlLIO;
173 struct IPerlDir m_hostperlDir;
174 struct IPerlSock m_hostperlSock;
175 struct IPerlProc m_hostperlProc;
177 struct IPerlMem* m_pHostperlMem;
178 struct IPerlMem* m_pHostperlMemShared;
179 struct IPerlMem* m_pHostperlMemParse;
180 struct IPerlEnv* m_pHostperlEnv;
181 struct IPerlStdIO* m_pHostperlStdIO;
182 struct IPerlLIO* m_pHostperlLIO;
183 struct IPerlDir* m_pHostperlDir;
184 struct IPerlSock* m_pHostperlSock;
185 struct IPerlProc* m_pHostperlProc;
187 inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
188 inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
201 #define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
203 inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
205 return STRUCT2PTR(piPerl, m_hostperlMem);
208 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
210 return STRUCT2PTR(piPerl, m_hostperlMemShared);
213 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
215 return STRUCT2PTR(piPerl, m_hostperlMemParse);
218 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
220 return STRUCT2PTR(piPerl, m_hostperlEnv);
223 inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
225 return STRUCT2PTR(piPerl, m_hostperlStdIO);
228 inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
230 return STRUCT2PTR(piPerl, m_hostperlLIO);
233 inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
235 return STRUCT2PTR(piPerl, m_hostperlDir);
238 inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
240 return STRUCT2PTR(piPerl, m_hostperlSock);
243 inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
245 return STRUCT2PTR(piPerl, m_hostperlProc);
251 #define IPERL2HOST(x) IPerlMem2Host(x)
255 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
257 return IPERL2HOST(piPerl)->Malloc(size);
260 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
262 return IPERL2HOST(piPerl)->Realloc(ptr, size);
265 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
267 IPERL2HOST(piPerl)->Free(ptr);
270 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
272 return IPERL2HOST(piPerl)->Calloc(num, size);
276 PerlMemGetLock(struct IPerlMem* piPerl)
278 IPERL2HOST(piPerl)->GetLock();
282 PerlMemFreeLock(struct IPerlMem* piPerl)
284 IPERL2HOST(piPerl)->FreeLock();
288 PerlMemIsLocked(struct IPerlMem* piPerl)
290 return IPERL2HOST(piPerl)->IsLocked();
293 struct IPerlMem perlMem =
305 #define IPERL2HOST(x) IPerlMemShared2Host(x)
309 PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
311 return IPERL2HOST(piPerl)->MallocShared(size);
314 PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
316 return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
319 PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
321 IPERL2HOST(piPerl)->FreeShared(ptr);
324 PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
326 return IPERL2HOST(piPerl)->CallocShared(num, size);
330 PerlMemSharedGetLock(struct IPerlMem* piPerl)
332 IPERL2HOST(piPerl)->GetLockShared();
336 PerlMemSharedFreeLock(struct IPerlMem* piPerl)
338 IPERL2HOST(piPerl)->FreeLockShared();
342 PerlMemSharedIsLocked(struct IPerlMem* piPerl)
344 return IPERL2HOST(piPerl)->IsLockedShared();
347 struct IPerlMem perlMemShared =
350 PerlMemSharedRealloc,
353 PerlMemSharedGetLock,
354 PerlMemSharedFreeLock,
355 PerlMemSharedIsLocked,
359 #define IPERL2HOST(x) IPerlMemParse2Host(x)
363 PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
365 return IPERL2HOST(piPerl)->MallocParse(size);
368 PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
370 return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
373 PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
375 IPERL2HOST(piPerl)->FreeParse(ptr);
378 PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
380 return IPERL2HOST(piPerl)->CallocParse(num, size);
384 PerlMemParseGetLock(struct IPerlMem* piPerl)
386 IPERL2HOST(piPerl)->GetLockParse();
390 PerlMemParseFreeLock(struct IPerlMem* piPerl)
392 IPERL2HOST(piPerl)->FreeLockParse();
396 PerlMemParseIsLocked(struct IPerlMem* piPerl)
398 return IPERL2HOST(piPerl)->IsLockedParse();
401 struct IPerlMem perlMemParse =
408 PerlMemParseFreeLock,
409 PerlMemParseIsLocked,
414 #define IPERL2HOST(x) IPerlEnv2Host(x)
418 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
420 return IPERL2HOST(piPerl)->Getenv(varname);
424 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
426 return IPERL2HOST(piPerl)->Putenv(envstring);
430 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
432 return IPERL2HOST(piPerl)->Getenv(varname, len);
436 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
438 return win32_uname(name);
442 PerlEnvClearenv(struct IPerlEnv* piPerl)
444 IPERL2HOST(piPerl)->Clearenv();
448 PerlEnvGetChildenv(struct IPerlEnv* piPerl)
450 return IPERL2HOST(piPerl)->CreateChildEnv();
454 PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
456 IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
460 PerlEnvGetChilddir(struct IPerlEnv* piPerl)
462 return IPERL2HOST(piPerl)->GetChildDir();
466 PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
468 IPERL2HOST(piPerl)->FreeChildDir(childDir);
472 PerlEnvOsId(struct IPerlEnv* piPerl)
474 return win32_os_id();
478 PerlEnvLibPath(struct IPerlEnv* piPerl, char *pl)
480 return g_win32_get_privlib(pl);
484 PerlEnvSiteLibPath(struct IPerlEnv* piPerl, char *pl)
486 return g_win32_get_sitelib(pl);
489 struct IPerlEnv perlEnv =
506 #define IPERL2HOST(x) IPerlStdIO2Host(x)
510 PerlStdIOStdin(struct IPerlStdIO* piPerl)
512 return (PerlIO*)win32_stdin();
516 PerlStdIOStdout(struct IPerlStdIO* piPerl)
518 return (PerlIO*)win32_stdout();
522 PerlStdIOStderr(struct IPerlStdIO* piPerl)
524 return (PerlIO*)win32_stderr();
528 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
530 return (PerlIO*)win32_fopen(path, mode);
534 PerlStdIOClose(struct IPerlStdIO* piPerl, PerlIO* pf)
536 return win32_fclose(((FILE*)pf));
540 PerlStdIOEof(struct IPerlStdIO* piPerl, PerlIO* pf)
542 return win32_feof((FILE*)pf);
546 PerlStdIOError(struct IPerlStdIO* piPerl, PerlIO* pf)
548 return win32_ferror((FILE*)pf);
552 PerlStdIOClearerr(struct IPerlStdIO* piPerl, PerlIO* pf)
554 win32_clearerr((FILE*)pf);
558 PerlStdIOGetc(struct IPerlStdIO* piPerl, PerlIO* pf)
560 return win32_getc((FILE*)pf);
564 PerlStdIOGetBase(struct IPerlStdIO* piPerl, PerlIO* pf)
575 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, PerlIO* pf)
579 return FILE_bufsiz(f);
586 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, PerlIO* pf)
597 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, PerlIO* pf)
608 PerlStdIOGets(struct IPerlStdIO* piPerl, PerlIO* pf, char* s, int n)
610 return win32_fgets(s, n, (FILE*)pf);
614 PerlStdIOPutc(struct IPerlStdIO* piPerl, PerlIO* pf, int c)
616 return win32_fputc(c, (FILE*)pf);
620 PerlStdIOPuts(struct IPerlStdIO* piPerl, PerlIO* pf, const char *s)
622 return win32_fputs(s, (FILE*)pf);
626 PerlStdIOFlush(struct IPerlStdIO* piPerl, PerlIO* pf)
628 return win32_fflush((FILE*)pf);
632 PerlStdIOUngetc(struct IPerlStdIO* piPerl, PerlIO* pf,int c)
634 return win32_ungetc(c, (FILE*)pf);
638 PerlStdIOFileno(struct IPerlStdIO* piPerl, PerlIO* pf)
640 return win32_fileno((FILE*)pf);
644 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
646 return (PerlIO*)win32_fdopen(fd, mode);
650 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, PerlIO* pf)
652 return (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
656 PerlStdIORead(struct IPerlStdIO* piPerl, PerlIO* pf, void *buffer, Size_t size)
658 return win32_fread(buffer, 1, size, (FILE*)pf);
662 PerlStdIOWrite(struct IPerlStdIO* piPerl, PerlIO* pf, const void *buffer, Size_t size)
664 return win32_fwrite(buffer, 1, size, (FILE*)pf);
668 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, PerlIO* pf, char* buffer)
670 win32_setbuf((FILE*)pf, buffer);
674 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, PerlIO* pf, char* buffer, int type, Size_t size)
676 return win32_setvbuf((FILE*)pf, buffer, type, size);
680 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, PerlIO* pf, int n)
682 #ifdef STDIO_CNT_LVALUE
689 PerlStdIOSetPtrCnt(struct IPerlStdIO* piPerl, PerlIO* pf, char * ptr, int n)
691 #ifdef STDIO_PTR_LVALUE
699 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, PerlIO* pf)
701 win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
705 PerlStdIOPrintf(struct IPerlStdIO* piPerl, PerlIO* pf, const char *format,...)
708 va_start(arglist, format);
709 return win32_vfprintf((FILE*)pf, format, arglist);
713 PerlStdIOVprintf(struct IPerlStdIO* piPerl, PerlIO* pf, const char *format, va_list arglist)
715 return win32_vfprintf((FILE*)pf, format, arglist);
719 PerlStdIOTell(struct IPerlStdIO* piPerl, PerlIO* pf)
721 return win32_ftell((FILE*)pf);
725 PerlStdIOSeek(struct IPerlStdIO* piPerl, PerlIO* pf, off_t offset, int origin)
727 return win32_fseek((FILE*)pf, offset, origin);
731 PerlStdIORewind(struct IPerlStdIO* piPerl, PerlIO* pf)
733 win32_rewind((FILE*)pf);
737 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
739 return (PerlIO*)win32_tmpfile();
743 PerlStdIOGetpos(struct IPerlStdIO* piPerl, PerlIO* pf, Fpos_t *p)
745 return win32_fgetpos((FILE*)pf, p);
749 PerlStdIOSetpos(struct IPerlStdIO* piPerl, PerlIO* pf, const Fpos_t *p)
751 return win32_fsetpos((FILE*)pf, p);
754 PerlStdIOInit(struct IPerlStdIO* piPerl)
759 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
761 Perl_init_os_extras();
765 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags)
767 return win32_open_osfhandle(osfhandle, flags);
771 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
773 return win32_get_osfhandle(filenum);
777 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, PerlIO* pf)
782 int fileno = win32_dup(win32_fileno((FILE*)pf));
784 /* open the file in the same mode */
786 if(((FILE*)pf)->flags & _F_READ) {
790 else if(((FILE*)pf)->flags & _F_WRIT) {
794 else if(((FILE*)pf)->flags & _F_RDWR) {
800 if(((FILE*)pf)->_flag & _IOREAD) {
804 else if(((FILE*)pf)->_flag & _IOWRT) {
808 else if(((FILE*)pf)->_flag & _IORW) {
815 /* it appears that the binmode is attached to the
816 * file descriptor so binmode files will be handled
819 pfdup = (PerlIO*)win32_fdopen(fileno, mode);
821 /* move the file pointer to the same position */
822 if (!fgetpos((FILE*)pf, &pos)) {
823 fsetpos((FILE*)pfdup, &pos);
828 struct IPerlStdIO perlStdIO =
867 PerlStdIOInitOSExtras,
873 #define IPERL2HOST(x) IPerlLIO2Host(x)
877 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
879 return win32_access(path, mode);
883 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
885 return win32_chmod(filename, pmode);
889 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
891 return chown(filename, owner, group);
895 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
897 return chsize(handle, size);
901 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
903 return win32_close(handle);
907 PerlLIODup(struct IPerlLIO* piPerl, int handle)
909 return win32_dup(handle);
913 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
915 return win32_dup2(handle1, handle2);
919 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
921 return win32_flock(fd, oper);
925 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
927 return fstat(handle, buffer);
931 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
933 return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
937 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
943 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
945 return win32_link(oldname, newname);
949 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
951 return win32_lseek(handle, offset, origin);
955 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
957 return win32_stat(path, buffer);
961 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
963 return mktemp(Template);
967 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
969 return win32_open(filename, oflag);
973 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
975 return win32_open(filename, oflag, pmode);
979 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
981 return win32_read(handle, buffer, count);
985 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
987 return win32_rename(OldFileName, newname);
991 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
993 return win32_setmode(handle, mode);
997 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
999 return win32_stat(path, buffer);
1003 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1005 return tmpnam(string);
1009 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1011 return umask(pmode);
1015 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1017 return win32_unlink(filename);
1021 PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
1023 return win32_utime(filename, times);
1027 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1029 return win32_write(handle, buffer, count);
1032 struct IPerlLIO perlLIO =
1064 #define IPERL2HOST(x) IPerlDir2Host(x)
1068 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1070 return win32_mkdir(dirname, mode);
1074 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1076 return IPERL2HOST(piPerl)->Chdir(dirname);
1080 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1082 return win32_rmdir(dirname);
1086 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1088 return win32_closedir(dirp);
1092 PerlDirOpen(struct IPerlDir* piPerl, char *filename)
1094 return win32_opendir(filename);
1098 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1100 return win32_readdir(dirp);
1104 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1106 win32_rewinddir(dirp);
1110 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1112 win32_seekdir(dirp, loc);
1116 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1118 return win32_telldir(dirp);
1122 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1124 return IPERL2HOST(piPerl)->MapPathA(path);
1128 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1130 return IPERL2HOST(piPerl)->MapPathW(path);
1133 struct IPerlDir perlDir =
1151 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1153 return win32_htonl(hostlong);
1157 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1159 return win32_htons(hostshort);
1163 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1165 return win32_ntohl(netlong);
1169 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1171 return win32_ntohs(netshort);
1174 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1176 return win32_accept(s, addr, addrlen);
1180 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1182 return win32_bind(s, name, namelen);
1186 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1188 return win32_connect(s, name, namelen);
1192 PerlSockEndhostent(struct IPerlSock* piPerl)
1198 PerlSockEndnetent(struct IPerlSock* piPerl)
1204 PerlSockEndprotoent(struct IPerlSock* piPerl)
1206 win32_endprotoent();
1210 PerlSockEndservent(struct IPerlSock* piPerl)
1216 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1218 return win32_gethostbyaddr(addr, len, type);
1222 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1224 return win32_gethostbyname(name);
1228 PerlSockGethostent(struct IPerlSock* piPerl)
1231 Perl_croak(aTHX_ "gethostent not implemented!\n");
1236 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1238 return win32_gethostname(name, namelen);
1242 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1244 return win32_getnetbyaddr(net, type);
1248 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1250 return win32_getnetbyname((char*)name);
1254 PerlSockGetnetent(struct IPerlSock* piPerl)
1256 return win32_getnetent();
1259 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1261 return win32_getpeername(s, name, namelen);
1265 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1267 return win32_getprotobyname(name);
1271 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1273 return win32_getprotobynumber(number);
1277 PerlSockGetprotoent(struct IPerlSock* piPerl)
1279 return win32_getprotoent();
1283 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1285 return win32_getservbyname(name, proto);
1289 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1291 return win32_getservbyport(port, proto);
1295 PerlSockGetservent(struct IPerlSock* piPerl)
1297 return win32_getservent();
1301 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1303 return win32_getsockname(s, name, namelen);
1307 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1309 return win32_getsockopt(s, level, optname, optval, optlen);
1313 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1315 return win32_inet_addr(cp);
1319 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1321 return win32_inet_ntoa(in);
1325 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1327 return win32_listen(s, backlog);
1331 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1333 return win32_recv(s, buffer, len, flags);
1337 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1339 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1343 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1345 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1349 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1351 return win32_send(s, buffer, len, flags);
1355 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1357 return win32_sendto(s, buffer, len, flags, to, tolen);
1361 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1363 win32_sethostent(stayopen);
1367 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1369 win32_setnetent(stayopen);
1373 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1375 win32_setprotoent(stayopen);
1379 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1381 win32_setservent(stayopen);
1385 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1387 return win32_setsockopt(s, level, optname, optval, optlen);
1391 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1393 return win32_shutdown(s, how);
1397 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1399 return win32_socket(af, type, protocol);
1403 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1406 Perl_croak(aTHX_ "socketpair not implemented!\n");
1411 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1413 return win32_closesocket(s);
1417 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1419 return win32_ioctlsocket(s, cmd, argp);
1422 struct IPerlSock perlSock =
1433 PerlSockEndprotoent,
1435 PerlSockGethostname,
1436 PerlSockGetpeername,
1437 PerlSockGethostbyaddr,
1438 PerlSockGethostbyname,
1440 PerlSockGetnetbyaddr,
1441 PerlSockGetnetbyname,
1443 PerlSockGetprotobyname,
1444 PerlSockGetprotobynumber,
1445 PerlSockGetprotoent,
1446 PerlSockGetservbyname,
1447 PerlSockGetservbyport,
1449 PerlSockGetsockname,
1461 PerlSockSetprotoent,
1467 PerlSockClosesocket,
1473 #define EXECF_EXEC 1
1474 #define EXECF_SPAWN 2
1477 PerlProcAbort(struct IPerlProc* piPerl)
1483 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1485 return win32_crypt(clear, salt);
1489 PerlProcExit(struct IPerlProc* piPerl, int status)
1495 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1501 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1503 return execl(cmdname, arg0, arg1, arg2, arg3);
1507 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1509 return win32_execvp(cmdname, argv);
1513 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1515 return win32_execvp(cmdname, argv);
1519 PerlProcGetuid(struct IPerlProc* piPerl)
1525 PerlProcGeteuid(struct IPerlProc* piPerl)
1531 PerlProcGetgid(struct IPerlProc* piPerl)
1537 PerlProcGetegid(struct IPerlProc* piPerl)
1543 PerlProcGetlogin(struct IPerlProc* piPerl)
1545 return g_getlogin();
1549 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1551 return win32_kill(pid, sig);
1555 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1558 Perl_croak(aTHX_ "killpg not implemented!\n");
1563 PerlProcPauseProc(struct IPerlProc* piPerl)
1565 return win32_sleep((32767L << 16) + 32767);
1569 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1572 PERL_FLUSHALL_FOR_CHILD;
1573 return (PerlIO*)win32_popen(command, mode);
1577 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1579 return win32_pclose((FILE*)stream);
1583 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1585 return win32_pipe(phandles, 512, O_BINARY);
1589 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1595 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1601 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1603 return win32_sleep(s);
1607 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1609 return win32_times(timebuf);
1613 PerlProcWait(struct IPerlProc* piPerl, int *status)
1615 return win32_wait(status);
1619 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1621 return win32_waitpid(pid, status, flags);
1625 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1631 static THREAD_RET_TYPE
1632 win32_start_child(LPVOID arg)
1634 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1638 CPerlObj *pPerl = (CPerlObj*)my_perl;
1640 #ifdef PERL_SYNC_FORK
1641 static long sync_fork_id = 0;
1642 long id = ++sync_fork_id;
1646 PERL_SET_INTERP(my_perl);
1648 /* set $$ to pseudo id */
1649 #ifdef PERL_SYNC_FORK
1652 w32_pseudo_id = GetCurrentThreadId();
1654 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
1655 sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
1656 hv_clear(PL_pidstatus);
1658 /* push a zero on the stack (we are the child) */
1666 /* continue from next op */
1667 PL_op = PL_op->op_next;
1671 volatile int oldscope = PL_scopestack_ix;
1674 JMPENV_PUSH(status);
1681 while (PL_scopestack_ix > oldscope)
1684 PL_curstash = PL_defstash;
1685 if (PL_endav && !PL_minus_c)
1686 call_list(oldscope, PL_endav);
1687 status = STATUS_NATIVE_EXPORT;
1691 POPSTACK_TO(PL_mainstack);
1692 PL_op = PL_restartop;
1693 PL_restartop = Nullop;
1696 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1703 /* XXX hack to avoid perl_destruct() freeing optree */
1704 PL_main_root = Nullop;
1707 /* destroy everything (waits for any pseudo-forked children) */
1708 perl_destruct(my_perl);
1711 #ifdef PERL_SYNC_FORK
1714 return (DWORD)status;
1717 #endif /* USE_ITHREADS */
1720 PerlProcFork(struct IPerlProc* piPerl)
1726 CPerlHost *h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1727 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHXo, 1,
1729 h->m_pHostperlMemShared,
1730 h->m_pHostperlMemParse,
1732 h->m_pHostperlStdIO,
1738 new_perl->Isys_intern.internal_host = h;
1739 # ifdef PERL_SYNC_FORK
1740 id = win32_start_child((LPVOID)new_perl);
1741 PERL_SET_INTERP(aTHXo);
1743 # ifdef USE_RTL_THREAD_API
1744 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1745 (void*)new_perl, 0, (unsigned*)&id);
1747 handle = CreateThread(NULL, 0, win32_start_child,
1748 (LPVOID)new_perl, 0, &id);
1750 PERL_SET_INTERP(aTHXo); /* XXX perl_clone*() set TLS */
1752 Perl_croak(aTHX_ "panic: pseudo fork() failed");
1753 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1754 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1755 ++w32_num_pseudo_children;
1759 Perl_croak(aTHX_ "fork() not implemented!\n");
1761 #endif /* USE_ITHREADS */
1765 PerlProcGetpid(struct IPerlProc* piPerl)
1767 return win32_getpid();
1771 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1773 return win32_dynaload(filename);
1777 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1779 win32_str_os_error(sv, dwErr);
1783 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1785 do_spawn2(cmd, EXECF_EXEC);
1790 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1792 return do_spawn2(cmds, EXECF_SPAWN);
1796 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1798 return win32_spawnvp(mode, cmdname, argv);
1802 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1804 return do_aspawn(vreally, vmark, vsp);
1807 struct IPerlProc perlProc =
1849 CPerlHost::CPerlHost(void)
1851 m_pvDir = new VDir();
1852 m_pVMem = new VMem();
1853 m_pVMemShared = new VMem();
1854 m_pVMemParse = new VMem();
1856 m_pvDir->Init(NULL, m_pVMem);
1859 m_lppEnvList = NULL;
1861 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1862 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1863 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1864 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1865 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1866 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1867 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1868 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1869 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1871 m_pHostperlMem = &m_hostperlMem;
1872 m_pHostperlMemShared = &m_hostperlMemShared;
1873 m_pHostperlMemParse = &m_hostperlMemParse;
1874 m_pHostperlEnv = &m_hostperlEnv;
1875 m_pHostperlStdIO = &m_hostperlStdIO;
1876 m_pHostperlLIO = &m_hostperlLIO;
1877 m_pHostperlDir = &m_hostperlDir;
1878 m_pHostperlSock = &m_hostperlSock;
1879 m_pHostperlProc = &m_hostperlProc;
1882 #define SETUPEXCHANGE(xptr, iptr, table) \
1893 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1894 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1895 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1896 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1897 struct IPerlProc** ppProc)
1899 m_pvDir = new VDir(0);
1900 m_pVMem = new VMem();
1901 m_pVMemShared = new VMem();
1902 m_pVMemParse = new VMem();
1904 m_pvDir->Init(NULL, m_pVMem);
1907 m_lppEnvList = NULL;
1909 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1910 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1911 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1912 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1913 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1914 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1915 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1916 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1917 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1919 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
1920 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
1921 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
1922 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
1923 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
1924 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
1925 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
1926 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
1927 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
1929 #undef SETUPEXCHANGE
1931 CPerlHost::CPerlHost(CPerlHost& host)
1933 m_pVMem = new VMem();
1934 m_pVMemShared = host.GetMemShared();
1935 m_pVMemParse = host.GetMemParse();
1937 /* duplicate directory info */
1938 m_pvDir = new VDir(0);
1939 m_pvDir->Init(host.GetDir(), m_pVMem);
1941 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1942 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1943 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1944 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1945 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1946 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1947 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1948 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1949 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1950 m_pHostperlMem = &m_hostperlMem;
1951 m_pHostperlMemShared = &m_hostperlMemShared;
1952 m_pHostperlMemParse = &m_hostperlMemParse;
1953 m_pHostperlEnv = &m_hostperlEnv;
1954 m_pHostperlStdIO = &m_hostperlStdIO;
1955 m_pHostperlLIO = &m_hostperlLIO;
1956 m_pHostperlDir = &m_hostperlDir;
1957 m_pHostperlSock = &m_hostperlSock;
1958 m_pHostperlProc = &m_hostperlProc;
1961 m_lppEnvList = NULL;
1963 /* duplicate environment info */
1966 while(lpPtr = host.GetIndex(dwIndex))
1970 CPerlHost::~CPerlHost(void)
1974 m_pVMemParse->Release();
1975 m_pVMemShared->Release();
1980 CPerlHost::Find(LPCSTR lpStr)
1983 LPSTR* lppPtr = Lookup(lpStr);
1984 if(lppPtr != NULL) {
1985 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
1997 lookup(const void *arg1, const void *arg2)
1998 { // Compare strings
2002 ptr1 = *(char**)arg1;
2003 ptr2 = *(char**)arg2;
2007 if(c1 == '\0' || c1 == '=') {
2008 if(c2 == '\0' || c2 == '=')
2011 return -1; // string 1 < string 2
2013 else if(c2 == '\0' || c2 == '=')
2014 return 1; // string 1 > string 2
2020 return -1; // string 1 < string 2
2022 return 1; // string 1 > string 2
2030 CPerlHost::Lookup(LPCSTR lpStr)
2032 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2036 compare(const void *arg1, const void *arg2)
2037 { // Compare strings
2041 ptr1 = *(char**)arg1;
2042 ptr2 = *(char**)arg2;
2046 if(c1 == '\0' || c1 == '=') {
2050 return -1; // string 1 < string 2
2052 else if(c2 == '\0' || c2 == '=')
2053 return 1; // string 1 > string 2
2059 return -1; // string 1 < string 2
2061 return 1; // string 1 > string 2
2069 CPerlHost::Add(LPCSTR lpStr)
2072 char szBuffer[1024];
2074 int index, length = strlen(lpStr)+1;
2076 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2077 szBuffer[index] = lpStr[index];
2079 szBuffer[index] = '\0';
2082 lpPtr = Lookup(szBuffer);
2084 Renew(*lpPtr, length, char);
2085 strcpy(*lpPtr, lpStr);
2089 Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2090 New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2091 if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2092 strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2093 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2101 CPerlHost::CalculateEnvironmentSpace(void)
2105 for(index = 0; index < m_dwEnvCount; ++index)
2106 dwSize += strlen(m_lppEnvList[index]) + 1;
2112 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2119 CPerlHost::GetChildDir(void)
2124 New(0, ptr, MAX_PATH+1, char);
2126 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2127 length = strlen(ptr)-1;
2129 if((ptr[length] == '\\') || (ptr[length] == '/'))
2137 CPerlHost::FreeChildDir(char* pStr)
2144 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2147 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2148 DWORD dwSize, dwEnvIndex;
2149 int nLength, compVal;
2151 // get the process environment strings
2152 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2154 // step over current directory stuff
2155 while(*lpTmp == '=')
2156 lpTmp += strlen(lpTmp) + 1;
2158 // save the start of the environment strings
2160 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2161 // calculate the size of the environment strings
2162 dwSize += strlen(lpTmp) + 1;
2165 // add the size of current directories
2166 dwSize += vDir.CalculateEnvironmentSpace();
2168 // add the additional space used by changes made to the environment
2169 dwSize += CalculateEnvironmentSpace();
2171 New(1, lpStr, dwSize, char);
2174 // build the local environment
2175 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2178 lpLocalEnv = GetIndex(dwEnvIndex);
2179 while(*lpEnvPtr != '\0') {
2180 if(lpLocalEnv == NULL) {
2181 // all environment overrides have been added
2182 // so copy string into place
2183 strcpy(lpStr, lpEnvPtr);
2184 nLength = strlen(lpEnvPtr) + 1;
2186 lpEnvPtr += nLength;
2189 // determine which string to copy next
2190 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2192 strcpy(lpStr, lpEnvPtr);
2193 nLength = strlen(lpEnvPtr) + 1;
2195 lpEnvPtr += nLength;
2198 char *ptr = strchr(lpLocalEnv, '=');
2200 strcpy(lpStr, lpLocalEnv);
2201 lpStr += strlen(lpLocalEnv) + 1;
2203 lpLocalEnv = GetIndex(dwEnvIndex);
2205 // this string was replaced
2206 lpEnvPtr += strlen(lpEnvPtr) + 1;
2216 // release the process environment strings
2217 FreeEnvironmentStrings(lpAllocPtr);
2223 CPerlHost::Reset(void)
2226 if(m_lppEnvList != NULL) {
2227 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2228 Safefree(m_lppEnvList[index]);
2229 m_lppEnvList[index] = NULL;
2236 CPerlHost::Clearenv(void)
2239 LPSTR lpPtr, lpStr, lpEnvPtr;
2240 if(m_lppEnvList != NULL) {
2241 /* set every entry to an empty string */
2242 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2243 char* ptr = strchr(m_lppEnvList[index], '=');
2250 /* get the process environment strings */
2251 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2253 /* step over current directory stuff */
2254 while(*lpStr == '=')
2255 lpStr += strlen(lpStr) + 1;
2258 lpPtr = strchr(lpStr, '=');
2265 lpStr += strlen(lpStr) + 1;
2268 FreeEnvironmentStrings(lpEnvPtr);
2273 CPerlHost::Getenv(const char *varname)
2275 char* pEnv = Find(varname);
2277 pEnv = win32_getenv(varname);
2288 CPerlHost::Putenv(const char *envstring)
2295 CPerlHost::Chdir(const char *dirname)
2300 WCHAR wBuffer[MAX_PATH];
2301 A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2302 ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2305 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2312 #endif /* ___PerlHost_H___ */