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___
25 extern char * g_win32_get_privlib(const char *pl);
26 extern char * g_win32_get_sitelib(const char *pl);
27 extern char * g_win32_get_vendorlib(const char *pl);
28 extern char * g_getlogin(void);
36 CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
37 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
38 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
39 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
40 struct IPerlProc** ppProc);
41 CPerlHost(CPerlHost& host);
44 static CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl);
45 static CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl);
46 static CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl);
47 static CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl);
48 static CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl);
49 static CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl);
50 static CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl);
51 static CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl);
52 static CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl);
54 BOOL PerlCreate(void);
55 int PerlParse(int argc, char** argv, char** env);
57 void PerlDestroy(void);
60 /* Locks provided but should be unnecessary as this is private pool */
61 inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
62 inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
63 inline void Free(void* ptr) { m_pVMem->Free(ptr); };
64 inline void* Calloc(size_t num, size_t size)
66 size_t count = num*size;
67 void* lpVoid = Malloc(count);
69 ZeroMemory(lpVoid, count);
72 inline void GetLock(void) { m_pVMem->GetLock(); };
73 inline void FreeLock(void) { m_pVMem->FreeLock(); };
74 inline int IsLocked(void) { return m_pVMem->IsLocked(); };
77 /* Locks used to serialize access to the pool */
78 inline void GetLockShared(void) { m_pVMemShared->GetLock(); };
79 inline void FreeLockShared(void) { m_pVMemShared->FreeLock(); };
80 inline int IsLockedShared(void) { return m_pVMemShared->IsLocked(); };
81 inline void* MallocShared(size_t size)
85 result = m_pVMemShared->Malloc(size);
89 inline void* ReallocShared(void* ptr, size_t size)
93 result = m_pVMemShared->Realloc(ptr, size);
97 inline void FreeShared(void* ptr)
100 m_pVMemShared->Free(ptr);
103 inline void* CallocShared(size_t num, size_t size)
105 size_t count = num*size;
106 void* lpVoid = MallocShared(count);
108 ZeroMemory(lpVoid, count);
113 /* Assume something else is using locks to mangaging serialize
116 inline void GetLockParse(void) { m_pVMemParse->GetLock(); };
117 inline void FreeLockParse(void) { m_pVMemParse->FreeLock(); };
118 inline int IsLockedParse(void) { return m_pVMemParse->IsLocked(); };
119 inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
120 inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
121 inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
122 inline void* CallocParse(size_t num, size_t size)
124 size_t count = num*size;
125 void* lpVoid = MallocParse(count);
127 ZeroMemory(lpVoid, count);
132 char *Getenv(const char *varname);
133 int Putenv(const char *envstring);
134 inline char *Getenv(const char *varname, unsigned long *len)
137 char *e = Getenv(varname);
142 void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
143 void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
144 char* GetChildDir(void);
145 void FreeChildDir(char* pStr);
149 inline LPSTR GetIndex(DWORD &dwIndex)
151 if(dwIndex < m_dwEnvCount)
154 return m_lppEnvList[dwIndex-1];
160 LPSTR Find(LPCSTR lpStr);
161 void Add(LPCSTR lpStr);
163 LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
164 void FreeLocalEnvironmentStrings(LPSTR lpStr);
165 LPSTR* Lookup(LPCSTR lpStr);
166 DWORD CalculateEnvironmentSpace(void);
171 virtual int Chdir(const char *dirname);
175 void Exit(int status);
176 void _Exit(int status);
177 int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
178 int Execv(const char *cmdname, const char *const *argv);
179 int Execvp(const char *cmdname, const char *const *argv);
181 inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
182 inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
183 inline VDir* GetDir(void) { return m_pvDir; };
187 struct IPerlMem m_hostperlMem;
188 struct IPerlMem m_hostperlMemShared;
189 struct IPerlMem m_hostperlMemParse;
190 struct IPerlEnv m_hostperlEnv;
191 struct IPerlStdIO m_hostperlStdIO;
192 struct IPerlLIO m_hostperlLIO;
193 struct IPerlDir m_hostperlDir;
194 struct IPerlSock m_hostperlSock;
195 struct IPerlProc m_hostperlProc;
197 struct IPerlMem* m_pHostperlMem;
198 struct IPerlMem* m_pHostperlMemShared;
199 struct IPerlMem* m_pHostperlMemParse;
200 struct IPerlEnv* m_pHostperlEnv;
201 struct IPerlStdIO* m_pHostperlStdIO;
202 struct IPerlLIO* m_pHostperlLIO;
203 struct IPerlDir* m_pHostperlDir;
204 struct IPerlSock* m_pHostperlSock;
205 struct IPerlProc* m_pHostperlProc;
207 inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
208 inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
218 BOOL m_bTopLevel; // is this a toplevel host?
219 static long num_hosts;
221 inline int LastHost(void) { return num_hosts == 1L; };
222 struct interpreter *host_perl;
225 long CPerlHost::num_hosts = 0L;
227 extern "C" void win32_checkTLS(struct interpreter *host_perl);
229 #define STRUCT2RAWPTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
230 #ifdef CHECK_HOST_INTERP
231 inline CPerlHost* CheckInterp(CPerlHost *host)
233 win32_checkTLS(host->host_perl);
236 #define STRUCT2PTR(x, y) CheckInterp(STRUCT2RAWPTR(x, y))
238 #define STRUCT2PTR(x, y) STRUCT2RAWPTR(x, y)
241 inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
243 return STRUCT2RAWPTR(piPerl, m_hostperlMem);
246 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
248 return STRUCT2RAWPTR(piPerl, m_hostperlMemShared);
251 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
253 return STRUCT2RAWPTR(piPerl, m_hostperlMemParse);
256 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
258 return STRUCT2PTR(piPerl, m_hostperlEnv);
261 inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
263 return STRUCT2PTR(piPerl, m_hostperlStdIO);
266 inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
268 return STRUCT2PTR(piPerl, m_hostperlLIO);
271 inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
273 return STRUCT2PTR(piPerl, m_hostperlDir);
276 inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
278 return STRUCT2PTR(piPerl, m_hostperlSock);
281 inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
283 return STRUCT2PTR(piPerl, m_hostperlProc);
289 #define IPERL2HOST(x) IPerlMem2Host(x)
293 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
295 return IPERL2HOST(piPerl)->Malloc(size);
298 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
300 return IPERL2HOST(piPerl)->Realloc(ptr, size);
303 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
305 IPERL2HOST(piPerl)->Free(ptr);
308 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
310 return IPERL2HOST(piPerl)->Calloc(num, size);
314 PerlMemGetLock(struct IPerlMem* piPerl)
316 IPERL2HOST(piPerl)->GetLock();
320 PerlMemFreeLock(struct IPerlMem* piPerl)
322 IPERL2HOST(piPerl)->FreeLock();
326 PerlMemIsLocked(struct IPerlMem* piPerl)
328 return IPERL2HOST(piPerl)->IsLocked();
331 struct IPerlMem perlMem =
343 #define IPERL2HOST(x) IPerlMemShared2Host(x)
347 PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
349 return IPERL2HOST(piPerl)->MallocShared(size);
352 PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
354 return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
357 PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
359 IPERL2HOST(piPerl)->FreeShared(ptr);
362 PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
364 return IPERL2HOST(piPerl)->CallocShared(num, size);
368 PerlMemSharedGetLock(struct IPerlMem* piPerl)
370 IPERL2HOST(piPerl)->GetLockShared();
374 PerlMemSharedFreeLock(struct IPerlMem* piPerl)
376 IPERL2HOST(piPerl)->FreeLockShared();
380 PerlMemSharedIsLocked(struct IPerlMem* piPerl)
382 return IPERL2HOST(piPerl)->IsLockedShared();
385 struct IPerlMem perlMemShared =
388 PerlMemSharedRealloc,
391 PerlMemSharedGetLock,
392 PerlMemSharedFreeLock,
393 PerlMemSharedIsLocked,
397 #define IPERL2HOST(x) IPerlMemParse2Host(x)
401 PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
403 return IPERL2HOST(piPerl)->MallocParse(size);
406 PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
408 return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
411 PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
413 IPERL2HOST(piPerl)->FreeParse(ptr);
416 PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
418 return IPERL2HOST(piPerl)->CallocParse(num, size);
422 PerlMemParseGetLock(struct IPerlMem* piPerl)
424 IPERL2HOST(piPerl)->GetLockParse();
428 PerlMemParseFreeLock(struct IPerlMem* piPerl)
430 IPERL2HOST(piPerl)->FreeLockParse();
434 PerlMemParseIsLocked(struct IPerlMem* piPerl)
436 return IPERL2HOST(piPerl)->IsLockedParse();
439 struct IPerlMem perlMemParse =
446 PerlMemParseFreeLock,
447 PerlMemParseIsLocked,
452 #define IPERL2HOST(x) IPerlEnv2Host(x)
456 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
458 return IPERL2HOST(piPerl)->Getenv(varname);
462 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
464 return IPERL2HOST(piPerl)->Putenv(envstring);
468 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
470 return IPERL2HOST(piPerl)->Getenv(varname, len);
474 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
476 return win32_uname(name);
480 PerlEnvClearenv(struct IPerlEnv* piPerl)
482 IPERL2HOST(piPerl)->Clearenv();
486 PerlEnvGetChildenv(struct IPerlEnv* piPerl)
488 return IPERL2HOST(piPerl)->CreateChildEnv();
492 PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
494 IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
498 PerlEnvGetChilddir(struct IPerlEnv* piPerl)
500 return IPERL2HOST(piPerl)->GetChildDir();
504 PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
506 IPERL2HOST(piPerl)->FreeChildDir(childDir);
510 PerlEnvOsId(struct IPerlEnv* piPerl)
512 return win32_os_id();
516 PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
518 return g_win32_get_privlib(pl);
522 PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
524 return g_win32_get_sitelib(pl);
528 PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
530 return g_win32_get_vendorlib(pl);
534 PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
536 win32_get_child_IO(ptr);
539 struct IPerlEnv perlEnv =
553 PerlEnvVendorLibPath,
558 #define IPERL2HOST(x) IPerlStdIO2Host(x)
562 PerlStdIOStdin(struct IPerlStdIO* piPerl)
564 return win32_stdin();
568 PerlStdIOStdout(struct IPerlStdIO* piPerl)
570 return win32_stdout();
574 PerlStdIOStderr(struct IPerlStdIO* piPerl)
576 return win32_stderr();
580 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
582 return win32_fopen(path, mode);
586 PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf)
588 return win32_fclose((pf));
592 PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf)
594 return win32_feof(pf);
598 PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf)
600 return win32_ferror(pf);
604 PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf)
610 PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf)
612 return win32_getc(pf);
616 PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf)
627 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf)
631 return FILE_bufsiz(f);
638 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf)
649 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
660 PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n)
662 return win32_fgets(s, n, pf);
666 PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c)
668 return win32_fputc(c, pf);
672 PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s)
674 return win32_fputs(s, pf);
678 PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf)
680 return win32_fflush(pf);
684 PerlStdIOUngetc(struct IPerlStdIO* piPerl,int c, FILE* pf)
686 return win32_ungetc(c, pf);
690 PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf)
692 return win32_fileno(pf);
696 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
698 return win32_fdopen(fd, mode);
702 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf)
704 return win32_freopen(path, mode, (FILE*)pf);
708 PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf)
710 return win32_fread(buffer, size, count, pf);
714 PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf)
716 return win32_fwrite(buffer, size, count, pf);
720 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer)
722 win32_setbuf(pf, buffer);
726 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size)
728 return win32_setvbuf(pf, buffer, type, size);
732 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n)
734 #ifdef STDIO_CNT_LVALUE
741 PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr)
743 #ifdef STDIO_PTR_LVALUE
750 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf)
752 win32_setvbuf(pf, NULL, _IOLBF, 0);
756 PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...)
759 va_start(arglist, format);
760 return win32_vfprintf(pf, format, arglist);
764 PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist)
766 return win32_vfprintf(pf, format, arglist);
770 PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf)
772 return win32_ftell(pf);
776 PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, Off_t offset, int origin)
778 return win32_fseek(pf, offset, origin);
782 PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf)
788 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
790 return win32_tmpfile();
794 PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p)
796 return win32_fgetpos(pf, p);
800 PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p)
802 return win32_fsetpos(pf, p);
805 PerlStdIOInit(struct IPerlStdIO* piPerl)
810 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
812 Perl_init_os_extras();
816 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, intptr_t osfhandle, int flags)
818 return win32_open_osfhandle(osfhandle, flags);
822 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
824 return win32_get_osfhandle(filenum);
828 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
834 int fileno = win32_dup(win32_fileno(pf));
836 /* open the file in the same mode */
838 if((pf)->flags & _F_READ) {
842 else if((pf)->flags & _F_WRIT) {
846 else if((pf)->flags & _F_RDWR) {
852 if((pf)->_flag & _IOREAD) {
856 else if((pf)->_flag & _IOWRT) {
860 else if((pf)->_flag & _IORW) {
867 /* it appears that the binmode is attached to the
868 * file descriptor so binmode files will be handled
871 pfdup = win32_fdopen(fileno, mode);
873 /* move the file pointer to the same position */
874 if (!fgetpos(pf, &pos)) {
875 fsetpos(pfdup, &pos);
883 struct IPerlStdIO perlStdIO =
922 PerlStdIOInitOSExtras,
928 #define IPERL2HOST(x) IPerlLIO2Host(x)
932 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
934 return win32_access(path, mode);
938 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
940 return win32_chmod(filename, pmode);
944 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
946 return chown(filename, owner, group);
950 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, Off_t size)
952 return win32_chsize(handle, size);
956 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
958 return win32_close(handle);
962 PerlLIODup(struct IPerlLIO* piPerl, int handle)
964 return win32_dup(handle);
968 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
970 return win32_dup2(handle1, handle2);
974 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
976 return win32_flock(fd, oper);
980 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, Stat_t *buffer)
982 return win32_fstat(handle, buffer);
986 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
988 return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
992 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
998 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
1000 return win32_link(oldname, newname);
1004 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, Off_t offset, int origin)
1006 return win32_lseek(handle, offset, origin);
1010 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer)
1012 return win32_stat(path, buffer);
1016 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
1018 return mktemp(Template);
1022 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
1024 return win32_open(filename, oflag);
1028 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
1030 return win32_open(filename, oflag, pmode);
1034 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
1036 return win32_read(handle, buffer, count);
1040 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
1042 return win32_rename(OldFileName, newname);
1046 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1048 return win32_setmode(handle, mode);
1052 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer)
1054 return win32_stat(path, buffer);
1058 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1060 return tmpnam(string);
1064 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1066 return umask(pmode);
1070 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1072 return win32_unlink(filename);
1076 PerlLIOUtime(struct IPerlLIO* piPerl, const char *filename, struct utimbuf *times)
1078 return win32_utime(filename, times);
1082 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1084 return win32_write(handle, buffer, count);
1087 struct IPerlLIO perlLIO =
1119 #define IPERL2HOST(x) IPerlDir2Host(x)
1123 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1125 return win32_mkdir(dirname, mode);
1129 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1131 return IPERL2HOST(piPerl)->Chdir(dirname);
1135 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1137 return win32_rmdir(dirname);
1141 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1143 return win32_closedir(dirp);
1147 PerlDirOpen(struct IPerlDir* piPerl, const char *filename)
1149 return win32_opendir(filename);
1153 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1155 return win32_readdir(dirp);
1159 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1161 win32_rewinddir(dirp);
1165 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1167 win32_seekdir(dirp, loc);
1171 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1173 return win32_telldir(dirp);
1177 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1179 return IPERL2HOST(piPerl)->MapPathA(path);
1183 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1185 return IPERL2HOST(piPerl)->MapPathW(path);
1188 struct IPerlDir perlDir =
1206 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1208 return win32_htonl(hostlong);
1212 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1214 return win32_htons(hostshort);
1218 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1220 return win32_ntohl(netlong);
1224 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1226 return win32_ntohs(netshort);
1229 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1231 return win32_accept(s, addr, addrlen);
1235 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1237 return win32_bind(s, name, namelen);
1241 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1243 return win32_connect(s, name, namelen);
1247 PerlSockEndhostent(struct IPerlSock* piPerl)
1253 PerlSockEndnetent(struct IPerlSock* piPerl)
1259 PerlSockEndprotoent(struct IPerlSock* piPerl)
1261 win32_endprotoent();
1265 PerlSockEndservent(struct IPerlSock* piPerl)
1271 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1273 return win32_gethostbyaddr(addr, len, type);
1277 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1279 return win32_gethostbyname(name);
1283 PerlSockGethostent(struct IPerlSock* piPerl)
1286 Perl_croak(aTHX_ "gethostent not implemented!\n");
1291 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1293 return win32_gethostname(name, namelen);
1297 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1299 return win32_getnetbyaddr(net, type);
1303 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1305 return win32_getnetbyname((char*)name);
1309 PerlSockGetnetent(struct IPerlSock* piPerl)
1311 return win32_getnetent();
1314 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1316 return win32_getpeername(s, name, namelen);
1320 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1322 return win32_getprotobyname(name);
1326 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1328 return win32_getprotobynumber(number);
1332 PerlSockGetprotoent(struct IPerlSock* piPerl)
1334 return win32_getprotoent();
1338 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1340 return win32_getservbyname(name, proto);
1344 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1346 return win32_getservbyport(port, proto);
1350 PerlSockGetservent(struct IPerlSock* piPerl)
1352 return win32_getservent();
1356 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1358 return win32_getsockname(s, name, namelen);
1362 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1364 return win32_getsockopt(s, level, optname, optval, optlen);
1368 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1370 return win32_inet_addr(cp);
1374 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1376 return win32_inet_ntoa(in);
1380 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1382 return win32_listen(s, backlog);
1386 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1388 return win32_recv(s, buffer, len, flags);
1392 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1394 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1398 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1400 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1404 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1406 return win32_send(s, buffer, len, flags);
1410 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1412 return win32_sendto(s, buffer, len, flags, to, tolen);
1416 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1418 win32_sethostent(stayopen);
1422 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1424 win32_setnetent(stayopen);
1428 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1430 win32_setprotoent(stayopen);
1434 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1436 win32_setservent(stayopen);
1440 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1442 return win32_setsockopt(s, level, optname, optval, optlen);
1446 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1448 return win32_shutdown(s, how);
1452 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1454 return win32_socket(af, type, protocol);
1458 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1460 return Perl_my_socketpair(domain, type, protocol, fds);
1464 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1466 return win32_closesocket(s);
1470 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1472 return win32_ioctlsocket(s, cmd, argp);
1475 struct IPerlSock perlSock =
1486 PerlSockEndprotoent,
1488 PerlSockGethostname,
1489 PerlSockGetpeername,
1490 PerlSockGethostbyaddr,
1491 PerlSockGethostbyname,
1493 PerlSockGetnetbyaddr,
1494 PerlSockGetnetbyname,
1496 PerlSockGetprotobyname,
1497 PerlSockGetprotobynumber,
1498 PerlSockGetprotoent,
1499 PerlSockGetservbyname,
1500 PerlSockGetservbyport,
1502 PerlSockGetsockname,
1514 PerlSockSetprotoent,
1520 PerlSockClosesocket,
1526 #define EXECF_EXEC 1
1527 #define EXECF_SPAWN 2
1530 PerlProcAbort(struct IPerlProc* piPerl)
1536 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1538 return win32_crypt(clear, salt);
1542 PerlProcExit(struct IPerlProc* piPerl, int status)
1548 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1554 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1556 return execl(cmdname, arg0, arg1, arg2, arg3);
1560 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1562 return win32_execvp(cmdname, argv);
1566 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1568 return win32_execvp(cmdname, argv);
1572 PerlProcGetuid(struct IPerlProc* piPerl)
1578 PerlProcGeteuid(struct IPerlProc* piPerl)
1584 PerlProcGetgid(struct IPerlProc* piPerl)
1590 PerlProcGetegid(struct IPerlProc* piPerl)
1596 PerlProcGetlogin(struct IPerlProc* piPerl)
1598 return g_getlogin();
1602 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1604 return win32_kill(pid, sig);
1608 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1611 Perl_croak(aTHX_ "killpg not implemented!\n");
1616 PerlProcPauseProc(struct IPerlProc* piPerl)
1618 return win32_sleep((32767L << 16) + 32767);
1622 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1625 PERL_FLUSHALL_FOR_CHILD;
1626 return win32_popen(command, mode);
1630 PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
1633 PERL_FLUSHALL_FOR_CHILD;
1634 return win32_popenlist(mode, narg, args);
1638 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1640 return win32_pclose(stream);
1644 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1646 return win32_pipe(phandles, 512, O_BINARY);
1650 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1656 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1662 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1664 return win32_sleep(s);
1668 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1670 return win32_times(timebuf);
1674 PerlProcWait(struct IPerlProc* piPerl, int *status)
1676 return win32_wait(status);
1680 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1682 return win32_waitpid(pid, status, flags);
1686 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1688 return win32_signal(sig, subcode);
1692 PerlProcGetTimeOfDay(struct IPerlProc* piPerl, struct timeval *t, void *z)
1694 return win32_gettimeofday(t, z);
1698 static THREAD_RET_TYPE
1699 win32_start_child(LPVOID arg)
1701 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1704 HWND parent_message_hwnd;
1705 #ifdef PERL_SYNC_FORK
1706 static long sync_fork_id = 0;
1707 long id = ++sync_fork_id;
1711 PERL_SET_THX(my_perl);
1712 win32_checkTLS(my_perl);
1714 /* set $$ to pseudo id */
1715 #ifdef PERL_SYNC_FORK
1718 w32_pseudo_id = GetCurrentThreadId();
1720 int pid = (int)w32_pseudo_id;
1722 w32_pseudo_id = -pid;
1725 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) {
1726 SV *sv = GvSV(tmpgv);
1728 sv_setiv(sv, -(IV)w32_pseudo_id);
1731 #ifdef PERL_USES_PL_PIDSTATUS
1732 hv_clear(PL_pidstatus);
1735 /* create message window and tell parent about it */
1736 parent_message_hwnd = w32_message_hwnd;
1737 w32_message_hwnd = win32_create_message_window();
1738 if (parent_message_hwnd != NULL)
1739 PostMessage(parent_message_hwnd, WM_USER_MESSAGE, w32_pseudo_id, (LONG)w32_message_hwnd);
1741 /* push a zero on the stack (we are the child) */
1749 /* continue from next op */
1750 PL_op = PL_op->op_next;
1754 volatile int oldscope = PL_scopestack_ix;
1757 JMPENV_PUSH(status);
1764 while (PL_scopestack_ix > oldscope)
1767 PL_curstash = PL_defstash;
1768 if (PL_endav && !PL_minus_c)
1769 call_list(oldscope, PL_endav);
1770 status = STATUS_EXIT;
1774 POPSTACK_TO(PL_mainstack);
1775 PL_op = PL_restartop;
1776 PL_restartop = Nullop;
1779 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1786 /* XXX hack to avoid perl_destruct() freeing optree */
1787 win32_checkTLS(my_perl);
1788 PL_main_root = Nullop;
1791 win32_checkTLS(my_perl);
1792 /* close the std handles to avoid fd leaks */
1794 do_close(PL_stdingv, FALSE);
1795 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE); /* PL_stdoutgv - ISAGN */
1796 do_close(PL_stderrgv, FALSE);
1799 /* destroy everything (waits for any pseudo-forked children) */
1800 win32_checkTLS(my_perl);
1801 perl_destruct(my_perl);
1802 win32_checkTLS(my_perl);
1805 #ifdef PERL_SYNC_FORK
1808 return (DWORD)status;
1811 #endif /* USE_ITHREADS */
1814 PerlProcFork(struct IPerlProc* piPerl)
1822 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1826 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1827 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 1,
1829 h->m_pHostperlMemShared,
1830 h->m_pHostperlMemParse,
1832 h->m_pHostperlStdIO,
1838 new_perl->Isys_intern.internal_host = h;
1839 h->host_perl = new_perl;
1840 # ifdef PERL_SYNC_FORK
1841 id = win32_start_child((LPVOID)new_perl);
1844 if (w32_message_hwnd == INVALID_HANDLE_VALUE)
1845 w32_message_hwnd = win32_create_message_window();
1846 new_perl->Isys_intern.message_hwnd = w32_message_hwnd;
1847 w32_pseudo_child_message_hwnds[w32_num_pseudo_children] =
1848 (w32_message_hwnd == NULL) ? (HWND)NULL : (HWND)INVALID_HANDLE_VALUE;
1849 # ifdef USE_RTL_THREAD_API
1850 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1851 (void*)new_perl, 0, (unsigned*)&id);
1853 handle = CreateThread(NULL, 0, win32_start_child,
1854 (LPVOID)new_perl, 0, &id);
1856 PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
1866 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1867 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1868 ++w32_num_pseudo_children;
1872 Perl_croak(aTHX_ "fork() not implemented!\n");
1874 #endif /* USE_ITHREADS */
1878 PerlProcGetpid(struct IPerlProc* piPerl)
1880 return win32_getpid();
1884 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1886 return win32_dynaload(filename);
1890 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1892 win32_str_os_error(sv, dwErr);
1896 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1898 return win32_spawnvp(mode, cmdname, argv);
1902 PerlProcLastHost(struct IPerlProc* piPerl)
1905 CPerlHost *h = (CPerlHost*)w32_internal_host;
1906 return h->LastHost();
1909 struct IPerlProc perlProc =
1943 PerlProcGetTimeOfDay
1951 CPerlHost::CPerlHost(void)
1953 /* Construct a host from scratch */
1954 InterlockedIncrement(&num_hosts);
1955 m_pvDir = new VDir();
1956 m_pVMem = new VMem();
1957 m_pVMemShared = new VMem();
1958 m_pVMemParse = new VMem();
1960 m_pvDir->Init(NULL, m_pVMem);
1963 m_lppEnvList = NULL;
1966 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1967 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1968 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1969 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1970 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1971 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1972 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1973 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1974 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1976 m_pHostperlMem = &m_hostperlMem;
1977 m_pHostperlMemShared = &m_hostperlMemShared;
1978 m_pHostperlMemParse = &m_hostperlMemParse;
1979 m_pHostperlEnv = &m_hostperlEnv;
1980 m_pHostperlStdIO = &m_hostperlStdIO;
1981 m_pHostperlLIO = &m_hostperlLIO;
1982 m_pHostperlDir = &m_hostperlDir;
1983 m_pHostperlSock = &m_hostperlSock;
1984 m_pHostperlProc = &m_hostperlProc;
1987 #define SETUPEXCHANGE(xptr, iptr, table) \
1998 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1999 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
2000 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
2001 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
2002 struct IPerlProc** ppProc)
2004 InterlockedIncrement(&num_hosts);
2005 m_pvDir = new VDir(0);
2006 m_pVMem = new VMem();
2007 m_pVMemShared = new VMem();
2008 m_pVMemParse = new VMem();
2010 m_pvDir->Init(NULL, m_pVMem);
2013 m_lppEnvList = NULL;
2014 m_bTopLevel = FALSE;
2016 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2017 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2018 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2019 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2020 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2021 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2022 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2023 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2024 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2026 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
2027 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
2028 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
2029 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
2030 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
2031 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
2032 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
2033 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
2034 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
2036 #undef SETUPEXCHANGE
2038 CPerlHost::CPerlHost(CPerlHost& host)
2040 /* Construct a host from another host */
2041 InterlockedIncrement(&num_hosts);
2042 m_pVMem = new VMem();
2043 m_pVMemShared = host.GetMemShared();
2044 m_pVMemParse = host.GetMemParse();
2046 /* duplicate directory info */
2047 m_pvDir = new VDir(0);
2048 m_pvDir->Init(host.GetDir(), m_pVMem);
2050 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2051 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2052 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2053 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2054 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2055 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2056 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2057 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2058 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2059 m_pHostperlMem = &m_hostperlMem;
2060 m_pHostperlMemShared = &m_hostperlMemShared;
2061 m_pHostperlMemParse = &m_hostperlMemParse;
2062 m_pHostperlEnv = &m_hostperlEnv;
2063 m_pHostperlStdIO = &m_hostperlStdIO;
2064 m_pHostperlLIO = &m_hostperlLIO;
2065 m_pHostperlDir = &m_hostperlDir;
2066 m_pHostperlSock = &m_hostperlSock;
2067 m_pHostperlProc = &m_hostperlProc;
2070 m_lppEnvList = NULL;
2071 m_bTopLevel = FALSE;
2073 /* duplicate environment info */
2076 while(lpPtr = host.GetIndex(dwIndex))
2080 CPerlHost::~CPerlHost(void)
2083 InterlockedDecrement(&num_hosts);
2085 m_pVMemParse->Release();
2086 m_pVMemShared->Release();
2091 CPerlHost::Find(LPCSTR lpStr)
2094 LPSTR* lppPtr = Lookup(lpStr);
2095 if(lppPtr != NULL) {
2096 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2108 lookup(const void *arg1, const void *arg2)
2109 { // Compare strings
2113 ptr1 = *(char**)arg1;
2114 ptr2 = *(char**)arg2;
2118 if(c1 == '\0' || c1 == '=') {
2119 if(c2 == '\0' || c2 == '=')
2122 return -1; // string 1 < string 2
2124 else if(c2 == '\0' || c2 == '=')
2125 return 1; // string 1 > string 2
2131 return -1; // string 1 < string 2
2133 return 1; // string 1 > string 2
2141 CPerlHost::Lookup(LPCSTR lpStr)
2144 if (!m_lppEnvList || !m_dwEnvCount)
2149 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2153 compare(const void *arg1, const void *arg2)
2154 { // Compare strings
2158 ptr1 = *(char**)arg1;
2159 ptr2 = *(char**)arg2;
2163 if(c1 == '\0' || c1 == '=') {
2167 return -1; // string 1 < string 2
2169 else if(c2 == '\0' || c2 == '=')
2170 return 1; // string 1 > string 2
2176 return -1; // string 1 < string 2
2178 return 1; // string 1 > string 2
2186 CPerlHost::Add(LPCSTR lpStr)
2189 char szBuffer[1024];
2191 int index, length = strlen(lpStr)+1;
2193 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2194 szBuffer[index] = lpStr[index];
2196 szBuffer[index] = '\0';
2199 lpPtr = Lookup(szBuffer);
2200 if (lpPtr != NULL) {
2201 // must allocate things via host memory allocation functions
2202 // rather than perl's Renew() et al, as the perl interpreter
2203 // may either not be initialized enough when we allocate these,
2204 // or may already be dead when we go to free these
2205 *lpPtr = (char*)Realloc(*lpPtr, length * sizeof(char));
2206 strcpy(*lpPtr, lpStr);
2209 m_lppEnvList = (LPSTR*)Realloc(m_lppEnvList, (m_dwEnvCount+1) * sizeof(LPSTR));
2211 m_lppEnvList[m_dwEnvCount] = (char*)Malloc(length * sizeof(char));
2212 if (m_lppEnvList[m_dwEnvCount] != NULL) {
2213 strcpy(m_lppEnvList[m_dwEnvCount], lpStr);
2215 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2222 CPerlHost::CalculateEnvironmentSpace(void)
2226 for(index = 0; index < m_dwEnvCount; ++index)
2227 dwSize += strlen(m_lppEnvList[index]) + 1;
2233 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2240 CPerlHost::GetChildDir(void)
2245 Newx(ptr, MAX_PATH+1, char);
2247 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2248 length = strlen(ptr);
2250 if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2258 CPerlHost::FreeChildDir(char* pStr)
2265 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2268 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2269 DWORD dwSize, dwEnvIndex;
2270 int nLength, compVal;
2272 // get the process environment strings
2273 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2275 // step over current directory stuff
2276 while(*lpTmp == '=')
2277 lpTmp += strlen(lpTmp) + 1;
2279 // save the start of the environment strings
2281 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2282 // calculate the size of the environment strings
2283 dwSize += strlen(lpTmp) + 1;
2286 // add the size of current directories
2287 dwSize += vDir.CalculateEnvironmentSpace();
2289 // add the additional space used by changes made to the environment
2290 dwSize += CalculateEnvironmentSpace();
2292 Newx(lpStr, dwSize, char);
2295 // build the local environment
2296 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2299 lpLocalEnv = GetIndex(dwEnvIndex);
2300 while(*lpEnvPtr != '\0') {
2302 // all environment overrides have been added
2303 // so copy string into place
2304 strcpy(lpStr, lpEnvPtr);
2305 nLength = strlen(lpEnvPtr) + 1;
2307 lpEnvPtr += nLength;
2310 // determine which string to copy next
2311 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2313 strcpy(lpStr, lpEnvPtr);
2314 nLength = strlen(lpEnvPtr) + 1;
2316 lpEnvPtr += nLength;
2319 char *ptr = strchr(lpLocalEnv, '=');
2321 strcpy(lpStr, lpLocalEnv);
2322 lpStr += strlen(lpLocalEnv) + 1;
2324 lpLocalEnv = GetIndex(dwEnvIndex);
2326 // this string was replaced
2327 lpEnvPtr += strlen(lpEnvPtr) + 1;
2334 // still have environment overrides to add
2335 // so copy the strings into place if not an override
2336 char *ptr = strchr(lpLocalEnv, '=');
2338 strcpy(lpStr, lpLocalEnv);
2339 lpStr += strlen(lpLocalEnv) + 1;
2341 lpLocalEnv = GetIndex(dwEnvIndex);
2348 // release the process environment strings
2349 FreeEnvironmentStrings(lpAllocPtr);
2355 CPerlHost::Reset(void)
2358 if(m_lppEnvList != NULL) {
2359 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2360 Free(m_lppEnvList[index]);
2361 m_lppEnvList[index] = NULL;
2366 m_lppEnvList = NULL;
2370 CPerlHost::Clearenv(void)
2374 LPSTR lpPtr, lpStr, lpEnvPtr;
2375 if (m_lppEnvList != NULL) {
2376 /* set every entry to an empty string */
2377 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2378 char* ptr = strchr(m_lppEnvList[index], '=');
2385 /* get the process environment strings */
2386 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2388 /* step over current directory stuff */
2389 while(*lpStr == '=')
2390 lpStr += strlen(lpStr) + 1;
2393 lpPtr = strchr(lpStr, '=');
2399 (void)win32_putenv(lpStr);
2402 lpStr += strlen(lpStr) + 1;
2405 FreeEnvironmentStrings(lpEnvPtr);
2410 CPerlHost::Getenv(const char *varname)
2414 char *pEnv = Find(varname);
2418 return win32_getenv(varname);
2422 CPerlHost::Putenv(const char *envstring)
2427 return win32_putenv(envstring);
2433 CPerlHost::Chdir(const char *dirname)
2441 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2448 #endif /* ___PerlHost_H___ */