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 inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
56 inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
57 inline void Free(void* ptr) { m_pVMem->Free(ptr); };
58 inline void* Calloc(size_t num, size_t size)
60 size_t count = num*size;
61 void* lpVoid = Malloc(count);
63 ZeroMemory(lpVoid, count);
66 inline void GetLock(void) { m_pVMem->GetLock(); };
67 inline void FreeLock(void) { m_pVMem->FreeLock(); };
68 inline int IsLocked(void) { return m_pVMem->IsLocked(); };
71 inline void* MallocShared(size_t size)
73 return m_pVMemShared->Malloc(size);
75 inline void* ReallocShared(void* ptr, size_t size) { return m_pVMemShared->Realloc(ptr, size); };
76 inline void FreeShared(void* ptr) { m_pVMemShared->Free(ptr); };
77 inline void* CallocShared(size_t num, size_t size)
79 size_t count = num*size;
80 void* lpVoid = MallocShared(count);
82 ZeroMemory(lpVoid, count);
85 inline void GetLockShared(void) { m_pVMem->GetLock(); };
86 inline void FreeLockShared(void) { m_pVMem->FreeLock(); };
87 inline int IsLockedShared(void) { return m_pVMem->IsLocked(); };
90 inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
91 inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
92 inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
93 inline void* CallocParse(size_t num, size_t size)
95 size_t count = num*size;
96 void* lpVoid = MallocParse(count);
98 ZeroMemory(lpVoid, count);
101 inline void GetLockParse(void) { m_pVMem->GetLock(); };
102 inline void FreeLockParse(void) { m_pVMem->FreeLock(); };
103 inline int IsLockedParse(void) { return m_pVMem->IsLocked(); };
106 char *Getenv(const char *varname);
107 int Putenv(const char *envstring);
108 inline char *Getenv(const char *varname, unsigned long *len)
111 char *e = Getenv(varname);
116 void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
117 void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
118 char* GetChildDir(void);
119 void FreeChildDir(char* pStr);
123 inline LPSTR GetIndex(DWORD &dwIndex)
125 if(dwIndex < m_dwEnvCount)
128 return m_lppEnvList[dwIndex-1];
134 LPSTR Find(LPCSTR lpStr);
135 void Add(LPCSTR lpStr);
137 LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
138 void FreeLocalEnvironmentStrings(LPSTR lpStr);
139 LPSTR* Lookup(LPCSTR lpStr);
140 DWORD CalculateEnvironmentSpace(void);
145 virtual int Chdir(const char *dirname);
149 void Exit(int status);
150 void _Exit(int status);
151 int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
152 int Execv(const char *cmdname, const char *const *argv);
153 int Execvp(const char *cmdname, const char *const *argv);
155 inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
156 inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
157 inline VDir* GetDir(void) { return m_pvDir; };
161 struct IPerlMem m_hostperlMem;
162 struct IPerlMem m_hostperlMemShared;
163 struct IPerlMem m_hostperlMemParse;
164 struct IPerlEnv m_hostperlEnv;
165 struct IPerlStdIO m_hostperlStdIO;
166 struct IPerlLIO m_hostperlLIO;
167 struct IPerlDir m_hostperlDir;
168 struct IPerlSock m_hostperlSock;
169 struct IPerlProc m_hostperlProc;
171 struct IPerlMem* m_pHostperlMem;
172 struct IPerlMem* m_pHostperlMemShared;
173 struct IPerlMem* m_pHostperlMemParse;
174 struct IPerlEnv* m_pHostperlEnv;
175 struct IPerlStdIO* m_pHostperlStdIO;
176 struct IPerlLIO* m_pHostperlLIO;
177 struct IPerlDir* m_pHostperlDir;
178 struct IPerlSock* m_pHostperlSock;
179 struct IPerlProc* m_pHostperlProc;
181 inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
182 inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
192 static long num_hosts;
194 inline int LastHost(void) { return num_hosts == 1L; };
197 long CPerlHost::num_hosts = 0L;
200 #define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
202 inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
204 return STRUCT2PTR(piPerl, m_hostperlMem);
207 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
209 return STRUCT2PTR(piPerl, m_hostperlMemShared);
212 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
214 return STRUCT2PTR(piPerl, m_hostperlMemParse);
217 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
219 return STRUCT2PTR(piPerl, m_hostperlEnv);
222 inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
224 return STRUCT2PTR(piPerl, m_hostperlStdIO);
227 inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
229 return STRUCT2PTR(piPerl, m_hostperlLIO);
232 inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
234 return STRUCT2PTR(piPerl, m_hostperlDir);
237 inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
239 return STRUCT2PTR(piPerl, m_hostperlSock);
242 inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
244 return STRUCT2PTR(piPerl, m_hostperlProc);
250 #define IPERL2HOST(x) IPerlMem2Host(x)
254 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
256 return IPERL2HOST(piPerl)->Malloc(size);
259 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
261 return IPERL2HOST(piPerl)->Realloc(ptr, size);
264 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
266 IPERL2HOST(piPerl)->Free(ptr);
269 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
271 return IPERL2HOST(piPerl)->Calloc(num, size);
275 PerlMemGetLock(struct IPerlMem* piPerl)
277 IPERL2HOST(piPerl)->GetLock();
281 PerlMemFreeLock(struct IPerlMem* piPerl)
283 IPERL2HOST(piPerl)->FreeLock();
287 PerlMemIsLocked(struct IPerlMem* piPerl)
289 return IPERL2HOST(piPerl)->IsLocked();
292 struct IPerlMem perlMem =
304 #define IPERL2HOST(x) IPerlMemShared2Host(x)
308 PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
310 return IPERL2HOST(piPerl)->MallocShared(size);
313 PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
315 return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
318 PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
320 IPERL2HOST(piPerl)->FreeShared(ptr);
323 PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
325 return IPERL2HOST(piPerl)->CallocShared(num, size);
329 PerlMemSharedGetLock(struct IPerlMem* piPerl)
331 IPERL2HOST(piPerl)->GetLockShared();
335 PerlMemSharedFreeLock(struct IPerlMem* piPerl)
337 IPERL2HOST(piPerl)->FreeLockShared();
341 PerlMemSharedIsLocked(struct IPerlMem* piPerl)
343 return IPERL2HOST(piPerl)->IsLockedShared();
346 struct IPerlMem perlMemShared =
349 PerlMemSharedRealloc,
352 PerlMemSharedGetLock,
353 PerlMemSharedFreeLock,
354 PerlMemSharedIsLocked,
358 #define IPERL2HOST(x) IPerlMemParse2Host(x)
362 PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
364 return IPERL2HOST(piPerl)->MallocParse(size);
367 PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
369 return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
372 PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
374 IPERL2HOST(piPerl)->FreeParse(ptr);
377 PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
379 return IPERL2HOST(piPerl)->CallocParse(num, size);
383 PerlMemParseGetLock(struct IPerlMem* piPerl)
385 IPERL2HOST(piPerl)->GetLockParse();
389 PerlMemParseFreeLock(struct IPerlMem* piPerl)
391 IPERL2HOST(piPerl)->FreeLockParse();
395 PerlMemParseIsLocked(struct IPerlMem* piPerl)
397 return IPERL2HOST(piPerl)->IsLockedParse();
400 struct IPerlMem perlMemParse =
407 PerlMemParseFreeLock,
408 PerlMemParseIsLocked,
413 #define IPERL2HOST(x) IPerlEnv2Host(x)
417 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
419 return IPERL2HOST(piPerl)->Getenv(varname);
423 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
425 return IPERL2HOST(piPerl)->Putenv(envstring);
429 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
431 return IPERL2HOST(piPerl)->Getenv(varname, len);
435 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
437 return win32_uname(name);
441 PerlEnvClearenv(struct IPerlEnv* piPerl)
443 IPERL2HOST(piPerl)->Clearenv();
447 PerlEnvGetChildenv(struct IPerlEnv* piPerl)
449 return IPERL2HOST(piPerl)->CreateChildEnv();
453 PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
455 IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
459 PerlEnvGetChilddir(struct IPerlEnv* piPerl)
461 return IPERL2HOST(piPerl)->GetChildDir();
465 PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
467 IPERL2HOST(piPerl)->FreeChildDir(childDir);
471 PerlEnvOsId(struct IPerlEnv* piPerl)
473 return win32_os_id();
477 PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
479 return g_win32_get_privlib(pl);
483 PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
485 return g_win32_get_sitelib(pl);
489 PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
491 return g_win32_get_vendorlib(pl);
495 PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
497 win32_get_child_IO(ptr);
500 struct IPerlEnv perlEnv =
514 PerlEnvVendorLibPath,
519 #define IPERL2HOST(x) IPerlStdIO2Host(x)
523 PerlStdIOStdin(struct IPerlStdIO* piPerl)
525 return win32_stdin();
529 PerlStdIOStdout(struct IPerlStdIO* piPerl)
531 return win32_stdout();
535 PerlStdIOStderr(struct IPerlStdIO* piPerl)
537 return win32_stderr();
541 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
543 return win32_fopen(path, mode);
547 PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf)
549 return win32_fclose((pf));
553 PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf)
555 return win32_feof(pf);
559 PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf)
561 return win32_ferror(pf);
565 PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf)
571 PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf)
573 return win32_getc(pf);
577 PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf)
588 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf)
592 return FILE_bufsiz(f);
599 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf)
610 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
621 PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n)
623 return win32_fgets(s, n, pf);
627 PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c)
629 return win32_fputc(c, pf);
633 PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s)
635 return win32_fputs(s, pf);
639 PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf)
641 return win32_fflush(pf);
645 PerlStdIOUngetc(struct IPerlStdIO* piPerl,int c, FILE* pf)
647 return win32_ungetc(c, pf);
651 PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf)
653 return win32_fileno(pf);
657 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
659 return win32_fdopen(fd, mode);
663 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf)
665 return win32_freopen(path, mode, (FILE*)pf);
669 PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf)
671 return win32_fread(buffer, size, count, pf);
675 PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf)
677 return win32_fwrite(buffer, size, count, pf);
681 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer)
683 win32_setbuf(pf, buffer);
687 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size)
689 return win32_setvbuf(pf, buffer, type, size);
693 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n)
695 #ifdef STDIO_CNT_LVALUE
702 PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr)
704 #ifdef STDIO_PTR_LVALUE
711 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf)
713 win32_setvbuf(pf, NULL, _IOLBF, 0);
717 PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...)
720 va_start(arglist, format);
721 return win32_vfprintf(pf, format, arglist);
725 PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist)
727 return win32_vfprintf(pf, format, arglist);
731 PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf)
733 return win32_ftell(pf);
737 PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, off_t offset, int origin)
739 return win32_fseek(pf, offset, origin);
743 PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf)
749 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
751 return win32_tmpfile();
755 PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p)
757 return win32_fgetpos(pf, p);
761 PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p)
763 return win32_fsetpos(pf, p);
766 PerlStdIOInit(struct IPerlStdIO* piPerl)
771 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
773 Perl_init_os_extras();
777 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags)
779 return win32_open_osfhandle(osfhandle, flags);
783 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
785 return win32_get_osfhandle(filenum);
789 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
794 int fileno = win32_dup(win32_fileno(pf));
796 /* open the file in the same mode */
798 if((pf)->flags & _F_READ) {
802 else if((pf)->flags & _F_WRIT) {
806 else if((pf)->flags & _F_RDWR) {
812 if((pf)->_flag & _IOREAD) {
816 else if((pf)->_flag & _IOWRT) {
820 else if((pf)->_flag & _IORW) {
827 /* it appears that the binmode is attached to the
828 * file descriptor so binmode files will be handled
831 pfdup = win32_fdopen(fileno, mode);
833 /* move the file pointer to the same position */
834 if (!fgetpos(pf, &pos)) {
835 fsetpos(pfdup, &pos);
840 struct IPerlStdIO perlStdIO =
879 PerlStdIOInitOSExtras,
885 #define IPERL2HOST(x) IPerlLIO2Host(x)
889 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
891 return win32_access(path, mode);
895 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
897 return win32_chmod(filename, pmode);
901 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
903 return chown(filename, owner, group);
907 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
909 return chsize(handle, size);
913 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
915 return win32_close(handle);
919 PerlLIODup(struct IPerlLIO* piPerl, int handle)
921 return win32_dup(handle);
925 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
927 return win32_dup2(handle1, handle2);
931 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
933 return win32_flock(fd, oper);
937 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
939 return win32_fstat(handle, buffer);
943 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
945 return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
949 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
955 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
957 return win32_link(oldname, newname);
961 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
963 return win32_lseek(handle, offset, origin);
967 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
969 return win32_stat(path, buffer);
973 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
975 return mktemp(Template);
979 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
981 return win32_open(filename, oflag);
985 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
987 return win32_open(filename, oflag, pmode);
991 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
993 return win32_read(handle, buffer, count);
997 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
999 return win32_rename(OldFileName, newname);
1003 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1005 return win32_setmode(handle, mode);
1009 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
1011 return win32_stat(path, buffer);
1015 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1017 return tmpnam(string);
1021 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1023 return umask(pmode);
1027 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1029 return win32_unlink(filename);
1033 PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
1035 return win32_utime(filename, times);
1039 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1041 return win32_write(handle, buffer, count);
1044 struct IPerlLIO perlLIO =
1076 #define IPERL2HOST(x) IPerlDir2Host(x)
1080 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1082 return win32_mkdir(dirname, mode);
1086 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1088 return IPERL2HOST(piPerl)->Chdir(dirname);
1092 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1094 return win32_rmdir(dirname);
1098 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1100 return win32_closedir(dirp);
1104 PerlDirOpen(struct IPerlDir* piPerl, char *filename)
1106 return win32_opendir(filename);
1110 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1112 return win32_readdir(dirp);
1116 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1118 win32_rewinddir(dirp);
1122 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1124 win32_seekdir(dirp, loc);
1128 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1130 return win32_telldir(dirp);
1134 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1136 return IPERL2HOST(piPerl)->MapPathA(path);
1140 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1142 return IPERL2HOST(piPerl)->MapPathW(path);
1145 struct IPerlDir perlDir =
1163 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1165 return win32_htonl(hostlong);
1169 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1171 return win32_htons(hostshort);
1175 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1177 return win32_ntohl(netlong);
1181 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1183 return win32_ntohs(netshort);
1186 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1188 return win32_accept(s, addr, addrlen);
1192 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1194 return win32_bind(s, name, namelen);
1198 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1200 return win32_connect(s, name, namelen);
1204 PerlSockEndhostent(struct IPerlSock* piPerl)
1210 PerlSockEndnetent(struct IPerlSock* piPerl)
1216 PerlSockEndprotoent(struct IPerlSock* piPerl)
1218 win32_endprotoent();
1222 PerlSockEndservent(struct IPerlSock* piPerl)
1228 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1230 return win32_gethostbyaddr(addr, len, type);
1234 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1236 return win32_gethostbyname(name);
1240 PerlSockGethostent(struct IPerlSock* piPerl)
1243 Perl_croak(aTHX_ "gethostent not implemented!\n");
1248 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1250 return win32_gethostname(name, namelen);
1254 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1256 return win32_getnetbyaddr(net, type);
1260 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1262 return win32_getnetbyname((char*)name);
1266 PerlSockGetnetent(struct IPerlSock* piPerl)
1268 return win32_getnetent();
1271 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1273 return win32_getpeername(s, name, namelen);
1277 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1279 return win32_getprotobyname(name);
1283 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1285 return win32_getprotobynumber(number);
1289 PerlSockGetprotoent(struct IPerlSock* piPerl)
1291 return win32_getprotoent();
1295 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1297 return win32_getservbyname(name, proto);
1301 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1303 return win32_getservbyport(port, proto);
1307 PerlSockGetservent(struct IPerlSock* piPerl)
1309 return win32_getservent();
1313 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1315 return win32_getsockname(s, name, namelen);
1319 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1321 return win32_getsockopt(s, level, optname, optval, optlen);
1325 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1327 return win32_inet_addr(cp);
1331 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1333 return win32_inet_ntoa(in);
1337 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1339 return win32_listen(s, backlog);
1343 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1345 return win32_recv(s, buffer, len, flags);
1349 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1351 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1355 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1357 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1361 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1363 return win32_send(s, buffer, len, flags);
1367 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1369 return win32_sendto(s, buffer, len, flags, to, tolen);
1373 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1375 win32_sethostent(stayopen);
1379 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1381 win32_setnetent(stayopen);
1385 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1387 win32_setprotoent(stayopen);
1391 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1393 win32_setservent(stayopen);
1397 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1399 return win32_setsockopt(s, level, optname, optval, optlen);
1403 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1405 return win32_shutdown(s, how);
1409 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1411 return win32_socket(af, type, protocol);
1415 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1418 Perl_croak(aTHX_ "socketpair not implemented!\n");
1423 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1425 return win32_closesocket(s);
1429 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1431 return win32_ioctlsocket(s, cmd, argp);
1434 struct IPerlSock perlSock =
1445 PerlSockEndprotoent,
1447 PerlSockGethostname,
1448 PerlSockGetpeername,
1449 PerlSockGethostbyaddr,
1450 PerlSockGethostbyname,
1452 PerlSockGetnetbyaddr,
1453 PerlSockGetnetbyname,
1455 PerlSockGetprotobyname,
1456 PerlSockGetprotobynumber,
1457 PerlSockGetprotoent,
1458 PerlSockGetservbyname,
1459 PerlSockGetservbyport,
1461 PerlSockGetsockname,
1473 PerlSockSetprotoent,
1479 PerlSockClosesocket,
1485 #define EXECF_EXEC 1
1486 #define EXECF_SPAWN 2
1489 PerlProcAbort(struct IPerlProc* piPerl)
1495 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1497 return win32_crypt(clear, salt);
1501 PerlProcExit(struct IPerlProc* piPerl, int status)
1507 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1513 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1515 return execl(cmdname, arg0, arg1, arg2, arg3);
1519 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1521 return win32_execvp(cmdname, argv);
1525 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1527 return win32_execvp(cmdname, argv);
1531 PerlProcGetuid(struct IPerlProc* piPerl)
1537 PerlProcGeteuid(struct IPerlProc* piPerl)
1543 PerlProcGetgid(struct IPerlProc* piPerl)
1549 PerlProcGetegid(struct IPerlProc* piPerl)
1555 PerlProcGetlogin(struct IPerlProc* piPerl)
1557 return g_getlogin();
1561 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1563 return win32_kill(pid, sig);
1567 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1570 Perl_croak(aTHX_ "killpg not implemented!\n");
1575 PerlProcPauseProc(struct IPerlProc* piPerl)
1577 return win32_sleep((32767L << 16) + 32767);
1581 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1584 PERL_FLUSHALL_FOR_CHILD;
1585 return win32_popen(command, mode);
1589 PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
1592 PERL_FLUSHALL_FOR_CHILD;
1593 return win32_popenlist(mode, narg, args);
1597 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1599 return win32_pclose(stream);
1603 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1605 return win32_pipe(phandles, 512, O_BINARY);
1609 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1615 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1621 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1623 return win32_sleep(s);
1627 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1629 return win32_times(timebuf);
1633 PerlProcWait(struct IPerlProc* piPerl, int *status)
1635 return win32_wait(status);
1639 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1641 return win32_waitpid(pid, status, flags);
1645 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1647 return signal(sig, subcode);
1651 static THREAD_RET_TYPE
1652 win32_start_child(LPVOID arg)
1654 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1657 #ifdef PERL_SYNC_FORK
1658 static long sync_fork_id = 0;
1659 long id = ++sync_fork_id;
1663 PERL_SET_THX(my_perl);
1665 /* set $$ to pseudo id */
1666 #ifdef PERL_SYNC_FORK
1669 w32_pseudo_id = GetCurrentThreadId();
1671 int pid = (int)w32_pseudo_id;
1673 w32_pseudo_id = -pid;
1676 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
1677 sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
1678 hv_clear(PL_pidstatus);
1680 /* push a zero on the stack (we are the child) */
1688 /* continue from next op */
1689 PL_op = PL_op->op_next;
1693 volatile int oldscope = PL_scopestack_ix;
1696 JMPENV_PUSH(status);
1703 while (PL_scopestack_ix > oldscope)
1706 PL_curstash = PL_defstash;
1707 if (PL_endav && !PL_minus_c)
1708 call_list(oldscope, PL_endav);
1709 status = STATUS_NATIVE_EXPORT;
1713 POPSTACK_TO(PL_mainstack);
1714 PL_op = PL_restartop;
1715 PL_restartop = Nullop;
1718 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1725 /* XXX hack to avoid perl_destruct() freeing optree */
1726 PL_main_root = Nullop;
1729 /* close the std handles to avoid fd leaks */
1731 do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
1732 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE);
1733 do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE);
1736 /* destroy everything (waits for any pseudo-forked children) */
1737 perl_destruct(my_perl);
1740 #ifdef PERL_SYNC_FORK
1743 return (DWORD)status;
1746 #endif /* USE_ITHREADS */
1749 PerlProcFork(struct IPerlProc* piPerl)
1757 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1761 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1762 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 1,
1764 h->m_pHostperlMemShared,
1765 h->m_pHostperlMemParse,
1767 h->m_pHostperlStdIO,
1773 new_perl->Isys_intern.internal_host = h;
1774 # ifdef PERL_SYNC_FORK
1775 id = win32_start_child((LPVOID)new_perl);
1778 # ifdef USE_RTL_THREAD_API
1779 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1780 (void*)new_perl, 0, (unsigned*)&id);
1782 handle = CreateThread(NULL, 0, win32_start_child,
1783 (LPVOID)new_perl, 0, &id);
1785 PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
1795 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1796 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1797 ++w32_num_pseudo_children;
1801 Perl_croak(aTHX_ "fork() not implemented!\n");
1803 #endif /* USE_ITHREADS */
1807 PerlProcGetpid(struct IPerlProc* piPerl)
1809 return win32_getpid();
1813 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1815 return win32_dynaload(filename);
1819 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1821 win32_str_os_error(sv, dwErr);
1825 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1827 do_spawn2(cmd, EXECF_EXEC);
1832 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1834 return do_spawn2(cmds, EXECF_SPAWN);
1838 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1840 return win32_spawnvp(mode, cmdname, argv);
1844 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1846 return do_aspawn(vreally, vmark, vsp);
1850 PerlProcLastHost(struct IPerlProc* piPerl)
1853 CPerlHost *h = (CPerlHost*)w32_internal_host;
1854 return h->LastHost();
1857 struct IPerlProc perlProc =
1901 CPerlHost::CPerlHost(void)
1903 /* Construct a host from scratch */
1904 InterlockedIncrement(&num_hosts);
1905 m_pvDir = new VDir();
1906 m_pVMem = new VMem();
1907 m_pVMemShared = new VMem();
1908 m_pVMemParse = new VMem();
1910 m_pvDir->Init(NULL, m_pVMem);
1913 m_lppEnvList = NULL;
1915 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1916 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1917 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1918 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1919 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1920 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1921 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1922 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1923 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1925 m_pHostperlMem = &m_hostperlMem;
1926 m_pHostperlMemShared = &m_hostperlMemShared;
1927 m_pHostperlMemParse = &m_hostperlMemParse;
1928 m_pHostperlEnv = &m_hostperlEnv;
1929 m_pHostperlStdIO = &m_hostperlStdIO;
1930 m_pHostperlLIO = &m_hostperlLIO;
1931 m_pHostperlDir = &m_hostperlDir;
1932 m_pHostperlSock = &m_hostperlSock;
1933 m_pHostperlProc = &m_hostperlProc;
1936 #define SETUPEXCHANGE(xptr, iptr, table) \
1947 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1948 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1949 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1950 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1951 struct IPerlProc** ppProc)
1953 InterlockedIncrement(&num_hosts);
1954 m_pvDir = new VDir(0);
1955 m_pVMem = new VMem();
1956 m_pVMemShared = new VMem();
1957 m_pVMemParse = new VMem();
1959 m_pvDir->Init(NULL, m_pVMem);
1962 m_lppEnvList = NULL;
1964 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1965 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1966 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1967 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1968 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1969 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1970 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1971 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1972 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1974 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
1975 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
1976 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
1977 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
1978 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
1979 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
1980 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
1981 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
1982 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
1984 #undef SETUPEXCHANGE
1986 CPerlHost::CPerlHost(CPerlHost& host)
1988 /* Construct a host from another host */
1989 InterlockedIncrement(&num_hosts);
1990 m_pVMem = new VMem();
1991 m_pVMemShared = host.GetMemShared();
1992 m_pVMemParse = host.GetMemParse();
1994 /* duplicate directory info */
1995 m_pvDir = new VDir(0);
1996 m_pvDir->Init(host.GetDir(), m_pVMem);
1998 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1999 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2000 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2001 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2002 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2003 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2004 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2005 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2006 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2007 m_pHostperlMem = &m_hostperlMem;
2008 m_pHostperlMemShared = &m_hostperlMemShared;
2009 m_pHostperlMemParse = &m_hostperlMemParse;
2010 m_pHostperlEnv = &m_hostperlEnv;
2011 m_pHostperlStdIO = &m_hostperlStdIO;
2012 m_pHostperlLIO = &m_hostperlLIO;
2013 m_pHostperlDir = &m_hostperlDir;
2014 m_pHostperlSock = &m_hostperlSock;
2015 m_pHostperlProc = &m_hostperlProc;
2018 m_lppEnvList = NULL;
2020 /* duplicate environment info */
2023 while(lpPtr = host.GetIndex(dwIndex))
2027 CPerlHost::~CPerlHost(void)
2030 InterlockedDecrement(&num_hosts);
2032 m_pVMemParse->Release();
2033 m_pVMemShared->Release();
2038 CPerlHost::Find(LPCSTR lpStr)
2041 LPSTR* lppPtr = Lookup(lpStr);
2042 if(lppPtr != NULL) {
2043 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2055 lookup(const void *arg1, const void *arg2)
2056 { // Compare strings
2060 ptr1 = *(char**)arg1;
2061 ptr2 = *(char**)arg2;
2065 if(c1 == '\0' || c1 == '=') {
2066 if(c2 == '\0' || c2 == '=')
2069 return -1; // string 1 < string 2
2071 else if(c2 == '\0' || c2 == '=')
2072 return 1; // string 1 > string 2
2078 return -1; // string 1 < string 2
2080 return 1; // string 1 > string 2
2088 CPerlHost::Lookup(LPCSTR lpStr)
2090 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2094 compare(const void *arg1, const void *arg2)
2095 { // Compare strings
2099 ptr1 = *(char**)arg1;
2100 ptr2 = *(char**)arg2;
2104 if(c1 == '\0' || c1 == '=') {
2108 return -1; // string 1 < string 2
2110 else if(c2 == '\0' || c2 == '=')
2111 return 1; // string 1 > string 2
2117 return -1; // string 1 < string 2
2119 return 1; // string 1 > string 2
2127 CPerlHost::Add(LPCSTR lpStr)
2130 char szBuffer[1024];
2132 int index, length = strlen(lpStr)+1;
2134 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2135 szBuffer[index] = lpStr[index];
2137 szBuffer[index] = '\0';
2140 lpPtr = Lookup(szBuffer);
2142 Renew(*lpPtr, length, char);
2143 strcpy(*lpPtr, lpStr);
2147 Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2148 New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2149 if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2150 strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2151 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2159 CPerlHost::CalculateEnvironmentSpace(void)
2163 for(index = 0; index < m_dwEnvCount; ++index)
2164 dwSize += strlen(m_lppEnvList[index]) + 1;
2170 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2177 CPerlHost::GetChildDir(void)
2182 New(0, ptr, MAX_PATH+1, char);
2184 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2185 length = strlen(ptr);
2187 if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2195 CPerlHost::FreeChildDir(char* pStr)
2202 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2205 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2206 DWORD dwSize, dwEnvIndex;
2207 int nLength, compVal;
2209 // get the process environment strings
2210 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2212 // step over current directory stuff
2213 while(*lpTmp == '=')
2214 lpTmp += strlen(lpTmp) + 1;
2216 // save the start of the environment strings
2218 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2219 // calculate the size of the environment strings
2220 dwSize += strlen(lpTmp) + 1;
2223 // add the size of current directories
2224 dwSize += vDir.CalculateEnvironmentSpace();
2226 // add the additional space used by changes made to the environment
2227 dwSize += CalculateEnvironmentSpace();
2229 New(1, lpStr, dwSize, char);
2232 // build the local environment
2233 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2236 lpLocalEnv = GetIndex(dwEnvIndex);
2237 while(*lpEnvPtr != '\0') {
2239 // all environment overrides have been added
2240 // so copy string into place
2241 strcpy(lpStr, lpEnvPtr);
2242 nLength = strlen(lpEnvPtr) + 1;
2244 lpEnvPtr += nLength;
2247 // determine which string to copy next
2248 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2250 strcpy(lpStr, lpEnvPtr);
2251 nLength = strlen(lpEnvPtr) + 1;
2253 lpEnvPtr += nLength;
2256 char *ptr = strchr(lpLocalEnv, '=');
2258 strcpy(lpStr, lpLocalEnv);
2259 lpStr += strlen(lpLocalEnv) + 1;
2261 lpLocalEnv = GetIndex(dwEnvIndex);
2263 // this string was replaced
2264 lpEnvPtr += strlen(lpEnvPtr) + 1;
2271 // still have environment overrides to add
2272 // so copy the strings into place
2273 strcpy(lpStr, lpLocalEnv);
2274 nLength = strlen(lpLocalEnv) + 1;
2276 lpEnvPtr += nLength;
2277 lpLocalEnv = GetIndex(dwEnvIndex);
2284 // release the process environment strings
2285 FreeEnvironmentStrings(lpAllocPtr);
2291 CPerlHost::Reset(void)
2294 if(m_lppEnvList != NULL) {
2295 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2296 Safefree(m_lppEnvList[index]);
2297 m_lppEnvList[index] = NULL;
2304 CPerlHost::Clearenv(void)
2308 LPSTR lpPtr, lpStr, lpEnvPtr;
2309 if (m_lppEnvList != NULL) {
2310 /* set every entry to an empty string */
2311 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2312 char* ptr = strchr(m_lppEnvList[index], '=');
2319 /* get the process environment strings */
2320 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2322 /* step over current directory stuff */
2323 while(*lpStr == '=')
2324 lpStr += strlen(lpStr) + 1;
2327 lpPtr = strchr(lpStr, '=');
2333 (void)win32_putenv(lpStr);
2336 lpStr += strlen(lpStr) + 1;
2339 FreeEnvironmentStrings(lpEnvPtr);
2344 CPerlHost::Getenv(const char *varname)
2347 if (w32_pseudo_id) {
2348 char *pEnv = Find(varname);
2352 return win32_getenv(varname);
2356 CPerlHost::Putenv(const char *envstring)
2361 return win32_putenv(envstring);
2367 CPerlHost::Chdir(const char *dirname)
2376 WCHAR wBuffer[MAX_PATH];
2377 A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2378 ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2381 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2388 #endif /* ___PerlHost_H___ */