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.
10 #define CHECK_HOST_INTERP
12 #ifndef ___PerlHost_H___
13 #define ___PerlHost_H___
21 extern char * g_win32_get_privlib(const char *pl);
22 extern char * g_win32_get_sitelib(const char *pl);
23 extern char * g_win32_get_vendorlib(const char *pl);
24 extern char * g_getlogin(void);
32 CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
33 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
34 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
35 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
36 struct IPerlProc** ppProc);
37 CPerlHost(CPerlHost& host);
40 static CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl);
41 static CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl);
42 static CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl);
43 static CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl);
44 static CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl);
45 static CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl);
46 static CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl);
47 static CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl);
48 static CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl);
50 BOOL PerlCreate(void);
51 int PerlParse(int argc, char** argv, char** env);
53 void PerlDestroy(void);
56 /* Locks provided but should be unnecessary as this is private pool */
57 inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
58 inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
59 inline void Free(void* ptr) { m_pVMem->Free(ptr); };
60 inline void* Calloc(size_t num, size_t size)
62 size_t count = num*size;
63 void* lpVoid = Malloc(count);
65 ZeroMemory(lpVoid, count);
68 inline void GetLock(void) { m_pVMem->GetLock(); };
69 inline void FreeLock(void) { m_pVMem->FreeLock(); };
70 inline int IsLocked(void) { return m_pVMem->IsLocked(); };
73 /* Locks used to serialize access to the pool */
74 inline void GetLockShared(void) { m_pVMemShared->GetLock(); };
75 inline void FreeLockShared(void) { m_pVMemShared->FreeLock(); };
76 inline int IsLockedShared(void) { return m_pVMemShared->IsLocked(); };
77 inline void* MallocShared(size_t size)
81 result = m_pVMemShared->Malloc(size);
85 inline void* ReallocShared(void* ptr, size_t size)
89 result = m_pVMemShared->Realloc(ptr, size);
93 inline void FreeShared(void* ptr)
96 m_pVMemShared->Free(ptr);
99 inline void* CallocShared(size_t num, size_t size)
101 size_t count = num*size;
102 void* lpVoid = MallocShared(count);
104 ZeroMemory(lpVoid, count);
109 /* Assume something else is using locks to mangaging serialize
112 inline void GetLockParse(void) { m_pVMemParse->GetLock(); };
113 inline void FreeLockParse(void) { m_pVMemParse->FreeLock(); };
114 inline int IsLockedParse(void) { return m_pVMemParse->IsLocked(); };
115 inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
116 inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
117 inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
118 inline void* CallocParse(size_t num, size_t size)
120 size_t count = num*size;
121 void* lpVoid = MallocParse(count);
123 ZeroMemory(lpVoid, count);
128 char *Getenv(const char *varname);
129 int Putenv(const char *envstring);
130 inline char *Getenv(const char *varname, unsigned long *len)
133 char *e = Getenv(varname);
138 void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
139 void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
140 char* GetChildDir(void);
141 void FreeChildDir(char* pStr);
145 inline LPSTR GetIndex(DWORD &dwIndex)
147 if(dwIndex < m_dwEnvCount)
150 return m_lppEnvList[dwIndex-1];
156 LPSTR Find(LPCSTR lpStr);
157 void Add(LPCSTR lpStr);
159 LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
160 void FreeLocalEnvironmentStrings(LPSTR lpStr);
161 LPSTR* Lookup(LPCSTR lpStr);
162 DWORD CalculateEnvironmentSpace(void);
167 virtual int Chdir(const char *dirname);
171 void Exit(int status);
172 void _Exit(int status);
173 int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
174 int Execv(const char *cmdname, const char *const *argv);
175 int Execvp(const char *cmdname, const char *const *argv);
177 inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
178 inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
179 inline VDir* GetDir(void) { return m_pvDir; };
183 struct IPerlMem m_hostperlMem;
184 struct IPerlMem m_hostperlMemShared;
185 struct IPerlMem m_hostperlMemParse;
186 struct IPerlEnv m_hostperlEnv;
187 struct IPerlStdIO m_hostperlStdIO;
188 struct IPerlLIO m_hostperlLIO;
189 struct IPerlDir m_hostperlDir;
190 struct IPerlSock m_hostperlSock;
191 struct IPerlProc m_hostperlProc;
193 struct IPerlMem* m_pHostperlMem;
194 struct IPerlMem* m_pHostperlMemShared;
195 struct IPerlMem* m_pHostperlMemParse;
196 struct IPerlEnv* m_pHostperlEnv;
197 struct IPerlStdIO* m_pHostperlStdIO;
198 struct IPerlLIO* m_pHostperlLIO;
199 struct IPerlDir* m_pHostperlDir;
200 struct IPerlSock* m_pHostperlSock;
201 struct IPerlProc* m_pHostperlProc;
203 inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
204 inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
214 BOOL m_bTopLevel; // is this a toplevel host?
215 static long num_hosts;
217 inline int LastHost(void) { return num_hosts == 1L; };
218 struct interpreter *host_perl;
221 long CPerlHost::num_hosts = 0L;
223 extern "C" void win32_checkTLS(struct interpreter *host_perl);
225 #define STRUCT2RAWPTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
226 #ifdef CHECK_HOST_INTERP
227 inline CPerlHost* CheckInterp(CPerlHost *host)
229 win32_checkTLS(host->host_perl);
232 #define STRUCT2PTR(x, y) CheckInterp(STRUCT2RAWPTR(x, y))
234 #define STRUCT2PTR(x, y) STRUCT2RAWPTR(x, y)
237 inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
239 return STRUCT2RAWPTR(piPerl, m_hostperlMem);
242 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
244 return STRUCT2RAWPTR(piPerl, m_hostperlMemShared);
247 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
249 return STRUCT2RAWPTR(piPerl, m_hostperlMemParse);
252 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
254 return STRUCT2PTR(piPerl, m_hostperlEnv);
257 inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
259 return STRUCT2PTR(piPerl, m_hostperlStdIO);
262 inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
264 return STRUCT2PTR(piPerl, m_hostperlLIO);
267 inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
269 return STRUCT2PTR(piPerl, m_hostperlDir);
272 inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
274 return STRUCT2PTR(piPerl, m_hostperlSock);
277 inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
279 return STRUCT2PTR(piPerl, m_hostperlProc);
285 #define IPERL2HOST(x) IPerlMem2Host(x)
289 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
291 return IPERL2HOST(piPerl)->Malloc(size);
294 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
296 return IPERL2HOST(piPerl)->Realloc(ptr, size);
299 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
301 IPERL2HOST(piPerl)->Free(ptr);
304 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
306 return IPERL2HOST(piPerl)->Calloc(num, size);
310 PerlMemGetLock(struct IPerlMem* piPerl)
312 IPERL2HOST(piPerl)->GetLock();
316 PerlMemFreeLock(struct IPerlMem* piPerl)
318 IPERL2HOST(piPerl)->FreeLock();
322 PerlMemIsLocked(struct IPerlMem* piPerl)
324 return IPERL2HOST(piPerl)->IsLocked();
327 struct IPerlMem perlMem =
339 #define IPERL2HOST(x) IPerlMemShared2Host(x)
343 PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
345 return IPERL2HOST(piPerl)->MallocShared(size);
348 PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
350 return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
353 PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
355 IPERL2HOST(piPerl)->FreeShared(ptr);
358 PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
360 return IPERL2HOST(piPerl)->CallocShared(num, size);
364 PerlMemSharedGetLock(struct IPerlMem* piPerl)
366 IPERL2HOST(piPerl)->GetLockShared();
370 PerlMemSharedFreeLock(struct IPerlMem* piPerl)
372 IPERL2HOST(piPerl)->FreeLockShared();
376 PerlMemSharedIsLocked(struct IPerlMem* piPerl)
378 return IPERL2HOST(piPerl)->IsLockedShared();
381 struct IPerlMem perlMemShared =
384 PerlMemSharedRealloc,
387 PerlMemSharedGetLock,
388 PerlMemSharedFreeLock,
389 PerlMemSharedIsLocked,
393 #define IPERL2HOST(x) IPerlMemParse2Host(x)
397 PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
399 return IPERL2HOST(piPerl)->MallocParse(size);
402 PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
404 return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
407 PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
409 IPERL2HOST(piPerl)->FreeParse(ptr);
412 PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
414 return IPERL2HOST(piPerl)->CallocParse(num, size);
418 PerlMemParseGetLock(struct IPerlMem* piPerl)
420 IPERL2HOST(piPerl)->GetLockParse();
424 PerlMemParseFreeLock(struct IPerlMem* piPerl)
426 IPERL2HOST(piPerl)->FreeLockParse();
430 PerlMemParseIsLocked(struct IPerlMem* piPerl)
432 return IPERL2HOST(piPerl)->IsLockedParse();
435 struct IPerlMem perlMemParse =
442 PerlMemParseFreeLock,
443 PerlMemParseIsLocked,
448 #define IPERL2HOST(x) IPerlEnv2Host(x)
452 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
454 return IPERL2HOST(piPerl)->Getenv(varname);
458 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
460 return IPERL2HOST(piPerl)->Putenv(envstring);
464 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
466 return IPERL2HOST(piPerl)->Getenv(varname, len);
470 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
472 return win32_uname(name);
476 PerlEnvClearenv(struct IPerlEnv* piPerl)
478 IPERL2HOST(piPerl)->Clearenv();
482 PerlEnvGetChildenv(struct IPerlEnv* piPerl)
484 return IPERL2HOST(piPerl)->CreateChildEnv();
488 PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
490 IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
494 PerlEnvGetChilddir(struct IPerlEnv* piPerl)
496 return IPERL2HOST(piPerl)->GetChildDir();
500 PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
502 IPERL2HOST(piPerl)->FreeChildDir(childDir);
506 PerlEnvOsId(struct IPerlEnv* piPerl)
508 return win32_os_id();
512 PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
514 return g_win32_get_privlib(pl);
518 PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
520 return g_win32_get_sitelib(pl);
524 PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
526 return g_win32_get_vendorlib(pl);
530 PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
532 win32_get_child_IO(ptr);
535 struct IPerlEnv perlEnv =
549 PerlEnvVendorLibPath,
554 #define IPERL2HOST(x) IPerlStdIO2Host(x)
558 PerlStdIOStdin(struct IPerlStdIO* piPerl)
560 return win32_stdin();
564 PerlStdIOStdout(struct IPerlStdIO* piPerl)
566 return win32_stdout();
570 PerlStdIOStderr(struct IPerlStdIO* piPerl)
572 return win32_stderr();
576 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
578 return win32_fopen(path, mode);
582 PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf)
584 return win32_fclose((pf));
588 PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf)
590 return win32_feof(pf);
594 PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf)
596 return win32_ferror(pf);
600 PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf)
606 PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf)
608 return win32_getc(pf);
612 PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf)
623 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf)
627 return FILE_bufsiz(f);
634 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf)
645 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
656 PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n)
658 return win32_fgets(s, n, pf);
662 PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c)
664 return win32_fputc(c, pf);
668 PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s)
670 return win32_fputs(s, pf);
674 PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf)
676 return win32_fflush(pf);
680 PerlStdIOUngetc(struct IPerlStdIO* piPerl,int c, FILE* pf)
682 return win32_ungetc(c, pf);
686 PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf)
688 return win32_fileno(pf);
692 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
694 return win32_fdopen(fd, mode);
698 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf)
700 return win32_freopen(path, mode, (FILE*)pf);
704 PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf)
706 return win32_fread(buffer, size, count, pf);
710 PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf)
712 return win32_fwrite(buffer, size, count, pf);
716 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer)
718 win32_setbuf(pf, buffer);
722 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size)
724 return win32_setvbuf(pf, buffer, type, size);
728 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n)
730 #ifdef STDIO_CNT_LVALUE
737 PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr)
739 #ifdef STDIO_PTR_LVALUE
746 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf)
748 win32_setvbuf(pf, NULL, _IOLBF, 0);
752 PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...)
755 va_start(arglist, format);
756 return win32_vfprintf(pf, format, arglist);
760 PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist)
762 return win32_vfprintf(pf, format, arglist);
766 PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf)
768 return win32_ftell(pf);
772 PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, Off_t offset, int origin)
774 return win32_fseek(pf, offset, origin);
778 PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf)
784 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
786 return win32_tmpfile();
790 PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p)
792 return win32_fgetpos(pf, p);
796 PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p)
798 return win32_fsetpos(pf, p);
801 PerlStdIOInit(struct IPerlStdIO* piPerl)
806 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
808 Perl_init_os_extras();
812 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, intptr_t osfhandle, int flags)
814 return win32_open_osfhandle(osfhandle, flags);
818 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
820 return win32_get_osfhandle(filenum);
824 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
829 int fileno = win32_dup(win32_fileno(pf));
831 /* open the file in the same mode */
833 if((pf)->flags & _F_READ) {
837 else if((pf)->flags & _F_WRIT) {
841 else if((pf)->flags & _F_RDWR) {
847 if((pf)->_flag & _IOREAD) {
851 else if((pf)->_flag & _IOWRT) {
855 else if((pf)->_flag & _IORW) {
862 /* it appears that the binmode is attached to the
863 * file descriptor so binmode files will be handled
866 pfdup = win32_fdopen(fileno, mode);
868 /* move the file pointer to the same position */
869 if (!fgetpos(pf, &pos)) {
870 fsetpos(pfdup, &pos);
875 struct IPerlStdIO perlStdIO =
914 PerlStdIOInitOSExtras,
920 #define IPERL2HOST(x) IPerlLIO2Host(x)
924 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
926 return win32_access(path, mode);
930 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
932 return win32_chmod(filename, pmode);
936 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
938 return chown(filename, owner, group);
942 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, Off_t size)
944 return win32_chsize(handle, size);
948 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
950 return win32_close(handle);
954 PerlLIODup(struct IPerlLIO* piPerl, int handle)
956 return win32_dup(handle);
960 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
962 return win32_dup2(handle1, handle2);
966 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
968 return win32_flock(fd, oper);
972 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, Stat_t *buffer)
974 return win32_fstat(handle, buffer);
978 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
980 return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
984 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
990 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
992 return win32_link(oldname, newname);
996 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, Off_t offset, int origin)
998 return win32_lseek(handle, offset, origin);
1002 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer)
1004 return win32_stat(path, buffer);
1008 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
1010 return mktemp(Template);
1014 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
1016 return win32_open(filename, oflag);
1020 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
1022 return win32_open(filename, oflag, pmode);
1026 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
1028 return win32_read(handle, buffer, count);
1032 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
1034 return win32_rename(OldFileName, newname);
1038 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1040 return win32_setmode(handle, mode);
1044 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer)
1046 return win32_stat(path, buffer);
1050 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1052 return tmpnam(string);
1056 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1058 return umask(pmode);
1062 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1064 return win32_unlink(filename);
1068 PerlLIOUtime(struct IPerlLIO* piPerl, const char *filename, struct utimbuf *times)
1070 return win32_utime(filename, times);
1074 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1076 return win32_write(handle, buffer, count);
1079 struct IPerlLIO perlLIO =
1111 #define IPERL2HOST(x) IPerlDir2Host(x)
1115 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1117 return win32_mkdir(dirname, mode);
1121 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1123 return IPERL2HOST(piPerl)->Chdir(dirname);
1127 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1129 return win32_rmdir(dirname);
1133 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1135 return win32_closedir(dirp);
1139 PerlDirOpen(struct IPerlDir* piPerl, const char *filename)
1141 return win32_opendir(filename);
1145 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1147 return win32_readdir(dirp);
1151 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1153 win32_rewinddir(dirp);
1157 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1159 win32_seekdir(dirp, loc);
1163 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1165 return win32_telldir(dirp);
1169 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1171 return IPERL2HOST(piPerl)->MapPathA(path);
1175 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1177 return IPERL2HOST(piPerl)->MapPathW(path);
1180 struct IPerlDir perlDir =
1198 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1200 return win32_htonl(hostlong);
1204 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1206 return win32_htons(hostshort);
1210 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1212 return win32_ntohl(netlong);
1216 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1218 return win32_ntohs(netshort);
1221 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1223 return win32_accept(s, addr, addrlen);
1227 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1229 return win32_bind(s, name, namelen);
1233 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1235 return win32_connect(s, name, namelen);
1239 PerlSockEndhostent(struct IPerlSock* piPerl)
1245 PerlSockEndnetent(struct IPerlSock* piPerl)
1251 PerlSockEndprotoent(struct IPerlSock* piPerl)
1253 win32_endprotoent();
1257 PerlSockEndservent(struct IPerlSock* piPerl)
1263 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1265 return win32_gethostbyaddr(addr, len, type);
1269 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1271 return win32_gethostbyname(name);
1275 PerlSockGethostent(struct IPerlSock* piPerl)
1278 Perl_croak(aTHX_ "gethostent not implemented!\n");
1283 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1285 return win32_gethostname(name, namelen);
1289 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1291 return win32_getnetbyaddr(net, type);
1295 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1297 return win32_getnetbyname((char*)name);
1301 PerlSockGetnetent(struct IPerlSock* piPerl)
1303 return win32_getnetent();
1306 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1308 return win32_getpeername(s, name, namelen);
1312 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1314 return win32_getprotobyname(name);
1318 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1320 return win32_getprotobynumber(number);
1324 PerlSockGetprotoent(struct IPerlSock* piPerl)
1326 return win32_getprotoent();
1330 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1332 return win32_getservbyname(name, proto);
1336 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1338 return win32_getservbyport(port, proto);
1342 PerlSockGetservent(struct IPerlSock* piPerl)
1344 return win32_getservent();
1348 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1350 return win32_getsockname(s, name, namelen);
1354 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1356 return win32_getsockopt(s, level, optname, optval, optlen);
1360 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1362 return win32_inet_addr(cp);
1366 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1368 return win32_inet_ntoa(in);
1372 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1374 return win32_listen(s, backlog);
1378 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1380 return win32_recv(s, buffer, len, flags);
1384 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1386 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1390 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1392 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1396 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1398 return win32_send(s, buffer, len, flags);
1402 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1404 return win32_sendto(s, buffer, len, flags, to, tolen);
1408 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1410 win32_sethostent(stayopen);
1414 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1416 win32_setnetent(stayopen);
1420 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1422 win32_setprotoent(stayopen);
1426 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1428 win32_setservent(stayopen);
1432 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1434 return win32_setsockopt(s, level, optname, optval, optlen);
1438 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1440 return win32_shutdown(s, how);
1444 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1446 return win32_socket(af, type, protocol);
1450 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1452 return Perl_my_socketpair(domain, type, protocol, fds);
1456 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1458 return win32_closesocket(s);
1462 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1464 return win32_ioctlsocket(s, cmd, argp);
1467 struct IPerlSock perlSock =
1478 PerlSockEndprotoent,
1480 PerlSockGethostname,
1481 PerlSockGetpeername,
1482 PerlSockGethostbyaddr,
1483 PerlSockGethostbyname,
1485 PerlSockGetnetbyaddr,
1486 PerlSockGetnetbyname,
1488 PerlSockGetprotobyname,
1489 PerlSockGetprotobynumber,
1490 PerlSockGetprotoent,
1491 PerlSockGetservbyname,
1492 PerlSockGetservbyport,
1494 PerlSockGetsockname,
1506 PerlSockSetprotoent,
1512 PerlSockClosesocket,
1518 #define EXECF_EXEC 1
1519 #define EXECF_SPAWN 2
1522 PerlProcAbort(struct IPerlProc* piPerl)
1528 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1530 return win32_crypt(clear, salt);
1534 PerlProcExit(struct IPerlProc* piPerl, int status)
1540 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1546 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1548 return execl(cmdname, arg0, arg1, arg2, arg3);
1552 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1554 return win32_execvp(cmdname, argv);
1558 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1560 return win32_execvp(cmdname, argv);
1564 PerlProcGetuid(struct IPerlProc* piPerl)
1570 PerlProcGeteuid(struct IPerlProc* piPerl)
1576 PerlProcGetgid(struct IPerlProc* piPerl)
1582 PerlProcGetegid(struct IPerlProc* piPerl)
1588 PerlProcGetlogin(struct IPerlProc* piPerl)
1590 return g_getlogin();
1594 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1596 return win32_kill(pid, sig);
1600 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1603 Perl_croak(aTHX_ "killpg not implemented!\n");
1608 PerlProcPauseProc(struct IPerlProc* piPerl)
1610 return win32_sleep((32767L << 16) + 32767);
1614 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1617 PERL_FLUSHALL_FOR_CHILD;
1618 return win32_popen(command, mode);
1622 PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
1625 PERL_FLUSHALL_FOR_CHILD;
1626 return win32_popenlist(mode, narg, args);
1630 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1632 return win32_pclose(stream);
1636 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1638 return win32_pipe(phandles, 512, O_BINARY);
1642 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1648 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1654 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1656 return win32_sleep(s);
1660 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1662 return win32_times(timebuf);
1666 PerlProcWait(struct IPerlProc* piPerl, int *status)
1668 return win32_wait(status);
1672 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1674 return win32_waitpid(pid, status, flags);
1678 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1680 return win32_signal(sig, subcode);
1684 PerlProcGetTimeOfDay(struct IPerlProc* piPerl, struct timeval *t, void *z)
1686 return win32_gettimeofday(t, z);
1690 static THREAD_RET_TYPE
1691 win32_start_child(LPVOID arg)
1693 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1696 HWND parent_message_hwnd;
1697 #ifdef PERL_SYNC_FORK
1698 static long sync_fork_id = 0;
1699 long id = ++sync_fork_id;
1703 PERL_SET_THX(my_perl);
1704 win32_checkTLS(my_perl);
1706 /* set $$ to pseudo id */
1707 #ifdef PERL_SYNC_FORK
1710 w32_pseudo_id = GetCurrentThreadId();
1712 int pid = (int)w32_pseudo_id;
1714 w32_pseudo_id = -pid;
1717 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) {
1718 SV *sv = GvSV(tmpgv);
1720 sv_setiv(sv, -(IV)w32_pseudo_id);
1723 #ifdef PERL_USES_PL_PIDSTATUS
1724 hv_clear(PL_pidstatus);
1727 /* create message window and tell parent about it */
1728 parent_message_hwnd = w32_message_hwnd;
1729 w32_message_hwnd = win32_create_message_window();
1730 if (parent_message_hwnd != NULL)
1731 PostMessage(parent_message_hwnd, WM_USER_MESSAGE, w32_pseudo_id, (LONG)w32_message_hwnd);
1733 /* push a zero on the stack (we are the child) */
1741 /* continue from next op */
1742 PL_op = PL_op->op_next;
1746 volatile int oldscope = PL_scopestack_ix;
1749 JMPENV_PUSH(status);
1756 while (PL_scopestack_ix > oldscope)
1759 PL_curstash = PL_defstash;
1760 if (PL_endav && !PL_minus_c)
1761 call_list(oldscope, PL_endav);
1762 status = STATUS_EXIT;
1766 POPSTACK_TO(PL_mainstack);
1767 PL_op = PL_restartop;
1768 PL_restartop = Nullop;
1771 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1778 /* XXX hack to avoid perl_destruct() freeing optree */
1779 win32_checkTLS(my_perl);
1780 PL_main_root = Nullop;
1783 win32_checkTLS(my_perl);
1784 /* close the std handles to avoid fd leaks */
1786 do_close(PL_stdingv, FALSE);
1787 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE); /* PL_stdoutgv - ISAGN */
1788 do_close(PL_stderrgv, FALSE);
1791 /* destroy everything (waits for any pseudo-forked children) */
1792 win32_checkTLS(my_perl);
1793 perl_destruct(my_perl);
1794 win32_checkTLS(my_perl);
1797 #ifdef PERL_SYNC_FORK
1800 return (DWORD)status;
1803 #endif /* USE_ITHREADS */
1806 PerlProcFork(struct IPerlProc* piPerl)
1814 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1818 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1819 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 1,
1821 h->m_pHostperlMemShared,
1822 h->m_pHostperlMemParse,
1824 h->m_pHostperlStdIO,
1830 new_perl->Isys_intern.internal_host = h;
1831 h->host_perl = new_perl;
1832 # ifdef PERL_SYNC_FORK
1833 id = win32_start_child((LPVOID)new_perl);
1836 if (w32_message_hwnd == INVALID_HANDLE_VALUE)
1837 w32_message_hwnd = win32_create_message_window();
1838 new_perl->Isys_intern.message_hwnd = w32_message_hwnd;
1839 w32_pseudo_child_message_hwnds[w32_num_pseudo_children] =
1840 (w32_message_hwnd == NULL) ? (HWND)NULL : (HWND)INVALID_HANDLE_VALUE;
1841 # ifdef USE_RTL_THREAD_API
1842 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1843 (void*)new_perl, 0, (unsigned*)&id);
1845 handle = CreateThread(NULL, 0, win32_start_child,
1846 (LPVOID)new_perl, 0, &id);
1848 PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
1858 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1859 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1860 ++w32_num_pseudo_children;
1864 Perl_croak(aTHX_ "fork() not implemented!\n");
1866 #endif /* USE_ITHREADS */
1870 PerlProcGetpid(struct IPerlProc* piPerl)
1872 return win32_getpid();
1876 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1878 return win32_dynaload(filename);
1882 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1884 win32_str_os_error(sv, dwErr);
1888 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1890 return win32_spawnvp(mode, cmdname, argv);
1894 PerlProcLastHost(struct IPerlProc* piPerl)
1897 CPerlHost *h = (CPerlHost*)w32_internal_host;
1898 return h->LastHost();
1901 struct IPerlProc perlProc =
1935 PerlProcGetTimeOfDay
1943 CPerlHost::CPerlHost(void)
1945 /* Construct a host from scratch */
1946 InterlockedIncrement(&num_hosts);
1947 m_pvDir = new VDir();
1948 m_pVMem = new VMem();
1949 m_pVMemShared = new VMem();
1950 m_pVMemParse = new VMem();
1952 m_pvDir->Init(NULL, m_pVMem);
1955 m_lppEnvList = NULL;
1958 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1959 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1960 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1961 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1962 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1963 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1964 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1965 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1966 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1968 m_pHostperlMem = &m_hostperlMem;
1969 m_pHostperlMemShared = &m_hostperlMemShared;
1970 m_pHostperlMemParse = &m_hostperlMemParse;
1971 m_pHostperlEnv = &m_hostperlEnv;
1972 m_pHostperlStdIO = &m_hostperlStdIO;
1973 m_pHostperlLIO = &m_hostperlLIO;
1974 m_pHostperlDir = &m_hostperlDir;
1975 m_pHostperlSock = &m_hostperlSock;
1976 m_pHostperlProc = &m_hostperlProc;
1979 #define SETUPEXCHANGE(xptr, iptr, table) \
1990 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1991 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1992 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1993 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1994 struct IPerlProc** ppProc)
1996 InterlockedIncrement(&num_hosts);
1997 m_pvDir = new VDir(0);
1998 m_pVMem = new VMem();
1999 m_pVMemShared = new VMem();
2000 m_pVMemParse = new VMem();
2002 m_pvDir->Init(NULL, m_pVMem);
2005 m_lppEnvList = NULL;
2006 m_bTopLevel = FALSE;
2008 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2009 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2010 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2011 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2012 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2013 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2014 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2015 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2016 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2018 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
2019 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
2020 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
2021 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
2022 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
2023 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
2024 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
2025 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
2026 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
2028 #undef SETUPEXCHANGE
2030 CPerlHost::CPerlHost(CPerlHost& host)
2032 /* Construct a host from another host */
2033 InterlockedIncrement(&num_hosts);
2034 m_pVMem = new VMem();
2035 m_pVMemShared = host.GetMemShared();
2036 m_pVMemParse = host.GetMemParse();
2038 /* duplicate directory info */
2039 m_pvDir = new VDir(0);
2040 m_pvDir->Init(host.GetDir(), m_pVMem);
2042 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2043 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2044 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2045 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2046 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2047 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2048 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2049 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2050 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2051 m_pHostperlMem = &m_hostperlMem;
2052 m_pHostperlMemShared = &m_hostperlMemShared;
2053 m_pHostperlMemParse = &m_hostperlMemParse;
2054 m_pHostperlEnv = &m_hostperlEnv;
2055 m_pHostperlStdIO = &m_hostperlStdIO;
2056 m_pHostperlLIO = &m_hostperlLIO;
2057 m_pHostperlDir = &m_hostperlDir;
2058 m_pHostperlSock = &m_hostperlSock;
2059 m_pHostperlProc = &m_hostperlProc;
2062 m_lppEnvList = NULL;
2063 m_bTopLevel = FALSE;
2065 /* duplicate environment info */
2068 while(lpPtr = host.GetIndex(dwIndex))
2072 CPerlHost::~CPerlHost(void)
2075 InterlockedDecrement(&num_hosts);
2077 m_pVMemParse->Release();
2078 m_pVMemShared->Release();
2083 CPerlHost::Find(LPCSTR lpStr)
2086 LPSTR* lppPtr = Lookup(lpStr);
2087 if(lppPtr != NULL) {
2088 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2100 lookup(const void *arg1, const void *arg2)
2101 { // Compare strings
2105 ptr1 = *(char**)arg1;
2106 ptr2 = *(char**)arg2;
2110 if(c1 == '\0' || c1 == '=') {
2111 if(c2 == '\0' || c2 == '=')
2114 return -1; // string 1 < string 2
2116 else if(c2 == '\0' || c2 == '=')
2117 return 1; // string 1 > string 2
2123 return -1; // string 1 < string 2
2125 return 1; // string 1 > string 2
2133 CPerlHost::Lookup(LPCSTR lpStr)
2137 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2141 compare(const void *arg1, const void *arg2)
2142 { // Compare strings
2146 ptr1 = *(char**)arg1;
2147 ptr2 = *(char**)arg2;
2151 if(c1 == '\0' || c1 == '=') {
2155 return -1; // string 1 < string 2
2157 else if(c2 == '\0' || c2 == '=')
2158 return 1; // string 1 > string 2
2164 return -1; // string 1 < string 2
2166 return 1; // string 1 > string 2
2174 CPerlHost::Add(LPCSTR lpStr)
2177 char szBuffer[1024];
2179 int index, length = strlen(lpStr)+1;
2181 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2182 szBuffer[index] = lpStr[index];
2184 szBuffer[index] = '\0';
2187 lpPtr = Lookup(szBuffer);
2188 if (lpPtr != NULL) {
2189 // must allocate things via host memory allocation functions
2190 // rather than perl's Renew() et al, as the perl interpreter
2191 // may either not be initialized enough when we allocate these,
2192 // or may already be dead when we go to free these
2193 *lpPtr = (char*)Realloc(*lpPtr, length * sizeof(char));
2194 strcpy(*lpPtr, lpStr);
2197 m_lppEnvList = (LPSTR*)Realloc(m_lppEnvList, (m_dwEnvCount+1) * sizeof(LPSTR));
2199 m_lppEnvList[m_dwEnvCount] = (char*)Malloc(length * sizeof(char));
2200 if (m_lppEnvList[m_dwEnvCount] != NULL) {
2201 strcpy(m_lppEnvList[m_dwEnvCount], lpStr);
2203 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2210 CPerlHost::CalculateEnvironmentSpace(void)
2214 for(index = 0; index < m_dwEnvCount; ++index)
2215 dwSize += strlen(m_lppEnvList[index]) + 1;
2221 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2228 CPerlHost::GetChildDir(void)
2233 Newx(ptr, MAX_PATH+1, char);
2235 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2236 length = strlen(ptr);
2238 if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2246 CPerlHost::FreeChildDir(char* pStr)
2253 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2256 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2257 DWORD dwSize, dwEnvIndex;
2258 int nLength, compVal;
2260 // get the process environment strings
2261 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2263 // step over current directory stuff
2264 while(*lpTmp == '=')
2265 lpTmp += strlen(lpTmp) + 1;
2267 // save the start of the environment strings
2269 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2270 // calculate the size of the environment strings
2271 dwSize += strlen(lpTmp) + 1;
2274 // add the size of current directories
2275 dwSize += vDir.CalculateEnvironmentSpace();
2277 // add the additional space used by changes made to the environment
2278 dwSize += CalculateEnvironmentSpace();
2280 Newx(lpStr, dwSize, char);
2283 // build the local environment
2284 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2287 lpLocalEnv = GetIndex(dwEnvIndex);
2288 while(*lpEnvPtr != '\0') {
2290 // all environment overrides have been added
2291 // so copy string into place
2292 strcpy(lpStr, lpEnvPtr);
2293 nLength = strlen(lpEnvPtr) + 1;
2295 lpEnvPtr += nLength;
2298 // determine which string to copy next
2299 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2301 strcpy(lpStr, lpEnvPtr);
2302 nLength = strlen(lpEnvPtr) + 1;
2304 lpEnvPtr += nLength;
2307 char *ptr = strchr(lpLocalEnv, '=');
2309 strcpy(lpStr, lpLocalEnv);
2310 lpStr += strlen(lpLocalEnv) + 1;
2312 lpLocalEnv = GetIndex(dwEnvIndex);
2314 // this string was replaced
2315 lpEnvPtr += strlen(lpEnvPtr) + 1;
2322 // still have environment overrides to add
2323 // so copy the strings into place if not an override
2324 char *ptr = strchr(lpLocalEnv, '=');
2326 strcpy(lpStr, lpLocalEnv);
2327 lpStr += strlen(lpLocalEnv) + 1;
2329 lpLocalEnv = GetIndex(dwEnvIndex);
2336 // release the process environment strings
2337 FreeEnvironmentStrings(lpAllocPtr);
2343 CPerlHost::Reset(void)
2346 if(m_lppEnvList != NULL) {
2347 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2348 Free(m_lppEnvList[index]);
2349 m_lppEnvList[index] = NULL;
2354 m_lppEnvList = NULL;
2358 CPerlHost::Clearenv(void)
2362 LPSTR lpPtr, lpStr, lpEnvPtr;
2363 if (m_lppEnvList != NULL) {
2364 /* set every entry to an empty string */
2365 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2366 char* ptr = strchr(m_lppEnvList[index], '=');
2373 /* get the process environment strings */
2374 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2376 /* step over current directory stuff */
2377 while(*lpStr == '=')
2378 lpStr += strlen(lpStr) + 1;
2381 lpPtr = strchr(lpStr, '=');
2387 (void)win32_putenv(lpStr);
2390 lpStr += strlen(lpStr) + 1;
2393 FreeEnvironmentStrings(lpEnvPtr);
2398 CPerlHost::Getenv(const char *varname)
2402 char *pEnv = Find(varname);
2406 return win32_getenv(varname);
2410 CPerlHost::Putenv(const char *envstring)
2415 return win32_putenv(envstring);
2421 CPerlHost::Chdir(const char *dirname)
2429 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2436 #endif /* ___PerlHost_H___ */