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,
33 extern char * g_getlogin(void);
41 CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
42 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
43 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
44 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
45 struct IPerlProc** ppProc);
46 CPerlHost(CPerlHost& host);
49 static CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl);
50 static CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl);
51 static CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl);
52 static CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl);
53 static CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl);
54 static CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl);
55 static CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl);
56 static CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl);
57 static CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl);
59 BOOL PerlCreate(void);
60 int PerlParse(int argc, char** argv, char** env);
62 void PerlDestroy(void);
65 /* Locks provided but should be unnecessary as this is private pool */
66 inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
67 inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
68 inline void Free(void* ptr) { m_pVMem->Free(ptr); };
69 inline void* Calloc(size_t num, size_t size)
71 size_t count = num*size;
72 void* lpVoid = Malloc(count);
74 ZeroMemory(lpVoid, count);
77 inline void GetLock(void) { m_pVMem->GetLock(); };
78 inline void FreeLock(void) { m_pVMem->FreeLock(); };
79 inline int IsLocked(void) { return m_pVMem->IsLocked(); };
82 /* Locks used to serialize access to the pool */
83 inline void GetLockShared(void) { m_pVMemShared->GetLock(); };
84 inline void FreeLockShared(void) { m_pVMemShared->FreeLock(); };
85 inline int IsLockedShared(void) { return m_pVMemShared->IsLocked(); };
86 inline void* MallocShared(size_t size)
90 result = m_pVMemShared->Malloc(size);
94 inline void* ReallocShared(void* ptr, size_t size)
98 result = m_pVMemShared->Realloc(ptr, size);
102 inline void FreeShared(void* ptr)
105 m_pVMemShared->Free(ptr);
108 inline void* CallocShared(size_t num, size_t size)
110 size_t count = num*size;
111 void* lpVoid = MallocShared(count);
113 ZeroMemory(lpVoid, count);
118 /* Assume something else is using locks to mangaging serialize
121 inline void GetLockParse(void) { m_pVMemParse->GetLock(); };
122 inline void FreeLockParse(void) { m_pVMemParse->FreeLock(); };
123 inline int IsLockedParse(void) { return m_pVMemParse->IsLocked(); };
124 inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
125 inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
126 inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
127 inline void* CallocParse(size_t num, size_t size)
129 size_t count = num*size;
130 void* lpVoid = MallocParse(count);
132 ZeroMemory(lpVoid, count);
137 char *Getenv(const char *varname);
138 int Putenv(const char *envstring);
139 inline char *Getenv(const char *varname, unsigned long *len)
142 char *e = Getenv(varname);
147 void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
148 void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
149 char* GetChildDir(void);
150 void FreeChildDir(char* pStr);
154 inline LPSTR GetIndex(DWORD &dwIndex)
156 if(dwIndex < m_dwEnvCount)
159 return m_lppEnvList[dwIndex-1];
165 LPSTR Find(LPCSTR lpStr);
166 void Add(LPCSTR lpStr);
168 LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
169 void FreeLocalEnvironmentStrings(LPSTR lpStr);
170 LPSTR* Lookup(LPCSTR lpStr);
171 DWORD CalculateEnvironmentSpace(void);
176 virtual int Chdir(const char *dirname);
180 void Exit(int status);
181 void _Exit(int status);
182 int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
183 int Execv(const char *cmdname, const char *const *argv);
184 int Execvp(const char *cmdname, const char *const *argv);
186 inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
187 inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
188 inline VDir* GetDir(void) { return m_pvDir; };
192 struct IPerlMem m_hostperlMem;
193 struct IPerlMem m_hostperlMemShared;
194 struct IPerlMem m_hostperlMemParse;
195 struct IPerlEnv m_hostperlEnv;
196 struct IPerlStdIO m_hostperlStdIO;
197 struct IPerlLIO m_hostperlLIO;
198 struct IPerlDir m_hostperlDir;
199 struct IPerlSock m_hostperlSock;
200 struct IPerlProc m_hostperlProc;
202 struct IPerlMem* m_pHostperlMem;
203 struct IPerlMem* m_pHostperlMemShared;
204 struct IPerlMem* m_pHostperlMemParse;
205 struct IPerlEnv* m_pHostperlEnv;
206 struct IPerlStdIO* m_pHostperlStdIO;
207 struct IPerlLIO* m_pHostperlLIO;
208 struct IPerlDir* m_pHostperlDir;
209 struct IPerlSock* m_pHostperlSock;
210 struct IPerlProc* m_pHostperlProc;
212 inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
213 inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
223 BOOL m_bTopLevel; // is this a toplevel host?
224 static long num_hosts;
226 inline int LastHost(void) { return num_hosts == 1L; };
227 struct interpreter *host_perl;
230 long CPerlHost::num_hosts = 0L;
232 extern "C" void win32_checkTLS(struct interpreter *host_perl);
234 #define STRUCT2RAWPTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
235 #ifdef CHECK_HOST_INTERP
236 inline CPerlHost* CheckInterp(CPerlHost *host)
238 win32_checkTLS(host->host_perl);
241 #define STRUCT2PTR(x, y) CheckInterp(STRUCT2RAWPTR(x, y))
243 #define STRUCT2PTR(x, y) STRUCT2RAWPTR(x, y)
246 inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
248 return STRUCT2RAWPTR(piPerl, m_hostperlMem);
251 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
253 return STRUCT2RAWPTR(piPerl, m_hostperlMemShared);
256 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
258 return STRUCT2RAWPTR(piPerl, m_hostperlMemParse);
261 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
263 return STRUCT2PTR(piPerl, m_hostperlEnv);
266 inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
268 return STRUCT2PTR(piPerl, m_hostperlStdIO);
271 inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
273 return STRUCT2PTR(piPerl, m_hostperlLIO);
276 inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
278 return STRUCT2PTR(piPerl, m_hostperlDir);
281 inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
283 return STRUCT2PTR(piPerl, m_hostperlSock);
286 inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
288 return STRUCT2PTR(piPerl, m_hostperlProc);
294 #define IPERL2HOST(x) IPerlMem2Host(x)
298 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
300 return IPERL2HOST(piPerl)->Malloc(size);
303 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
305 return IPERL2HOST(piPerl)->Realloc(ptr, size);
308 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
310 IPERL2HOST(piPerl)->Free(ptr);
313 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
315 return IPERL2HOST(piPerl)->Calloc(num, size);
319 PerlMemGetLock(struct IPerlMem* piPerl)
321 IPERL2HOST(piPerl)->GetLock();
325 PerlMemFreeLock(struct IPerlMem* piPerl)
327 IPERL2HOST(piPerl)->FreeLock();
331 PerlMemIsLocked(struct IPerlMem* piPerl)
333 return IPERL2HOST(piPerl)->IsLocked();
336 struct IPerlMem perlMem =
348 #define IPERL2HOST(x) IPerlMemShared2Host(x)
352 PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
354 return IPERL2HOST(piPerl)->MallocShared(size);
357 PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
359 return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
362 PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
364 IPERL2HOST(piPerl)->FreeShared(ptr);
367 PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
369 return IPERL2HOST(piPerl)->CallocShared(num, size);
373 PerlMemSharedGetLock(struct IPerlMem* piPerl)
375 IPERL2HOST(piPerl)->GetLockShared();
379 PerlMemSharedFreeLock(struct IPerlMem* piPerl)
381 IPERL2HOST(piPerl)->FreeLockShared();
385 PerlMemSharedIsLocked(struct IPerlMem* piPerl)
387 return IPERL2HOST(piPerl)->IsLockedShared();
390 struct IPerlMem perlMemShared =
393 PerlMemSharedRealloc,
396 PerlMemSharedGetLock,
397 PerlMemSharedFreeLock,
398 PerlMemSharedIsLocked,
402 #define IPERL2HOST(x) IPerlMemParse2Host(x)
406 PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
408 return IPERL2HOST(piPerl)->MallocParse(size);
411 PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
413 return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
416 PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
418 IPERL2HOST(piPerl)->FreeParse(ptr);
421 PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
423 return IPERL2HOST(piPerl)->CallocParse(num, size);
427 PerlMemParseGetLock(struct IPerlMem* piPerl)
429 IPERL2HOST(piPerl)->GetLockParse();
433 PerlMemParseFreeLock(struct IPerlMem* piPerl)
435 IPERL2HOST(piPerl)->FreeLockParse();
439 PerlMemParseIsLocked(struct IPerlMem* piPerl)
441 return IPERL2HOST(piPerl)->IsLockedParse();
444 struct IPerlMem perlMemParse =
451 PerlMemParseFreeLock,
452 PerlMemParseIsLocked,
457 #define IPERL2HOST(x) IPerlEnv2Host(x)
461 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
463 return IPERL2HOST(piPerl)->Getenv(varname);
467 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
469 return IPERL2HOST(piPerl)->Putenv(envstring);
473 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
475 return IPERL2HOST(piPerl)->Getenv(varname, len);
479 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
481 return win32_uname(name);
485 PerlEnvClearenv(struct IPerlEnv* piPerl)
487 IPERL2HOST(piPerl)->Clearenv();
491 PerlEnvGetChildenv(struct IPerlEnv* piPerl)
493 return IPERL2HOST(piPerl)->CreateChildEnv();
497 PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
499 IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
503 PerlEnvGetChilddir(struct IPerlEnv* piPerl)
505 return IPERL2HOST(piPerl)->GetChildDir();
509 PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
511 IPERL2HOST(piPerl)->FreeChildDir(childDir);
515 PerlEnvOsId(struct IPerlEnv* piPerl)
517 return win32_os_id();
521 PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl, STRLEN *const len)
523 return g_win32_get_privlib(pl, len);
527 PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl, STRLEN *const len)
529 return g_win32_get_sitelib(pl, len);
533 PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl,
536 return g_win32_get_vendorlib(pl, len);
540 PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
542 win32_get_child_IO(ptr);
545 struct IPerlEnv perlEnv =
559 PerlEnvVendorLibPath,
564 #define IPERL2HOST(x) IPerlStdIO2Host(x)
568 PerlStdIOStdin(struct IPerlStdIO* piPerl)
570 return win32_stdin();
574 PerlStdIOStdout(struct IPerlStdIO* piPerl)
576 return win32_stdout();
580 PerlStdIOStderr(struct IPerlStdIO* piPerl)
582 return win32_stderr();
586 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
588 return win32_fopen(path, mode);
592 PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf)
594 return win32_fclose((pf));
598 PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf)
600 return win32_feof(pf);
604 PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf)
606 return win32_ferror(pf);
610 PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf)
616 PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf)
618 return win32_getc(pf);
622 PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf)
633 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf)
637 return FILE_bufsiz(f);
644 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf)
655 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
666 PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n)
668 return win32_fgets(s, n, pf);
672 PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c)
674 return win32_fputc(c, pf);
678 PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s)
680 return win32_fputs(s, pf);
684 PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf)
686 return win32_fflush(pf);
690 PerlStdIOUngetc(struct IPerlStdIO* piPerl,int c, FILE* pf)
692 return win32_ungetc(c, pf);
696 PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf)
698 return win32_fileno(pf);
702 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
704 return win32_fdopen(fd, mode);
708 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf)
710 return win32_freopen(path, mode, (FILE*)pf);
714 PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf)
716 return win32_fread(buffer, size, count, pf);
720 PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf)
722 return win32_fwrite(buffer, size, count, pf);
726 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer)
728 win32_setbuf(pf, buffer);
732 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size)
734 return win32_setvbuf(pf, buffer, type, size);
738 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n)
740 #ifdef STDIO_CNT_LVALUE
747 PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, STDCHAR * ptr)
749 #ifdef STDIO_PTR_LVALUE
756 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf)
758 win32_setvbuf(pf, NULL, _IOLBF, 0);
762 PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...)
765 va_start(arglist, format);
766 return win32_vfprintf(pf, format, arglist);
770 PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist)
772 return win32_vfprintf(pf, format, arglist);
776 PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf)
778 return win32_ftell(pf);
782 PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, Off_t offset, int origin)
784 return win32_fseek(pf, offset, origin);
788 PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf)
794 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
796 return win32_tmpfile();
800 PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p)
802 return win32_fgetpos(pf, p);
806 PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p)
808 return win32_fsetpos(pf, p);
811 PerlStdIOInit(struct IPerlStdIO* piPerl)
816 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
818 Perl_init_os_extras();
822 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, intptr_t osfhandle, int flags)
824 return win32_open_osfhandle(osfhandle, flags);
828 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
830 return win32_get_osfhandle(filenum);
834 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
840 int fileno = win32_dup(win32_fileno(pf));
842 /* open the file in the same mode */
844 if((pf)->flags & _F_READ) {
848 else if((pf)->flags & _F_WRIT) {
852 else if((pf)->flags & _F_RDWR) {
858 if((pf)->_flag & _IOREAD) {
862 else if((pf)->_flag & _IOWRT) {
866 else if((pf)->_flag & _IORW) {
873 /* it appears that the binmode is attached to the
874 * file descriptor so binmode files will be handled
877 pfdup = win32_fdopen(fileno, mode);
879 /* move the file pointer to the same position */
880 if (!fgetpos(pf, &pos)) {
881 fsetpos(pfdup, &pos);
889 struct IPerlStdIO perlStdIO =
928 PerlStdIOInitOSExtras,
934 #define IPERL2HOST(x) IPerlLIO2Host(x)
938 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
940 return win32_access(path, mode);
944 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
946 return win32_chmod(filename, pmode);
950 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
952 return chown(filename, owner, group);
956 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, Off_t size)
958 return win32_chsize(handle, size);
962 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
964 return win32_close(handle);
968 PerlLIODup(struct IPerlLIO* piPerl, int handle)
970 return win32_dup(handle);
974 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
976 return win32_dup2(handle1, handle2);
980 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
982 return win32_flock(fd, oper);
986 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, Stat_t *buffer)
988 return win32_fstat(handle, buffer);
992 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
997 /* mauke says using memcpy avoids alignment issues */
998 memcpy(&u_long_arg, data, sizeof u_long_arg);
999 retval = win32_ioctlsocket((SOCKET)i, (long)u, &u_long_arg);
1000 memcpy(data, &u_long_arg, sizeof u_long_arg);
1005 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
1007 return win32_isatty(fd);
1011 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
1013 return win32_link(oldname, newname);
1017 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, Off_t offset, int origin)
1019 return win32_lseek(handle, offset, origin);
1023 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer)
1025 return win32_stat(path, buffer);
1029 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
1031 return mktemp(Template);
1035 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
1037 return win32_open(filename, oflag);
1041 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
1043 return win32_open(filename, oflag, pmode);
1047 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
1049 return win32_read(handle, buffer, count);
1053 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
1055 return win32_rename(OldFileName, newname);
1059 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1061 return win32_setmode(handle, mode);
1065 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer)
1067 return win32_stat(path, buffer);
1071 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1073 return tmpnam(string);
1077 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1079 return umask(pmode);
1083 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1085 return win32_unlink(filename);
1089 PerlLIOUtime(struct IPerlLIO* piPerl, const char *filename, struct utimbuf *times)
1091 return win32_utime(filename, times);
1095 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1097 return win32_write(handle, buffer, count);
1100 struct IPerlLIO perlLIO =
1132 #define IPERL2HOST(x) IPerlDir2Host(x)
1136 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1138 return win32_mkdir(dirname, mode);
1142 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1144 return IPERL2HOST(piPerl)->Chdir(dirname);
1148 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1150 return win32_rmdir(dirname);
1154 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1156 return win32_closedir(dirp);
1160 PerlDirOpen(struct IPerlDir* piPerl, const char *filename)
1162 return win32_opendir(filename);
1166 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1168 return win32_readdir(dirp);
1172 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1174 win32_rewinddir(dirp);
1178 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1180 win32_seekdir(dirp, loc);
1184 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1186 return win32_telldir(dirp);
1190 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1192 return IPERL2HOST(piPerl)->MapPathA(path);
1196 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1198 return IPERL2HOST(piPerl)->MapPathW(path);
1201 struct IPerlDir perlDir =
1219 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1221 return win32_htonl(hostlong);
1225 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1227 return win32_htons(hostshort);
1231 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1233 return win32_ntohl(netlong);
1237 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1239 return win32_ntohs(netshort);
1242 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1244 return win32_accept(s, addr, addrlen);
1248 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1250 return win32_bind(s, name, namelen);
1254 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1256 return win32_connect(s, name, namelen);
1260 PerlSockEndhostent(struct IPerlSock* piPerl)
1266 PerlSockEndnetent(struct IPerlSock* piPerl)
1272 PerlSockEndprotoent(struct IPerlSock* piPerl)
1274 win32_endprotoent();
1278 PerlSockEndservent(struct IPerlSock* piPerl)
1284 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1286 return win32_gethostbyaddr(addr, len, type);
1290 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1292 return win32_gethostbyname(name);
1296 PerlSockGethostent(struct IPerlSock* piPerl)
1299 Perl_croak(aTHX_ "gethostent not implemented!\n");
1304 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1306 return win32_gethostname(name, namelen);
1310 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1312 return win32_getnetbyaddr(net, type);
1316 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1318 return win32_getnetbyname((char*)name);
1322 PerlSockGetnetent(struct IPerlSock* piPerl)
1324 return win32_getnetent();
1327 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1329 return win32_getpeername(s, name, namelen);
1333 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1335 return win32_getprotobyname(name);
1339 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1341 return win32_getprotobynumber(number);
1345 PerlSockGetprotoent(struct IPerlSock* piPerl)
1347 return win32_getprotoent();
1351 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1353 return win32_getservbyname(name, proto);
1357 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1359 return win32_getservbyport(port, proto);
1363 PerlSockGetservent(struct IPerlSock* piPerl)
1365 return win32_getservent();
1369 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1371 return win32_getsockname(s, name, namelen);
1375 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1377 return win32_getsockopt(s, level, optname, optval, optlen);
1381 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1383 return win32_inet_addr(cp);
1387 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1389 return win32_inet_ntoa(in);
1393 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1395 return win32_listen(s, backlog);
1399 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1401 return win32_recv(s, buffer, len, flags);
1405 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1407 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1411 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1413 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1417 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1419 return win32_send(s, buffer, len, flags);
1423 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1425 return win32_sendto(s, buffer, len, flags, to, tolen);
1429 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1431 win32_sethostent(stayopen);
1435 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1437 win32_setnetent(stayopen);
1441 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1443 win32_setprotoent(stayopen);
1447 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1449 win32_setservent(stayopen);
1453 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1455 return win32_setsockopt(s, level, optname, optval, optlen);
1459 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1461 return win32_shutdown(s, how);
1465 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1467 return win32_socket(af, type, protocol);
1471 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1473 return Perl_my_socketpair(domain, type, protocol, fds);
1477 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1479 return win32_closesocket(s);
1483 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1485 return win32_ioctlsocket(s, cmd, argp);
1488 struct IPerlSock perlSock =
1499 PerlSockEndprotoent,
1501 PerlSockGethostname,
1502 PerlSockGetpeername,
1503 PerlSockGethostbyaddr,
1504 PerlSockGethostbyname,
1506 PerlSockGetnetbyaddr,
1507 PerlSockGetnetbyname,
1509 PerlSockGetprotobyname,
1510 PerlSockGetprotobynumber,
1511 PerlSockGetprotoent,
1512 PerlSockGetservbyname,
1513 PerlSockGetservbyport,
1515 PerlSockGetsockname,
1527 PerlSockSetprotoent,
1533 PerlSockClosesocket,
1539 #define EXECF_EXEC 1
1540 #define EXECF_SPAWN 2
1543 PerlProcAbort(struct IPerlProc* piPerl)
1549 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1551 return win32_crypt(clear, salt);
1555 PerlProcExit(struct IPerlProc* piPerl, int status)
1561 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1567 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1569 return execl(cmdname, arg0, arg1, arg2, arg3);
1573 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1575 return win32_execvp(cmdname, argv);
1579 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1581 return win32_execvp(cmdname, argv);
1585 PerlProcGetuid(struct IPerlProc* piPerl)
1591 PerlProcGeteuid(struct IPerlProc* piPerl)
1597 PerlProcGetgid(struct IPerlProc* piPerl)
1603 PerlProcGetegid(struct IPerlProc* piPerl)
1609 PerlProcGetlogin(struct IPerlProc* piPerl)
1611 return g_getlogin();
1615 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1617 return win32_kill(pid, sig);
1621 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1623 return win32_kill(pid, -sig);
1627 PerlProcPauseProc(struct IPerlProc* piPerl)
1629 return win32_sleep((32767L << 16) + 32767);
1633 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1636 PERL_FLUSHALL_FOR_CHILD;
1637 return win32_popen(command, mode);
1641 PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
1644 PERL_FLUSHALL_FOR_CHILD;
1645 return win32_popenlist(mode, narg, args);
1649 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1651 return win32_pclose(stream);
1655 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1657 return win32_pipe(phandles, 512, O_BINARY);
1661 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1667 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1673 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1675 return win32_sleep(s);
1679 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1681 return win32_times(timebuf);
1685 PerlProcWait(struct IPerlProc* piPerl, int *status)
1687 return win32_wait(status);
1691 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1693 return win32_waitpid(pid, status, flags);
1697 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1699 return win32_signal(sig, subcode);
1703 PerlProcGetTimeOfDay(struct IPerlProc* piPerl, struct timeval *t, void *z)
1705 return win32_gettimeofday(t, z);
1709 static THREAD_RET_TYPE
1710 win32_start_child(LPVOID arg)
1712 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1715 HWND parent_message_hwnd;
1716 #ifdef PERL_SYNC_FORK
1717 static long sync_fork_id = 0;
1718 long id = ++sync_fork_id;
1722 PERL_SET_THX(my_perl);
1723 win32_checkTLS(my_perl);
1725 /* set $$ to pseudo id */
1726 #ifdef PERL_SYNC_FORK
1729 w32_pseudo_id = GetCurrentThreadId();
1731 int pid = (int)w32_pseudo_id;
1733 w32_pseudo_id = -pid;
1736 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) {
1737 SV *sv = GvSV(tmpgv);
1739 sv_setiv(sv, -(IV)w32_pseudo_id);
1742 #ifdef PERL_USES_PL_PIDSTATUS
1743 hv_clear(PL_pidstatus);
1746 /* create message window and tell parent about it */
1747 parent_message_hwnd = w32_message_hwnd;
1748 w32_message_hwnd = win32_create_message_window();
1749 if (parent_message_hwnd != NULL)
1750 PostMessage(parent_message_hwnd, WM_USER_MESSAGE, w32_pseudo_id, (LPARAM)w32_message_hwnd);
1752 /* push a zero on the stack (we are the child) */
1760 /* continue from next op */
1761 PL_op = PL_op->op_next;
1765 volatile int oldscope = 1; /* We are responsible for all scopes */
1768 JMPENV_PUSH(status);
1772 /* We may have additional unclosed scopes if fork() was called
1773 * from within a BEGIN block. See perlfork.pod for more details.
1774 * We cannot clean up these other scopes because they belong to a
1775 * different interpreter, but we also cannot leave PL_scopestack_ix
1776 * dangling because that can trigger an assertion in perl_destruct().
1778 if (PL_scopestack_ix > oldscope) {
1779 PL_scopestack[oldscope-1] = PL_scopestack[PL_scopestack_ix-1];
1780 PL_scopestack_ix = oldscope;
1785 while (PL_scopestack_ix > oldscope)
1788 PL_curstash = PL_defstash;
1789 if (PL_endav && !PL_minus_c)
1790 call_list(oldscope, PL_endav);
1791 status = STATUS_EXIT;
1795 POPSTACK_TO(PL_mainstack);
1796 PL_op = PL_restartop;
1797 PL_restartop = (OP*)NULL;
1800 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1807 /* XXX hack to avoid perl_destruct() freeing optree */
1808 win32_checkTLS(my_perl);
1809 PL_main_root = (OP*)NULL;
1812 win32_checkTLS(my_perl);
1813 /* close the std handles to avoid fd leaks */
1815 do_close(PL_stdingv, FALSE);
1816 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE); /* PL_stdoutgv - ISAGN */
1817 do_close(PL_stderrgv, FALSE);
1820 /* destroy everything (waits for any pseudo-forked children) */
1821 win32_checkTLS(my_perl);
1822 perl_destruct(my_perl);
1823 win32_checkTLS(my_perl);
1826 #ifdef PERL_SYNC_FORK
1829 return (DWORD)status;
1832 #endif /* USE_ITHREADS */
1835 PerlProcFork(struct IPerlProc* piPerl)
1843 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1847 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1848 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX,
1851 h->m_pHostperlMemShared,
1852 h->m_pHostperlMemParse,
1854 h->m_pHostperlStdIO,
1860 new_perl->Isys_intern.internal_host = h;
1861 h->host_perl = new_perl;
1862 # ifdef PERL_SYNC_FORK
1863 id = win32_start_child((LPVOID)new_perl);
1866 if (w32_message_hwnd == INVALID_HANDLE_VALUE)
1867 w32_message_hwnd = win32_create_message_window();
1868 new_perl->Isys_intern.message_hwnd = w32_message_hwnd;
1869 w32_pseudo_child_message_hwnds[w32_num_pseudo_children] =
1870 (w32_message_hwnd == NULL) ? (HWND)NULL : (HWND)INVALID_HANDLE_VALUE;
1871 # ifdef USE_RTL_THREAD_API
1872 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1873 (void*)new_perl, 0, (unsigned*)&id);
1875 handle = CreateThread(NULL, 0, win32_start_child,
1876 (LPVOID)new_perl, 0, &id);
1878 PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
1888 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1889 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1890 ++w32_num_pseudo_children;
1894 Perl_croak(aTHX_ "fork() not implemented!\n");
1896 #endif /* USE_ITHREADS */
1900 PerlProcGetpid(struct IPerlProc* piPerl)
1902 return win32_getpid();
1906 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1908 return win32_dynaload(filename);
1912 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1914 win32_str_os_error(sv, dwErr);
1918 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1920 return win32_spawnvp(mode, cmdname, argv);
1924 PerlProcLastHost(struct IPerlProc* piPerl)
1927 CPerlHost *h = (CPerlHost*)w32_internal_host;
1928 return h->LastHost();
1931 struct IPerlProc perlProc =
1965 PerlProcGetTimeOfDay
1973 CPerlHost::CPerlHost(void)
1975 /* Construct a host from scratch */
1976 InterlockedIncrement(&num_hosts);
1977 m_pvDir = new VDir();
1978 m_pVMem = new VMem();
1979 m_pVMemShared = new VMem();
1980 m_pVMemParse = new VMem();
1982 m_pvDir->Init(NULL, m_pVMem);
1985 m_lppEnvList = NULL;
1988 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1989 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1990 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1991 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1992 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1993 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1994 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1995 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1996 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1998 m_pHostperlMem = &m_hostperlMem;
1999 m_pHostperlMemShared = &m_hostperlMemShared;
2000 m_pHostperlMemParse = &m_hostperlMemParse;
2001 m_pHostperlEnv = &m_hostperlEnv;
2002 m_pHostperlStdIO = &m_hostperlStdIO;
2003 m_pHostperlLIO = &m_hostperlLIO;
2004 m_pHostperlDir = &m_hostperlDir;
2005 m_pHostperlSock = &m_hostperlSock;
2006 m_pHostperlProc = &m_hostperlProc;
2009 #define SETUPEXCHANGE(xptr, iptr, table) \
2020 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
2021 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
2022 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
2023 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
2024 struct IPerlProc** ppProc)
2026 InterlockedIncrement(&num_hosts);
2027 m_pvDir = new VDir(0);
2028 m_pVMem = new VMem();
2029 m_pVMemShared = new VMem();
2030 m_pVMemParse = new VMem();
2032 m_pvDir->Init(NULL, m_pVMem);
2035 m_lppEnvList = NULL;
2036 m_bTopLevel = FALSE;
2038 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2039 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2040 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2041 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2042 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2043 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2044 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2045 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2046 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2048 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
2049 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
2050 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
2051 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
2052 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
2053 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
2054 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
2055 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
2056 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
2058 #undef SETUPEXCHANGE
2060 CPerlHost::CPerlHost(CPerlHost& host)
2062 /* Construct a host from another host */
2063 InterlockedIncrement(&num_hosts);
2064 m_pVMem = new VMem();
2065 m_pVMemShared = host.GetMemShared();
2066 m_pVMemParse = host.GetMemParse();
2068 /* duplicate directory info */
2069 m_pvDir = new VDir(0);
2070 m_pvDir->Init(host.GetDir(), m_pVMem);
2072 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2073 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2074 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2075 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2076 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2077 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2078 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2079 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2080 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2081 m_pHostperlMem = &m_hostperlMem;
2082 m_pHostperlMemShared = &m_hostperlMemShared;
2083 m_pHostperlMemParse = &m_hostperlMemParse;
2084 m_pHostperlEnv = &m_hostperlEnv;
2085 m_pHostperlStdIO = &m_hostperlStdIO;
2086 m_pHostperlLIO = &m_hostperlLIO;
2087 m_pHostperlDir = &m_hostperlDir;
2088 m_pHostperlSock = &m_hostperlSock;
2089 m_pHostperlProc = &m_hostperlProc;
2092 m_lppEnvList = NULL;
2093 m_bTopLevel = FALSE;
2095 /* duplicate environment info */
2098 while(lpPtr = host.GetIndex(dwIndex))
2102 CPerlHost::~CPerlHost(void)
2105 InterlockedDecrement(&num_hosts);
2107 m_pVMemParse->Release();
2108 m_pVMemShared->Release();
2113 CPerlHost::Find(LPCSTR lpStr)
2116 LPSTR* lppPtr = Lookup(lpStr);
2117 if(lppPtr != NULL) {
2118 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2130 lookup(const void *arg1, const void *arg2)
2131 { // Compare strings
2135 ptr1 = *(char**)arg1;
2136 ptr2 = *(char**)arg2;
2140 if(c1 == '\0' || c1 == '=') {
2141 if(c2 == '\0' || c2 == '=')
2144 return -1; // string 1 < string 2
2146 else if(c2 == '\0' || c2 == '=')
2147 return 1; // string 1 > string 2
2153 return -1; // string 1 < string 2
2155 return 1; // string 1 > string 2
2163 CPerlHost::Lookup(LPCSTR lpStr)
2166 if (!m_lppEnvList || !m_dwEnvCount)
2171 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2175 compare(const void *arg1, const void *arg2)
2176 { // Compare strings
2180 ptr1 = *(char**)arg1;
2181 ptr2 = *(char**)arg2;
2185 if(c1 == '\0' || c1 == '=') {
2189 return -1; // string 1 < string 2
2191 else if(c2 == '\0' || c2 == '=')
2192 return 1; // string 1 > string 2
2198 return -1; // string 1 < string 2
2200 return 1; // string 1 > string 2
2208 CPerlHost::Add(LPCSTR lpStr)
2211 char szBuffer[1024];
2213 int index, length = strlen(lpStr)+1;
2215 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2216 szBuffer[index] = lpStr[index];
2218 szBuffer[index] = '\0';
2221 lpPtr = Lookup(szBuffer);
2222 if (lpPtr != NULL) {
2223 // must allocate things via host memory allocation functions
2224 // rather than perl's Renew() et al, as the perl interpreter
2225 // may either not be initialized enough when we allocate these,
2226 // or may already be dead when we go to free these
2227 *lpPtr = (char*)Realloc(*lpPtr, length * sizeof(char));
2228 strcpy(*lpPtr, lpStr);
2231 m_lppEnvList = (LPSTR*)Realloc(m_lppEnvList, (m_dwEnvCount+1) * sizeof(LPSTR));
2233 m_lppEnvList[m_dwEnvCount] = (char*)Malloc(length * sizeof(char));
2234 if (m_lppEnvList[m_dwEnvCount] != NULL) {
2235 strcpy(m_lppEnvList[m_dwEnvCount], lpStr);
2237 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2244 CPerlHost::CalculateEnvironmentSpace(void)
2248 for(index = 0; index < m_dwEnvCount; ++index)
2249 dwSize += strlen(m_lppEnvList[index]) + 1;
2255 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2262 CPerlHost::GetChildDir(void)
2268 Newx(ptr, MAX_PATH+1, char);
2269 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2270 length = strlen(ptr);
2272 if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2279 CPerlHost::FreeChildDir(char* pStr)
2286 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2289 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2290 DWORD dwSize, dwEnvIndex;
2291 int nLength, compVal;
2293 // get the process environment strings
2294 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2296 // step over current directory stuff
2297 while(*lpTmp == '=')
2298 lpTmp += strlen(lpTmp) + 1;
2300 // save the start of the environment strings
2302 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2303 // calculate the size of the environment strings
2304 dwSize += strlen(lpTmp) + 1;
2307 // add the size of current directories
2308 dwSize += vDir.CalculateEnvironmentSpace();
2310 // add the additional space used by changes made to the environment
2311 dwSize += CalculateEnvironmentSpace();
2313 Newx(lpStr, dwSize, char);
2316 // build the local environment
2317 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2320 lpLocalEnv = GetIndex(dwEnvIndex);
2321 while(*lpEnvPtr != '\0') {
2323 // all environment overrides have been added
2324 // so copy string into place
2325 strcpy(lpStr, lpEnvPtr);
2326 nLength = strlen(lpEnvPtr) + 1;
2328 lpEnvPtr += nLength;
2331 // determine which string to copy next
2332 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2334 strcpy(lpStr, lpEnvPtr);
2335 nLength = strlen(lpEnvPtr) + 1;
2337 lpEnvPtr += nLength;
2340 char *ptr = strchr(lpLocalEnv, '=');
2342 strcpy(lpStr, lpLocalEnv);
2343 lpStr += strlen(lpLocalEnv) + 1;
2345 lpLocalEnv = GetIndex(dwEnvIndex);
2347 // this string was replaced
2348 lpEnvPtr += strlen(lpEnvPtr) + 1;
2355 // still have environment overrides to add
2356 // so copy the strings into place if not an override
2357 char *ptr = strchr(lpLocalEnv, '=');
2359 strcpy(lpStr, lpLocalEnv);
2360 lpStr += strlen(lpLocalEnv) + 1;
2362 lpLocalEnv = GetIndex(dwEnvIndex);
2369 // release the process environment strings
2370 FreeEnvironmentStrings(lpAllocPtr);
2376 CPerlHost::Reset(void)
2379 if(m_lppEnvList != NULL) {
2380 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2381 Free(m_lppEnvList[index]);
2382 m_lppEnvList[index] = NULL;
2387 m_lppEnvList = NULL;
2391 CPerlHost::Clearenv(void)
2395 LPSTR lpPtr, lpStr, lpEnvPtr;
2396 if (m_lppEnvList != NULL) {
2397 /* set every entry to an empty string */
2398 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2399 char* ptr = strchr(m_lppEnvList[index], '=');
2406 /* get the process environment strings */
2407 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2409 /* step over current directory stuff */
2410 while(*lpStr == '=')
2411 lpStr += strlen(lpStr) + 1;
2414 lpPtr = strchr(lpStr, '=');
2420 (void)win32_putenv(lpStr);
2423 lpStr += strlen(lpStr) + 1;
2426 FreeEnvironmentStrings(lpEnvPtr);
2431 CPerlHost::Getenv(const char *varname)
2435 char *pEnv = Find(varname);
2439 return win32_getenv(varname);
2443 CPerlHost::Putenv(const char *envstring)
2448 return win32_putenv(envstring);
2454 CPerlHost::Chdir(const char *dirname)
2462 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2469 #endif /* ___PerlHost_H___ */