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);
25 extern int do_spawn2(char *cmd, int exectype);
33 CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
34 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
35 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
36 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
37 struct IPerlProc** ppProc);
38 CPerlHost(CPerlHost& host);
41 static CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl);
42 static CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl);
43 static CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl);
44 static CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl);
45 static CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl);
46 static CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl);
47 static CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl);
48 static CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl);
49 static CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl);
51 BOOL PerlCreate(void);
52 int PerlParse(int argc, char** argv, char** env);
54 void PerlDestroy(void);
57 /* Locks provided but should be unnecessary as this is private pool */
58 inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
59 inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
60 inline void Free(void* ptr) { m_pVMem->Free(ptr); };
61 inline void* Calloc(size_t num, size_t size)
63 size_t count = num*size;
64 void* lpVoid = Malloc(count);
66 ZeroMemory(lpVoid, count);
69 inline void GetLock(void) { m_pVMem->GetLock(); };
70 inline void FreeLock(void) { m_pVMem->FreeLock(); };
71 inline int IsLocked(void) { return m_pVMem->IsLocked(); };
74 /* Locks used to serialize access to the pool */
75 inline void GetLockShared(void) { m_pVMemShared->GetLock(); };
76 inline void FreeLockShared(void) { m_pVMemShared->FreeLock(); };
77 inline int IsLockedShared(void) { return m_pVMemShared->IsLocked(); };
78 inline void* MallocShared(size_t size)
82 result = m_pVMemShared->Malloc(size);
86 inline void* ReallocShared(void* ptr, size_t size)
90 result = m_pVMemShared->Realloc(ptr, size);
94 inline void FreeShared(void* ptr)
97 m_pVMemShared->Free(ptr);
100 inline void* CallocShared(size_t num, size_t size)
102 size_t count = num*size;
103 void* lpVoid = MallocShared(count);
105 ZeroMemory(lpVoid, count);
110 /* Assume something else is using locks to mangaging serialize
113 inline void GetLockParse(void) { m_pVMemParse->GetLock(); };
114 inline void FreeLockParse(void) { m_pVMemParse->FreeLock(); };
115 inline int IsLockedParse(void) { return m_pVMemParse->IsLocked(); };
116 inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
117 inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
118 inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
119 inline void* CallocParse(size_t num, size_t size)
121 size_t count = num*size;
122 void* lpVoid = MallocParse(count);
124 ZeroMemory(lpVoid, count);
129 char *Getenv(const char *varname);
130 int Putenv(const char *envstring);
131 inline char *Getenv(const char *varname, unsigned long *len)
134 char *e = Getenv(varname);
139 void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
140 void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
141 char* GetChildDir(void);
142 void FreeChildDir(char* pStr);
146 inline LPSTR GetIndex(DWORD &dwIndex)
148 if(dwIndex < m_dwEnvCount)
151 return m_lppEnvList[dwIndex-1];
157 LPSTR Find(LPCSTR lpStr);
158 void Add(LPCSTR lpStr);
160 LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
161 void FreeLocalEnvironmentStrings(LPSTR lpStr);
162 LPSTR* Lookup(LPCSTR lpStr);
163 DWORD CalculateEnvironmentSpace(void);
168 virtual int Chdir(const char *dirname);
172 void Exit(int status);
173 void _Exit(int status);
174 int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
175 int Execv(const char *cmdname, const char *const *argv);
176 int Execvp(const char *cmdname, const char *const *argv);
178 inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
179 inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
180 inline VDir* GetDir(void) { return m_pvDir; };
184 struct IPerlMem m_hostperlMem;
185 struct IPerlMem m_hostperlMemShared;
186 struct IPerlMem m_hostperlMemParse;
187 struct IPerlEnv m_hostperlEnv;
188 struct IPerlStdIO m_hostperlStdIO;
189 struct IPerlLIO m_hostperlLIO;
190 struct IPerlDir m_hostperlDir;
191 struct IPerlSock m_hostperlSock;
192 struct IPerlProc m_hostperlProc;
194 struct IPerlMem* m_pHostperlMem;
195 struct IPerlMem* m_pHostperlMemShared;
196 struct IPerlMem* m_pHostperlMemParse;
197 struct IPerlEnv* m_pHostperlEnv;
198 struct IPerlStdIO* m_pHostperlStdIO;
199 struct IPerlLIO* m_pHostperlLIO;
200 struct IPerlDir* m_pHostperlDir;
201 struct IPerlSock* m_pHostperlSock;
202 struct IPerlProc* m_pHostperlProc;
204 inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
205 inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
215 BOOL m_bTopLevel; // is this a toplevel host?
216 static long num_hosts;
218 inline int LastHost(void) { return num_hosts == 1L; };
219 #ifdef CHECK_HOST_INTERP
220 struct interpreter *host_perl;
224 long CPerlHost::num_hosts = 0L;
226 extern "C" void win32_checkTLS(struct interpreter *host_perl);
228 #define STRUCT2RAWPTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
229 #ifdef CHECK_HOST_INTERP
230 inline CPerlHost* CheckInterp(CPerlHost *host)
232 win32_checkTLS(host->host_perl);
235 #define STRUCT2PTR(x, y) CheckInterp(STRUCT2RAWPTR(x, y))
237 #define STRUCT2PTR(x, y) STRUCT2RAWPTR(x, y)
240 inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
242 return STRUCT2RAWPTR(piPerl, m_hostperlMem);
245 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
247 return STRUCT2PTR(piPerl, m_hostperlMemShared);
250 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
252 return STRUCT2PTR(piPerl, m_hostperlMemParse);
255 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
257 return STRUCT2PTR(piPerl, m_hostperlEnv);
260 inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
262 return STRUCT2PTR(piPerl, m_hostperlStdIO);
265 inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
267 return STRUCT2PTR(piPerl, m_hostperlLIO);
270 inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
272 return STRUCT2PTR(piPerl, m_hostperlDir);
275 inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
277 return STRUCT2PTR(piPerl, m_hostperlSock);
280 inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
282 return STRUCT2PTR(piPerl, m_hostperlProc);
288 #define IPERL2HOST(x) IPerlMem2Host(x)
292 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
294 return IPERL2HOST(piPerl)->Malloc(size);
297 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
299 return IPERL2HOST(piPerl)->Realloc(ptr, size);
302 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
304 IPERL2HOST(piPerl)->Free(ptr);
307 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
309 return IPERL2HOST(piPerl)->Calloc(num, size);
313 PerlMemGetLock(struct IPerlMem* piPerl)
315 IPERL2HOST(piPerl)->GetLock();
319 PerlMemFreeLock(struct IPerlMem* piPerl)
321 IPERL2HOST(piPerl)->FreeLock();
325 PerlMemIsLocked(struct IPerlMem* piPerl)
327 return IPERL2HOST(piPerl)->IsLocked();
330 struct IPerlMem perlMem =
342 #define IPERL2HOST(x) IPerlMemShared2Host(x)
346 PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
348 return IPERL2HOST(piPerl)->MallocShared(size);
351 PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
353 return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
356 PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
358 IPERL2HOST(piPerl)->FreeShared(ptr);
361 PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
363 return IPERL2HOST(piPerl)->CallocShared(num, size);
367 PerlMemSharedGetLock(struct IPerlMem* piPerl)
369 IPERL2HOST(piPerl)->GetLockShared();
373 PerlMemSharedFreeLock(struct IPerlMem* piPerl)
375 IPERL2HOST(piPerl)->FreeLockShared();
379 PerlMemSharedIsLocked(struct IPerlMem* piPerl)
381 return IPERL2HOST(piPerl)->IsLockedShared();
384 struct IPerlMem perlMemShared =
387 PerlMemSharedRealloc,
390 PerlMemSharedGetLock,
391 PerlMemSharedFreeLock,
392 PerlMemSharedIsLocked,
396 #define IPERL2HOST(x) IPerlMemParse2Host(x)
400 PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
402 return IPERL2HOST(piPerl)->MallocParse(size);
405 PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
407 return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
410 PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
412 IPERL2HOST(piPerl)->FreeParse(ptr);
415 PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
417 return IPERL2HOST(piPerl)->CallocParse(num, size);
421 PerlMemParseGetLock(struct IPerlMem* piPerl)
423 IPERL2HOST(piPerl)->GetLockParse();
427 PerlMemParseFreeLock(struct IPerlMem* piPerl)
429 IPERL2HOST(piPerl)->FreeLockParse();
433 PerlMemParseIsLocked(struct IPerlMem* piPerl)
435 return IPERL2HOST(piPerl)->IsLockedParse();
438 struct IPerlMem perlMemParse =
445 PerlMemParseFreeLock,
446 PerlMemParseIsLocked,
451 #define IPERL2HOST(x) IPerlEnv2Host(x)
455 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
457 return IPERL2HOST(piPerl)->Getenv(varname);
461 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
463 return IPERL2HOST(piPerl)->Putenv(envstring);
467 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
469 return IPERL2HOST(piPerl)->Getenv(varname, len);
473 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
475 return win32_uname(name);
479 PerlEnvClearenv(struct IPerlEnv* piPerl)
481 IPERL2HOST(piPerl)->Clearenv();
485 PerlEnvGetChildenv(struct IPerlEnv* piPerl)
487 return IPERL2HOST(piPerl)->CreateChildEnv();
491 PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
493 IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
497 PerlEnvGetChilddir(struct IPerlEnv* piPerl)
499 return IPERL2HOST(piPerl)->GetChildDir();
503 PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
505 IPERL2HOST(piPerl)->FreeChildDir(childDir);
509 PerlEnvOsId(struct IPerlEnv* piPerl)
511 return win32_os_id();
515 PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
517 return g_win32_get_privlib(pl);
521 PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
523 return g_win32_get_sitelib(pl);
527 PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
529 return g_win32_get_vendorlib(pl);
533 PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
535 win32_get_child_IO(ptr);
538 struct IPerlEnv perlEnv =
552 PerlEnvVendorLibPath,
557 #define IPERL2HOST(x) IPerlStdIO2Host(x)
561 PerlStdIOStdin(struct IPerlStdIO* piPerl)
563 return win32_stdin();
567 PerlStdIOStdout(struct IPerlStdIO* piPerl)
569 return win32_stdout();
573 PerlStdIOStderr(struct IPerlStdIO* piPerl)
575 return win32_stderr();
579 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
581 return win32_fopen(path, mode);
585 PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf)
587 return win32_fclose((pf));
591 PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf)
593 return win32_feof(pf);
597 PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf)
599 return win32_ferror(pf);
603 PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf)
609 PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf)
611 return win32_getc(pf);
615 PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf)
626 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf)
630 return FILE_bufsiz(f);
637 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf)
648 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
659 PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n)
661 return win32_fgets(s, n, pf);
665 PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c)
667 return win32_fputc(c, pf);
671 PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s)
673 return win32_fputs(s, pf);
677 PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf)
679 return win32_fflush(pf);
683 PerlStdIOUngetc(struct IPerlStdIO* piPerl,int c, FILE* pf)
685 return win32_ungetc(c, pf);
689 PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf)
691 return win32_fileno(pf);
695 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
697 return win32_fdopen(fd, mode);
701 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf)
703 return win32_freopen(path, mode, (FILE*)pf);
707 PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf)
709 return win32_fread(buffer, size, count, pf);
713 PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf)
715 return win32_fwrite(buffer, size, count, pf);
719 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer)
721 win32_setbuf(pf, buffer);
725 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size)
727 return win32_setvbuf(pf, buffer, type, size);
731 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n)
733 #ifdef STDIO_CNT_LVALUE
740 PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr)
742 #ifdef STDIO_PTR_LVALUE
749 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf)
751 win32_setvbuf(pf, NULL, _IOLBF, 0);
755 PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...)
758 va_start(arglist, format);
759 return win32_vfprintf(pf, format, arglist);
763 PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist)
765 return win32_vfprintf(pf, format, arglist);
769 PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf)
771 return win32_ftell(pf);
775 PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, off_t offset, int origin)
777 return win32_fseek(pf, offset, origin);
781 PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf)
787 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
789 return win32_tmpfile();
793 PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p)
795 return win32_fgetpos(pf, p);
799 PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p)
801 return win32_fsetpos(pf, p);
804 PerlStdIOInit(struct IPerlStdIO* piPerl)
809 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
811 Perl_init_os_extras();
815 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags)
817 return win32_open_osfhandle(osfhandle, flags);
821 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
823 return win32_get_osfhandle(filenum);
827 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
832 int fileno = win32_dup(win32_fileno(pf));
834 /* open the file in the same mode */
836 if((pf)->flags & _F_READ) {
840 else if((pf)->flags & _F_WRIT) {
844 else if((pf)->flags & _F_RDWR) {
850 if((pf)->_flag & _IOREAD) {
854 else if((pf)->_flag & _IOWRT) {
858 else if((pf)->_flag & _IORW) {
865 /* it appears that the binmode is attached to the
866 * file descriptor so binmode files will be handled
869 pfdup = win32_fdopen(fileno, mode);
871 /* move the file pointer to the same position */
872 if (!fgetpos(pf, &pos)) {
873 fsetpos(pfdup, &pos);
878 struct IPerlStdIO perlStdIO =
917 PerlStdIOInitOSExtras,
923 #define IPERL2HOST(x) IPerlLIO2Host(x)
927 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
929 return win32_access(path, mode);
933 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
935 return win32_chmod(filename, pmode);
939 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
941 return chown(filename, owner, group);
945 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
947 return chsize(handle, size);
951 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
953 return win32_close(handle);
957 PerlLIODup(struct IPerlLIO* piPerl, int handle)
959 return win32_dup(handle);
963 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
965 return win32_dup2(handle1, handle2);
969 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
971 return win32_flock(fd, oper);
975 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
977 return win32_fstat(handle, buffer);
981 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
983 return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
987 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
993 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
995 return win32_link(oldname, newname);
999 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
1001 return win32_lseek(handle, offset, origin);
1005 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
1007 return win32_stat(path, buffer);
1011 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
1013 return mktemp(Template);
1017 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
1019 return win32_open(filename, oflag);
1023 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
1025 return win32_open(filename, oflag, pmode);
1029 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
1031 return win32_read(handle, buffer, count);
1035 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
1037 return win32_rename(OldFileName, newname);
1041 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1043 return win32_setmode(handle, mode);
1047 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
1049 return win32_stat(path, buffer);
1053 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1055 return tmpnam(string);
1059 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1061 return umask(pmode);
1065 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1067 return win32_unlink(filename);
1071 PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
1073 return win32_utime(filename, times);
1077 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1079 return win32_write(handle, buffer, count);
1082 struct IPerlLIO perlLIO =
1114 #define IPERL2HOST(x) IPerlDir2Host(x)
1118 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1120 return win32_mkdir(dirname, mode);
1124 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1126 return IPERL2HOST(piPerl)->Chdir(dirname);
1130 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1132 return win32_rmdir(dirname);
1136 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1138 return win32_closedir(dirp);
1142 PerlDirOpen(struct IPerlDir* piPerl, char *filename)
1144 return win32_opendir(filename);
1148 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1150 return win32_readdir(dirp);
1154 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1156 win32_rewinddir(dirp);
1160 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1162 win32_seekdir(dirp, loc);
1166 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1168 return win32_telldir(dirp);
1172 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1174 return IPERL2HOST(piPerl)->MapPathA(path);
1178 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1180 return IPERL2HOST(piPerl)->MapPathW(path);
1183 struct IPerlDir perlDir =
1201 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1203 return win32_htonl(hostlong);
1207 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1209 return win32_htons(hostshort);
1213 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1215 return win32_ntohl(netlong);
1219 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1221 return win32_ntohs(netshort);
1224 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1226 return win32_accept(s, addr, addrlen);
1230 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1232 return win32_bind(s, name, namelen);
1236 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1238 return win32_connect(s, name, namelen);
1242 PerlSockEndhostent(struct IPerlSock* piPerl)
1248 PerlSockEndnetent(struct IPerlSock* piPerl)
1254 PerlSockEndprotoent(struct IPerlSock* piPerl)
1256 win32_endprotoent();
1260 PerlSockEndservent(struct IPerlSock* piPerl)
1266 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1268 return win32_gethostbyaddr(addr, len, type);
1272 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1274 return win32_gethostbyname(name);
1278 PerlSockGethostent(struct IPerlSock* piPerl)
1281 Perl_croak(aTHX_ "gethostent not implemented!\n");
1286 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1288 return win32_gethostname(name, namelen);
1292 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1294 return win32_getnetbyaddr(net, type);
1298 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1300 return win32_getnetbyname((char*)name);
1304 PerlSockGetnetent(struct IPerlSock* piPerl)
1306 return win32_getnetent();
1309 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1311 return win32_getpeername(s, name, namelen);
1315 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1317 return win32_getprotobyname(name);
1321 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1323 return win32_getprotobynumber(number);
1327 PerlSockGetprotoent(struct IPerlSock* piPerl)
1329 return win32_getprotoent();
1333 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1335 return win32_getservbyname(name, proto);
1339 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1341 return win32_getservbyport(port, proto);
1345 PerlSockGetservent(struct IPerlSock* piPerl)
1347 return win32_getservent();
1351 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1353 return win32_getsockname(s, name, namelen);
1357 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1359 return win32_getsockopt(s, level, optname, optval, optlen);
1363 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1365 return win32_inet_addr(cp);
1369 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1371 return win32_inet_ntoa(in);
1375 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1377 return win32_listen(s, backlog);
1381 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1383 return win32_recv(s, buffer, len, flags);
1387 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1389 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1393 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1395 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1399 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1401 return win32_send(s, buffer, len, flags);
1405 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1407 return win32_sendto(s, buffer, len, flags, to, tolen);
1411 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1413 win32_sethostent(stayopen);
1417 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1419 win32_setnetent(stayopen);
1423 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1425 win32_setprotoent(stayopen);
1429 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1431 win32_setservent(stayopen);
1435 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1437 return win32_setsockopt(s, level, optname, optval, optlen);
1441 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1443 return win32_shutdown(s, how);
1447 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1449 return win32_socket(af, type, protocol);
1453 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1455 return Perl_my_socketpair(domain, type, protocol, fds);
1459 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1461 return win32_closesocket(s);
1465 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1467 return win32_ioctlsocket(s, cmd, argp);
1470 struct IPerlSock perlSock =
1481 PerlSockEndprotoent,
1483 PerlSockGethostname,
1484 PerlSockGetpeername,
1485 PerlSockGethostbyaddr,
1486 PerlSockGethostbyname,
1488 PerlSockGetnetbyaddr,
1489 PerlSockGetnetbyname,
1491 PerlSockGetprotobyname,
1492 PerlSockGetprotobynumber,
1493 PerlSockGetprotoent,
1494 PerlSockGetservbyname,
1495 PerlSockGetservbyport,
1497 PerlSockGetsockname,
1509 PerlSockSetprotoent,
1515 PerlSockClosesocket,
1521 #define EXECF_EXEC 1
1522 #define EXECF_SPAWN 2
1525 PerlProcAbort(struct IPerlProc* piPerl)
1531 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1533 return win32_crypt(clear, salt);
1537 PerlProcExit(struct IPerlProc* piPerl, int status)
1543 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1549 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1551 return execl(cmdname, arg0, arg1, arg2, arg3);
1555 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1557 return win32_execvp(cmdname, argv);
1561 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1563 return win32_execvp(cmdname, argv);
1567 PerlProcGetuid(struct IPerlProc* piPerl)
1573 PerlProcGeteuid(struct IPerlProc* piPerl)
1579 PerlProcGetgid(struct IPerlProc* piPerl)
1585 PerlProcGetegid(struct IPerlProc* piPerl)
1591 PerlProcGetlogin(struct IPerlProc* piPerl)
1593 return g_getlogin();
1597 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1599 return win32_kill(pid, sig);
1603 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1606 Perl_croak(aTHX_ "killpg not implemented!\n");
1611 PerlProcPauseProc(struct IPerlProc* piPerl)
1613 return win32_sleep((32767L << 16) + 32767);
1617 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1620 PERL_FLUSHALL_FOR_CHILD;
1621 return win32_popen(command, mode);
1625 PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
1628 PERL_FLUSHALL_FOR_CHILD;
1629 return win32_popenlist(mode, narg, args);
1633 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1635 return win32_pclose(stream);
1639 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1641 return win32_pipe(phandles, 512, O_BINARY);
1645 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1651 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1657 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1659 return win32_sleep(s);
1663 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1665 return win32_times(timebuf);
1669 PerlProcWait(struct IPerlProc* piPerl, int *status)
1671 return win32_wait(status);
1675 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1677 return win32_waitpid(pid, status, flags);
1681 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1683 return signal(sig, subcode);
1687 static THREAD_RET_TYPE
1688 win32_start_child(LPVOID arg)
1690 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1693 #ifdef PERL_SYNC_FORK
1694 static long sync_fork_id = 0;
1695 long id = ++sync_fork_id;
1699 PERL_SET_THX(my_perl);
1700 win32_checkTLS(my_perl);
1702 /* set $$ to pseudo id */
1703 #ifdef PERL_SYNC_FORK
1706 w32_pseudo_id = GetCurrentThreadId();
1708 int pid = (int)w32_pseudo_id;
1710 w32_pseudo_id = -pid;
1713 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) {
1714 SV *sv = GvSV(tmpgv);
1716 sv_setiv(sv, -(IV)w32_pseudo_id);
1719 hv_clear(PL_pidstatus);
1721 /* push a zero on the stack (we are the child) */
1729 /* continue from next op */
1730 PL_op = PL_op->op_next;
1734 volatile int oldscope = PL_scopestack_ix;
1737 JMPENV_PUSH(status);
1744 while (PL_scopestack_ix > oldscope)
1747 PL_curstash = PL_defstash;
1748 if (PL_endav && !PL_minus_c)
1749 call_list(oldscope, PL_endav);
1750 status = STATUS_NATIVE_EXPORT;
1754 POPSTACK_TO(PL_mainstack);
1755 PL_op = PL_restartop;
1756 PL_restartop = Nullop;
1759 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1766 /* XXX hack to avoid perl_destruct() freeing optree */
1767 win32_checkTLS(my_perl);
1768 PL_main_root = Nullop;
1771 win32_checkTLS(my_perl);
1772 /* close the std handles to avoid fd leaks */
1774 do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
1775 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE);
1776 do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE);
1779 /* destroy everything (waits for any pseudo-forked children) */
1780 win32_checkTLS(my_perl);
1781 perl_destruct(my_perl);
1782 win32_checkTLS(my_perl);
1785 #ifdef PERL_SYNC_FORK
1788 return (DWORD)status;
1791 #endif /* USE_ITHREADS */
1794 PerlProcFork(struct IPerlProc* piPerl)
1802 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1806 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1807 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 1,
1809 h->m_pHostperlMemShared,
1810 h->m_pHostperlMemParse,
1812 h->m_pHostperlStdIO,
1818 new_perl->Isys_intern.internal_host = h;
1819 h->host_perl = new_perl;
1820 # ifdef PERL_SYNC_FORK
1821 id = win32_start_child((LPVOID)new_perl);
1824 # ifdef USE_RTL_THREAD_API
1825 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1826 (void*)new_perl, 0, (unsigned*)&id);
1828 handle = CreateThread(NULL, 0, win32_start_child,
1829 (LPVOID)new_perl, 0, &id);
1831 PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
1841 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1842 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1843 ++w32_num_pseudo_children;
1847 Perl_croak(aTHX_ "fork() not implemented!\n");
1849 #endif /* USE_ITHREADS */
1853 PerlProcGetpid(struct IPerlProc* piPerl)
1855 return win32_getpid();
1859 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1861 return win32_dynaload(filename);
1865 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1867 win32_str_os_error(sv, dwErr);
1871 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1873 do_spawn2(cmd, EXECF_EXEC);
1878 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1880 return do_spawn2(cmds, EXECF_SPAWN);
1884 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1886 return win32_spawnvp(mode, cmdname, argv);
1890 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1892 return do_aspawn(vreally, vmark, vsp);
1896 PerlProcLastHost(struct IPerlProc* piPerl)
1899 CPerlHost *h = (CPerlHost*)w32_internal_host;
1900 return h->LastHost();
1903 struct IPerlProc perlProc =
1947 CPerlHost::CPerlHost(void)
1949 /* Construct a host from scratch */
1950 InterlockedIncrement(&num_hosts);
1951 m_pvDir = new VDir();
1952 m_pVMem = new VMem();
1953 m_pVMemShared = new VMem();
1954 m_pVMemParse = new VMem();
1956 m_pvDir->Init(NULL, m_pVMem);
1959 m_lppEnvList = NULL;
1962 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1963 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1964 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1965 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1966 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1967 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1968 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1969 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1970 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1972 m_pHostperlMem = &m_hostperlMem;
1973 m_pHostperlMemShared = &m_hostperlMemShared;
1974 m_pHostperlMemParse = &m_hostperlMemParse;
1975 m_pHostperlEnv = &m_hostperlEnv;
1976 m_pHostperlStdIO = &m_hostperlStdIO;
1977 m_pHostperlLIO = &m_hostperlLIO;
1978 m_pHostperlDir = &m_hostperlDir;
1979 m_pHostperlSock = &m_hostperlSock;
1980 m_pHostperlProc = &m_hostperlProc;
1983 #define SETUPEXCHANGE(xptr, iptr, table) \
1994 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1995 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1996 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1997 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1998 struct IPerlProc** ppProc)
2000 InterlockedIncrement(&num_hosts);
2001 m_pvDir = new VDir(0);
2002 m_pVMem = new VMem();
2003 m_pVMemShared = new VMem();
2004 m_pVMemParse = new VMem();
2006 m_pvDir->Init(NULL, m_pVMem);
2009 m_lppEnvList = NULL;
2010 m_bTopLevel = FALSE;
2012 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2013 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2014 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2015 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2016 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2017 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2018 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2019 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2020 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2022 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
2023 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
2024 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
2025 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
2026 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
2027 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
2028 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
2029 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
2030 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
2032 #undef SETUPEXCHANGE
2034 CPerlHost::CPerlHost(CPerlHost& host)
2036 /* Construct a host from another host */
2037 InterlockedIncrement(&num_hosts);
2038 m_pVMem = new VMem();
2039 m_pVMemShared = host.GetMemShared();
2040 m_pVMemParse = host.GetMemParse();
2042 /* duplicate directory info */
2043 m_pvDir = new VDir(0);
2044 m_pvDir->Init(host.GetDir(), m_pVMem);
2046 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2047 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2048 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2049 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2050 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2051 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2052 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2053 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2054 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2055 m_pHostperlMem = &m_hostperlMem;
2056 m_pHostperlMemShared = &m_hostperlMemShared;
2057 m_pHostperlMemParse = &m_hostperlMemParse;
2058 m_pHostperlEnv = &m_hostperlEnv;
2059 m_pHostperlStdIO = &m_hostperlStdIO;
2060 m_pHostperlLIO = &m_hostperlLIO;
2061 m_pHostperlDir = &m_hostperlDir;
2062 m_pHostperlSock = &m_hostperlSock;
2063 m_pHostperlProc = &m_hostperlProc;
2066 m_lppEnvList = NULL;
2067 m_bTopLevel = FALSE;
2069 /* duplicate environment info */
2072 while(lpPtr = host.GetIndex(dwIndex))
2076 CPerlHost::~CPerlHost(void)
2079 InterlockedDecrement(&num_hosts);
2081 m_pVMemParse->Release();
2082 m_pVMemShared->Release();
2087 CPerlHost::Find(LPCSTR lpStr)
2090 LPSTR* lppPtr = Lookup(lpStr);
2091 if(lppPtr != NULL) {
2092 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2104 lookup(const void *arg1, const void *arg2)
2105 { // Compare strings
2109 ptr1 = *(char**)arg1;
2110 ptr2 = *(char**)arg2;
2114 if(c1 == '\0' || c1 == '=') {
2115 if(c2 == '\0' || c2 == '=')
2118 return -1; // string 1 < string 2
2120 else if(c2 == '\0' || c2 == '=')
2121 return 1; // string 1 > string 2
2127 return -1; // string 1 < string 2
2129 return 1; // string 1 > string 2
2137 CPerlHost::Lookup(LPCSTR lpStr)
2139 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2143 compare(const void *arg1, const void *arg2)
2144 { // Compare strings
2148 ptr1 = *(char**)arg1;
2149 ptr2 = *(char**)arg2;
2153 if(c1 == '\0' || c1 == '=') {
2157 return -1; // string 1 < string 2
2159 else if(c2 == '\0' || c2 == '=')
2160 return 1; // string 1 > string 2
2166 return -1; // string 1 < string 2
2168 return 1; // string 1 > string 2
2176 CPerlHost::Add(LPCSTR lpStr)
2179 char szBuffer[1024];
2181 int index, length = strlen(lpStr)+1;
2183 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2184 szBuffer[index] = lpStr[index];
2186 szBuffer[index] = '\0';
2189 lpPtr = Lookup(szBuffer);
2191 Renew(*lpPtr, length, char);
2192 strcpy(*lpPtr, lpStr);
2196 Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2197 New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2198 if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2199 strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2200 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 Safefree(m_lppEnvList[index]);
2347 m_lppEnvList[index] = NULL;
2354 CPerlHost::Clearenv(void)
2358 LPSTR lpPtr, lpStr, lpEnvPtr;
2359 if (m_lppEnvList != NULL) {
2360 /* set every entry to an empty string */
2361 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2362 char* ptr = strchr(m_lppEnvList[index], '=');
2369 /* get the process environment strings */
2370 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2372 /* step over current directory stuff */
2373 while(*lpStr == '=')
2374 lpStr += strlen(lpStr) + 1;
2377 lpPtr = strchr(lpStr, '=');
2383 (void)win32_putenv(lpStr);
2386 lpStr += strlen(lpStr) + 1;
2389 FreeEnvironmentStrings(lpEnvPtr);
2394 CPerlHost::Getenv(const char *varname)
2398 char *pEnv = Find(varname);
2402 return win32_getenv(varname);
2406 CPerlHost::Putenv(const char *envstring)
2411 return win32_putenv(envstring);
2417 CPerlHost::Chdir(const char *dirname)
2426 WCHAR wBuffer[MAX_PATH];
2427 A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2428 ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2431 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2438 #endif /* ___PerlHost_H___ */