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.
11 #define CHECK_HOST_INTERP
14 #ifndef ___PerlHost_H___
15 #define ___PerlHost_H___
24 #ifndef WC_NO_BEST_FIT_CHARS
25 # define WC_NO_BEST_FIT_CHARS 0x00000400
29 extern char * g_win32_get_privlib(const char *pl, STRLEN *const len);
30 extern char * g_win32_get_sitelib(const char *pl, STRLEN *const len);
31 extern char * g_win32_get_vendorlib(const char *pl, STRLEN *const len);
32 extern char * g_getlogin(void);
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 /* Locks provided but should be unnecessary as this is private pool */
65 inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
66 inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
67 inline void Free(void* ptr) { m_pVMem->Free(ptr); };
68 inline void* Calloc(size_t num, size_t size)
70 size_t count = num*size;
71 void* lpVoid = Malloc(count);
73 ZeroMemory(lpVoid, count);
76 inline void GetLock(void) { m_pVMem->GetLock(); };
77 inline void FreeLock(void) { m_pVMem->FreeLock(); };
78 inline int IsLocked(void) { return m_pVMem->IsLocked(); };
81 /* Locks used to serialize access to the pool */
82 inline void GetLockShared(void) { m_pVMemShared->GetLock(); };
83 inline void FreeLockShared(void) { m_pVMemShared->FreeLock(); };
84 inline int IsLockedShared(void) { return m_pVMemShared->IsLocked(); };
85 inline void* MallocShared(size_t size)
89 result = m_pVMemShared->Malloc(size);
93 inline void* ReallocShared(void* ptr, size_t size)
97 result = m_pVMemShared->Realloc(ptr, size);
101 inline void FreeShared(void* ptr)
104 m_pVMemShared->Free(ptr);
107 inline void* CallocShared(size_t num, size_t size)
109 size_t count = num*size;
110 void* lpVoid = MallocShared(count);
112 ZeroMemory(lpVoid, count);
117 /* Assume something else is using locks to mangaging serialize
120 inline void GetLockParse(void) { m_pVMemParse->GetLock(); };
121 inline void FreeLockParse(void) { m_pVMemParse->FreeLock(); };
122 inline int IsLockedParse(void) { return m_pVMemParse->IsLocked(); };
123 inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
124 inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
125 inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
126 inline void* CallocParse(size_t num, size_t size)
128 size_t count = num*size;
129 void* lpVoid = MallocParse(count);
131 ZeroMemory(lpVoid, count);
136 char *Getenv(const char *varname);
137 int Putenv(const char *envstring);
138 inline char *Getenv(const char *varname, unsigned long *len)
141 char *e = Getenv(varname);
146 void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
147 void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
148 char* GetChildDir(void);
149 void FreeChildDir(char* pStr);
153 inline LPSTR GetIndex(DWORD &dwIndex)
155 if(dwIndex < m_dwEnvCount)
158 return m_lppEnvList[dwIndex-1];
164 LPSTR Find(LPCSTR lpStr);
165 void Add(LPCSTR lpStr);
167 LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
168 void FreeLocalEnvironmentStrings(LPSTR lpStr);
169 LPSTR* Lookup(LPCSTR lpStr);
170 DWORD CalculateEnvironmentSpace(void);
175 virtual int Chdir(const char *dirname);
179 void Exit(int status);
180 void _Exit(int status);
181 int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
182 int Execv(const char *cmdname, const char *const *argv);
183 int Execvp(const char *cmdname, const char *const *argv);
185 inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
186 inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
187 inline VDir* GetDir(void) { return m_pvDir; };
191 struct IPerlMem m_hostperlMem;
192 struct IPerlMem m_hostperlMemShared;
193 struct IPerlMem m_hostperlMemParse;
194 struct IPerlEnv m_hostperlEnv;
195 struct IPerlStdIO m_hostperlStdIO;
196 struct IPerlLIO m_hostperlLIO;
197 struct IPerlDir m_hostperlDir;
198 struct IPerlSock m_hostperlSock;
199 struct IPerlProc m_hostperlProc;
201 struct IPerlMem* m_pHostperlMem;
202 struct IPerlMem* m_pHostperlMemShared;
203 struct IPerlMem* m_pHostperlMemParse;
204 struct IPerlEnv* m_pHostperlEnv;
205 struct IPerlStdIO* m_pHostperlStdIO;
206 struct IPerlLIO* m_pHostperlLIO;
207 struct IPerlDir* m_pHostperlDir;
208 struct IPerlSock* m_pHostperlSock;
209 struct IPerlProc* m_pHostperlProc;
211 inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
212 inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
222 BOOL m_bTopLevel; // is this a toplevel host?
223 static long num_hosts;
225 inline int LastHost(void) { return num_hosts == 1L; };
226 struct interpreter *host_perl;
229 long CPerlHost::num_hosts = 0L;
231 extern "C" void win32_checkTLS(struct interpreter *host_perl);
233 #define STRUCT2RAWPTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
234 #ifdef CHECK_HOST_INTERP
235 inline CPerlHost* CheckInterp(CPerlHost *host)
237 win32_checkTLS(host->host_perl);
240 #define STRUCT2PTR(x, y) CheckInterp(STRUCT2RAWPTR(x, y))
242 #define STRUCT2PTR(x, y) STRUCT2RAWPTR(x, y)
245 inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
247 return STRUCT2RAWPTR(piPerl, m_hostperlMem);
250 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
252 return STRUCT2RAWPTR(piPerl, m_hostperlMemShared);
255 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
257 return STRUCT2RAWPTR(piPerl, m_hostperlMemParse);
260 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
262 return STRUCT2PTR(piPerl, m_hostperlEnv);
265 inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
267 return STRUCT2PTR(piPerl, m_hostperlStdIO);
270 inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
272 return STRUCT2PTR(piPerl, m_hostperlLIO);
275 inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
277 return STRUCT2PTR(piPerl, m_hostperlDir);
280 inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
282 return STRUCT2PTR(piPerl, m_hostperlSock);
285 inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
287 return STRUCT2PTR(piPerl, m_hostperlProc);
293 #define IPERL2HOST(x) IPerlMem2Host(x)
297 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
299 return IPERL2HOST(piPerl)->Malloc(size);
302 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
304 return IPERL2HOST(piPerl)->Realloc(ptr, size);
307 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
309 IPERL2HOST(piPerl)->Free(ptr);
312 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
314 return IPERL2HOST(piPerl)->Calloc(num, size);
318 PerlMemGetLock(struct IPerlMem* piPerl)
320 IPERL2HOST(piPerl)->GetLock();
324 PerlMemFreeLock(struct IPerlMem* piPerl)
326 IPERL2HOST(piPerl)->FreeLock();
330 PerlMemIsLocked(struct IPerlMem* piPerl)
332 return IPERL2HOST(piPerl)->IsLocked();
335 struct IPerlMem perlMem =
347 #define IPERL2HOST(x) IPerlMemShared2Host(x)
351 PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
353 return IPERL2HOST(piPerl)->MallocShared(size);
356 PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
358 return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
361 PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
363 IPERL2HOST(piPerl)->FreeShared(ptr);
366 PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
368 return IPERL2HOST(piPerl)->CallocShared(num, size);
372 PerlMemSharedGetLock(struct IPerlMem* piPerl)
374 IPERL2HOST(piPerl)->GetLockShared();
378 PerlMemSharedFreeLock(struct IPerlMem* piPerl)
380 IPERL2HOST(piPerl)->FreeLockShared();
384 PerlMemSharedIsLocked(struct IPerlMem* piPerl)
386 return IPERL2HOST(piPerl)->IsLockedShared();
389 struct IPerlMem perlMemShared =
392 PerlMemSharedRealloc,
395 PerlMemSharedGetLock,
396 PerlMemSharedFreeLock,
397 PerlMemSharedIsLocked,
401 #define IPERL2HOST(x) IPerlMemParse2Host(x)
405 PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
407 return IPERL2HOST(piPerl)->MallocParse(size);
410 PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
412 return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
415 PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
417 IPERL2HOST(piPerl)->FreeParse(ptr);
420 PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
422 return IPERL2HOST(piPerl)->CallocParse(num, size);
426 PerlMemParseGetLock(struct IPerlMem* piPerl)
428 IPERL2HOST(piPerl)->GetLockParse();
432 PerlMemParseFreeLock(struct IPerlMem* piPerl)
434 IPERL2HOST(piPerl)->FreeLockParse();
438 PerlMemParseIsLocked(struct IPerlMem* piPerl)
440 return IPERL2HOST(piPerl)->IsLockedParse();
443 struct IPerlMem perlMemParse =
450 PerlMemParseFreeLock,
451 PerlMemParseIsLocked,
456 #define IPERL2HOST(x) IPerlEnv2Host(x)
460 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
462 return IPERL2HOST(piPerl)->Getenv(varname);
466 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
468 return IPERL2HOST(piPerl)->Putenv(envstring);
472 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
474 return IPERL2HOST(piPerl)->Getenv(varname, len);
478 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
480 return win32_uname(name);
484 PerlEnvClearenv(struct IPerlEnv* piPerl)
486 IPERL2HOST(piPerl)->Clearenv();
490 PerlEnvGetChildenv(struct IPerlEnv* piPerl)
492 return IPERL2HOST(piPerl)->CreateChildEnv();
496 PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
498 IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
502 PerlEnvGetChilddir(struct IPerlEnv* piPerl)
504 return IPERL2HOST(piPerl)->GetChildDir();
508 PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
510 IPERL2HOST(piPerl)->FreeChildDir(childDir);
514 PerlEnvOsId(struct IPerlEnv* piPerl)
516 return win32_os_id();
520 PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl, STRLEN *const len)
522 return g_win32_get_privlib(pl, len);
526 PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl, STRLEN *const len)
528 return g_win32_get_sitelib(pl, len);
532 PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl,
535 return g_win32_get_vendorlib(pl, len);
539 PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
541 win32_get_child_IO(ptr);
544 struct IPerlEnv perlEnv =
558 PerlEnvVendorLibPath,
563 #define IPERL2HOST(x) IPerlStdIO2Host(x)
567 PerlStdIOStdin(struct IPerlStdIO* piPerl)
569 return win32_stdin();
573 PerlStdIOStdout(struct IPerlStdIO* piPerl)
575 return win32_stdout();
579 PerlStdIOStderr(struct IPerlStdIO* piPerl)
581 return win32_stderr();
585 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
587 return win32_fopen(path, mode);
591 PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf)
593 return win32_fclose((pf));
597 PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf)
599 return win32_feof(pf);
603 PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf)
605 return win32_ferror(pf);
609 PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf)
615 PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf)
617 return win32_getc(pf);
621 PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf)
632 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf)
636 return FILE_bufsiz(f);
643 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf)
654 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
665 PerlStdIOGets(struct IPerlStdIO* piPerl, char* s, int n, FILE* pf)
667 return win32_fgets(s, n, pf);
671 PerlStdIOPutc(struct IPerlStdIO* piPerl, int c, FILE* pf)
673 return win32_fputc(c, pf);
677 PerlStdIOPuts(struct IPerlStdIO* piPerl, const char *s, FILE* pf)
679 return win32_fputs(s, pf);
683 PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf)
685 return win32_fflush(pf);
689 PerlStdIOUngetc(struct IPerlStdIO* piPerl,int c, FILE* pf)
691 return win32_ungetc(c, pf);
695 PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf)
697 return win32_fileno(pf);
701 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
703 return win32_fdopen(fd, mode);
707 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf)
709 return win32_freopen(path, mode, (FILE*)pf);
713 PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf)
715 return win32_fread(buffer, size, count, pf);
719 PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf)
721 return win32_fwrite(buffer, size, count, pf);
725 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer)
727 win32_setbuf(pf, buffer);
731 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size)
733 return win32_setvbuf(pf, buffer, type, size);
737 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n)
739 #ifdef STDIO_CNT_LVALUE
746 PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, STDCHAR * ptr)
748 #ifdef STDIO_PTR_LVALUE
755 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf)
757 win32_setvbuf(pf, NULL, _IOLBF, 0);
761 PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...)
764 va_start(arglist, format);
765 return win32_vfprintf(pf, format, arglist);
769 PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist)
771 return win32_vfprintf(pf, format, arglist);
775 PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf)
777 return win32_ftell(pf);
781 PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, Off_t offset, int origin)
783 return win32_fseek(pf, offset, origin);
787 PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf)
793 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
795 return win32_tmpfile();
799 PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p)
801 return win32_fgetpos(pf, p);
805 PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p)
807 return win32_fsetpos(pf, p);
810 PerlStdIOInit(struct IPerlStdIO* piPerl)
815 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
817 Perl_init_os_extras();
821 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, intptr_t osfhandle, int flags)
823 return win32_open_osfhandle(osfhandle, flags);
827 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
829 return win32_get_osfhandle(filenum);
833 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
839 int fileno = win32_dup(win32_fileno(pf));
841 /* open the file in the same mode */
842 if((pf)->_flag & _IOREAD) {
846 else if((pf)->_flag & _IOWRT) {
850 else if((pf)->_flag & _IORW) {
856 /* it appears that the binmode is attached to the
857 * file descriptor so binmode files will be handled
860 pfdup = win32_fdopen(fileno, mode);
862 /* move the file pointer to the same position */
863 if (!fgetpos(pf, &pos)) {
864 fsetpos(pfdup, &pos);
872 struct IPerlStdIO perlStdIO =
911 PerlStdIOInitOSExtras,
917 #define IPERL2HOST(x) IPerlLIO2Host(x)
921 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
923 return win32_access(path, mode);
927 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
929 return win32_chmod(filename, pmode);
933 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
935 return chown(filename, owner, group);
939 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, Off_t size)
941 return win32_chsize(handle, size);
945 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
947 return win32_close(handle);
951 PerlLIODup(struct IPerlLIO* piPerl, int handle)
953 return win32_dup(handle);
957 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
959 return win32_dup2(handle1, handle2);
963 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
965 return win32_flock(fd, oper);
969 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, Stat_t *buffer)
971 return win32_fstat(handle, buffer);
975 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
980 /* mauke says using memcpy avoids alignment issues */
981 memcpy(&u_long_arg, data, sizeof u_long_arg);
982 retval = win32_ioctlsocket((SOCKET)i, (long)u, &u_long_arg);
983 memcpy(data, &u_long_arg, sizeof u_long_arg);
988 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
990 return win32_isatty(fd);
994 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
996 return win32_link(oldname, newname);
1000 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, Off_t offset, int origin)
1002 return win32_lseek(handle, offset, origin);
1006 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer)
1008 return win32_stat(path, buffer);
1012 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
1014 return mktemp(Template);
1018 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
1020 return win32_open(filename, oflag);
1024 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
1026 return win32_open(filename, oflag, pmode);
1030 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
1032 return win32_read(handle, buffer, count);
1036 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
1038 return win32_rename(OldFileName, newname);
1042 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1044 return win32_setmode(handle, mode);
1048 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer)
1050 return win32_stat(path, buffer);
1054 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1056 return tmpnam(string);
1060 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1062 return umask(pmode);
1066 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1068 return win32_unlink(filename);
1072 PerlLIOUtime(struct IPerlLIO* piPerl, const char *filename, struct utimbuf *times)
1074 return win32_utime(filename, times);
1078 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1080 return win32_write(handle, buffer, count);
1083 struct IPerlLIO perlLIO =
1115 #define IPERL2HOST(x) IPerlDir2Host(x)
1119 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1121 return win32_mkdir(dirname, mode);
1125 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1127 return IPERL2HOST(piPerl)->Chdir(dirname);
1131 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1133 return win32_rmdir(dirname);
1137 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1139 return win32_closedir(dirp);
1143 PerlDirOpen(struct IPerlDir* piPerl, const char *filename)
1145 return win32_opendir(filename);
1149 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1151 return win32_readdir(dirp);
1155 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1157 win32_rewinddir(dirp);
1161 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1163 win32_seekdir(dirp, loc);
1167 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1169 return win32_telldir(dirp);
1173 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1175 return IPERL2HOST(piPerl)->MapPathA(path);
1179 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1181 return IPERL2HOST(piPerl)->MapPathW(path);
1184 struct IPerlDir perlDir =
1202 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1204 return win32_htonl(hostlong);
1208 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1210 return win32_htons(hostshort);
1214 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1216 return win32_ntohl(netlong);
1220 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1222 return win32_ntohs(netshort);
1225 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1227 return win32_accept(s, addr, addrlen);
1231 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1233 return win32_bind(s, name, namelen);
1237 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1239 return win32_connect(s, name, namelen);
1243 PerlSockEndhostent(struct IPerlSock* piPerl)
1249 PerlSockEndnetent(struct IPerlSock* piPerl)
1255 PerlSockEndprotoent(struct IPerlSock* piPerl)
1257 win32_endprotoent();
1261 PerlSockEndservent(struct IPerlSock* piPerl)
1267 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1269 return win32_gethostbyaddr(addr, len, type);
1273 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1275 return win32_gethostbyname(name);
1279 PerlSockGethostent(struct IPerlSock* piPerl)
1281 win32_croak_not_implemented("gethostent");
1286 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1288 return win32_gethostname(name, namelen);
1292 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1294 return win32_getnetbyaddr(net, type);
1298 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1300 return win32_getnetbyname((char*)name);
1304 PerlSockGetnetent(struct IPerlSock* piPerl)
1306 return win32_getnetent();
1309 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1311 return win32_getpeername(s, name, namelen);
1315 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1317 return win32_getprotobyname(name);
1321 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1323 return win32_getprotobynumber(number);
1327 PerlSockGetprotoent(struct IPerlSock* piPerl)
1329 return win32_getprotoent();
1333 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1335 return win32_getservbyname(name, proto);
1339 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1341 return win32_getservbyport(port, proto);
1345 PerlSockGetservent(struct IPerlSock* piPerl)
1347 return win32_getservent();
1351 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1353 return win32_getsockname(s, name, namelen);
1357 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1359 return win32_getsockopt(s, level, optname, optval, optlen);
1363 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1365 return win32_inet_addr(cp);
1369 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1371 return win32_inet_ntoa(in);
1375 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1377 return win32_listen(s, backlog);
1381 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1383 return win32_recv(s, buffer, len, flags);
1387 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1389 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1393 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1395 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1399 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1401 return win32_send(s, buffer, len, flags);
1405 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1407 return win32_sendto(s, buffer, len, flags, to, tolen);
1411 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1413 win32_sethostent(stayopen);
1417 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1419 win32_setnetent(stayopen);
1423 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1425 win32_setprotoent(stayopen);
1429 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1431 win32_setservent(stayopen);
1435 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1437 return win32_setsockopt(s, level, optname, optval, optlen);
1441 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1443 return win32_shutdown(s, how);
1447 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1449 return win32_socket(af, type, protocol);
1453 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1455 return Perl_my_socketpair(domain, type, protocol, fds);
1459 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1461 return win32_closesocket(s);
1465 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1467 return win32_ioctlsocket(s, cmd, argp);
1470 struct IPerlSock perlSock =
1481 PerlSockEndprotoent,
1483 PerlSockGethostname,
1484 PerlSockGetpeername,
1485 PerlSockGethostbyaddr,
1486 PerlSockGethostbyname,
1488 PerlSockGetnetbyaddr,
1489 PerlSockGetnetbyname,
1491 PerlSockGetprotobyname,
1492 PerlSockGetprotobynumber,
1493 PerlSockGetprotoent,
1494 PerlSockGetservbyname,
1495 PerlSockGetservbyport,
1497 PerlSockGetsockname,
1509 PerlSockSetprotoent,
1515 PerlSockClosesocket,
1521 #define EXECF_EXEC 1
1522 #define EXECF_SPAWN 2
1525 PerlProcAbort(struct IPerlProc* piPerl)
1531 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1533 return win32_crypt(clear, salt);
1536 PERL_CALLCONV_NO_RET void
1537 PerlProcExit(struct IPerlProc* piPerl, int status)
1542 PERL_CALLCONV_NO_RET void
1543 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1549 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1551 return execl(cmdname, arg0, arg1, arg2, arg3);
1555 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1557 return win32_execvp(cmdname, argv);
1561 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1563 return win32_execvp(cmdname, argv);
1567 PerlProcGetuid(struct IPerlProc* piPerl)
1573 PerlProcGeteuid(struct IPerlProc* piPerl)
1579 PerlProcGetgid(struct IPerlProc* piPerl)
1585 PerlProcGetegid(struct IPerlProc* piPerl)
1591 PerlProcGetlogin(struct IPerlProc* piPerl)
1593 return g_getlogin();
1597 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1599 return win32_kill(pid, sig);
1603 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1605 return win32_kill(pid, -sig);
1609 PerlProcPauseProc(struct IPerlProc* piPerl)
1611 return win32_sleep((32767L << 16) + 32767);
1615 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1618 PERL_FLUSHALL_FOR_CHILD;
1619 return win32_popen(command, mode);
1623 PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
1626 PERL_FLUSHALL_FOR_CHILD;
1627 return win32_popenlist(mode, narg, args);
1631 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1633 return win32_pclose(stream);
1637 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1639 return win32_pipe(phandles, 512, O_BINARY);
1643 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1649 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1655 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1657 return win32_sleep(s);
1661 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1663 return win32_times(timebuf);
1667 PerlProcWait(struct IPerlProc* piPerl, int *status)
1669 return win32_wait(status);
1673 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1675 return win32_waitpid(pid, status, flags);
1679 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1681 return win32_signal(sig, subcode);
1685 PerlProcGetTimeOfDay(struct IPerlProc* piPerl, struct timeval *t, void *z)
1687 return win32_gettimeofday(t, z);
1691 static THREAD_RET_TYPE
1692 win32_start_child(LPVOID arg)
1694 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1696 HWND parent_message_hwnd;
1697 #ifdef PERL_SYNC_FORK
1698 static long sync_fork_id = 0;
1699 long id = ++sync_fork_id;
1703 PERL_SET_THX(my_perl);
1704 win32_checkTLS(my_perl);
1706 #ifdef PERL_SYNC_FORK
1709 w32_pseudo_id = GetCurrentThreadId();
1711 #ifdef PERL_USES_PL_PIDSTATUS
1712 hv_clear(PL_pidstatus);
1715 /* create message window and tell parent about it */
1716 parent_message_hwnd = w32_message_hwnd;
1717 w32_message_hwnd = win32_create_message_window();
1718 if (parent_message_hwnd != NULL)
1719 PostMessage(parent_message_hwnd, WM_USER_MESSAGE, w32_pseudo_id, (LPARAM)w32_message_hwnd);
1721 /* push a zero on the stack (we are the child) */
1729 /* continue from next op */
1730 PL_op = PL_op->op_next;
1734 volatile int oldscope = 1; /* We are responsible for all scopes */
1737 JMPENV_PUSH(status);
1741 /* We may have additional unclosed scopes if fork() was called
1742 * from within a BEGIN block. See perlfork.pod for more details.
1743 * We cannot clean up these other scopes because they belong to a
1744 * different interpreter, but we also cannot leave PL_scopestack_ix
1745 * dangling because that can trigger an assertion in perl_destruct().
1747 if (PL_scopestack_ix > oldscope) {
1748 PL_scopestack[oldscope-1] = PL_scopestack[PL_scopestack_ix-1];
1749 PL_scopestack_ix = oldscope;
1754 while (PL_scopestack_ix > oldscope)
1757 PL_curstash = PL_defstash;
1758 if (PL_curstash != PL_defstash) {
1759 SvREFCNT_dec(PL_curstash);
1760 PL_curstash = (HV *)SvREFCNT_inc(PL_defstash);
1762 if (PL_endav && !PL_minus_c) {
1763 PERL_SET_PHASE(PERL_PHASE_END);
1764 call_list(oldscope, PL_endav);
1766 status = STATUS_EXIT;
1770 POPSTACK_TO(PL_mainstack);
1771 PL_op = PL_restartop;
1772 PL_restartop = (OP*)NULL;
1775 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1782 /* XXX hack to avoid perl_destruct() freeing optree */
1783 win32_checkTLS(my_perl);
1784 PL_main_root = (OP*)NULL;
1787 win32_checkTLS(my_perl);
1788 /* close the std handles to avoid fd leaks */
1790 do_close(PL_stdingv, FALSE);
1791 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE); /* PL_stdoutgv - ISAGN */
1792 do_close(PL_stderrgv, FALSE);
1795 /* destroy everything (waits for any pseudo-forked children) */
1796 win32_checkTLS(my_perl);
1797 perl_destruct(my_perl);
1798 win32_checkTLS(my_perl);
1801 #ifdef PERL_SYNC_FORK
1804 return (DWORD)status;
1807 #endif /* USE_ITHREADS */
1810 PerlProcFork(struct IPerlProc* piPerl)
1818 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1822 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1823 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX,
1826 h->m_pHostperlMemShared,
1827 h->m_pHostperlMemParse,
1829 h->m_pHostperlStdIO,
1835 new_perl->Isys_intern.internal_host = h;
1836 h->host_perl = new_perl;
1837 # ifdef PERL_SYNC_FORK
1838 id = win32_start_child((LPVOID)new_perl);
1841 if (w32_message_hwnd == INVALID_HANDLE_VALUE)
1842 w32_message_hwnd = win32_create_message_window();
1843 new_perl->Isys_intern.message_hwnd = w32_message_hwnd;
1844 w32_pseudo_child_message_hwnds[w32_num_pseudo_children] =
1845 (w32_message_hwnd == NULL) ? (HWND)NULL : (HWND)INVALID_HANDLE_VALUE;
1846 # ifdef USE_RTL_THREAD_API
1847 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1848 (void*)new_perl, 0, (unsigned*)&id);
1850 handle = CreateThread(NULL, 0, win32_start_child,
1851 (LPVOID)new_perl, 0, &id);
1853 PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
1858 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1859 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1860 w32_pseudo_child_sigterm[w32_num_pseudo_children] = 0;
1861 ++w32_num_pseudo_children;
1865 win32_croak_not_implemented("fork()");
1867 #endif /* USE_ITHREADS */
1871 PerlProcGetpid(struct IPerlProc* piPerl)
1873 return win32_getpid();
1877 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1879 return win32_dynaload(filename);
1883 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1885 win32_str_os_error(sv, dwErr);
1889 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1891 return win32_spawnvp(mode, cmdname, argv);
1895 PerlProcLastHost(struct IPerlProc* piPerl)
1897 /* this dTHX is unused in an optimized build since CPerlHost::num_hosts
1900 CPerlHost *h = (CPerlHost*)w32_internal_host;
1901 return h->LastHost();
1904 struct IPerlProc perlProc =
1938 PerlProcGetTimeOfDay
1946 CPerlHost::CPerlHost(void)
1948 /* Construct a host from scratch */
1949 InterlockedIncrement(&num_hosts);
1950 m_pvDir = new VDir();
1951 m_pVMem = new VMem();
1952 m_pVMemShared = new VMem();
1953 m_pVMemParse = new VMem();
1955 m_pvDir->Init(NULL, m_pVMem);
1958 m_lppEnvList = NULL;
1961 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1962 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1963 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1964 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1965 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1966 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1967 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1968 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1969 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1971 m_pHostperlMem = &m_hostperlMem;
1972 m_pHostperlMemShared = &m_hostperlMemShared;
1973 m_pHostperlMemParse = &m_hostperlMemParse;
1974 m_pHostperlEnv = &m_hostperlEnv;
1975 m_pHostperlStdIO = &m_hostperlStdIO;
1976 m_pHostperlLIO = &m_hostperlLIO;
1977 m_pHostperlDir = &m_hostperlDir;
1978 m_pHostperlSock = &m_hostperlSock;
1979 m_pHostperlProc = &m_hostperlProc;
1982 #define SETUPEXCHANGE(xptr, iptr, table) \
1993 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1994 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1995 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1996 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1997 struct IPerlProc** ppProc)
1999 InterlockedIncrement(&num_hosts);
2000 m_pvDir = new VDir(0);
2001 m_pVMem = new VMem();
2002 m_pVMemShared = new VMem();
2003 m_pVMemParse = new VMem();
2005 m_pvDir->Init(NULL, m_pVMem);
2008 m_lppEnvList = NULL;
2009 m_bTopLevel = FALSE;
2011 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2012 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2013 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2014 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2015 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2016 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2017 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2018 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2019 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2021 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
2022 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
2023 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
2024 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
2025 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
2026 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
2027 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
2028 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
2029 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
2031 #undef SETUPEXCHANGE
2033 CPerlHost::CPerlHost(CPerlHost& host)
2035 /* Construct a host from another host */
2036 InterlockedIncrement(&num_hosts);
2037 m_pVMem = new VMem();
2038 m_pVMemShared = host.GetMemShared();
2039 m_pVMemParse = host.GetMemParse();
2041 /* duplicate directory info */
2042 m_pvDir = new VDir(0);
2043 m_pvDir->Init(host.GetDir(), m_pVMem);
2045 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2046 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2047 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2048 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2049 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2050 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2051 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2052 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2053 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2054 m_pHostperlMem = &m_hostperlMem;
2055 m_pHostperlMemShared = &m_hostperlMemShared;
2056 m_pHostperlMemParse = &m_hostperlMemParse;
2057 m_pHostperlEnv = &m_hostperlEnv;
2058 m_pHostperlStdIO = &m_hostperlStdIO;
2059 m_pHostperlLIO = &m_hostperlLIO;
2060 m_pHostperlDir = &m_hostperlDir;
2061 m_pHostperlSock = &m_hostperlSock;
2062 m_pHostperlProc = &m_hostperlProc;
2065 m_lppEnvList = NULL;
2066 m_bTopLevel = FALSE;
2068 /* duplicate environment info */
2071 while(lpPtr = host.GetIndex(dwIndex))
2075 CPerlHost::~CPerlHost(void)
2078 InterlockedDecrement(&num_hosts);
2080 m_pVMemParse->Release();
2081 m_pVMemShared->Release();
2086 CPerlHost::Find(LPCSTR lpStr)
2089 LPSTR* lppPtr = Lookup(lpStr);
2090 if(lppPtr != NULL) {
2091 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2103 lookup(const void *arg1, const void *arg2)
2104 { // Compare strings
2108 ptr1 = *(char**)arg1;
2109 ptr2 = *(char**)arg2;
2113 if(c1 == '\0' || c1 == '=') {
2114 if(c2 == '\0' || c2 == '=')
2117 return -1; // string 1 < string 2
2119 else if(c2 == '\0' || c2 == '=')
2120 return 1; // string 1 > string 2
2126 return -1; // string 1 < string 2
2128 return 1; // string 1 > string 2
2136 CPerlHost::Lookup(LPCSTR lpStr)
2139 if (!m_lppEnvList || !m_dwEnvCount)
2144 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2148 compare(const void *arg1, const void *arg2)
2149 { // Compare strings
2153 ptr1 = *(char**)arg1;
2154 ptr2 = *(char**)arg2;
2158 if(c1 == '\0' || c1 == '=') {
2162 return -1; // string 1 < string 2
2164 else if(c2 == '\0' || c2 == '=')
2165 return 1; // string 1 > string 2
2171 return -1; // string 1 < string 2
2173 return 1; // string 1 > string 2
2181 CPerlHost::Add(LPCSTR lpStr)
2183 char szBuffer[1024];
2185 int index, length = strlen(lpStr)+1;
2187 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2188 szBuffer[index] = lpStr[index];
2190 szBuffer[index] = '\0';
2193 lpPtr = Lookup(szBuffer);
2194 if (lpPtr != NULL) {
2195 // must allocate things via host memory allocation functions
2196 // rather than perl's Renew() et al, as the perl interpreter
2197 // may either not be initialized enough when we allocate these,
2198 // or may already be dead when we go to free these
2199 *lpPtr = (char*)Realloc(*lpPtr, length * sizeof(char));
2200 strcpy(*lpPtr, lpStr);
2203 m_lppEnvList = (LPSTR*)Realloc(m_lppEnvList, (m_dwEnvCount+1) * sizeof(LPSTR));
2205 m_lppEnvList[m_dwEnvCount] = (char*)Malloc(length * sizeof(char));
2206 if (m_lppEnvList[m_dwEnvCount] != NULL) {
2207 strcpy(m_lppEnvList[m_dwEnvCount], lpStr);
2209 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2216 CPerlHost::CalculateEnvironmentSpace(void)
2220 for(index = 0; index < m_dwEnvCount; ++index)
2221 dwSize += strlen(m_lppEnvList[index]) + 1;
2227 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2233 CPerlHost::GetChildDir(void)
2238 Newx(ptr, MAX_PATH+1, char);
2239 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2240 length = strlen(ptr);
2242 if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2249 CPerlHost::FreeChildDir(char* pStr)
2255 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2257 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2258 DWORD dwSize, dwEnvIndex;
2259 int nLength, compVal;
2261 // get the process environment strings
2262 lpAllocPtr = lpTmp = (LPSTR)win32_getenvironmentstrings();
2264 // step over current directory stuff
2265 while(*lpTmp == '=')
2266 lpTmp += strlen(lpTmp) + 1;
2268 // save the start of the environment strings
2270 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2271 // calculate the size of the environment strings
2272 dwSize += strlen(lpTmp) + 1;
2275 // add the size of current directories
2276 dwSize += vDir.CalculateEnvironmentSpace();
2278 // add the additional space used by changes made to the environment
2279 dwSize += CalculateEnvironmentSpace();
2281 Newx(lpStr, dwSize, char);
2284 // build the local environment
2285 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2288 lpLocalEnv = GetIndex(dwEnvIndex);
2289 while(*lpEnvPtr != '\0') {
2291 // all environment overrides have been added
2292 // so copy string into place
2293 strcpy(lpStr, lpEnvPtr);
2294 nLength = strlen(lpEnvPtr) + 1;
2296 lpEnvPtr += nLength;
2299 // determine which string to copy next
2300 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2302 strcpy(lpStr, lpEnvPtr);
2303 nLength = strlen(lpEnvPtr) + 1;
2305 lpEnvPtr += nLength;
2308 char *ptr = strchr(lpLocalEnv, '=');
2310 strcpy(lpStr, lpLocalEnv);
2311 lpStr += strlen(lpLocalEnv) + 1;
2313 lpLocalEnv = GetIndex(dwEnvIndex);
2315 // this string was replaced
2316 lpEnvPtr += strlen(lpEnvPtr) + 1;
2323 // still have environment overrides to add
2324 // so copy the strings into place if not an override
2325 char *ptr = strchr(lpLocalEnv, '=');
2327 strcpy(lpStr, lpLocalEnv);
2328 lpStr += strlen(lpLocalEnv) + 1;
2330 lpLocalEnv = GetIndex(dwEnvIndex);
2337 // release the process environment strings
2338 win32_freeenvironmentstrings(lpAllocPtr);
2344 CPerlHost::Reset(void)
2346 if(m_lppEnvList != NULL) {
2347 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2348 Free(m_lppEnvList[index]);
2349 m_lppEnvList[index] = NULL;
2354 m_lppEnvList = NULL;
2358 CPerlHost::Clearenv(void)
2361 LPSTR lpPtr, lpStr, lpEnvPtr;
2362 if (m_lppEnvList != NULL) {
2363 /* set every entry to an empty string */
2364 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2365 char* ptr = strchr(m_lppEnvList[index], '=');
2372 /* get the process environment strings */
2373 lpStr = lpEnvPtr = (LPSTR)win32_getenvironmentstrings();
2375 /* step over current directory stuff */
2376 while(*lpStr == '=')
2377 lpStr += strlen(lpStr) + 1;
2380 lpPtr = strchr(lpStr, '=');
2386 (void)win32_putenv(lpStr);
2389 lpStr += strlen(lpStr) + 1;
2392 win32_freeenvironmentstrings(lpEnvPtr);
2397 CPerlHost::Getenv(const char *varname)
2400 char *pEnv = Find(varname);
2404 return win32_getenv(varname);
2408 CPerlHost::Putenv(const char *envstring)
2412 return win32_putenv(envstring);
2418 CPerlHost::Chdir(const char *dirname)
2425 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2432 #endif /* ___PerlHost_H___ */