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___
19 extern char * g_win32_get_privlib(const char *pl);
20 extern char * g_win32_get_sitelib(const char *pl);
21 extern char * g_win32_get_vendorlib(const char *pl);
22 extern char * g_getlogin(void);
23 extern int do_spawn2(char *cmd, int exectype);
31 CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
32 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
33 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
34 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
35 struct IPerlProc** ppProc);
36 CPerlHost(CPerlHost& host);
39 static CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl);
40 static CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl);
41 static CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl);
42 static CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl);
43 static CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl);
44 static CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl);
45 static CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl);
46 static CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl);
47 static CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl);
49 BOOL PerlCreate(void);
50 int PerlParse(int argc, char** argv, char** env);
52 void PerlDestroy(void);
55 /* Locks provided but should be unnecessary as this is private pool */
56 inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
57 inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
58 inline void Free(void* ptr) { m_pVMem->Free(ptr); };
59 inline void* Calloc(size_t num, size_t size)
61 size_t count = num*size;
62 void* lpVoid = Malloc(count);
64 ZeroMemory(lpVoid, count);
67 inline void GetLock(void) { m_pVMem->GetLock(); };
68 inline void FreeLock(void) { m_pVMem->FreeLock(); };
69 inline int IsLocked(void) { return m_pVMem->IsLocked(); };
72 /* Locks used to serialize access to the pool */
73 inline void GetLockShared(void) { m_pVMemShared->GetLock(); };
74 inline void FreeLockShared(void) { m_pVMemShared->FreeLock(); };
75 inline int IsLockedShared(void) { return m_pVMemShared->IsLocked(); };
76 inline void* MallocShared(size_t size)
80 result = m_pVMemShared->Malloc(size);
84 inline void* ReallocShared(void* ptr, size_t size)
88 result = m_pVMemShared->Realloc(ptr, size);
92 inline void FreeShared(void* ptr)
95 m_pVMemShared->Free(ptr);
98 inline void* CallocShared(size_t num, size_t size)
100 size_t count = num*size;
101 void* lpVoid = MallocShared(count);
103 ZeroMemory(lpVoid, count);
108 /* Assume something else is using locks to mangaging serialize
111 inline void GetLockParse(void) { m_pVMemParse->GetLock(); };
112 inline void FreeLockParse(void) { m_pVMemParse->FreeLock(); };
113 inline int IsLockedParse(void) { return m_pVMemParse->IsLocked(); };
114 inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
115 inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
116 inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
117 inline void* CallocParse(size_t num, size_t size)
119 size_t count = num*size;
120 void* lpVoid = MallocParse(count);
122 ZeroMemory(lpVoid, count);
127 char *Getenv(const char *varname);
128 int Putenv(const char *envstring);
129 inline char *Getenv(const char *varname, unsigned long *len)
132 char *e = Getenv(varname);
137 void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
138 void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
139 char* GetChildDir(void);
140 void FreeChildDir(char* pStr);
144 inline LPSTR GetIndex(DWORD &dwIndex)
146 if(dwIndex < m_dwEnvCount)
149 return m_lppEnvList[dwIndex-1];
155 LPSTR Find(LPCSTR lpStr);
156 void Add(LPCSTR lpStr);
158 LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
159 void FreeLocalEnvironmentStrings(LPSTR lpStr);
160 LPSTR* Lookup(LPCSTR lpStr);
161 DWORD CalculateEnvironmentSpace(void);
166 virtual int Chdir(const char *dirname);
170 void Exit(int status);
171 void _Exit(int status);
172 int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
173 int Execv(const char *cmdname, const char *const *argv);
174 int Execvp(const char *cmdname, const char *const *argv);
176 inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
177 inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
178 inline VDir* GetDir(void) { return m_pvDir; };
182 struct IPerlMem m_hostperlMem;
183 struct IPerlMem m_hostperlMemShared;
184 struct IPerlMem m_hostperlMemParse;
185 struct IPerlEnv m_hostperlEnv;
186 struct IPerlStdIO m_hostperlStdIO;
187 struct IPerlLIO m_hostperlLIO;
188 struct IPerlDir m_hostperlDir;
189 struct IPerlSock m_hostperlSock;
190 struct IPerlProc m_hostperlProc;
192 struct IPerlMem* m_pHostperlMem;
193 struct IPerlMem* m_pHostperlMemShared;
194 struct IPerlMem* m_pHostperlMemParse;
195 struct IPerlEnv* m_pHostperlEnv;
196 struct IPerlStdIO* m_pHostperlStdIO;
197 struct IPerlLIO* m_pHostperlLIO;
198 struct IPerlDir* m_pHostperlDir;
199 struct IPerlSock* m_pHostperlSock;
200 struct IPerlProc* m_pHostperlProc;
202 inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
203 inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
213 BOOL m_bTopLevel; // is this a toplevel host?
214 static long num_hosts;
216 inline int LastHost(void) { return num_hosts == 1L; };
219 long CPerlHost::num_hosts = 0L;
222 #define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
224 inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
226 return STRUCT2PTR(piPerl, m_hostperlMem);
229 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
231 return STRUCT2PTR(piPerl, m_hostperlMemShared);
234 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
236 return STRUCT2PTR(piPerl, m_hostperlMemParse);
239 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
241 return STRUCT2PTR(piPerl, m_hostperlEnv);
244 inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
246 return STRUCT2PTR(piPerl, m_hostperlStdIO);
249 inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
251 return STRUCT2PTR(piPerl, m_hostperlLIO);
254 inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
256 return STRUCT2PTR(piPerl, m_hostperlDir);
259 inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
261 return STRUCT2PTR(piPerl, m_hostperlSock);
264 inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
266 return STRUCT2PTR(piPerl, m_hostperlProc);
272 #define IPERL2HOST(x) IPerlMem2Host(x)
276 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
278 return IPERL2HOST(piPerl)->Malloc(size);
281 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
283 return IPERL2HOST(piPerl)->Realloc(ptr, size);
286 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
288 IPERL2HOST(piPerl)->Free(ptr);
291 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
293 return IPERL2HOST(piPerl)->Calloc(num, size);
297 PerlMemGetLock(struct IPerlMem* piPerl)
299 IPERL2HOST(piPerl)->GetLock();
303 PerlMemFreeLock(struct IPerlMem* piPerl)
305 IPERL2HOST(piPerl)->FreeLock();
309 PerlMemIsLocked(struct IPerlMem* piPerl)
311 return IPERL2HOST(piPerl)->IsLocked();
314 struct IPerlMem perlMem =
326 #define IPERL2HOST(x) IPerlMemShared2Host(x)
330 PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
332 return IPERL2HOST(piPerl)->MallocShared(size);
335 PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
337 return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
340 PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
342 IPERL2HOST(piPerl)->FreeShared(ptr);
345 PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
347 return IPERL2HOST(piPerl)->CallocShared(num, size);
351 PerlMemSharedGetLock(struct IPerlMem* piPerl)
353 IPERL2HOST(piPerl)->GetLockShared();
357 PerlMemSharedFreeLock(struct IPerlMem* piPerl)
359 IPERL2HOST(piPerl)->FreeLockShared();
363 PerlMemSharedIsLocked(struct IPerlMem* piPerl)
365 return IPERL2HOST(piPerl)->IsLockedShared();
368 struct IPerlMem perlMemShared =
371 PerlMemSharedRealloc,
374 PerlMemSharedGetLock,
375 PerlMemSharedFreeLock,
376 PerlMemSharedIsLocked,
380 #define IPERL2HOST(x) IPerlMemParse2Host(x)
384 PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
386 return IPERL2HOST(piPerl)->MallocParse(size);
389 PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
391 return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
394 PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
396 IPERL2HOST(piPerl)->FreeParse(ptr);
399 PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
401 return IPERL2HOST(piPerl)->CallocParse(num, size);
405 PerlMemParseGetLock(struct IPerlMem* piPerl)
407 IPERL2HOST(piPerl)->GetLockParse();
411 PerlMemParseFreeLock(struct IPerlMem* piPerl)
413 IPERL2HOST(piPerl)->FreeLockParse();
417 PerlMemParseIsLocked(struct IPerlMem* piPerl)
419 return IPERL2HOST(piPerl)->IsLockedParse();
422 struct IPerlMem perlMemParse =
429 PerlMemParseFreeLock,
430 PerlMemParseIsLocked,
435 #define IPERL2HOST(x) IPerlEnv2Host(x)
439 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
441 return IPERL2HOST(piPerl)->Getenv(varname);
445 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
447 return IPERL2HOST(piPerl)->Putenv(envstring);
451 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
453 return IPERL2HOST(piPerl)->Getenv(varname, len);
457 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
459 return win32_uname(name);
463 PerlEnvClearenv(struct IPerlEnv* piPerl)
465 IPERL2HOST(piPerl)->Clearenv();
469 PerlEnvGetChildenv(struct IPerlEnv* piPerl)
471 return IPERL2HOST(piPerl)->CreateChildEnv();
475 PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
477 IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
481 PerlEnvGetChilddir(struct IPerlEnv* piPerl)
483 return IPERL2HOST(piPerl)->GetChildDir();
487 PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
489 IPERL2HOST(piPerl)->FreeChildDir(childDir);
493 PerlEnvOsId(struct IPerlEnv* piPerl)
495 return win32_os_id();
499 PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
501 return g_win32_get_privlib(pl);
505 PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
507 return g_win32_get_sitelib(pl);
511 PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
513 return g_win32_get_vendorlib(pl);
517 PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
519 win32_get_child_IO(ptr);
522 struct IPerlEnv perlEnv =
536 PerlEnvVendorLibPath,
541 #define IPERL2HOST(x) IPerlStdIO2Host(x)
545 PerlStdIOStdin(struct IPerlStdIO* piPerl)
547 return win32_stdin();
551 PerlStdIOStdout(struct IPerlStdIO* piPerl)
553 return win32_stdout();
557 PerlStdIOStderr(struct IPerlStdIO* piPerl)
559 return win32_stderr();
563 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
565 return win32_fopen(path, mode);
569 PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf)
571 return win32_fclose((pf));
575 PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf)
577 return win32_feof(pf);
581 PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf)
583 return win32_ferror(pf);
587 PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf)
593 PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf)
595 return win32_getc(pf);
599 PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf)
610 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf)
614 return FILE_bufsiz(f);
621 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf)
632 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
643 PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n)
645 return win32_fgets(s, n, pf);
649 PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c)
651 return win32_fputc(c, pf);
655 PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s)
657 return win32_fputs(s, pf);
661 PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf)
663 return win32_fflush(pf);
667 PerlStdIOUngetc(struct IPerlStdIO* piPerl,int c, FILE* pf)
669 return win32_ungetc(c, pf);
673 PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf)
675 return win32_fileno(pf);
679 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
681 return win32_fdopen(fd, mode);
685 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf)
687 return win32_freopen(path, mode, (FILE*)pf);
691 PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf)
693 return win32_fread(buffer, size, count, pf);
697 PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf)
699 return win32_fwrite(buffer, size, count, pf);
703 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer)
705 win32_setbuf(pf, buffer);
709 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size)
711 return win32_setvbuf(pf, buffer, type, size);
715 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n)
717 #ifdef STDIO_CNT_LVALUE
724 PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr)
726 #ifdef STDIO_PTR_LVALUE
733 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf)
735 win32_setvbuf(pf, NULL, _IOLBF, 0);
739 PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...)
742 va_start(arglist, format);
743 return win32_vfprintf(pf, format, arglist);
747 PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist)
749 return win32_vfprintf(pf, format, arglist);
753 PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf)
755 return win32_ftell(pf);
759 PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, off_t offset, int origin)
761 return win32_fseek(pf, offset, origin);
765 PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf)
771 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
773 return win32_tmpfile();
777 PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p)
779 return win32_fgetpos(pf, p);
783 PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p)
785 return win32_fsetpos(pf, p);
788 PerlStdIOInit(struct IPerlStdIO* piPerl)
793 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
795 Perl_init_os_extras();
799 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags)
801 return win32_open_osfhandle(osfhandle, flags);
805 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
807 return win32_get_osfhandle(filenum);
811 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
816 int fileno = win32_dup(win32_fileno(pf));
818 /* open the file in the same mode */
820 if((pf)->flags & _F_READ) {
824 else if((pf)->flags & _F_WRIT) {
828 else if((pf)->flags & _F_RDWR) {
834 if((pf)->_flag & _IOREAD) {
838 else if((pf)->_flag & _IOWRT) {
842 else if((pf)->_flag & _IORW) {
849 /* it appears that the binmode is attached to the
850 * file descriptor so binmode files will be handled
853 pfdup = win32_fdopen(fileno, mode);
855 /* move the file pointer to the same position */
856 if (!fgetpos(pf, &pos)) {
857 fsetpos(pfdup, &pos);
862 struct IPerlStdIO perlStdIO =
901 PerlStdIOInitOSExtras,
907 #define IPERL2HOST(x) IPerlLIO2Host(x)
911 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
913 return win32_access(path, mode);
917 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
919 return win32_chmod(filename, pmode);
923 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
925 return chown(filename, owner, group);
929 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
931 return chsize(handle, size);
935 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
937 return win32_close(handle);
941 PerlLIODup(struct IPerlLIO* piPerl, int handle)
943 return win32_dup(handle);
947 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
949 return win32_dup2(handle1, handle2);
953 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
955 return win32_flock(fd, oper);
959 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
961 return win32_fstat(handle, buffer);
965 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
967 return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
971 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
977 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
979 return win32_link(oldname, newname);
983 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
985 return win32_lseek(handle, offset, origin);
989 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
991 return win32_stat(path, buffer);
995 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
997 return mktemp(Template);
1001 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
1003 return win32_open(filename, oflag);
1007 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
1009 return win32_open(filename, oflag, pmode);
1013 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
1015 return win32_read(handle, buffer, count);
1019 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
1021 return win32_rename(OldFileName, newname);
1025 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1027 return win32_setmode(handle, mode);
1031 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
1033 return win32_stat(path, buffer);
1037 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1039 return tmpnam(string);
1043 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1045 return umask(pmode);
1049 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1051 return win32_unlink(filename);
1055 PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
1057 return win32_utime(filename, times);
1061 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1063 return win32_write(handle, buffer, count);
1066 struct IPerlLIO perlLIO =
1098 #define IPERL2HOST(x) IPerlDir2Host(x)
1102 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1104 return win32_mkdir(dirname, mode);
1108 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1110 return IPERL2HOST(piPerl)->Chdir(dirname);
1114 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1116 return win32_rmdir(dirname);
1120 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1122 return win32_closedir(dirp);
1126 PerlDirOpen(struct IPerlDir* piPerl, char *filename)
1128 return win32_opendir(filename);
1132 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1134 return win32_readdir(dirp);
1138 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1140 win32_rewinddir(dirp);
1144 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1146 win32_seekdir(dirp, loc);
1150 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1152 return win32_telldir(dirp);
1156 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1158 return IPERL2HOST(piPerl)->MapPathA(path);
1162 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1164 return IPERL2HOST(piPerl)->MapPathW(path);
1167 struct IPerlDir perlDir =
1185 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1187 return win32_htonl(hostlong);
1191 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1193 return win32_htons(hostshort);
1197 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1199 return win32_ntohl(netlong);
1203 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1205 return win32_ntohs(netshort);
1208 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1210 return win32_accept(s, addr, addrlen);
1214 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1216 return win32_bind(s, name, namelen);
1220 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1222 return win32_connect(s, name, namelen);
1226 PerlSockEndhostent(struct IPerlSock* piPerl)
1232 PerlSockEndnetent(struct IPerlSock* piPerl)
1238 PerlSockEndprotoent(struct IPerlSock* piPerl)
1240 win32_endprotoent();
1244 PerlSockEndservent(struct IPerlSock* piPerl)
1250 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1252 return win32_gethostbyaddr(addr, len, type);
1256 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1258 return win32_gethostbyname(name);
1262 PerlSockGethostent(struct IPerlSock* piPerl)
1265 Perl_croak(aTHX_ "gethostent not implemented!\n");
1270 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1272 return win32_gethostname(name, namelen);
1276 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1278 return win32_getnetbyaddr(net, type);
1282 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1284 return win32_getnetbyname((char*)name);
1288 PerlSockGetnetent(struct IPerlSock* piPerl)
1290 return win32_getnetent();
1293 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1295 return win32_getpeername(s, name, namelen);
1299 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1301 return win32_getprotobyname(name);
1305 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1307 return win32_getprotobynumber(number);
1311 PerlSockGetprotoent(struct IPerlSock* piPerl)
1313 return win32_getprotoent();
1317 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1319 return win32_getservbyname(name, proto);
1323 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1325 return win32_getservbyport(port, proto);
1329 PerlSockGetservent(struct IPerlSock* piPerl)
1331 return win32_getservent();
1335 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1337 return win32_getsockname(s, name, namelen);
1341 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1343 return win32_getsockopt(s, level, optname, optval, optlen);
1347 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1349 return win32_inet_addr(cp);
1353 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1355 return win32_inet_ntoa(in);
1359 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1361 return win32_listen(s, backlog);
1365 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1367 return win32_recv(s, buffer, len, flags);
1371 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1373 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1377 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1379 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1383 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1385 return win32_send(s, buffer, len, flags);
1389 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1391 return win32_sendto(s, buffer, len, flags, to, tolen);
1395 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1397 win32_sethostent(stayopen);
1401 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1403 win32_setnetent(stayopen);
1407 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1409 win32_setprotoent(stayopen);
1413 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1415 win32_setservent(stayopen);
1419 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1421 return win32_setsockopt(s, level, optname, optval, optlen);
1425 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1427 return win32_shutdown(s, how);
1431 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1433 return win32_socket(af, type, protocol);
1437 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1440 Perl_croak(aTHX_ "socketpair not implemented!\n");
1445 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1447 return win32_closesocket(s);
1451 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1453 return win32_ioctlsocket(s, cmd, argp);
1456 struct IPerlSock perlSock =
1467 PerlSockEndprotoent,
1469 PerlSockGethostname,
1470 PerlSockGetpeername,
1471 PerlSockGethostbyaddr,
1472 PerlSockGethostbyname,
1474 PerlSockGetnetbyaddr,
1475 PerlSockGetnetbyname,
1477 PerlSockGetprotobyname,
1478 PerlSockGetprotobynumber,
1479 PerlSockGetprotoent,
1480 PerlSockGetservbyname,
1481 PerlSockGetservbyport,
1483 PerlSockGetsockname,
1495 PerlSockSetprotoent,
1501 PerlSockClosesocket,
1507 #define EXECF_EXEC 1
1508 #define EXECF_SPAWN 2
1511 PerlProcAbort(struct IPerlProc* piPerl)
1517 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1519 return win32_crypt(clear, salt);
1523 PerlProcExit(struct IPerlProc* piPerl, int status)
1529 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1535 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1537 return execl(cmdname, arg0, arg1, arg2, arg3);
1541 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1543 return win32_execvp(cmdname, argv);
1547 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1549 return win32_execvp(cmdname, argv);
1553 PerlProcGetuid(struct IPerlProc* piPerl)
1559 PerlProcGeteuid(struct IPerlProc* piPerl)
1565 PerlProcGetgid(struct IPerlProc* piPerl)
1571 PerlProcGetegid(struct IPerlProc* piPerl)
1577 PerlProcGetlogin(struct IPerlProc* piPerl)
1579 return g_getlogin();
1583 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1585 return win32_kill(pid, sig);
1589 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1592 Perl_croak(aTHX_ "killpg not implemented!\n");
1597 PerlProcPauseProc(struct IPerlProc* piPerl)
1599 return win32_sleep((32767L << 16) + 32767);
1603 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1606 PERL_FLUSHALL_FOR_CHILD;
1607 return win32_popen(command, mode);
1611 PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
1614 PERL_FLUSHALL_FOR_CHILD;
1615 return win32_popenlist(mode, narg, args);
1619 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1621 return win32_pclose(stream);
1625 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1627 return win32_pipe(phandles, 512, O_BINARY);
1631 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1637 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1643 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1645 return win32_sleep(s);
1649 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1651 return win32_times(timebuf);
1655 PerlProcWait(struct IPerlProc* piPerl, int *status)
1657 return win32_wait(status);
1661 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1663 return win32_waitpid(pid, status, flags);
1667 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1669 return signal(sig, subcode);
1673 static THREAD_RET_TYPE
1674 win32_start_child(LPVOID arg)
1676 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1679 #ifdef PERL_SYNC_FORK
1680 static long sync_fork_id = 0;
1681 long id = ++sync_fork_id;
1685 PERL_SET_THX(my_perl);
1687 /* set $$ to pseudo id */
1688 #ifdef PERL_SYNC_FORK
1691 w32_pseudo_id = GetCurrentThreadId();
1693 int pid = (int)w32_pseudo_id;
1695 w32_pseudo_id = -pid;
1698 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
1699 sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
1700 hv_clear(PL_pidstatus);
1702 /* push a zero on the stack (we are the child) */
1710 /* continue from next op */
1711 PL_op = PL_op->op_next;
1715 volatile int oldscope = PL_scopestack_ix;
1718 JMPENV_PUSH(status);
1725 while (PL_scopestack_ix > oldscope)
1728 PL_curstash = PL_defstash;
1729 if (PL_endav && !PL_minus_c)
1730 call_list(oldscope, PL_endav);
1731 status = STATUS_NATIVE_EXPORT;
1735 POPSTACK_TO(PL_mainstack);
1736 PL_op = PL_restartop;
1737 PL_restartop = Nullop;
1740 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1747 /* XXX hack to avoid perl_destruct() freeing optree */
1748 PL_main_root = Nullop;
1751 /* close the std handles to avoid fd leaks */
1753 do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
1754 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE);
1755 do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE);
1758 /* destroy everything (waits for any pseudo-forked children) */
1759 perl_destruct(my_perl);
1762 #ifdef PERL_SYNC_FORK
1765 return (DWORD)status;
1768 #endif /* USE_ITHREADS */
1771 PerlProcFork(struct IPerlProc* piPerl)
1779 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1783 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1784 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 1,
1786 h->m_pHostperlMemShared,
1787 h->m_pHostperlMemParse,
1789 h->m_pHostperlStdIO,
1795 new_perl->Isys_intern.internal_host = h;
1796 # ifdef PERL_SYNC_FORK
1797 id = win32_start_child((LPVOID)new_perl);
1800 # ifdef USE_RTL_THREAD_API
1801 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1802 (void*)new_perl, 0, (unsigned*)&id);
1804 handle = CreateThread(NULL, 0, win32_start_child,
1805 (LPVOID)new_perl, 0, &id);
1807 PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
1817 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1818 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1819 ++w32_num_pseudo_children;
1823 Perl_croak(aTHX_ "fork() not implemented!\n");
1825 #endif /* USE_ITHREADS */
1829 PerlProcGetpid(struct IPerlProc* piPerl)
1831 return win32_getpid();
1835 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1837 return win32_dynaload(filename);
1841 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1843 win32_str_os_error(sv, dwErr);
1847 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1849 do_spawn2(cmd, EXECF_EXEC);
1854 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1856 return do_spawn2(cmds, EXECF_SPAWN);
1860 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1862 return win32_spawnvp(mode, cmdname, argv);
1866 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1868 return do_aspawn(vreally, vmark, vsp);
1872 PerlProcLastHost(struct IPerlProc* piPerl)
1875 CPerlHost *h = (CPerlHost*)w32_internal_host;
1876 return h->LastHost();
1879 struct IPerlProc perlProc =
1923 CPerlHost::CPerlHost(void)
1925 /* Construct a host from scratch */
1926 InterlockedIncrement(&num_hosts);
1927 m_pvDir = new VDir();
1928 m_pVMem = new VMem();
1929 m_pVMemShared = new VMem();
1930 m_pVMemParse = new VMem();
1932 m_pvDir->Init(NULL, m_pVMem);
1935 m_lppEnvList = NULL;
1938 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1939 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1940 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1941 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1942 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1943 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1944 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1945 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1946 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1948 m_pHostperlMem = &m_hostperlMem;
1949 m_pHostperlMemShared = &m_hostperlMemShared;
1950 m_pHostperlMemParse = &m_hostperlMemParse;
1951 m_pHostperlEnv = &m_hostperlEnv;
1952 m_pHostperlStdIO = &m_hostperlStdIO;
1953 m_pHostperlLIO = &m_hostperlLIO;
1954 m_pHostperlDir = &m_hostperlDir;
1955 m_pHostperlSock = &m_hostperlSock;
1956 m_pHostperlProc = &m_hostperlProc;
1959 #define SETUPEXCHANGE(xptr, iptr, table) \
1970 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1971 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1972 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1973 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1974 struct IPerlProc** ppProc)
1976 InterlockedIncrement(&num_hosts);
1977 m_pvDir = new VDir(0);
1978 m_pVMem = new VMem();
1979 m_pVMemShared = new VMem();
1980 m_pVMemParse = new VMem();
1982 m_pvDir->Init(NULL, m_pVMem);
1985 m_lppEnvList = NULL;
1986 m_bTopLevel = FALSE;
1988 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1989 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1990 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1991 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1992 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1993 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1994 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1995 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1996 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1998 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
1999 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
2000 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
2001 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
2002 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
2003 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
2004 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
2005 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
2006 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
2008 #undef SETUPEXCHANGE
2010 CPerlHost::CPerlHost(CPerlHost& host)
2012 /* Construct a host from another host */
2013 InterlockedIncrement(&num_hosts);
2014 m_pVMem = new VMem();
2015 m_pVMemShared = host.GetMemShared();
2016 m_pVMemParse = host.GetMemParse();
2018 /* duplicate directory info */
2019 m_pvDir = new VDir(0);
2020 m_pvDir->Init(host.GetDir(), m_pVMem);
2022 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2023 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2024 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2025 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2026 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2027 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2028 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2029 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2030 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2031 m_pHostperlMem = &m_hostperlMem;
2032 m_pHostperlMemShared = &m_hostperlMemShared;
2033 m_pHostperlMemParse = &m_hostperlMemParse;
2034 m_pHostperlEnv = &m_hostperlEnv;
2035 m_pHostperlStdIO = &m_hostperlStdIO;
2036 m_pHostperlLIO = &m_hostperlLIO;
2037 m_pHostperlDir = &m_hostperlDir;
2038 m_pHostperlSock = &m_hostperlSock;
2039 m_pHostperlProc = &m_hostperlProc;
2042 m_lppEnvList = NULL;
2043 m_bTopLevel = FALSE;
2045 /* duplicate environment info */
2048 while(lpPtr = host.GetIndex(dwIndex))
2052 CPerlHost::~CPerlHost(void)
2055 InterlockedDecrement(&num_hosts);
2057 m_pVMemParse->Release();
2058 m_pVMemShared->Release();
2063 CPerlHost::Find(LPCSTR lpStr)
2066 LPSTR* lppPtr = Lookup(lpStr);
2067 if(lppPtr != NULL) {
2068 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2080 lookup(const void *arg1, const void *arg2)
2081 { // Compare strings
2085 ptr1 = *(char**)arg1;
2086 ptr2 = *(char**)arg2;
2090 if(c1 == '\0' || c1 == '=') {
2091 if(c2 == '\0' || c2 == '=')
2094 return -1; // string 1 < string 2
2096 else if(c2 == '\0' || c2 == '=')
2097 return 1; // string 1 > string 2
2103 return -1; // string 1 < string 2
2105 return 1; // string 1 > string 2
2113 CPerlHost::Lookup(LPCSTR lpStr)
2115 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2119 compare(const void *arg1, const void *arg2)
2120 { // Compare strings
2124 ptr1 = *(char**)arg1;
2125 ptr2 = *(char**)arg2;
2129 if(c1 == '\0' || c1 == '=') {
2133 return -1; // string 1 < string 2
2135 else if(c2 == '\0' || c2 == '=')
2136 return 1; // string 1 > string 2
2142 return -1; // string 1 < string 2
2144 return 1; // string 1 > string 2
2152 CPerlHost::Add(LPCSTR lpStr)
2155 char szBuffer[1024];
2157 int index, length = strlen(lpStr)+1;
2159 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2160 szBuffer[index] = lpStr[index];
2162 szBuffer[index] = '\0';
2165 lpPtr = Lookup(szBuffer);
2167 Renew(*lpPtr, length, char);
2168 strcpy(*lpPtr, lpStr);
2172 Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2173 New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2174 if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2175 strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2176 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2184 CPerlHost::CalculateEnvironmentSpace(void)
2188 for(index = 0; index < m_dwEnvCount; ++index)
2189 dwSize += strlen(m_lppEnvList[index]) + 1;
2195 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2202 CPerlHost::GetChildDir(void)
2207 New(0, ptr, MAX_PATH+1, char);
2209 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2210 length = strlen(ptr);
2212 if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2220 CPerlHost::FreeChildDir(char* pStr)
2227 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2230 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2231 DWORD dwSize, dwEnvIndex;
2232 int nLength, compVal;
2234 // get the process environment strings
2235 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2237 // step over current directory stuff
2238 while(*lpTmp == '=')
2239 lpTmp += strlen(lpTmp) + 1;
2241 // save the start of the environment strings
2243 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2244 // calculate the size of the environment strings
2245 dwSize += strlen(lpTmp) + 1;
2248 // add the size of current directories
2249 dwSize += vDir.CalculateEnvironmentSpace();
2251 // add the additional space used by changes made to the environment
2252 dwSize += CalculateEnvironmentSpace();
2254 New(1, lpStr, dwSize, char);
2257 // build the local environment
2258 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2261 lpLocalEnv = GetIndex(dwEnvIndex);
2262 while(*lpEnvPtr != '\0') {
2264 // all environment overrides have been added
2265 // so copy string into place
2266 strcpy(lpStr, lpEnvPtr);
2267 nLength = strlen(lpEnvPtr) + 1;
2269 lpEnvPtr += nLength;
2272 // determine which string to copy next
2273 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2275 strcpy(lpStr, lpEnvPtr);
2276 nLength = strlen(lpEnvPtr) + 1;
2278 lpEnvPtr += nLength;
2281 char *ptr = strchr(lpLocalEnv, '=');
2283 strcpy(lpStr, lpLocalEnv);
2284 lpStr += strlen(lpLocalEnv) + 1;
2286 lpLocalEnv = GetIndex(dwEnvIndex);
2288 // this string was replaced
2289 lpEnvPtr += strlen(lpEnvPtr) + 1;
2296 // still have environment overrides to add
2297 // so copy the strings into place if not an override
2298 char *ptr = strchr(lpLocalEnv, '=');
2300 strcpy(lpStr, lpLocalEnv);
2301 lpStr += strlen(lpLocalEnv) + 1;
2303 lpLocalEnv = GetIndex(dwEnvIndex);
2310 // release the process environment strings
2311 FreeEnvironmentStrings(lpAllocPtr);
2317 CPerlHost::Reset(void)
2320 if(m_lppEnvList != NULL) {
2321 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2322 Safefree(m_lppEnvList[index]);
2323 m_lppEnvList[index] = NULL;
2330 CPerlHost::Clearenv(void)
2334 LPSTR lpPtr, lpStr, lpEnvPtr;
2335 if (m_lppEnvList != NULL) {
2336 /* set every entry to an empty string */
2337 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2338 char* ptr = strchr(m_lppEnvList[index], '=');
2345 /* get the process environment strings */
2346 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2348 /* step over current directory stuff */
2349 while(*lpStr == '=')
2350 lpStr += strlen(lpStr) + 1;
2353 lpPtr = strchr(lpStr, '=');
2359 (void)win32_putenv(lpStr);
2362 lpStr += strlen(lpStr) + 1;
2365 FreeEnvironmentStrings(lpEnvPtr);
2370 CPerlHost::Getenv(const char *varname)
2374 char *pEnv = Find(varname);
2378 return win32_getenv(varname);
2382 CPerlHost::Putenv(const char *envstring)
2387 return win32_putenv(envstring);
2393 CPerlHost::Chdir(const char *dirname)
2402 WCHAR wBuffer[MAX_PATH];
2403 A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2404 ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2407 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2414 #endif /* ___PerlHost_H___ */