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, char* s, int n, FILE* pf)
668 return win32_fgets(s, n, pf);
672 PerlStdIOPutc(struct IPerlStdIO* piPerl, int c, FILE* pf)
674 return win32_fputc(c, pf);
678 PerlStdIOPuts(struct IPerlStdIO* piPerl, const char *s, FILE* pf)
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;
1714 HWND parent_message_hwnd;
1715 #ifdef PERL_SYNC_FORK
1716 static long sync_fork_id = 0;
1717 long id = ++sync_fork_id;
1721 PERL_SET_THX(my_perl);
1722 win32_checkTLS(my_perl);
1724 #ifdef PERL_SYNC_FORK
1727 w32_pseudo_id = GetCurrentThreadId();
1729 #ifdef PERL_USES_PL_PIDSTATUS
1730 hv_clear(PL_pidstatus);
1733 /* create message window and tell parent about it */
1734 parent_message_hwnd = w32_message_hwnd;
1735 w32_message_hwnd = win32_create_message_window();
1736 if (parent_message_hwnd != NULL)
1737 PostMessage(parent_message_hwnd, WM_USER_MESSAGE, w32_pseudo_id, (LPARAM)w32_message_hwnd);
1739 /* push a zero on the stack (we are the child) */
1747 /* continue from next op */
1748 PL_op = PL_op->op_next;
1752 volatile int oldscope = 1; /* We are responsible for all scopes */
1755 JMPENV_PUSH(status);
1759 /* We may have additional unclosed scopes if fork() was called
1760 * from within a BEGIN block. See perlfork.pod for more details.
1761 * We cannot clean up these other scopes because they belong to a
1762 * different interpreter, but we also cannot leave PL_scopestack_ix
1763 * dangling because that can trigger an assertion in perl_destruct().
1765 if (PL_scopestack_ix > oldscope) {
1766 PL_scopestack[oldscope-1] = PL_scopestack[PL_scopestack_ix-1];
1767 PL_scopestack_ix = oldscope;
1772 while (PL_scopestack_ix > oldscope)
1775 PL_curstash = PL_defstash;
1776 if (PL_endav && !PL_minus_c)
1777 call_list(oldscope, PL_endav);
1778 status = STATUS_EXIT;
1782 POPSTACK_TO(PL_mainstack);
1783 PL_op = PL_restartop;
1784 PL_restartop = (OP*)NULL;
1787 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1794 /* XXX hack to avoid perl_destruct() freeing optree */
1795 win32_checkTLS(my_perl);
1796 PL_main_root = (OP*)NULL;
1799 win32_checkTLS(my_perl);
1800 /* close the std handles to avoid fd leaks */
1802 do_close(PL_stdingv, FALSE);
1803 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE); /* PL_stdoutgv - ISAGN */
1804 do_close(PL_stderrgv, FALSE);
1807 /* destroy everything (waits for any pseudo-forked children) */
1808 win32_checkTLS(my_perl);
1809 perl_destruct(my_perl);
1810 win32_checkTLS(my_perl);
1813 #ifdef PERL_SYNC_FORK
1816 return (DWORD)status;
1819 #endif /* USE_ITHREADS */
1822 PerlProcFork(struct IPerlProc* piPerl)
1830 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1834 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1835 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX,
1838 h->m_pHostperlMemShared,
1839 h->m_pHostperlMemParse,
1841 h->m_pHostperlStdIO,
1847 new_perl->Isys_intern.internal_host = h;
1848 h->host_perl = new_perl;
1849 # ifdef PERL_SYNC_FORK
1850 id = win32_start_child((LPVOID)new_perl);
1853 if (w32_message_hwnd == INVALID_HANDLE_VALUE)
1854 w32_message_hwnd = win32_create_message_window();
1855 new_perl->Isys_intern.message_hwnd = w32_message_hwnd;
1856 w32_pseudo_child_message_hwnds[w32_num_pseudo_children] =
1857 (w32_message_hwnd == NULL) ? (HWND)NULL : (HWND)INVALID_HANDLE_VALUE;
1858 # ifdef USE_RTL_THREAD_API
1859 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1860 (void*)new_perl, 0, (unsigned*)&id);
1862 handle = CreateThread(NULL, 0, win32_start_child,
1863 (LPVOID)new_perl, 0, &id);
1865 PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
1870 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1871 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1872 w32_pseudo_child_sigterm[w32_num_pseudo_children] = 0;
1873 ++w32_num_pseudo_children;
1877 Perl_croak(aTHX_ "fork() not implemented!\n");
1879 #endif /* USE_ITHREADS */
1883 PerlProcGetpid(struct IPerlProc* piPerl)
1885 return win32_getpid();
1889 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1891 return win32_dynaload(filename);
1895 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1897 win32_str_os_error(sv, dwErr);
1901 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1903 return win32_spawnvp(mode, cmdname, argv);
1907 PerlProcLastHost(struct IPerlProc* piPerl)
1910 CPerlHost *h = (CPerlHost*)w32_internal_host;
1911 return h->LastHost();
1914 struct IPerlProc perlProc =
1948 PerlProcGetTimeOfDay
1956 CPerlHost::CPerlHost(void)
1958 /* Construct a host from scratch */
1959 InterlockedIncrement(&num_hosts);
1960 m_pvDir = new VDir();
1961 m_pVMem = new VMem();
1962 m_pVMemShared = new VMem();
1963 m_pVMemParse = new VMem();
1965 m_pvDir->Init(NULL, m_pVMem);
1968 m_lppEnvList = NULL;
1971 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1972 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1973 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1974 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1975 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1976 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1977 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1978 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1979 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1981 m_pHostperlMem = &m_hostperlMem;
1982 m_pHostperlMemShared = &m_hostperlMemShared;
1983 m_pHostperlMemParse = &m_hostperlMemParse;
1984 m_pHostperlEnv = &m_hostperlEnv;
1985 m_pHostperlStdIO = &m_hostperlStdIO;
1986 m_pHostperlLIO = &m_hostperlLIO;
1987 m_pHostperlDir = &m_hostperlDir;
1988 m_pHostperlSock = &m_hostperlSock;
1989 m_pHostperlProc = &m_hostperlProc;
1992 #define SETUPEXCHANGE(xptr, iptr, table) \
2003 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
2004 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
2005 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
2006 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
2007 struct IPerlProc** ppProc)
2009 InterlockedIncrement(&num_hosts);
2010 m_pvDir = new VDir(0);
2011 m_pVMem = new VMem();
2012 m_pVMemShared = new VMem();
2013 m_pVMemParse = new VMem();
2015 m_pvDir->Init(NULL, m_pVMem);
2018 m_lppEnvList = NULL;
2019 m_bTopLevel = FALSE;
2021 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2022 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2023 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2024 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2025 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2026 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2027 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2028 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2029 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2031 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
2032 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
2033 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
2034 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
2035 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
2036 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
2037 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
2038 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
2039 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
2041 #undef SETUPEXCHANGE
2043 CPerlHost::CPerlHost(CPerlHost& host)
2045 /* Construct a host from another host */
2046 InterlockedIncrement(&num_hosts);
2047 m_pVMem = new VMem();
2048 m_pVMemShared = host.GetMemShared();
2049 m_pVMemParse = host.GetMemParse();
2051 /* duplicate directory info */
2052 m_pvDir = new VDir(0);
2053 m_pvDir->Init(host.GetDir(), m_pVMem);
2055 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2056 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2057 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2058 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2059 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2060 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2061 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2062 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2063 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2064 m_pHostperlMem = &m_hostperlMem;
2065 m_pHostperlMemShared = &m_hostperlMemShared;
2066 m_pHostperlMemParse = &m_hostperlMemParse;
2067 m_pHostperlEnv = &m_hostperlEnv;
2068 m_pHostperlStdIO = &m_hostperlStdIO;
2069 m_pHostperlLIO = &m_hostperlLIO;
2070 m_pHostperlDir = &m_hostperlDir;
2071 m_pHostperlSock = &m_hostperlSock;
2072 m_pHostperlProc = &m_hostperlProc;
2075 m_lppEnvList = NULL;
2076 m_bTopLevel = FALSE;
2078 /* duplicate environment info */
2081 while(lpPtr = host.GetIndex(dwIndex))
2085 CPerlHost::~CPerlHost(void)
2088 InterlockedDecrement(&num_hosts);
2090 m_pVMemParse->Release();
2091 m_pVMemShared->Release();
2096 CPerlHost::Find(LPCSTR lpStr)
2099 LPSTR* lppPtr = Lookup(lpStr);
2100 if(lppPtr != NULL) {
2101 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2113 lookup(const void *arg1, const void *arg2)
2114 { // Compare strings
2118 ptr1 = *(char**)arg1;
2119 ptr2 = *(char**)arg2;
2123 if(c1 == '\0' || c1 == '=') {
2124 if(c2 == '\0' || c2 == '=')
2127 return -1; // string 1 < string 2
2129 else if(c2 == '\0' || c2 == '=')
2130 return 1; // string 1 > string 2
2136 return -1; // string 1 < string 2
2138 return 1; // string 1 > string 2
2146 CPerlHost::Lookup(LPCSTR lpStr)
2149 if (!m_lppEnvList || !m_dwEnvCount)
2154 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2158 compare(const void *arg1, const void *arg2)
2159 { // Compare strings
2163 ptr1 = *(char**)arg1;
2164 ptr2 = *(char**)arg2;
2168 if(c1 == '\0' || c1 == '=') {
2172 return -1; // string 1 < string 2
2174 else if(c2 == '\0' || c2 == '=')
2175 return 1; // string 1 > string 2
2181 return -1; // string 1 < string 2
2183 return 1; // string 1 > string 2
2191 CPerlHost::Add(LPCSTR lpStr)
2194 char szBuffer[1024];
2196 int index, length = strlen(lpStr)+1;
2198 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2199 szBuffer[index] = lpStr[index];
2201 szBuffer[index] = '\0';
2204 lpPtr = Lookup(szBuffer);
2205 if (lpPtr != NULL) {
2206 // must allocate things via host memory allocation functions
2207 // rather than perl's Renew() et al, as the perl interpreter
2208 // may either not be initialized enough when we allocate these,
2209 // or may already be dead when we go to free these
2210 *lpPtr = (char*)Realloc(*lpPtr, length * sizeof(char));
2211 strcpy(*lpPtr, lpStr);
2214 m_lppEnvList = (LPSTR*)Realloc(m_lppEnvList, (m_dwEnvCount+1) * sizeof(LPSTR));
2216 m_lppEnvList[m_dwEnvCount] = (char*)Malloc(length * sizeof(char));
2217 if (m_lppEnvList[m_dwEnvCount] != NULL) {
2218 strcpy(m_lppEnvList[m_dwEnvCount], lpStr);
2220 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2227 CPerlHost::CalculateEnvironmentSpace(void)
2231 for(index = 0; index < m_dwEnvCount; ++index)
2232 dwSize += strlen(m_lppEnvList[index]) + 1;
2238 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2245 CPerlHost::GetChildDir(void)
2251 Newx(ptr, MAX_PATH+1, char);
2252 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2253 length = strlen(ptr);
2255 if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2262 CPerlHost::FreeChildDir(char* pStr)
2269 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2272 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2273 DWORD dwSize, dwEnvIndex;
2274 int nLength, compVal;
2276 // get the process environment strings
2277 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2279 // step over current directory stuff
2280 while(*lpTmp == '=')
2281 lpTmp += strlen(lpTmp) + 1;
2283 // save the start of the environment strings
2285 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2286 // calculate the size of the environment strings
2287 dwSize += strlen(lpTmp) + 1;
2290 // add the size of current directories
2291 dwSize += vDir.CalculateEnvironmentSpace();
2293 // add the additional space used by changes made to the environment
2294 dwSize += CalculateEnvironmentSpace();
2296 Newx(lpStr, dwSize, char);
2299 // build the local environment
2300 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2303 lpLocalEnv = GetIndex(dwEnvIndex);
2304 while(*lpEnvPtr != '\0') {
2306 // all environment overrides have been added
2307 // so copy string into place
2308 strcpy(lpStr, lpEnvPtr);
2309 nLength = strlen(lpEnvPtr) + 1;
2311 lpEnvPtr += nLength;
2314 // determine which string to copy next
2315 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2317 strcpy(lpStr, lpEnvPtr);
2318 nLength = strlen(lpEnvPtr) + 1;
2320 lpEnvPtr += nLength;
2323 char *ptr = strchr(lpLocalEnv, '=');
2325 strcpy(lpStr, lpLocalEnv);
2326 lpStr += strlen(lpLocalEnv) + 1;
2328 lpLocalEnv = GetIndex(dwEnvIndex);
2330 // this string was replaced
2331 lpEnvPtr += strlen(lpEnvPtr) + 1;
2338 // still have environment overrides to add
2339 // so copy the strings into place if not an override
2340 char *ptr = strchr(lpLocalEnv, '=');
2342 strcpy(lpStr, lpLocalEnv);
2343 lpStr += strlen(lpLocalEnv) + 1;
2345 lpLocalEnv = GetIndex(dwEnvIndex);
2352 // release the process environment strings
2353 FreeEnvironmentStrings(lpAllocPtr);
2359 CPerlHost::Reset(void)
2362 if(m_lppEnvList != NULL) {
2363 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2364 Free(m_lppEnvList[index]);
2365 m_lppEnvList[index] = NULL;
2370 m_lppEnvList = NULL;
2374 CPerlHost::Clearenv(void)
2378 LPSTR lpPtr, lpStr, lpEnvPtr;
2379 if (m_lppEnvList != NULL) {
2380 /* set every entry to an empty string */
2381 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2382 char* ptr = strchr(m_lppEnvList[index], '=');
2389 /* get the process environment strings */
2390 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2392 /* step over current directory stuff */
2393 while(*lpStr == '=')
2394 lpStr += strlen(lpStr) + 1;
2397 lpPtr = strchr(lpStr, '=');
2403 (void)win32_putenv(lpStr);
2406 lpStr += strlen(lpStr) + 1;
2409 FreeEnvironmentStrings(lpEnvPtr);
2414 CPerlHost::Getenv(const char *varname)
2418 char *pEnv = Find(varname);
2422 return win32_getenv(varname);
2426 CPerlHost::Putenv(const char *envstring)
2431 return win32_putenv(envstring);
2437 CPerlHost::Chdir(const char *dirname)
2445 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2452 #endif /* ___PerlHost_H___ */