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___
18 #if !defined(PERL_OBJECT)
21 extern char * g_win32_get_privlib(const char *pl);
22 extern char * g_win32_get_sitelib(const char *pl);
23 extern char * g_win32_get_vendorlib(const char *pl);
24 extern char * g_getlogin(void);
25 extern int do_spawn2(char *cmd, int exectype);
26 #if !defined(PERL_OBJECT)
31 extern int g_do_aspawn(void *vreally, void **vmark, void **vsp);
32 #define do_aspawn g_do_aspawn
40 CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
41 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
42 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
43 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
44 struct IPerlProc** ppProc);
45 CPerlHost(CPerlHost& host);
48 static CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl);
49 static CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl);
50 static CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl);
51 static CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl);
52 static CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl);
53 static CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl);
54 static CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl);
55 static CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl);
56 static CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl);
58 BOOL PerlCreate(void);
59 int PerlParse(int argc, char** argv, char** env);
61 void PerlDestroy(void);
64 inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
65 inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
66 inline void Free(void* ptr) { m_pVMem->Free(ptr); };
67 inline void* Calloc(size_t num, size_t size)
69 size_t count = num*size;
70 void* lpVoid = Malloc(count);
72 ZeroMemory(lpVoid, count);
75 inline void GetLock(void) { m_pVMem->GetLock(); };
76 inline void FreeLock(void) { m_pVMem->FreeLock(); };
77 inline int IsLocked(void) { return m_pVMem->IsLocked(); };
80 inline void* MallocShared(size_t size)
82 return m_pVMemShared->Malloc(size);
84 inline void* ReallocShared(void* ptr, size_t size) { return m_pVMemShared->Realloc(ptr, size); };
85 inline void FreeShared(void* ptr) { m_pVMemShared->Free(ptr); };
86 inline void* CallocShared(size_t num, size_t size)
88 size_t count = num*size;
89 void* lpVoid = MallocShared(count);
91 ZeroMemory(lpVoid, count);
94 inline void GetLockShared(void) { m_pVMem->GetLock(); };
95 inline void FreeLockShared(void) { m_pVMem->FreeLock(); };
96 inline int IsLockedShared(void) { return m_pVMem->IsLocked(); };
99 inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
100 inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
101 inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
102 inline void* CallocParse(size_t num, size_t size)
104 size_t count = num*size;
105 void* lpVoid = MallocParse(count);
107 ZeroMemory(lpVoid, count);
110 inline void GetLockParse(void) { m_pVMem->GetLock(); };
111 inline void FreeLockParse(void) { m_pVMem->FreeLock(); };
112 inline int IsLockedParse(void) { return m_pVMem->IsLocked(); };
115 char *Getenv(const char *varname);
116 int Putenv(const char *envstring);
117 inline char *Getenv(const char *varname, unsigned long *len)
120 char *e = Getenv(varname);
125 void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
126 void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
127 char* GetChildDir(void);
128 void FreeChildDir(char* pStr);
132 inline LPSTR GetIndex(DWORD &dwIndex)
134 if(dwIndex < m_dwEnvCount)
137 return m_lppEnvList[dwIndex-1];
143 LPSTR Find(LPCSTR lpStr);
144 void Add(LPCSTR lpStr);
146 LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
147 void FreeLocalEnvironmentStrings(LPSTR lpStr);
148 LPSTR* Lookup(LPCSTR lpStr);
149 DWORD CalculateEnvironmentSpace(void);
154 virtual int Chdir(const char *dirname);
158 void Exit(int status);
159 void _Exit(int status);
160 int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
161 int Execv(const char *cmdname, const char *const *argv);
162 int Execvp(const char *cmdname, const char *const *argv);
164 inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
165 inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
166 inline VDir* GetDir(void) { return m_pvDir; };
170 struct IPerlMem m_hostperlMem;
171 struct IPerlMem m_hostperlMemShared;
172 struct IPerlMem m_hostperlMemParse;
173 struct IPerlEnv m_hostperlEnv;
174 struct IPerlStdIO m_hostperlStdIO;
175 struct IPerlLIO m_hostperlLIO;
176 struct IPerlDir m_hostperlDir;
177 struct IPerlSock m_hostperlSock;
178 struct IPerlProc m_hostperlProc;
180 struct IPerlMem* m_pHostperlMem;
181 struct IPerlMem* m_pHostperlMemShared;
182 struct IPerlMem* m_pHostperlMemParse;
183 struct IPerlEnv* m_pHostperlEnv;
184 struct IPerlStdIO* m_pHostperlStdIO;
185 struct IPerlLIO* m_pHostperlLIO;
186 struct IPerlDir* m_pHostperlDir;
187 struct IPerlSock* m_pHostperlSock;
188 struct IPerlProc* m_pHostperlProc;
190 inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
191 inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
201 static long num_hosts;
203 inline int LastHost(void) { return num_hosts == 1L; };
206 long CPerlHost::num_hosts = 0L;
209 #define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
211 inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
213 return STRUCT2PTR(piPerl, m_hostperlMem);
216 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
218 return STRUCT2PTR(piPerl, m_hostperlMemShared);
221 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
223 return STRUCT2PTR(piPerl, m_hostperlMemParse);
226 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
228 return STRUCT2PTR(piPerl, m_hostperlEnv);
231 inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
233 return STRUCT2PTR(piPerl, m_hostperlStdIO);
236 inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
238 return STRUCT2PTR(piPerl, m_hostperlLIO);
241 inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
243 return STRUCT2PTR(piPerl, m_hostperlDir);
246 inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
248 return STRUCT2PTR(piPerl, m_hostperlSock);
251 inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
253 return STRUCT2PTR(piPerl, m_hostperlProc);
259 #define IPERL2HOST(x) IPerlMem2Host(x)
263 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
265 return IPERL2HOST(piPerl)->Malloc(size);
268 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
270 return IPERL2HOST(piPerl)->Realloc(ptr, size);
273 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
275 IPERL2HOST(piPerl)->Free(ptr);
278 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
280 return IPERL2HOST(piPerl)->Calloc(num, size);
284 PerlMemGetLock(struct IPerlMem* piPerl)
286 IPERL2HOST(piPerl)->GetLock();
290 PerlMemFreeLock(struct IPerlMem* piPerl)
292 IPERL2HOST(piPerl)->FreeLock();
296 PerlMemIsLocked(struct IPerlMem* piPerl)
298 return IPERL2HOST(piPerl)->IsLocked();
301 struct IPerlMem perlMem =
313 #define IPERL2HOST(x) IPerlMemShared2Host(x)
317 PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
319 return IPERL2HOST(piPerl)->MallocShared(size);
322 PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
324 return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
327 PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
329 IPERL2HOST(piPerl)->FreeShared(ptr);
332 PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
334 return IPERL2HOST(piPerl)->CallocShared(num, size);
338 PerlMemSharedGetLock(struct IPerlMem* piPerl)
340 IPERL2HOST(piPerl)->GetLockShared();
344 PerlMemSharedFreeLock(struct IPerlMem* piPerl)
346 IPERL2HOST(piPerl)->FreeLockShared();
350 PerlMemSharedIsLocked(struct IPerlMem* piPerl)
352 return IPERL2HOST(piPerl)->IsLockedShared();
355 struct IPerlMem perlMemShared =
358 PerlMemSharedRealloc,
361 PerlMemSharedGetLock,
362 PerlMemSharedFreeLock,
363 PerlMemSharedIsLocked,
367 #define IPERL2HOST(x) IPerlMemParse2Host(x)
371 PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
373 return IPERL2HOST(piPerl)->MallocParse(size);
376 PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
378 return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
381 PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
383 IPERL2HOST(piPerl)->FreeParse(ptr);
386 PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
388 return IPERL2HOST(piPerl)->CallocParse(num, size);
392 PerlMemParseGetLock(struct IPerlMem* piPerl)
394 IPERL2HOST(piPerl)->GetLockParse();
398 PerlMemParseFreeLock(struct IPerlMem* piPerl)
400 IPERL2HOST(piPerl)->FreeLockParse();
404 PerlMemParseIsLocked(struct IPerlMem* piPerl)
406 return IPERL2HOST(piPerl)->IsLockedParse();
409 struct IPerlMem perlMemParse =
416 PerlMemParseFreeLock,
417 PerlMemParseIsLocked,
422 #define IPERL2HOST(x) IPerlEnv2Host(x)
426 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
428 return IPERL2HOST(piPerl)->Getenv(varname);
432 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
434 return IPERL2HOST(piPerl)->Putenv(envstring);
438 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
440 return IPERL2HOST(piPerl)->Getenv(varname, len);
444 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
446 return win32_uname(name);
450 PerlEnvClearenv(struct IPerlEnv* piPerl)
452 IPERL2HOST(piPerl)->Clearenv();
456 PerlEnvGetChildenv(struct IPerlEnv* piPerl)
458 return IPERL2HOST(piPerl)->CreateChildEnv();
462 PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
464 IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
468 PerlEnvGetChilddir(struct IPerlEnv* piPerl)
470 return IPERL2HOST(piPerl)->GetChildDir();
474 PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
476 IPERL2HOST(piPerl)->FreeChildDir(childDir);
480 PerlEnvOsId(struct IPerlEnv* piPerl)
482 return win32_os_id();
486 PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
488 return g_win32_get_privlib(pl);
492 PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
494 return g_win32_get_sitelib(pl);
498 PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
500 return g_win32_get_vendorlib(pl);
504 PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
506 win32_get_child_IO(ptr);
509 struct IPerlEnv perlEnv =
523 PerlEnvVendorLibPath,
528 #define IPERL2HOST(x) IPerlStdIO2Host(x)
532 PerlStdIOStdin(struct IPerlStdIO* piPerl)
534 return win32_stdin();
538 PerlStdIOStdout(struct IPerlStdIO* piPerl)
540 return win32_stdout();
544 PerlStdIOStderr(struct IPerlStdIO* piPerl)
546 return win32_stderr();
550 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
552 return win32_fopen(path, mode);
556 PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf)
558 return win32_fclose((pf));
562 PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf)
564 return win32_feof(pf);
568 PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf)
570 return win32_ferror(pf);
574 PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf)
580 PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf)
582 return win32_getc(pf);
586 PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf)
597 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf)
601 return FILE_bufsiz(f);
608 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf)
619 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
630 PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n)
632 return win32_fgets(s, n, pf);
636 PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c)
638 return win32_fputc(c, pf);
642 PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s)
644 return win32_fputs(s, pf);
648 PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf)
650 return win32_fflush(pf);
654 PerlStdIOUngetc(struct IPerlStdIO* piPerl,int c, FILE* pf)
656 return win32_ungetc(c, pf);
660 PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf)
662 return win32_fileno(pf);
666 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
668 return win32_fdopen(fd, mode);
672 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf)
674 return win32_freopen(path, mode, (FILE*)pf);
678 PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf)
680 return win32_fread(buffer, size, count, pf);
684 PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf)
686 return win32_fwrite(buffer, size, count, pf);
690 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer)
692 win32_setbuf(pf, buffer);
696 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size)
698 return win32_setvbuf(pf, buffer, type, size);
702 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n)
704 #ifdef STDIO_CNT_LVALUE
711 PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr)
713 #ifdef STDIO_PTR_LVALUE
720 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf)
722 win32_setvbuf(pf, NULL, _IOLBF, 0);
726 PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...)
729 va_start(arglist, format);
730 return win32_vfprintf(pf, format, arglist);
734 PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist)
736 return win32_vfprintf(pf, format, arglist);
740 PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf)
742 return win32_ftell(pf);
746 PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, off_t offset, int origin)
748 return win32_fseek(pf, offset, origin);
752 PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf)
758 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
760 return win32_tmpfile();
764 PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p)
766 return win32_fgetpos(pf, p);
770 PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p)
772 return win32_fsetpos(pf, p);
775 PerlStdIOInit(struct IPerlStdIO* piPerl)
780 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
782 Perl_init_os_extras();
786 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags)
788 return win32_open_osfhandle(osfhandle, flags);
792 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
794 return win32_get_osfhandle(filenum);
798 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
803 int fileno = win32_dup(win32_fileno(pf));
805 /* open the file in the same mode */
807 if((pf)->flags & _F_READ) {
811 else if((pf)->flags & _F_WRIT) {
815 else if((pf)->flags & _F_RDWR) {
821 if((pf)->_flag & _IOREAD) {
825 else if((pf)->_flag & _IOWRT) {
829 else if((pf)->_flag & _IORW) {
836 /* it appears that the binmode is attached to the
837 * file descriptor so binmode files will be handled
840 pfdup = win32_fdopen(fileno, mode);
842 /* move the file pointer to the same position */
843 if (!fgetpos(pf, &pos)) {
844 fsetpos(pfdup, &pos);
849 struct IPerlStdIO perlStdIO =
888 PerlStdIOInitOSExtras,
894 #define IPERL2HOST(x) IPerlLIO2Host(x)
898 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
900 return win32_access(path, mode);
904 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
906 return win32_chmod(filename, pmode);
910 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
912 return chown(filename, owner, group);
916 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
918 return chsize(handle, size);
922 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
924 return win32_close(handle);
928 PerlLIODup(struct IPerlLIO* piPerl, int handle)
930 return win32_dup(handle);
934 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
936 return win32_dup2(handle1, handle2);
940 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
942 return win32_flock(fd, oper);
946 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
948 return win32_fstat(handle, buffer);
952 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
954 return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
958 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
964 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
966 return win32_link(oldname, newname);
970 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
972 return win32_lseek(handle, offset, origin);
976 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
978 return win32_stat(path, buffer);
982 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
984 return mktemp(Template);
988 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
990 return win32_open(filename, oflag);
994 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
996 return win32_open(filename, oflag, pmode);
1000 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
1002 return win32_read(handle, buffer, count);
1006 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
1008 return win32_rename(OldFileName, newname);
1012 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1014 return win32_setmode(handle, mode);
1018 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
1020 return win32_stat(path, buffer);
1024 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1026 return tmpnam(string);
1030 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1032 return umask(pmode);
1036 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1038 return win32_unlink(filename);
1042 PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
1044 return win32_utime(filename, times);
1048 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1050 return win32_write(handle, buffer, count);
1053 struct IPerlLIO perlLIO =
1085 #define IPERL2HOST(x) IPerlDir2Host(x)
1089 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1091 return win32_mkdir(dirname, mode);
1095 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1097 return IPERL2HOST(piPerl)->Chdir(dirname);
1101 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1103 return win32_rmdir(dirname);
1107 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1109 return win32_closedir(dirp);
1113 PerlDirOpen(struct IPerlDir* piPerl, char *filename)
1115 return win32_opendir(filename);
1119 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1121 return win32_readdir(dirp);
1125 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1127 win32_rewinddir(dirp);
1131 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1133 win32_seekdir(dirp, loc);
1137 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1139 return win32_telldir(dirp);
1143 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1145 return IPERL2HOST(piPerl)->MapPathA(path);
1149 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1151 return IPERL2HOST(piPerl)->MapPathW(path);
1154 struct IPerlDir perlDir =
1172 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1174 return win32_htonl(hostlong);
1178 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1180 return win32_htons(hostshort);
1184 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1186 return win32_ntohl(netlong);
1190 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1192 return win32_ntohs(netshort);
1195 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1197 return win32_accept(s, addr, addrlen);
1201 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1203 return win32_bind(s, name, namelen);
1207 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1209 return win32_connect(s, name, namelen);
1213 PerlSockEndhostent(struct IPerlSock* piPerl)
1219 PerlSockEndnetent(struct IPerlSock* piPerl)
1225 PerlSockEndprotoent(struct IPerlSock* piPerl)
1227 win32_endprotoent();
1231 PerlSockEndservent(struct IPerlSock* piPerl)
1237 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1239 return win32_gethostbyaddr(addr, len, type);
1243 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1245 return win32_gethostbyname(name);
1249 PerlSockGethostent(struct IPerlSock* piPerl)
1252 Perl_croak(aTHX_ "gethostent not implemented!\n");
1257 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1259 return win32_gethostname(name, namelen);
1263 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1265 return win32_getnetbyaddr(net, type);
1269 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1271 return win32_getnetbyname((char*)name);
1275 PerlSockGetnetent(struct IPerlSock* piPerl)
1277 return win32_getnetent();
1280 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1282 return win32_getpeername(s, name, namelen);
1286 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1288 return win32_getprotobyname(name);
1292 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1294 return win32_getprotobynumber(number);
1298 PerlSockGetprotoent(struct IPerlSock* piPerl)
1300 return win32_getprotoent();
1304 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1306 return win32_getservbyname(name, proto);
1310 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1312 return win32_getservbyport(port, proto);
1316 PerlSockGetservent(struct IPerlSock* piPerl)
1318 return win32_getservent();
1322 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1324 return win32_getsockname(s, name, namelen);
1328 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1330 return win32_getsockopt(s, level, optname, optval, optlen);
1334 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1336 return win32_inet_addr(cp);
1340 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1342 return win32_inet_ntoa(in);
1346 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1348 return win32_listen(s, backlog);
1352 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1354 return win32_recv(s, buffer, len, flags);
1358 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1360 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1364 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1366 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1370 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1372 return win32_send(s, buffer, len, flags);
1376 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1378 return win32_sendto(s, buffer, len, flags, to, tolen);
1382 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1384 win32_sethostent(stayopen);
1388 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1390 win32_setnetent(stayopen);
1394 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1396 win32_setprotoent(stayopen);
1400 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1402 win32_setservent(stayopen);
1406 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1408 return win32_setsockopt(s, level, optname, optval, optlen);
1412 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1414 return win32_shutdown(s, how);
1418 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1420 return win32_socket(af, type, protocol);
1424 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1427 Perl_croak(aTHX_ "socketpair not implemented!\n");
1432 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1434 return win32_closesocket(s);
1438 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1440 return win32_ioctlsocket(s, cmd, argp);
1443 struct IPerlSock perlSock =
1454 PerlSockEndprotoent,
1456 PerlSockGethostname,
1457 PerlSockGetpeername,
1458 PerlSockGethostbyaddr,
1459 PerlSockGethostbyname,
1461 PerlSockGetnetbyaddr,
1462 PerlSockGetnetbyname,
1464 PerlSockGetprotobyname,
1465 PerlSockGetprotobynumber,
1466 PerlSockGetprotoent,
1467 PerlSockGetservbyname,
1468 PerlSockGetservbyport,
1470 PerlSockGetsockname,
1482 PerlSockSetprotoent,
1488 PerlSockClosesocket,
1494 #define EXECF_EXEC 1
1495 #define EXECF_SPAWN 2
1498 PerlProcAbort(struct IPerlProc* piPerl)
1504 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1506 return win32_crypt(clear, salt);
1510 PerlProcExit(struct IPerlProc* piPerl, int status)
1516 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1522 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1524 return execl(cmdname, arg0, arg1, arg2, arg3);
1528 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1530 return win32_execvp(cmdname, argv);
1534 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1536 return win32_execvp(cmdname, argv);
1540 PerlProcGetuid(struct IPerlProc* piPerl)
1546 PerlProcGeteuid(struct IPerlProc* piPerl)
1552 PerlProcGetgid(struct IPerlProc* piPerl)
1558 PerlProcGetegid(struct IPerlProc* piPerl)
1564 PerlProcGetlogin(struct IPerlProc* piPerl)
1566 return g_getlogin();
1570 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1572 return win32_kill(pid, sig);
1576 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1579 Perl_croak(aTHX_ "killpg not implemented!\n");
1584 PerlProcPauseProc(struct IPerlProc* piPerl)
1586 return win32_sleep((32767L << 16) + 32767);
1590 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1593 PERL_FLUSHALL_FOR_CHILD;
1594 return win32_popen(command, mode);
1598 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1600 return win32_pclose(stream);
1604 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1606 return win32_pipe(phandles, 512, O_BINARY);
1610 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1616 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1622 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1624 return win32_sleep(s);
1628 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1630 return win32_times(timebuf);
1634 PerlProcWait(struct IPerlProc* piPerl, int *status)
1636 return win32_wait(status);
1640 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1642 return win32_waitpid(pid, status, flags);
1646 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1648 return signal(sig, subcode);
1652 static THREAD_RET_TYPE
1653 win32_start_child(LPVOID arg)
1655 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1659 CPerlObj *pPerl = (CPerlObj*)my_perl;
1661 #ifdef PERL_SYNC_FORK
1662 static long sync_fork_id = 0;
1663 long id = ++sync_fork_id;
1667 PERL_SET_THX(my_perl);
1669 /* set $$ to pseudo id */
1670 #ifdef PERL_SYNC_FORK
1673 w32_pseudo_id = GetCurrentThreadId();
1675 int pid = (int)w32_pseudo_id;
1677 w32_pseudo_id = -pid;
1680 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
1681 sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
1682 hv_clear(PL_pidstatus);
1684 /* push a zero on the stack (we are the child) */
1692 /* continue from next op */
1693 PL_op = PL_op->op_next;
1697 volatile int oldscope = PL_scopestack_ix;
1700 JMPENV_PUSH(status);
1707 while (PL_scopestack_ix > oldscope)
1710 PL_curstash = PL_defstash;
1711 if (PL_endav && !PL_minus_c)
1712 call_list(oldscope, PL_endav);
1713 status = STATUS_NATIVE_EXPORT;
1717 POPSTACK_TO(PL_mainstack);
1718 PL_op = PL_restartop;
1719 PL_restartop = Nullop;
1722 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1729 /* XXX hack to avoid perl_destruct() freeing optree */
1730 PL_main_root = Nullop;
1733 /* close the std handles to avoid fd leaks */
1735 do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
1736 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE);
1737 do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE);
1740 /* destroy everything (waits for any pseudo-forked children) */
1741 perl_destruct(my_perl);
1744 #ifdef PERL_SYNC_FORK
1747 return (DWORD)status;
1750 #endif /* USE_ITHREADS */
1753 PerlProcFork(struct IPerlProc* piPerl)
1761 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1765 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1766 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHXo, 1,
1768 h->m_pHostperlMemShared,
1769 h->m_pHostperlMemParse,
1771 h->m_pHostperlStdIO,
1777 new_perl->Isys_intern.internal_host = h;
1778 # ifdef PERL_SYNC_FORK
1779 id = win32_start_child((LPVOID)new_perl);
1780 PERL_SET_THX(aTHXo);
1782 # ifdef USE_RTL_THREAD_API
1783 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1784 (void*)new_perl, 0, (unsigned*)&id);
1786 handle = CreateThread(NULL, 0, win32_start_child,
1787 (LPVOID)new_perl, 0, &id);
1789 PERL_SET_THX(aTHXo); /* XXX perl_clone*() set TLS */
1799 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1800 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1801 ++w32_num_pseudo_children;
1805 Perl_croak(aTHX_ "fork() not implemented!\n");
1807 #endif /* USE_ITHREADS */
1811 PerlProcGetpid(struct IPerlProc* piPerl)
1813 return win32_getpid();
1817 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1819 return win32_dynaload(filename);
1823 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1825 win32_str_os_error(sv, dwErr);
1829 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1831 do_spawn2(cmd, EXECF_EXEC);
1836 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1838 return do_spawn2(cmds, EXECF_SPAWN);
1842 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1844 return win32_spawnvp(mode, cmdname, argv);
1848 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1850 return do_aspawn(vreally, vmark, vsp);
1854 PerlProcLastHost(struct IPerlProc* piPerl)
1857 CPerlHost *h = (CPerlHost*)w32_internal_host;
1858 return h->LastHost();
1861 struct IPerlProc perlProc =
1904 CPerlHost::CPerlHost(void)
1906 /* Construct a host from scratch */
1907 InterlockedIncrement(&num_hosts);
1908 m_pvDir = new VDir();
1909 m_pVMem = new VMem();
1910 m_pVMemShared = new VMem();
1911 m_pVMemParse = new VMem();
1913 m_pvDir->Init(NULL, m_pVMem);
1916 m_lppEnvList = NULL;
1918 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1919 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1920 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1921 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1922 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1923 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1924 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1925 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1926 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1928 m_pHostperlMem = &m_hostperlMem;
1929 m_pHostperlMemShared = &m_hostperlMemShared;
1930 m_pHostperlMemParse = &m_hostperlMemParse;
1931 m_pHostperlEnv = &m_hostperlEnv;
1932 m_pHostperlStdIO = &m_hostperlStdIO;
1933 m_pHostperlLIO = &m_hostperlLIO;
1934 m_pHostperlDir = &m_hostperlDir;
1935 m_pHostperlSock = &m_hostperlSock;
1936 m_pHostperlProc = &m_hostperlProc;
1939 #define SETUPEXCHANGE(xptr, iptr, table) \
1950 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1951 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1952 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1953 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1954 struct IPerlProc** ppProc)
1956 InterlockedIncrement(&num_hosts);
1957 m_pvDir = new VDir(0);
1958 m_pVMem = new VMem();
1959 m_pVMemShared = new VMem();
1960 m_pVMemParse = new VMem();
1962 m_pvDir->Init(NULL, m_pVMem);
1965 m_lppEnvList = NULL;
1967 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1968 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1969 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1970 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1971 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1972 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1973 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1974 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1975 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1977 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
1978 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
1979 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
1980 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
1981 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
1982 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
1983 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
1984 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
1985 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
1987 #undef SETUPEXCHANGE
1989 CPerlHost::CPerlHost(CPerlHost& host)
1991 /* Construct a host from another host */
1992 InterlockedIncrement(&num_hosts);
1993 m_pVMem = new VMem();
1994 m_pVMemShared = host.GetMemShared();
1995 m_pVMemParse = host.GetMemParse();
1997 /* duplicate directory info */
1998 m_pvDir = new VDir(0);
1999 m_pvDir->Init(host.GetDir(), m_pVMem);
2001 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2002 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2003 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2004 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2005 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2006 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2007 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2008 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2009 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2010 m_pHostperlMem = &m_hostperlMem;
2011 m_pHostperlMemShared = &m_hostperlMemShared;
2012 m_pHostperlMemParse = &m_hostperlMemParse;
2013 m_pHostperlEnv = &m_hostperlEnv;
2014 m_pHostperlStdIO = &m_hostperlStdIO;
2015 m_pHostperlLIO = &m_hostperlLIO;
2016 m_pHostperlDir = &m_hostperlDir;
2017 m_pHostperlSock = &m_hostperlSock;
2018 m_pHostperlProc = &m_hostperlProc;
2021 m_lppEnvList = NULL;
2023 /* duplicate environment info */
2026 while(lpPtr = host.GetIndex(dwIndex))
2030 CPerlHost::~CPerlHost(void)
2033 InterlockedDecrement(&num_hosts);
2035 m_pVMemParse->Release();
2036 m_pVMemShared->Release();
2041 CPerlHost::Find(LPCSTR lpStr)
2044 LPSTR* lppPtr = Lookup(lpStr);
2045 if(lppPtr != NULL) {
2046 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2058 lookup(const void *arg1, const void *arg2)
2059 { // Compare strings
2063 ptr1 = *(char**)arg1;
2064 ptr2 = *(char**)arg2;
2068 if(c1 == '\0' || c1 == '=') {
2069 if(c2 == '\0' || c2 == '=')
2072 return -1; // string 1 < string 2
2074 else if(c2 == '\0' || c2 == '=')
2075 return 1; // string 1 > string 2
2081 return -1; // string 1 < string 2
2083 return 1; // string 1 > string 2
2091 CPerlHost::Lookup(LPCSTR lpStr)
2093 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2097 compare(const void *arg1, const void *arg2)
2098 { // Compare strings
2102 ptr1 = *(char**)arg1;
2103 ptr2 = *(char**)arg2;
2107 if(c1 == '\0' || c1 == '=') {
2111 return -1; // string 1 < string 2
2113 else if(c2 == '\0' || c2 == '=')
2114 return 1; // string 1 > string 2
2120 return -1; // string 1 < string 2
2122 return 1; // string 1 > string 2
2130 CPerlHost::Add(LPCSTR lpStr)
2133 char szBuffer[1024];
2135 int index, length = strlen(lpStr)+1;
2137 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2138 szBuffer[index] = lpStr[index];
2140 szBuffer[index] = '\0';
2143 lpPtr = Lookup(szBuffer);
2145 Renew(*lpPtr, length, char);
2146 strcpy(*lpPtr, lpStr);
2150 Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2151 New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2152 if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2153 strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2154 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2162 CPerlHost::CalculateEnvironmentSpace(void)
2166 for(index = 0; index < m_dwEnvCount; ++index)
2167 dwSize += strlen(m_lppEnvList[index]) + 1;
2173 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2180 CPerlHost::GetChildDir(void)
2185 New(0, ptr, MAX_PATH+1, char);
2187 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2188 length = strlen(ptr)-1;
2190 if((ptr[length] == '\\') || (ptr[length] == '/'))
2198 CPerlHost::FreeChildDir(char* pStr)
2205 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2208 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2209 DWORD dwSize, dwEnvIndex;
2210 int nLength, compVal;
2212 // get the process environment strings
2213 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2215 // step over current directory stuff
2216 while(*lpTmp == '=')
2217 lpTmp += strlen(lpTmp) + 1;
2219 // save the start of the environment strings
2221 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2222 // calculate the size of the environment strings
2223 dwSize += strlen(lpTmp) + 1;
2226 // add the size of current directories
2227 dwSize += vDir.CalculateEnvironmentSpace();
2229 // add the additional space used by changes made to the environment
2230 dwSize += CalculateEnvironmentSpace();
2232 New(1, lpStr, dwSize, char);
2235 // build the local environment
2236 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2239 lpLocalEnv = GetIndex(dwEnvIndex);
2240 while(*lpEnvPtr != '\0') {
2242 // all environment overrides have been added
2243 // so copy string into place
2244 strcpy(lpStr, lpEnvPtr);
2245 nLength = strlen(lpEnvPtr) + 1;
2247 lpEnvPtr += nLength;
2250 // determine which string to copy next
2251 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2253 strcpy(lpStr, lpEnvPtr);
2254 nLength = strlen(lpEnvPtr) + 1;
2256 lpEnvPtr += nLength;
2259 char *ptr = strchr(lpLocalEnv, '=');
2261 strcpy(lpStr, lpLocalEnv);
2262 lpStr += strlen(lpLocalEnv) + 1;
2264 lpLocalEnv = GetIndex(dwEnvIndex);
2266 // this string was replaced
2267 lpEnvPtr += strlen(lpEnvPtr) + 1;
2274 // still have environment overrides to add
2275 // so copy the strings into place
2276 strcpy(lpStr, lpLocalEnv);
2277 nLength = strlen(lpLocalEnv) + 1;
2279 lpEnvPtr += nLength;
2280 lpLocalEnv = GetIndex(dwEnvIndex);
2287 // release the process environment strings
2288 FreeEnvironmentStrings(lpAllocPtr);
2294 CPerlHost::Reset(void)
2297 if(m_lppEnvList != NULL) {
2298 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2299 Safefree(m_lppEnvList[index]);
2300 m_lppEnvList[index] = NULL;
2307 CPerlHost::Clearenv(void)
2310 LPSTR lpPtr, lpStr, lpEnvPtr;
2311 if(m_lppEnvList != NULL) {
2312 /* set every entry to an empty string */
2313 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2314 char* ptr = strchr(m_lppEnvList[index], '=');
2321 /* get the process environment strings */
2322 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2324 /* step over current directory stuff */
2325 while(*lpStr == '=')
2326 lpStr += strlen(lpStr) + 1;
2329 lpPtr = strchr(lpStr, '=');
2336 lpStr += strlen(lpStr) + 1;
2339 FreeEnvironmentStrings(lpEnvPtr);
2344 CPerlHost::Getenv(const char *varname)
2346 char* pEnv = Find(varname);
2348 pEnv = win32_getenv(varname);
2359 CPerlHost::Putenv(const char *envstring)
2366 CPerlHost::Chdir(const char *dirname)
2371 WCHAR wBuffer[MAX_PATH];
2372 A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2373 ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2376 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2383 #endif /* ___PerlHost_H___ */