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)
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, (LONG)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 = PL_scopestack_ix;
1768 JMPENV_PUSH(status);
1775 while (PL_scopestack_ix > oldscope)
1778 PL_curstash = PL_defstash;
1779 if (PL_endav && !PL_minus_c)
1780 call_list(oldscope, PL_endav);
1781 status = STATUS_EXIT;
1785 POPSTACK_TO(PL_mainstack);
1786 PL_op = PL_restartop;
1787 PL_restartop = (OP*)NULL;
1790 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1797 /* XXX hack to avoid perl_destruct() freeing optree */
1798 win32_checkTLS(my_perl);
1799 PL_main_root = (OP*)NULL;
1802 win32_checkTLS(my_perl);
1803 /* close the std handles to avoid fd leaks */
1805 do_close(PL_stdingv, FALSE);
1806 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE); /* PL_stdoutgv - ISAGN */
1807 do_close(PL_stderrgv, FALSE);
1810 /* destroy everything (waits for any pseudo-forked children) */
1811 win32_checkTLS(my_perl);
1812 perl_destruct(my_perl);
1813 win32_checkTLS(my_perl);
1816 #ifdef PERL_SYNC_FORK
1819 return (DWORD)status;
1822 #endif /* USE_ITHREADS */
1825 PerlProcFork(struct IPerlProc* piPerl)
1833 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1837 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1838 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX,
1841 h->m_pHostperlMemShared,
1842 h->m_pHostperlMemParse,
1844 h->m_pHostperlStdIO,
1850 new_perl->Isys_intern.internal_host = h;
1851 h->host_perl = new_perl;
1852 # ifdef PERL_SYNC_FORK
1853 id = win32_start_child((LPVOID)new_perl);
1856 if (w32_message_hwnd == INVALID_HANDLE_VALUE)
1857 w32_message_hwnd = win32_create_message_window();
1858 new_perl->Isys_intern.message_hwnd = w32_message_hwnd;
1859 w32_pseudo_child_message_hwnds[w32_num_pseudo_children] =
1860 (w32_message_hwnd == NULL) ? (HWND)NULL : (HWND)INVALID_HANDLE_VALUE;
1861 # ifdef USE_RTL_THREAD_API
1862 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1863 (void*)new_perl, 0, (unsigned*)&id);
1865 handle = CreateThread(NULL, 0, win32_start_child,
1866 (LPVOID)new_perl, 0, &id);
1868 PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
1878 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1879 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1880 ++w32_num_pseudo_children;
1884 Perl_croak(aTHX_ "fork() not implemented!\n");
1886 #endif /* USE_ITHREADS */
1890 PerlProcGetpid(struct IPerlProc* piPerl)
1892 return win32_getpid();
1896 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1898 return win32_dynaload(filename);
1902 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1904 win32_str_os_error(sv, dwErr);
1908 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1910 return win32_spawnvp(mode, cmdname, argv);
1914 PerlProcLastHost(struct IPerlProc* piPerl)
1917 CPerlHost *h = (CPerlHost*)w32_internal_host;
1918 return h->LastHost();
1921 struct IPerlProc perlProc =
1955 PerlProcGetTimeOfDay
1963 CPerlHost::CPerlHost(void)
1965 /* Construct a host from scratch */
1966 InterlockedIncrement(&num_hosts);
1967 m_pvDir = new VDir();
1968 m_pVMem = new VMem();
1969 m_pVMemShared = new VMem();
1970 m_pVMemParse = new VMem();
1972 m_pvDir->Init(NULL, m_pVMem);
1975 m_lppEnvList = NULL;
1978 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1979 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1980 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1981 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1982 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1983 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1984 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1985 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1986 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1988 m_pHostperlMem = &m_hostperlMem;
1989 m_pHostperlMemShared = &m_hostperlMemShared;
1990 m_pHostperlMemParse = &m_hostperlMemParse;
1991 m_pHostperlEnv = &m_hostperlEnv;
1992 m_pHostperlStdIO = &m_hostperlStdIO;
1993 m_pHostperlLIO = &m_hostperlLIO;
1994 m_pHostperlDir = &m_hostperlDir;
1995 m_pHostperlSock = &m_hostperlSock;
1996 m_pHostperlProc = &m_hostperlProc;
1999 #define SETUPEXCHANGE(xptr, iptr, table) \
2010 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
2011 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
2012 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
2013 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
2014 struct IPerlProc** ppProc)
2016 InterlockedIncrement(&num_hosts);
2017 m_pvDir = new VDir(0);
2018 m_pVMem = new VMem();
2019 m_pVMemShared = new VMem();
2020 m_pVMemParse = new VMem();
2022 m_pvDir->Init(NULL, m_pVMem);
2025 m_lppEnvList = NULL;
2026 m_bTopLevel = FALSE;
2028 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2029 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2030 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2031 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2032 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2033 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2034 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2035 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2036 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2038 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
2039 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
2040 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
2041 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
2042 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
2043 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
2044 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
2045 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
2046 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
2048 #undef SETUPEXCHANGE
2050 CPerlHost::CPerlHost(CPerlHost& host)
2052 /* Construct a host from another host */
2053 InterlockedIncrement(&num_hosts);
2054 m_pVMem = new VMem();
2055 m_pVMemShared = host.GetMemShared();
2056 m_pVMemParse = host.GetMemParse();
2058 /* duplicate directory info */
2059 m_pvDir = new VDir(0);
2060 m_pvDir->Init(host.GetDir(), m_pVMem);
2062 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2063 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2064 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2065 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2066 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2067 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2068 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2069 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2070 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2071 m_pHostperlMem = &m_hostperlMem;
2072 m_pHostperlMemShared = &m_hostperlMemShared;
2073 m_pHostperlMemParse = &m_hostperlMemParse;
2074 m_pHostperlEnv = &m_hostperlEnv;
2075 m_pHostperlStdIO = &m_hostperlStdIO;
2076 m_pHostperlLIO = &m_hostperlLIO;
2077 m_pHostperlDir = &m_hostperlDir;
2078 m_pHostperlSock = &m_hostperlSock;
2079 m_pHostperlProc = &m_hostperlProc;
2082 m_lppEnvList = NULL;
2083 m_bTopLevel = FALSE;
2085 /* duplicate environment info */
2088 while(lpPtr = host.GetIndex(dwIndex))
2092 CPerlHost::~CPerlHost(void)
2095 InterlockedDecrement(&num_hosts);
2097 m_pVMemParse->Release();
2098 m_pVMemShared->Release();
2103 CPerlHost::Find(LPCSTR lpStr)
2106 LPSTR* lppPtr = Lookup(lpStr);
2107 if(lppPtr != NULL) {
2108 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2120 lookup(const void *arg1, const void *arg2)
2121 { // Compare strings
2125 ptr1 = *(char**)arg1;
2126 ptr2 = *(char**)arg2;
2130 if(c1 == '\0' || c1 == '=') {
2131 if(c2 == '\0' || c2 == '=')
2134 return -1; // string 1 < string 2
2136 else if(c2 == '\0' || c2 == '=')
2137 return 1; // string 1 > string 2
2143 return -1; // string 1 < string 2
2145 return 1; // string 1 > string 2
2153 CPerlHost::Lookup(LPCSTR lpStr)
2156 if (!m_lppEnvList || !m_dwEnvCount)
2161 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2165 compare(const void *arg1, const void *arg2)
2166 { // Compare strings
2170 ptr1 = *(char**)arg1;
2171 ptr2 = *(char**)arg2;
2175 if(c1 == '\0' || c1 == '=') {
2179 return -1; // string 1 < string 2
2181 else if(c2 == '\0' || c2 == '=')
2182 return 1; // string 1 > string 2
2188 return -1; // string 1 < string 2
2190 return 1; // string 1 > string 2
2198 CPerlHost::Add(LPCSTR lpStr)
2201 char szBuffer[1024];
2203 int index, length = strlen(lpStr)+1;
2205 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2206 szBuffer[index] = lpStr[index];
2208 szBuffer[index] = '\0';
2211 lpPtr = Lookup(szBuffer);
2212 if (lpPtr != NULL) {
2213 // must allocate things via host memory allocation functions
2214 // rather than perl's Renew() et al, as the perl interpreter
2215 // may either not be initialized enough when we allocate these,
2216 // or may already be dead when we go to free these
2217 *lpPtr = (char*)Realloc(*lpPtr, length * sizeof(char));
2218 strcpy(*lpPtr, lpStr);
2221 m_lppEnvList = (LPSTR*)Realloc(m_lppEnvList, (m_dwEnvCount+1) * sizeof(LPSTR));
2223 m_lppEnvList[m_dwEnvCount] = (char*)Malloc(length * sizeof(char));
2224 if (m_lppEnvList[m_dwEnvCount] != NULL) {
2225 strcpy(m_lppEnvList[m_dwEnvCount], lpStr);
2227 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2234 CPerlHost::CalculateEnvironmentSpace(void)
2238 for(index = 0; index < m_dwEnvCount; ++index)
2239 dwSize += strlen(m_lppEnvList[index]) + 1;
2245 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2252 CPerlHost::GetChildDir(void)
2258 Newx(ptr, MAX_PATH+1, char);
2259 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2260 length = strlen(ptr);
2262 if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2269 CPerlHost::FreeChildDir(char* pStr)
2276 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2279 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2280 DWORD dwSize, dwEnvIndex;
2281 int nLength, compVal;
2283 // get the process environment strings
2284 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2286 // step over current directory stuff
2287 while(*lpTmp == '=')
2288 lpTmp += strlen(lpTmp) + 1;
2290 // save the start of the environment strings
2292 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2293 // calculate the size of the environment strings
2294 dwSize += strlen(lpTmp) + 1;
2297 // add the size of current directories
2298 dwSize += vDir.CalculateEnvironmentSpace();
2300 // add the additional space used by changes made to the environment
2301 dwSize += CalculateEnvironmentSpace();
2303 Newx(lpStr, dwSize, char);
2306 // build the local environment
2307 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2310 lpLocalEnv = GetIndex(dwEnvIndex);
2311 while(*lpEnvPtr != '\0') {
2313 // all environment overrides have been added
2314 // so copy string into place
2315 strcpy(lpStr, lpEnvPtr);
2316 nLength = strlen(lpEnvPtr) + 1;
2318 lpEnvPtr += nLength;
2321 // determine which string to copy next
2322 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2324 strcpy(lpStr, lpEnvPtr);
2325 nLength = strlen(lpEnvPtr) + 1;
2327 lpEnvPtr += nLength;
2330 char *ptr = strchr(lpLocalEnv, '=');
2332 strcpy(lpStr, lpLocalEnv);
2333 lpStr += strlen(lpLocalEnv) + 1;
2335 lpLocalEnv = GetIndex(dwEnvIndex);
2337 // this string was replaced
2338 lpEnvPtr += strlen(lpEnvPtr) + 1;
2345 // still have environment overrides to add
2346 // so copy the strings into place if not an override
2347 char *ptr = strchr(lpLocalEnv, '=');
2349 strcpy(lpStr, lpLocalEnv);
2350 lpStr += strlen(lpLocalEnv) + 1;
2352 lpLocalEnv = GetIndex(dwEnvIndex);
2359 // release the process environment strings
2360 FreeEnvironmentStrings(lpAllocPtr);
2366 CPerlHost::Reset(void)
2369 if(m_lppEnvList != NULL) {
2370 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2371 Free(m_lppEnvList[index]);
2372 m_lppEnvList[index] = NULL;
2377 m_lppEnvList = NULL;
2381 CPerlHost::Clearenv(void)
2385 LPSTR lpPtr, lpStr, lpEnvPtr;
2386 if (m_lppEnvList != NULL) {
2387 /* set every entry to an empty string */
2388 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2389 char* ptr = strchr(m_lppEnvList[index], '=');
2396 /* get the process environment strings */
2397 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2399 /* step over current directory stuff */
2400 while(*lpStr == '=')
2401 lpStr += strlen(lpStr) + 1;
2404 lpPtr = strchr(lpStr, '=');
2410 (void)win32_putenv(lpStr);
2413 lpStr += strlen(lpStr) + 1;
2416 FreeEnvironmentStrings(lpEnvPtr);
2421 CPerlHost::Getenv(const char *varname)
2425 char *pEnv = Find(varname);
2429 return win32_getenv(varname);
2433 CPerlHost::Putenv(const char *envstring)
2438 return win32_putenv(envstring);
2444 CPerlHost::Chdir(const char *dirname)
2452 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2459 #endif /* ___PerlHost_H___ */