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 #ifdef PERL_SYNC_FORK
1697 static long sync_fork_id = 0;
1698 long id = ++sync_fork_id;
1702 PERL_SET_THX(my_perl);
1703 win32_checkTLS(my_perl);
1705 /* set $$ to pseudo id */
1706 #ifdef PERL_SYNC_FORK
1709 w32_pseudo_id = GetCurrentThreadId();
1711 int pid = (int)w32_pseudo_id;
1713 w32_pseudo_id = -pid;
1716 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) {
1717 SV *sv = GvSV(tmpgv);
1719 sv_setiv(sv, -(IV)w32_pseudo_id);
1722 #ifdef PERL_USES_PL_PIDSTATUS
1723 hv_clear(PL_pidstatus);
1726 /* push a zero on the stack (we are the child) */
1734 /* continue from next op */
1735 PL_op = PL_op->op_next;
1739 volatile int oldscope = PL_scopestack_ix;
1742 JMPENV_PUSH(status);
1749 while (PL_scopestack_ix > oldscope)
1752 PL_curstash = PL_defstash;
1753 if (PL_endav && !PL_minus_c)
1754 call_list(oldscope, PL_endav);
1755 status = STATUS_EXIT;
1759 POPSTACK_TO(PL_mainstack);
1760 PL_op = PL_restartop;
1761 PL_restartop = Nullop;
1764 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1771 /* XXX hack to avoid perl_destruct() freeing optree */
1772 win32_checkTLS(my_perl);
1773 PL_main_root = Nullop;
1776 win32_checkTLS(my_perl);
1777 /* close the std handles to avoid fd leaks */
1779 do_close(PL_stdingv, FALSE);
1780 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE); /* PL_stdoutgv - ISAGN */
1781 do_close(PL_stderrgv, FALSE);
1784 /* destroy everything (waits for any pseudo-forked children) */
1785 win32_checkTLS(my_perl);
1786 perl_destruct(my_perl);
1787 win32_checkTLS(my_perl);
1790 #ifdef PERL_SYNC_FORK
1793 return (DWORD)status;
1796 #endif /* USE_ITHREADS */
1799 PerlProcFork(struct IPerlProc* piPerl)
1807 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1811 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1812 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 1,
1814 h->m_pHostperlMemShared,
1815 h->m_pHostperlMemParse,
1817 h->m_pHostperlStdIO,
1823 new_perl->Isys_intern.internal_host = h;
1824 h->host_perl = new_perl;
1825 # ifdef PERL_SYNC_FORK
1826 id = win32_start_child((LPVOID)new_perl);
1829 # ifdef USE_RTL_THREAD_API
1830 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1831 (void*)new_perl, 0, (unsigned*)&id);
1833 handle = CreateThread(NULL, 0, win32_start_child,
1834 (LPVOID)new_perl, 0, &id);
1836 PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
1846 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1847 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1848 ++w32_num_pseudo_children;
1852 Perl_croak(aTHX_ "fork() not implemented!\n");
1854 #endif /* USE_ITHREADS */
1858 PerlProcGetpid(struct IPerlProc* piPerl)
1860 return win32_getpid();
1864 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1866 return win32_dynaload(filename);
1870 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1872 win32_str_os_error(sv, dwErr);
1876 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1878 return win32_spawnvp(mode, cmdname, argv);
1882 PerlProcLastHost(struct IPerlProc* piPerl)
1885 CPerlHost *h = (CPerlHost*)w32_internal_host;
1886 return h->LastHost();
1889 struct IPerlProc perlProc =
1923 PerlProcGetTimeOfDay
1931 CPerlHost::CPerlHost(void)
1933 /* Construct a host from scratch */
1934 InterlockedIncrement(&num_hosts);
1935 m_pvDir = new VDir();
1936 m_pVMem = new VMem();
1937 m_pVMemShared = new VMem();
1938 m_pVMemParse = new VMem();
1940 m_pvDir->Init(NULL, m_pVMem);
1943 m_lppEnvList = NULL;
1946 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1947 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1948 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1949 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1950 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1951 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1952 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1953 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1954 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1956 m_pHostperlMem = &m_hostperlMem;
1957 m_pHostperlMemShared = &m_hostperlMemShared;
1958 m_pHostperlMemParse = &m_hostperlMemParse;
1959 m_pHostperlEnv = &m_hostperlEnv;
1960 m_pHostperlStdIO = &m_hostperlStdIO;
1961 m_pHostperlLIO = &m_hostperlLIO;
1962 m_pHostperlDir = &m_hostperlDir;
1963 m_pHostperlSock = &m_hostperlSock;
1964 m_pHostperlProc = &m_hostperlProc;
1967 #define SETUPEXCHANGE(xptr, iptr, table) \
1978 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1979 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1980 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1981 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1982 struct IPerlProc** ppProc)
1984 InterlockedIncrement(&num_hosts);
1985 m_pvDir = new VDir(0);
1986 m_pVMem = new VMem();
1987 m_pVMemShared = new VMem();
1988 m_pVMemParse = new VMem();
1990 m_pvDir->Init(NULL, m_pVMem);
1993 m_lppEnvList = NULL;
1994 m_bTopLevel = FALSE;
1996 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1997 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1998 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1999 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2000 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2001 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2002 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2003 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2004 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2006 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
2007 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
2008 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
2009 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
2010 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
2011 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
2012 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
2013 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
2014 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
2016 #undef SETUPEXCHANGE
2018 CPerlHost::CPerlHost(CPerlHost& host)
2020 /* Construct a host from another host */
2021 InterlockedIncrement(&num_hosts);
2022 m_pVMem = new VMem();
2023 m_pVMemShared = host.GetMemShared();
2024 m_pVMemParse = host.GetMemParse();
2026 /* duplicate directory info */
2027 m_pvDir = new VDir(0);
2028 m_pvDir->Init(host.GetDir(), m_pVMem);
2030 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2031 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2032 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2033 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2034 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2035 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2036 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2037 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2038 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2039 m_pHostperlMem = &m_hostperlMem;
2040 m_pHostperlMemShared = &m_hostperlMemShared;
2041 m_pHostperlMemParse = &m_hostperlMemParse;
2042 m_pHostperlEnv = &m_hostperlEnv;
2043 m_pHostperlStdIO = &m_hostperlStdIO;
2044 m_pHostperlLIO = &m_hostperlLIO;
2045 m_pHostperlDir = &m_hostperlDir;
2046 m_pHostperlSock = &m_hostperlSock;
2047 m_pHostperlProc = &m_hostperlProc;
2050 m_lppEnvList = NULL;
2051 m_bTopLevel = FALSE;
2053 /* duplicate environment info */
2056 while(lpPtr = host.GetIndex(dwIndex))
2060 CPerlHost::~CPerlHost(void)
2063 InterlockedDecrement(&num_hosts);
2065 m_pVMemParse->Release();
2066 m_pVMemShared->Release();
2071 CPerlHost::Find(LPCSTR lpStr)
2074 LPSTR* lppPtr = Lookup(lpStr);
2075 if(lppPtr != NULL) {
2076 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2088 lookup(const void *arg1, const void *arg2)
2089 { // Compare strings
2093 ptr1 = *(char**)arg1;
2094 ptr2 = *(char**)arg2;
2098 if(c1 == '\0' || c1 == '=') {
2099 if(c2 == '\0' || c2 == '=')
2102 return -1; // string 1 < string 2
2104 else if(c2 == '\0' || c2 == '=')
2105 return 1; // string 1 > string 2
2111 return -1; // string 1 < string 2
2113 return 1; // string 1 > string 2
2121 CPerlHost::Lookup(LPCSTR lpStr)
2125 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2129 compare(const void *arg1, const void *arg2)
2130 { // Compare strings
2134 ptr1 = *(char**)arg1;
2135 ptr2 = *(char**)arg2;
2139 if(c1 == '\0' || c1 == '=') {
2143 return -1; // string 1 < string 2
2145 else if(c2 == '\0' || c2 == '=')
2146 return 1; // string 1 > string 2
2152 return -1; // string 1 < string 2
2154 return 1; // string 1 > string 2
2162 CPerlHost::Add(LPCSTR lpStr)
2165 char szBuffer[1024];
2167 int index, length = strlen(lpStr)+1;
2169 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2170 szBuffer[index] = lpStr[index];
2172 szBuffer[index] = '\0';
2175 lpPtr = Lookup(szBuffer);
2176 if (lpPtr != NULL) {
2177 // must allocate things via host memory allocation functions
2178 // rather than perl's Renew() et al, as the perl interpreter
2179 // may either not be initialized enough when we allocate these,
2180 // or may already be dead when we go to free these
2181 *lpPtr = (char*)Realloc(*lpPtr, length * sizeof(char));
2182 strcpy(*lpPtr, lpStr);
2185 m_lppEnvList = (LPSTR*)Realloc(m_lppEnvList, (m_dwEnvCount+1) * sizeof(LPSTR));
2187 m_lppEnvList[m_dwEnvCount] = (char*)Malloc(length * sizeof(char));
2188 if (m_lppEnvList[m_dwEnvCount] != NULL) {
2189 strcpy(m_lppEnvList[m_dwEnvCount], lpStr);
2191 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2198 CPerlHost::CalculateEnvironmentSpace(void)
2202 for(index = 0; index < m_dwEnvCount; ++index)
2203 dwSize += strlen(m_lppEnvList[index]) + 1;
2209 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2216 CPerlHost::GetChildDir(void)
2221 Newx(ptr, MAX_PATH+1, char);
2223 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2224 length = strlen(ptr);
2226 if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2234 CPerlHost::FreeChildDir(char* pStr)
2241 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2244 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2245 DWORD dwSize, dwEnvIndex;
2246 int nLength, compVal;
2248 // get the process environment strings
2249 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2251 // step over current directory stuff
2252 while(*lpTmp == '=')
2253 lpTmp += strlen(lpTmp) + 1;
2255 // save the start of the environment strings
2257 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2258 // calculate the size of the environment strings
2259 dwSize += strlen(lpTmp) + 1;
2262 // add the size of current directories
2263 dwSize += vDir.CalculateEnvironmentSpace();
2265 // add the additional space used by changes made to the environment
2266 dwSize += CalculateEnvironmentSpace();
2268 Newx(lpStr, dwSize, char);
2271 // build the local environment
2272 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2275 lpLocalEnv = GetIndex(dwEnvIndex);
2276 while(*lpEnvPtr != '\0') {
2278 // all environment overrides have been added
2279 // so copy string into place
2280 strcpy(lpStr, lpEnvPtr);
2281 nLength = strlen(lpEnvPtr) + 1;
2283 lpEnvPtr += nLength;
2286 // determine which string to copy next
2287 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2289 strcpy(lpStr, lpEnvPtr);
2290 nLength = strlen(lpEnvPtr) + 1;
2292 lpEnvPtr += nLength;
2295 char *ptr = strchr(lpLocalEnv, '=');
2297 strcpy(lpStr, lpLocalEnv);
2298 lpStr += strlen(lpLocalEnv) + 1;
2300 lpLocalEnv = GetIndex(dwEnvIndex);
2302 // this string was replaced
2303 lpEnvPtr += strlen(lpEnvPtr) + 1;
2310 // still have environment overrides to add
2311 // so copy the strings into place if not an override
2312 char *ptr = strchr(lpLocalEnv, '=');
2314 strcpy(lpStr, lpLocalEnv);
2315 lpStr += strlen(lpLocalEnv) + 1;
2317 lpLocalEnv = GetIndex(dwEnvIndex);
2324 // release the process environment strings
2325 FreeEnvironmentStrings(lpAllocPtr);
2331 CPerlHost::Reset(void)
2334 if(m_lppEnvList != NULL) {
2335 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2336 Free(m_lppEnvList[index]);
2337 m_lppEnvList[index] = NULL;
2342 m_lppEnvList = NULL;
2346 CPerlHost::Clearenv(void)
2350 LPSTR lpPtr, lpStr, lpEnvPtr;
2351 if (m_lppEnvList != NULL) {
2352 /* set every entry to an empty string */
2353 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2354 char* ptr = strchr(m_lppEnvList[index], '=');
2361 /* get the process environment strings */
2362 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2364 /* step over current directory stuff */
2365 while(*lpStr == '=')
2366 lpStr += strlen(lpStr) + 1;
2369 lpPtr = strchr(lpStr, '=');
2375 (void)win32_putenv(lpStr);
2378 lpStr += strlen(lpStr) + 1;
2381 FreeEnvironmentStrings(lpEnvPtr);
2386 CPerlHost::Getenv(const char *varname)
2390 char *pEnv = Find(varname);
2394 return win32_getenv(varname);
2398 CPerlHost::Putenv(const char *envstring)
2403 return win32_putenv(envstring);
2409 CPerlHost::Chdir(const char *dirname)
2418 WCHAR wBuffer[MAX_PATH];
2419 A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2420 ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2423 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2430 #endif /* ___PerlHost_H___ */