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 */
785 if(((FILE*)pf)->_flag & _IOREAD) {
789 else if(((FILE*)pf)->_flag & _IOWRT) {
793 else if(((FILE*)pf)->_flag & _IORW) {
799 /* it appears that the binmode is attached to the
800 * file descriptor so binmode files will be handled
803 pfdup = (PerlIO*)win32_fdopen(fileno, mode);
805 /* move the file pointer to the same position */
806 if (!fgetpos((FILE*)pf, &pos)) {
807 fsetpos((FILE*)pfdup, &pos);
812 struct IPerlStdIO perlStdIO =
851 PerlStdIOInitOSExtras,
857 #define IPERL2HOST(x) IPerlLIO2Host(x)
861 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
863 return win32_access(path, mode);
867 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
869 return win32_chmod(filename, pmode);
873 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
875 return chown(filename, owner, group);
879 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
881 return chsize(handle, size);
885 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
887 return win32_close(handle);
891 PerlLIODup(struct IPerlLIO* piPerl, int handle)
893 return win32_dup(handle);
897 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
899 return win32_dup2(handle1, handle2);
903 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
905 return win32_flock(fd, oper);
909 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
911 return fstat(handle, buffer);
915 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
917 return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
921 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
927 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
929 return win32_link(oldname, newname);
933 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
935 return win32_lseek(handle, offset, origin);
939 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
941 return win32_stat(path, buffer);
945 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
947 return mktemp(Template);
951 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
953 return win32_open(filename, oflag);
957 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
959 return win32_open(filename, oflag, pmode);
963 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
965 return win32_read(handle, buffer, count);
969 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
971 return win32_rename(OldFileName, newname);
975 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
977 return win32_setmode(handle, mode);
981 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
983 return win32_stat(path, buffer);
987 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
989 return tmpnam(string);
993 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
999 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1001 return win32_unlink(filename);
1005 PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
1007 return win32_utime(filename, times);
1011 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1013 return win32_write(handle, buffer, count);
1016 struct IPerlLIO perlLIO =
1048 #define IPERL2HOST(x) IPerlDir2Host(x)
1052 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1054 return win32_mkdir(dirname, mode);
1058 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1060 return IPERL2HOST(piPerl)->Chdir(dirname);
1064 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1066 return win32_rmdir(dirname);
1070 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1072 return win32_closedir(dirp);
1076 PerlDirOpen(struct IPerlDir* piPerl, char *filename)
1078 return win32_opendir(filename);
1082 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1084 return win32_readdir(dirp);
1088 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1090 win32_rewinddir(dirp);
1094 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1096 win32_seekdir(dirp, loc);
1100 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1102 return win32_telldir(dirp);
1106 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1108 return IPERL2HOST(piPerl)->MapPathA(path);
1112 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1114 return IPERL2HOST(piPerl)->MapPathW(path);
1117 struct IPerlDir perlDir =
1135 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1137 return win32_htonl(hostlong);
1141 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1143 return win32_htons(hostshort);
1147 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1149 return win32_ntohl(netlong);
1153 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1155 return win32_ntohs(netshort);
1158 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1160 return win32_accept(s, addr, addrlen);
1164 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1166 return win32_bind(s, name, namelen);
1170 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1172 return win32_connect(s, name, namelen);
1176 PerlSockEndhostent(struct IPerlSock* piPerl)
1182 PerlSockEndnetent(struct IPerlSock* piPerl)
1188 PerlSockEndprotoent(struct IPerlSock* piPerl)
1190 win32_endprotoent();
1194 PerlSockEndservent(struct IPerlSock* piPerl)
1200 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1202 return win32_gethostbyaddr(addr, len, type);
1206 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1208 return win32_gethostbyname(name);
1212 PerlSockGethostent(struct IPerlSock* piPerl)
1215 Perl_croak(aTHX_ "gethostent not implemented!\n");
1220 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1222 return win32_gethostname(name, namelen);
1226 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1228 return win32_getnetbyaddr(net, type);
1232 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1234 return win32_getnetbyname((char*)name);
1238 PerlSockGetnetent(struct IPerlSock* piPerl)
1240 return win32_getnetent();
1243 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1245 return win32_getpeername(s, name, namelen);
1249 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1251 return win32_getprotobyname(name);
1255 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1257 return win32_getprotobynumber(number);
1261 PerlSockGetprotoent(struct IPerlSock* piPerl)
1263 return win32_getprotoent();
1267 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1269 return win32_getservbyname(name, proto);
1273 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1275 return win32_getservbyport(port, proto);
1279 PerlSockGetservent(struct IPerlSock* piPerl)
1281 return win32_getservent();
1285 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1287 return win32_getsockname(s, name, namelen);
1291 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1293 return win32_getsockopt(s, level, optname, optval, optlen);
1297 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1299 return win32_inet_addr(cp);
1303 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1305 return win32_inet_ntoa(in);
1309 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1311 return win32_listen(s, backlog);
1315 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1317 return win32_recv(s, buffer, len, flags);
1321 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1323 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1327 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1329 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1333 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1335 return win32_send(s, buffer, len, flags);
1339 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1341 return win32_sendto(s, buffer, len, flags, to, tolen);
1345 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1347 win32_sethostent(stayopen);
1351 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1353 win32_setnetent(stayopen);
1357 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1359 win32_setprotoent(stayopen);
1363 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1365 win32_setservent(stayopen);
1369 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1371 return win32_setsockopt(s, level, optname, optval, optlen);
1375 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1377 return win32_shutdown(s, how);
1381 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1383 return win32_socket(af, type, protocol);
1387 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1390 Perl_croak(aTHX_ "socketpair not implemented!\n");
1395 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1397 return win32_closesocket(s);
1401 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1403 return win32_ioctlsocket(s, cmd, argp);
1406 struct IPerlSock perlSock =
1417 PerlSockEndprotoent,
1419 PerlSockGethostname,
1420 PerlSockGetpeername,
1421 PerlSockGethostbyaddr,
1422 PerlSockGethostbyname,
1424 PerlSockGetnetbyaddr,
1425 PerlSockGetnetbyname,
1427 PerlSockGetprotobyname,
1428 PerlSockGetprotobynumber,
1429 PerlSockGetprotoent,
1430 PerlSockGetservbyname,
1431 PerlSockGetservbyport,
1433 PerlSockGetsockname,
1445 PerlSockSetprotoent,
1451 PerlSockClosesocket,
1457 #define EXECF_EXEC 1
1458 #define EXECF_SPAWN 2
1461 PerlProcAbort(struct IPerlProc* piPerl)
1467 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1469 return win32_crypt(clear, salt);
1473 PerlProcExit(struct IPerlProc* piPerl, int status)
1479 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1485 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1487 return execl(cmdname, arg0, arg1, arg2, arg3);
1491 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1493 return win32_execvp(cmdname, argv);
1497 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1499 return win32_execvp(cmdname, argv);
1503 PerlProcGetuid(struct IPerlProc* piPerl)
1509 PerlProcGeteuid(struct IPerlProc* piPerl)
1515 PerlProcGetgid(struct IPerlProc* piPerl)
1521 PerlProcGetegid(struct IPerlProc* piPerl)
1527 PerlProcGetlogin(struct IPerlProc* piPerl)
1529 return g_getlogin();
1533 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1535 return win32_kill(pid, sig);
1539 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1542 Perl_croak(aTHX_ "killpg not implemented!\n");
1547 PerlProcPauseProc(struct IPerlProc* piPerl)
1549 return win32_sleep((32767L << 16) + 32767);
1553 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1556 PERL_FLUSHALL_FOR_CHILD;
1557 return (PerlIO*)win32_popen(command, mode);
1561 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1563 return win32_pclose((FILE*)stream);
1567 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1569 return win32_pipe(phandles, 512, O_BINARY);
1573 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1579 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1585 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1587 return win32_sleep(s);
1591 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1593 return win32_times(timebuf);
1597 PerlProcWait(struct IPerlProc* piPerl, int *status)
1599 return win32_wait(status);
1603 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1605 return win32_waitpid(pid, status, flags);
1609 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1616 win32_start_child(LPVOID arg)
1618 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1622 CPerlObj *pPerl = (CPerlObj*)my_perl;
1624 #ifdef PERL_SYNC_FORK
1625 static long sync_fork_id = 0;
1626 long id = ++sync_fork_id;
1630 PERL_SET_INTERP(my_perl);
1632 /* set $$ to pseudo id */
1633 #ifdef PERL_SYNC_FORK
1636 w32_pseudo_id = GetCurrentThreadId();
1638 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
1639 sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
1640 hv_clear(PL_pidstatus);
1642 /* push a zero on the stack (we are the child) */
1650 /* continue from next op */
1651 PL_op = PL_op->op_next;
1655 volatile oldscope = PL_scopestack_ix;
1658 JMPENV_PUSH(status);
1665 while (PL_scopestack_ix > oldscope)
1668 PL_curstash = PL_defstash;
1669 if (PL_endav && !PL_minus_c)
1670 call_list(oldscope, PL_endav);
1671 status = STATUS_NATIVE_EXPORT;
1675 POPSTACK_TO(PL_mainstack);
1676 PL_op = PL_restartop;
1677 PL_restartop = Nullop;
1680 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1687 /* XXX hack to avoid perl_destruct() freeing optree */
1688 PL_main_root = Nullop;
1691 /* destroy everything (waits for any pseudo-forked children) */
1692 perl_destruct(my_perl);
1695 #ifdef PERL_SYNC_FORK
1698 return (DWORD)status;
1701 #endif /* USE_ITHREADS */
1704 PerlProcFork(struct IPerlProc* piPerl)
1710 CPerlHost *h = new CPerlHost();
1711 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHXo, 1,
1713 h->m_pHostperlMemShared,
1714 h->m_pHostperlMemParse,
1716 h->m_pHostperlStdIO,
1722 # ifdef PERL_SYNC_FORK
1723 id = win32_start_child((LPVOID)new_perl);
1724 PERL_SET_INTERP(aTHXo);
1726 handle = CreateThread(NULL, 0, win32_start_child,
1727 (LPVOID)new_perl, 0, &id);
1728 PERL_SET_INTERP(aTHXo);
1730 Perl_croak(aTHX_ "panic: pseudo fork() failed");
1731 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1732 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1733 ++w32_num_pseudo_children;
1737 Perl_croak(aTHX_ "fork() not implemented!\n");
1739 #endif /* USE_ITHREADS */
1743 PerlProcGetpid(struct IPerlProc* piPerl)
1745 return win32_getpid();
1749 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1751 return win32_dynaload(filename);
1755 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1757 win32_str_os_error(sv, dwErr);
1761 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1763 do_spawn2(cmd, EXECF_EXEC);
1768 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1770 return do_spawn2(cmds, EXECF_SPAWN);
1774 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1776 return win32_spawnvp(mode, cmdname, argv);
1780 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1782 return do_aspawn(vreally, vmark, vsp);
1785 struct IPerlProc perlProc =
1827 CPerlHost::CPerlHost(void)
1829 m_pvDir = new VDir();
1830 m_pVMem = new VMem();
1831 m_pVMemShared = new VMem();
1832 m_pVMemParse = new VMem();
1834 m_pvDir->Init(NULL, m_pVMem);
1837 m_lppEnvList = NULL;
1839 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1840 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1841 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1842 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1843 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1844 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1845 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1846 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1847 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1849 m_pHostperlMem = &m_hostperlMem;
1850 m_pHostperlMemShared = &m_hostperlMemShared;
1851 m_pHostperlMemParse = &m_hostperlMemParse;
1852 m_pHostperlEnv = &m_hostperlEnv;
1853 m_pHostperlStdIO = &m_hostperlStdIO;
1854 m_pHostperlLIO = &m_hostperlLIO;
1855 m_pHostperlDir = &m_hostperlDir;
1856 m_pHostperlSock = &m_hostperlSock;
1857 m_pHostperlProc = &m_hostperlProc;
1860 #define SETUPEXCHANGE(xptr, iptr, table) \
1871 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1872 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1873 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1874 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1875 struct IPerlProc** ppProc)
1877 m_pvDir = new VDir();
1878 m_pVMem = new VMem();
1879 m_pVMemShared = new VMem();
1880 m_pVMemParse = new VMem();
1882 m_pvDir->Init(NULL, m_pVMem);
1885 m_lppEnvList = NULL;
1887 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1888 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1889 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1890 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1891 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1892 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1893 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1894 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1895 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1897 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
1898 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
1899 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
1900 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
1901 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
1902 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
1903 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
1904 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
1905 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
1907 #undef SETUPEXCHANGE
1909 CPerlHost::CPerlHost(CPerlHost& host)
1911 m_pVMem = new VMem();
1912 m_pVMemShared = host.GetMemShared();
1913 m_pVMemParse = host.GetMemParse();
1915 /* duplicate directory info */
1916 m_pvDir = new VDir();
1917 m_pvDir->Init(host.GetDir(), m_pVMem);
1919 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1920 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1921 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1922 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1923 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1924 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1925 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1926 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1927 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1928 m_pHostperlMem = &host.m_hostperlMem;
1929 m_pHostperlMemShared = &host.m_hostperlMemShared;
1930 m_pHostperlMemParse = &host.m_hostperlMemParse;
1931 m_pHostperlEnv = &host.m_hostperlEnv;
1932 m_pHostperlStdIO = &host.m_hostperlStdIO;
1933 m_pHostperlLIO = &host.m_hostperlLIO;
1934 m_pHostperlDir = &host.m_hostperlDir;
1935 m_pHostperlSock = &host.m_hostperlSock;
1936 m_pHostperlProc = &host.m_hostperlProc;
1939 m_lppEnvList = NULL;
1941 /* duplicate environment info */
1944 while(lpPtr = host.GetIndex(dwIndex))
1948 CPerlHost::~CPerlHost(void)
1952 m_pVMemParse->Release();
1953 m_pVMemShared->Release();
1958 CPerlHost::Find(LPCSTR lpStr)
1961 LPSTR* lppPtr = Lookup(lpStr);
1962 if(lppPtr != NULL) {
1963 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
1975 lookup(const void *arg1, const void *arg2)
1976 { // Compare strings
1980 ptr1 = *(char**)arg1;
1981 ptr2 = *(char**)arg2;
1985 if(c1 == '\0' || c1 == '=') {
1986 if(c2 == '\0' || c2 == '=')
1989 return -1; // string 1 < string 2
1991 else if(c2 == '\0' || c2 == '=')
1992 return 1; // string 1 > string 2
1998 return -1; // string 1 < string 2
2000 return 1; // string 1 > string 2
2008 CPerlHost::Lookup(LPCSTR lpStr)
2010 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2014 compare(const void *arg1, const void *arg2)
2015 { // Compare strings
2019 ptr1 = *(char**)arg1;
2020 ptr2 = *(char**)arg2;
2024 if(c1 == '\0' || c1 == '=') {
2028 return -1; // string 1 < string 2
2030 else if(c2 == '\0' || c2 == '=')
2031 return 1; // string 1 > string 2
2037 return -1; // string 1 < string 2
2039 return 1; // string 1 > string 2
2047 CPerlHost::Add(LPCSTR lpStr)
2050 char szBuffer[1024];
2052 int index, length = strlen(lpStr)+1;
2054 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2055 szBuffer[index] = lpStr[index];
2057 szBuffer[index] = '\0';
2060 lpPtr = Lookup(szBuffer);
2062 Renew(*lpPtr, length, char);
2063 strcpy(*lpPtr, lpStr);
2067 Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2068 New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2069 if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2070 strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2071 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2079 CPerlHost::CalculateEnvironmentSpace(void)
2083 for(index = 0; index < m_dwEnvCount; ++index)
2084 dwSize += strlen(m_lppEnvList[index]) + 1;
2090 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2097 CPerlHost::GetChildDir(void)
2102 New(0, ptr, MAX_PATH+1, char);
2104 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2105 length = strlen(ptr)-1;
2107 if((ptr[length] == '\\') || (ptr[length] == '/'))
2115 CPerlHost::FreeChildDir(char* pStr)
2122 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2125 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2126 DWORD dwSize, dwEnvIndex;
2127 int nLength, compVal;
2129 // get the process environment strings
2130 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2132 // step over current directory stuff
2133 while(*lpTmp == '=')
2134 lpTmp += strlen(lpTmp) + 1;
2136 // save the start of the environment strings
2138 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2139 // calculate the size of the environment strings
2140 dwSize += strlen(lpTmp) + 1;
2143 // add the size of current directories
2144 dwSize += vDir.CalculateEnvironmentSpace();
2146 // add the additional space used by changes made to the environment
2147 dwSize += CalculateEnvironmentSpace();
2149 New(1, lpStr, dwSize, char);
2152 // build the local environment
2153 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2156 lpLocalEnv = GetIndex(dwEnvIndex);
2157 while(*lpEnvPtr != '\0') {
2158 if(lpLocalEnv == NULL) {
2159 // all environment overrides have been added
2160 // so copy string into place
2161 strcpy(lpStr, lpEnvPtr);
2162 nLength = strlen(lpEnvPtr) + 1;
2164 lpEnvPtr += nLength;
2167 // determine which string to copy next
2168 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2170 strcpy(lpStr, lpEnvPtr);
2171 nLength = strlen(lpEnvPtr) + 1;
2173 lpEnvPtr += nLength;
2176 char *ptr = strchr(lpLocalEnv, '=');
2178 strcpy(lpStr, lpLocalEnv);
2179 lpStr += strlen(lpLocalEnv) + 1;
2181 lpLocalEnv = GetIndex(dwEnvIndex);
2183 // this string was replaced
2184 lpEnvPtr += strlen(lpEnvPtr) + 1;
2194 // release the process environment strings
2195 FreeEnvironmentStrings(lpAllocPtr);
2201 CPerlHost::Reset(void)
2204 if(m_lppEnvList != NULL) {
2205 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2206 Safefree(m_lppEnvList[index]);
2207 m_lppEnvList[index] = NULL;
2214 CPerlHost::Clearenv(void)
2217 LPSTR lpPtr, lpStr, lpEnvPtr;
2218 if(m_lppEnvList != NULL) {
2219 /* set every entry to an empty string */
2220 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2221 char* ptr = strchr(m_lppEnvList[index], '=');
2228 /* get the process environment strings */
2229 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2231 /* step over current directory stuff */
2232 while(*lpStr == '=')
2233 lpStr += strlen(lpStr) + 1;
2236 lpPtr = strchr(lpStr, '=');
2243 lpStr += strlen(lpStr) + 1;
2246 FreeEnvironmentStrings(lpEnvPtr);
2251 CPerlHost::Getenv(const char *varname)
2253 char* pEnv = Find(varname);
2255 pEnv = win32_getenv(varname);
2266 CPerlHost::Putenv(const char *envstring)
2273 CPerlHost::Chdir(const char *dirname)
2278 WCHAR wBuffer[MAX_PATH];
2279 A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2280 ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2283 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2290 #endif /* ___PerlHost_H___ */