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, 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, 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 #ifdef PERL_SYNC_FORK
1705 static long sync_fork_id = 0;
1706 long id = ++sync_fork_id;
1710 PERL_SET_THX(my_perl);
1711 win32_checkTLS(my_perl);
1713 /* set $$ to pseudo id */
1714 #ifdef PERL_SYNC_FORK
1717 w32_pseudo_id = GetCurrentThreadId();
1719 int pid = (int)w32_pseudo_id;
1721 w32_pseudo_id = -pid;
1724 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) {
1725 SV *sv = GvSV(tmpgv);
1727 sv_setiv(sv, -(IV)w32_pseudo_id);
1730 hv_clear(PL_pidstatus);
1732 /* push a zero on the stack (we are the child) */
1740 /* continue from next op */
1741 PL_op = PL_op->op_next;
1745 volatile int oldscope = PL_scopestack_ix;
1748 JMPENV_PUSH(status);
1755 while (PL_scopestack_ix > oldscope)
1758 PL_curstash = PL_defstash;
1759 if (PL_endav && !PL_minus_c)
1760 call_list(oldscope, PL_endav);
1761 status = STATUS_NATIVE_EXPORT;
1765 POPSTACK_TO(PL_mainstack);
1766 PL_op = PL_restartop;
1767 PL_restartop = Nullop;
1770 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1777 /* XXX hack to avoid perl_destruct() freeing optree */
1778 win32_checkTLS(my_perl);
1779 PL_main_root = Nullop;
1782 win32_checkTLS(my_perl);
1783 /* close the std handles to avoid fd leaks */
1785 do_close(PL_stdingv, FALSE);
1786 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE); /* PL_stdoutgv - ISAGN */
1787 do_close(PL_stderrgv, FALSE);
1790 /* destroy everything (waits for any pseudo-forked children) */
1791 win32_checkTLS(my_perl);
1792 perl_destruct(my_perl);
1793 win32_checkTLS(my_perl);
1796 #ifdef PERL_SYNC_FORK
1799 return (DWORD)status;
1802 #endif /* USE_ITHREADS */
1805 PerlProcFork(struct IPerlProc* piPerl)
1813 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1817 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1818 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 1,
1820 h->m_pHostperlMemShared,
1821 h->m_pHostperlMemParse,
1823 h->m_pHostperlStdIO,
1829 new_perl->Isys_intern.internal_host = h;
1830 h->host_perl = new_perl;
1831 # ifdef PERL_SYNC_FORK
1832 id = win32_start_child((LPVOID)new_perl);
1835 # ifdef USE_RTL_THREAD_API
1836 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1837 (void*)new_perl, 0, (unsigned*)&id);
1839 handle = CreateThread(NULL, 0, win32_start_child,
1840 (LPVOID)new_perl, 0, &id);
1842 PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
1852 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1853 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1854 ++w32_num_pseudo_children;
1858 Perl_croak(aTHX_ "fork() not implemented!\n");
1860 #endif /* USE_ITHREADS */
1864 PerlProcGetpid(struct IPerlProc* piPerl)
1866 return win32_getpid();
1870 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1872 return win32_dynaload(filename);
1876 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1878 win32_str_os_error(sv, dwErr);
1882 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1884 return win32_spawnvp(mode, cmdname, argv);
1888 PerlProcLastHost(struct IPerlProc* piPerl)
1891 CPerlHost *h = (CPerlHost*)w32_internal_host;
1892 return h->LastHost();
1895 struct IPerlProc perlProc =
1929 PerlProcGetTimeOfDay
1937 CPerlHost::CPerlHost(void)
1939 /* Construct a host from scratch */
1940 InterlockedIncrement(&num_hosts);
1941 m_pvDir = new VDir();
1942 m_pVMem = new VMem();
1943 m_pVMemShared = new VMem();
1944 m_pVMemParse = new VMem();
1946 m_pvDir->Init(NULL, m_pVMem);
1949 m_lppEnvList = NULL;
1952 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1953 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1954 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1955 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1956 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1957 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1958 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1959 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1960 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1962 m_pHostperlMem = &m_hostperlMem;
1963 m_pHostperlMemShared = &m_hostperlMemShared;
1964 m_pHostperlMemParse = &m_hostperlMemParse;
1965 m_pHostperlEnv = &m_hostperlEnv;
1966 m_pHostperlStdIO = &m_hostperlStdIO;
1967 m_pHostperlLIO = &m_hostperlLIO;
1968 m_pHostperlDir = &m_hostperlDir;
1969 m_pHostperlSock = &m_hostperlSock;
1970 m_pHostperlProc = &m_hostperlProc;
1973 #define SETUPEXCHANGE(xptr, iptr, table) \
1984 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1985 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1986 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1987 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1988 struct IPerlProc** ppProc)
1990 InterlockedIncrement(&num_hosts);
1991 m_pvDir = new VDir(0);
1992 m_pVMem = new VMem();
1993 m_pVMemShared = new VMem();
1994 m_pVMemParse = new VMem();
1996 m_pvDir->Init(NULL, m_pVMem);
1999 m_lppEnvList = NULL;
2000 m_bTopLevel = FALSE;
2002 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2003 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2004 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2005 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2006 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2007 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2008 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2009 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2010 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2012 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
2013 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
2014 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
2015 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
2016 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
2017 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
2018 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
2019 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
2020 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
2022 #undef SETUPEXCHANGE
2024 CPerlHost::CPerlHost(CPerlHost& host)
2026 /* Construct a host from another host */
2027 InterlockedIncrement(&num_hosts);
2028 m_pVMem = new VMem();
2029 m_pVMemShared = host.GetMemShared();
2030 m_pVMemParse = host.GetMemParse();
2032 /* duplicate directory info */
2033 m_pvDir = new VDir(0);
2034 m_pvDir->Init(host.GetDir(), m_pVMem);
2036 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2037 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2038 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2039 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2040 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2041 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2042 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2043 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2044 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2045 m_pHostperlMem = &m_hostperlMem;
2046 m_pHostperlMemShared = &m_hostperlMemShared;
2047 m_pHostperlMemParse = &m_hostperlMemParse;
2048 m_pHostperlEnv = &m_hostperlEnv;
2049 m_pHostperlStdIO = &m_hostperlStdIO;
2050 m_pHostperlLIO = &m_hostperlLIO;
2051 m_pHostperlDir = &m_hostperlDir;
2052 m_pHostperlSock = &m_hostperlSock;
2053 m_pHostperlProc = &m_hostperlProc;
2056 m_lppEnvList = NULL;
2057 m_bTopLevel = FALSE;
2059 /* duplicate environment info */
2062 while(lpPtr = host.GetIndex(dwIndex))
2066 CPerlHost::~CPerlHost(void)
2069 InterlockedDecrement(&num_hosts);
2071 m_pVMemParse->Release();
2072 m_pVMemShared->Release();
2077 CPerlHost::Find(LPCSTR lpStr)
2080 LPSTR* lppPtr = Lookup(lpStr);
2081 if(lppPtr != NULL) {
2082 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2094 lookup(const void *arg1, const void *arg2)
2095 { // Compare strings
2099 ptr1 = *(char**)arg1;
2100 ptr2 = *(char**)arg2;
2104 if(c1 == '\0' || c1 == '=') {
2105 if(c2 == '\0' || c2 == '=')
2108 return -1; // string 1 < string 2
2110 else if(c2 == '\0' || c2 == '=')
2111 return 1; // string 1 > string 2
2117 return -1; // string 1 < string 2
2119 return 1; // string 1 > string 2
2127 CPerlHost::Lookup(LPCSTR lpStr)
2130 if (!m_lppEnvList || !m_dwEnvCount)
2135 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2139 compare(const void *arg1, const void *arg2)
2140 { // Compare strings
2144 ptr1 = *(char**)arg1;
2145 ptr2 = *(char**)arg2;
2149 if(c1 == '\0' || c1 == '=') {
2153 return -1; // string 1 < string 2
2155 else if(c2 == '\0' || c2 == '=')
2156 return 1; // string 1 > string 2
2162 return -1; // string 1 < string 2
2164 return 1; // string 1 > string 2
2172 CPerlHost::Add(LPCSTR lpStr)
2175 char szBuffer[1024];
2177 int index, length = strlen(lpStr)+1;
2179 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2180 szBuffer[index] = lpStr[index];
2182 szBuffer[index] = '\0';
2185 lpPtr = Lookup(szBuffer);
2186 if (lpPtr != NULL) {
2187 // must allocate things via host memory allocation functions
2188 // rather than perl's Renew() et al, as the perl interpreter
2189 // may either not be initialized enough when we allocate these,
2190 // or may already be dead when we go to free these
2191 *lpPtr = (char*)Realloc(*lpPtr, length * sizeof(char));
2192 strcpy(*lpPtr, lpStr);
2195 m_lppEnvList = (LPSTR*)Realloc(m_lppEnvList, (m_dwEnvCount+1) * sizeof(LPSTR));
2197 m_lppEnvList[m_dwEnvCount] = (char*)Malloc(length * sizeof(char));
2198 if (m_lppEnvList[m_dwEnvCount] != NULL) {
2199 strcpy(m_lppEnvList[m_dwEnvCount], lpStr);
2201 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2208 CPerlHost::CalculateEnvironmentSpace(void)
2212 for(index = 0; index < m_dwEnvCount; ++index)
2213 dwSize += strlen(m_lppEnvList[index]) + 1;
2219 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2226 CPerlHost::GetChildDir(void)
2231 New(0, ptr, MAX_PATH+1, char);
2233 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2234 length = strlen(ptr);
2236 if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2244 CPerlHost::FreeChildDir(char* pStr)
2251 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2254 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2255 DWORD dwSize, dwEnvIndex;
2256 int nLength, compVal;
2258 // get the process environment strings
2259 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2261 // step over current directory stuff
2262 while(*lpTmp == '=')
2263 lpTmp += strlen(lpTmp) + 1;
2265 // save the start of the environment strings
2267 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2268 // calculate the size of the environment strings
2269 dwSize += strlen(lpTmp) + 1;
2272 // add the size of current directories
2273 dwSize += vDir.CalculateEnvironmentSpace();
2275 // add the additional space used by changes made to the environment
2276 dwSize += CalculateEnvironmentSpace();
2278 New(1, lpStr, dwSize, char);
2281 // build the local environment
2282 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2285 lpLocalEnv = GetIndex(dwEnvIndex);
2286 while(*lpEnvPtr != '\0') {
2288 // all environment overrides have been added
2289 // so copy string into place
2290 strcpy(lpStr, lpEnvPtr);
2291 nLength = strlen(lpEnvPtr) + 1;
2293 lpEnvPtr += nLength;
2296 // determine which string to copy next
2297 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2299 strcpy(lpStr, lpEnvPtr);
2300 nLength = strlen(lpEnvPtr) + 1;
2302 lpEnvPtr += nLength;
2305 char *ptr = strchr(lpLocalEnv, '=');
2307 strcpy(lpStr, lpLocalEnv);
2308 lpStr += strlen(lpLocalEnv) + 1;
2310 lpLocalEnv = GetIndex(dwEnvIndex);
2312 // this string was replaced
2313 lpEnvPtr += strlen(lpEnvPtr) + 1;
2320 // still have environment overrides to add
2321 // so copy the strings into place if not an override
2322 char *ptr = strchr(lpLocalEnv, '=');
2324 strcpy(lpStr, lpLocalEnv);
2325 lpStr += strlen(lpLocalEnv) + 1;
2327 lpLocalEnv = GetIndex(dwEnvIndex);
2334 // release the process environment strings
2335 FreeEnvironmentStrings(lpAllocPtr);
2341 CPerlHost::Reset(void)
2344 if(m_lppEnvList != NULL) {
2345 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2346 Free(m_lppEnvList[index]);
2347 m_lppEnvList[index] = NULL;
2352 m_lppEnvList = NULL;
2356 CPerlHost::Clearenv(void)
2360 LPSTR lpPtr, lpStr, lpEnvPtr;
2361 if (m_lppEnvList != NULL) {
2362 /* set every entry to an empty string */
2363 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2364 char* ptr = strchr(m_lppEnvList[index], '=');
2371 /* get the process environment strings */
2372 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2374 /* step over current directory stuff */
2375 while(*lpStr == '=')
2376 lpStr += strlen(lpStr) + 1;
2379 lpPtr = strchr(lpStr, '=');
2385 (void)win32_putenv(lpStr);
2388 lpStr += strlen(lpStr) + 1;
2391 FreeEnvironmentStrings(lpEnvPtr);
2396 CPerlHost::Getenv(const char *varname)
2400 char *pEnv = Find(varname);
2404 return win32_getenv(varname);
2408 CPerlHost::Putenv(const char *envstring)
2413 return win32_putenv(envstring);
2419 CPerlHost::Chdir(const char *dirname)
2428 WCHAR wBuffer[MAX_PATH];
2429 A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2430 ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2433 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2440 #endif /* ___PerlHost_H___ */