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 struct interpreter *host_perl;
222 long CPerlHost::num_hosts = 0L;
224 extern "C" void win32_checkTLS(struct interpreter *host_perl);
226 #define STRUCT2RAWPTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
227 #ifdef CHECK_HOST_INTERP
228 inline CPerlHost* CheckInterp(CPerlHost *host)
230 win32_checkTLS(host->host_perl);
233 #define STRUCT2PTR(x, y) CheckInterp(STRUCT2RAWPTR(x, y))
235 #define STRUCT2PTR(x, y) STRUCT2RAWPTR(x, y)
238 inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
240 return STRUCT2RAWPTR(piPerl, m_hostperlMem);
243 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
245 return STRUCT2RAWPTR(piPerl, m_hostperlMemShared);
248 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
250 return STRUCT2RAWPTR(piPerl, m_hostperlMemParse);
253 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
255 return STRUCT2PTR(piPerl, m_hostperlEnv);
258 inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
260 return STRUCT2PTR(piPerl, m_hostperlStdIO);
263 inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
265 return STRUCT2PTR(piPerl, m_hostperlLIO);
268 inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
270 return STRUCT2PTR(piPerl, m_hostperlDir);
273 inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
275 return STRUCT2PTR(piPerl, m_hostperlSock);
278 inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
280 return STRUCT2PTR(piPerl, m_hostperlProc);
286 #define IPERL2HOST(x) IPerlMem2Host(x)
290 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
292 return IPERL2HOST(piPerl)->Malloc(size);
295 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
297 return IPERL2HOST(piPerl)->Realloc(ptr, size);
300 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
302 IPERL2HOST(piPerl)->Free(ptr);
305 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
307 return IPERL2HOST(piPerl)->Calloc(num, size);
311 PerlMemGetLock(struct IPerlMem* piPerl)
313 IPERL2HOST(piPerl)->GetLock();
317 PerlMemFreeLock(struct IPerlMem* piPerl)
319 IPERL2HOST(piPerl)->FreeLock();
323 PerlMemIsLocked(struct IPerlMem* piPerl)
325 return IPERL2HOST(piPerl)->IsLocked();
328 struct IPerlMem perlMem =
340 #define IPERL2HOST(x) IPerlMemShared2Host(x)
344 PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
346 return IPERL2HOST(piPerl)->MallocShared(size);
349 PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
351 return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
354 PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
356 IPERL2HOST(piPerl)->FreeShared(ptr);
359 PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
361 return IPERL2HOST(piPerl)->CallocShared(num, size);
365 PerlMemSharedGetLock(struct IPerlMem* piPerl)
367 IPERL2HOST(piPerl)->GetLockShared();
371 PerlMemSharedFreeLock(struct IPerlMem* piPerl)
373 IPERL2HOST(piPerl)->FreeLockShared();
377 PerlMemSharedIsLocked(struct IPerlMem* piPerl)
379 return IPERL2HOST(piPerl)->IsLockedShared();
382 struct IPerlMem perlMemShared =
385 PerlMemSharedRealloc,
388 PerlMemSharedGetLock,
389 PerlMemSharedFreeLock,
390 PerlMemSharedIsLocked,
394 #define IPERL2HOST(x) IPerlMemParse2Host(x)
398 PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
400 return IPERL2HOST(piPerl)->MallocParse(size);
403 PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
405 return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
408 PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
410 IPERL2HOST(piPerl)->FreeParse(ptr);
413 PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
415 return IPERL2HOST(piPerl)->CallocParse(num, size);
419 PerlMemParseGetLock(struct IPerlMem* piPerl)
421 IPERL2HOST(piPerl)->GetLockParse();
425 PerlMemParseFreeLock(struct IPerlMem* piPerl)
427 IPERL2HOST(piPerl)->FreeLockParse();
431 PerlMemParseIsLocked(struct IPerlMem* piPerl)
433 return IPERL2HOST(piPerl)->IsLockedParse();
436 struct IPerlMem perlMemParse =
443 PerlMemParseFreeLock,
444 PerlMemParseIsLocked,
449 #define IPERL2HOST(x) IPerlEnv2Host(x)
453 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
455 return IPERL2HOST(piPerl)->Getenv(varname);
459 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
461 return IPERL2HOST(piPerl)->Putenv(envstring);
465 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
467 return IPERL2HOST(piPerl)->Getenv(varname, len);
471 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
473 return win32_uname(name);
477 PerlEnvClearenv(struct IPerlEnv* piPerl)
479 IPERL2HOST(piPerl)->Clearenv();
483 PerlEnvGetChildenv(struct IPerlEnv* piPerl)
485 return IPERL2HOST(piPerl)->CreateChildEnv();
489 PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
491 IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
495 PerlEnvGetChilddir(struct IPerlEnv* piPerl)
497 return IPERL2HOST(piPerl)->GetChildDir();
501 PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
503 IPERL2HOST(piPerl)->FreeChildDir(childDir);
507 PerlEnvOsId(struct IPerlEnv* piPerl)
509 return win32_os_id();
513 PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
515 return g_win32_get_privlib(pl);
519 PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
521 return g_win32_get_sitelib(pl);
525 PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
527 return g_win32_get_vendorlib(pl);
531 PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
533 win32_get_child_IO(ptr);
536 struct IPerlEnv perlEnv =
550 PerlEnvVendorLibPath,
555 #define IPERL2HOST(x) IPerlStdIO2Host(x)
559 PerlStdIOStdin(struct IPerlStdIO* piPerl)
561 return win32_stdin();
565 PerlStdIOStdout(struct IPerlStdIO* piPerl)
567 return win32_stdout();
571 PerlStdIOStderr(struct IPerlStdIO* piPerl)
573 return win32_stderr();
577 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
579 return win32_fopen(path, mode);
583 PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf)
585 return win32_fclose((pf));
589 PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf)
591 return win32_feof(pf);
595 PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf)
597 return win32_ferror(pf);
601 PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf)
607 PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf)
609 return win32_getc(pf);
613 PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf)
624 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf)
628 return FILE_bufsiz(f);
635 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf)
646 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
657 PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n)
659 return win32_fgets(s, n, pf);
663 PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c)
665 return win32_fputc(c, pf);
669 PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s)
671 return win32_fputs(s, pf);
675 PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf)
677 return win32_fflush(pf);
681 PerlStdIOUngetc(struct IPerlStdIO* piPerl,int c, FILE* pf)
683 return win32_ungetc(c, pf);
687 PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf)
689 return win32_fileno(pf);
693 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
695 return win32_fdopen(fd, mode);
699 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf)
701 return win32_freopen(path, mode, (FILE*)pf);
705 PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf)
707 return win32_fread(buffer, size, count, pf);
711 PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf)
713 return win32_fwrite(buffer, size, count, pf);
717 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer)
719 win32_setbuf(pf, buffer);
723 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size)
725 return win32_setvbuf(pf, buffer, type, size);
729 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n)
731 #ifdef STDIO_CNT_LVALUE
738 PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr)
740 #ifdef STDIO_PTR_LVALUE
747 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf)
749 win32_setvbuf(pf, NULL, _IOLBF, 0);
753 PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...)
756 va_start(arglist, format);
757 return win32_vfprintf(pf, format, arglist);
761 PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist)
763 return win32_vfprintf(pf, format, arglist);
767 PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf)
769 return win32_ftell(pf);
773 PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, Off_t offset, int origin)
775 return win32_fseek(pf, offset, origin);
779 PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf)
785 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
787 return win32_tmpfile();
791 PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p)
793 return win32_fgetpos(pf, p);
797 PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p)
799 return win32_fsetpos(pf, p);
802 PerlStdIOInit(struct IPerlStdIO* piPerl)
807 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
809 Perl_init_os_extras();
813 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, intptr_t osfhandle, int flags)
815 return win32_open_osfhandle(osfhandle, flags);
819 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
821 return win32_get_osfhandle(filenum);
825 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
830 int fileno = win32_dup(win32_fileno(pf));
832 /* open the file in the same mode */
834 if((pf)->flags & _F_READ) {
838 else if((pf)->flags & _F_WRIT) {
842 else if((pf)->flags & _F_RDWR) {
848 if((pf)->_flag & _IOREAD) {
852 else if((pf)->_flag & _IOWRT) {
856 else if((pf)->_flag & _IORW) {
863 /* it appears that the binmode is attached to the
864 * file descriptor so binmode files will be handled
867 pfdup = win32_fdopen(fileno, mode);
869 /* move the file pointer to the same position */
870 if (!fgetpos(pf, &pos)) {
871 fsetpos(pfdup, &pos);
876 struct IPerlStdIO perlStdIO =
915 PerlStdIOInitOSExtras,
921 #define IPERL2HOST(x) IPerlLIO2Host(x)
925 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
927 return win32_access(path, mode);
931 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
933 return win32_chmod(filename, pmode);
937 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
939 return chown(filename, owner, group);
943 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
945 return chsize(handle, size);
949 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
951 return win32_close(handle);
955 PerlLIODup(struct IPerlLIO* piPerl, int handle)
957 return win32_dup(handle);
961 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
963 return win32_dup2(handle1, handle2);
967 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
969 return win32_flock(fd, oper);
973 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, Stat_t *buffer)
975 return win32_fstat(handle, buffer);
979 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
981 return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
985 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
991 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
993 return win32_link(oldname, newname);
997 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, Off_t offset, int origin)
999 return win32_lseek(handle, offset, origin);
1003 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer)
1005 return win32_stat(path, buffer);
1009 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
1011 return mktemp(Template);
1015 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
1017 return win32_open(filename, oflag);
1021 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
1023 return win32_open(filename, oflag, pmode);
1027 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
1029 return win32_read(handle, buffer, count);
1033 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
1035 return win32_rename(OldFileName, newname);
1039 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1041 return win32_setmode(handle, mode);
1045 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer)
1047 return win32_stat(path, buffer);
1051 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1053 return tmpnam(string);
1057 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1059 return umask(pmode);
1063 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1065 return win32_unlink(filename);
1069 PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
1071 return win32_utime(filename, times);
1075 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1077 return win32_write(handle, buffer, count);
1080 struct IPerlLIO perlLIO =
1112 #define IPERL2HOST(x) IPerlDir2Host(x)
1116 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1118 return win32_mkdir(dirname, mode);
1122 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1124 return IPERL2HOST(piPerl)->Chdir(dirname);
1128 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1130 return win32_rmdir(dirname);
1134 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1136 return win32_closedir(dirp);
1140 PerlDirOpen(struct IPerlDir* piPerl, char *filename)
1142 return win32_opendir(filename);
1146 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1148 return win32_readdir(dirp);
1152 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1154 win32_rewinddir(dirp);
1158 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1160 win32_seekdir(dirp, loc);
1164 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1166 return win32_telldir(dirp);
1170 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1172 return IPERL2HOST(piPerl)->MapPathA(path);
1176 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1178 return IPERL2HOST(piPerl)->MapPathW(path);
1181 struct IPerlDir perlDir =
1199 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1201 return win32_htonl(hostlong);
1205 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1207 return win32_htons(hostshort);
1211 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1213 return win32_ntohl(netlong);
1217 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1219 return win32_ntohs(netshort);
1222 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1224 return win32_accept(s, addr, addrlen);
1228 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1230 return win32_bind(s, name, namelen);
1234 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1236 return win32_connect(s, name, namelen);
1240 PerlSockEndhostent(struct IPerlSock* piPerl)
1246 PerlSockEndnetent(struct IPerlSock* piPerl)
1252 PerlSockEndprotoent(struct IPerlSock* piPerl)
1254 win32_endprotoent();
1258 PerlSockEndservent(struct IPerlSock* piPerl)
1264 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1266 return win32_gethostbyaddr(addr, len, type);
1270 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1272 return win32_gethostbyname(name);
1276 PerlSockGethostent(struct IPerlSock* piPerl)
1279 Perl_croak(aTHX_ "gethostent not implemented!\n");
1284 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1286 return win32_gethostname(name, namelen);
1290 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1292 return win32_getnetbyaddr(net, type);
1296 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1298 return win32_getnetbyname((char*)name);
1302 PerlSockGetnetent(struct IPerlSock* piPerl)
1304 return win32_getnetent();
1307 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1309 return win32_getpeername(s, name, namelen);
1313 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1315 return win32_getprotobyname(name);
1319 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1321 return win32_getprotobynumber(number);
1325 PerlSockGetprotoent(struct IPerlSock* piPerl)
1327 return win32_getprotoent();
1331 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1333 return win32_getservbyname(name, proto);
1337 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1339 return win32_getservbyport(port, proto);
1343 PerlSockGetservent(struct IPerlSock* piPerl)
1345 return win32_getservent();
1349 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1351 return win32_getsockname(s, name, namelen);
1355 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1357 return win32_getsockopt(s, level, optname, optval, optlen);
1361 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1363 return win32_inet_addr(cp);
1367 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1369 return win32_inet_ntoa(in);
1373 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1375 return win32_listen(s, backlog);
1379 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1381 return win32_recv(s, buffer, len, flags);
1385 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1387 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1391 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1393 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1397 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1399 return win32_send(s, buffer, len, flags);
1403 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1405 return win32_sendto(s, buffer, len, flags, to, tolen);
1409 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1411 win32_sethostent(stayopen);
1415 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1417 win32_setnetent(stayopen);
1421 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1423 win32_setprotoent(stayopen);
1427 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1429 win32_setservent(stayopen);
1433 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1435 return win32_setsockopt(s, level, optname, optval, optlen);
1439 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1441 return win32_shutdown(s, how);
1445 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1447 return win32_socket(af, type, protocol);
1451 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1453 return Perl_my_socketpair(domain, type, protocol, fds);
1457 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1459 return win32_closesocket(s);
1463 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1465 return win32_ioctlsocket(s, cmd, argp);
1468 struct IPerlSock perlSock =
1479 PerlSockEndprotoent,
1481 PerlSockGethostname,
1482 PerlSockGetpeername,
1483 PerlSockGethostbyaddr,
1484 PerlSockGethostbyname,
1486 PerlSockGetnetbyaddr,
1487 PerlSockGetnetbyname,
1489 PerlSockGetprotobyname,
1490 PerlSockGetprotobynumber,
1491 PerlSockGetprotoent,
1492 PerlSockGetservbyname,
1493 PerlSockGetservbyport,
1495 PerlSockGetsockname,
1507 PerlSockSetprotoent,
1513 PerlSockClosesocket,
1519 #define EXECF_EXEC 1
1520 #define EXECF_SPAWN 2
1523 PerlProcAbort(struct IPerlProc* piPerl)
1529 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1531 return win32_crypt(clear, salt);
1535 PerlProcExit(struct IPerlProc* piPerl, int status)
1541 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1547 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1549 return execl(cmdname, arg0, arg1, arg2, arg3);
1553 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1555 return win32_execvp(cmdname, argv);
1559 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1561 return win32_execvp(cmdname, argv);
1565 PerlProcGetuid(struct IPerlProc* piPerl)
1571 PerlProcGeteuid(struct IPerlProc* piPerl)
1577 PerlProcGetgid(struct IPerlProc* piPerl)
1583 PerlProcGetegid(struct IPerlProc* piPerl)
1589 PerlProcGetlogin(struct IPerlProc* piPerl)
1591 return g_getlogin();
1595 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1597 return win32_kill(pid, sig);
1601 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1604 Perl_croak(aTHX_ "killpg not implemented!\n");
1609 PerlProcPauseProc(struct IPerlProc* piPerl)
1611 return win32_sleep((32767L << 16) + 32767);
1615 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1618 PERL_FLUSHALL_FOR_CHILD;
1619 return win32_popen(command, mode);
1623 PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
1626 PERL_FLUSHALL_FOR_CHILD;
1627 return win32_popenlist(mode, narg, args);
1631 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1633 return win32_pclose(stream);
1637 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1639 return win32_pipe(phandles, 512, O_BINARY);
1643 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1649 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1655 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1657 return win32_sleep(s);
1661 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1663 return win32_times(timebuf);
1667 PerlProcWait(struct IPerlProc* piPerl, int *status)
1669 return win32_wait(status);
1673 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1675 return win32_waitpid(pid, status, flags);
1679 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1681 return win32_signal(sig, subcode);
1685 PerlProcGetTimeOfDay(struct IPerlProc* piPerl, struct timeval *t, void *z)
1687 return win32_gettimeofday(t, z);
1691 static THREAD_RET_TYPE
1692 win32_start_child(LPVOID arg)
1694 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1697 #ifdef PERL_SYNC_FORK
1698 static long sync_fork_id = 0;
1699 long id = ++sync_fork_id;
1703 PERL_SET_THX(my_perl);
1704 win32_checkTLS(my_perl);
1706 /* set $$ to pseudo id */
1707 #ifdef PERL_SYNC_FORK
1710 w32_pseudo_id = GetCurrentThreadId();
1712 int pid = (int)w32_pseudo_id;
1714 w32_pseudo_id = -pid;
1717 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) {
1718 SV *sv = GvSV(tmpgv);
1720 sv_setiv(sv, -(IV)w32_pseudo_id);
1723 hv_clear(PL_pidstatus);
1725 /* push a zero on the stack (we are the child) */
1733 /* continue from next op */
1734 PL_op = PL_op->op_next;
1738 volatile int oldscope = PL_scopestack_ix;
1741 JMPENV_PUSH(status);
1748 while (PL_scopestack_ix > oldscope)
1751 PL_curstash = PL_defstash;
1752 if (PL_endav && !PL_minus_c)
1753 call_list(oldscope, PL_endav);
1754 status = STATUS_NATIVE_EXPORT;
1758 POPSTACK_TO(PL_mainstack);
1759 PL_op = PL_restartop;
1760 PL_restartop = Nullop;
1763 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1770 /* XXX hack to avoid perl_destruct() freeing optree */
1771 win32_checkTLS(my_perl);
1772 PL_main_root = Nullop;
1775 win32_checkTLS(my_perl);
1776 /* close the std handles to avoid fd leaks */
1778 do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
1779 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE);
1780 do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE);
1783 /* destroy everything (waits for any pseudo-forked children) */
1784 win32_checkTLS(my_perl);
1785 perl_destruct(my_perl);
1786 win32_checkTLS(my_perl);
1789 #ifdef PERL_SYNC_FORK
1792 return (DWORD)status;
1795 #endif /* USE_ITHREADS */
1798 PerlProcFork(struct IPerlProc* piPerl)
1806 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1810 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1811 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 1,
1813 h->m_pHostperlMemShared,
1814 h->m_pHostperlMemParse,
1816 h->m_pHostperlStdIO,
1822 new_perl->Isys_intern.internal_host = h;
1823 h->host_perl = new_perl;
1824 # ifdef PERL_SYNC_FORK
1825 id = win32_start_child((LPVOID)new_perl);
1828 # ifdef USE_RTL_THREAD_API
1829 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1830 (void*)new_perl, 0, (unsigned*)&id);
1832 handle = CreateThread(NULL, 0, win32_start_child,
1833 (LPVOID)new_perl, 0, &id);
1835 PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
1845 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1846 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1847 ++w32_num_pseudo_children;
1851 Perl_croak(aTHX_ "fork() not implemented!\n");
1853 #endif /* USE_ITHREADS */
1857 PerlProcGetpid(struct IPerlProc* piPerl)
1859 return win32_getpid();
1863 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1865 return win32_dynaload(filename);
1869 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1871 win32_str_os_error(sv, dwErr);
1875 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1877 do_spawn2(cmd, EXECF_EXEC);
1882 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1884 return do_spawn2(cmds, EXECF_SPAWN);
1888 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1890 return win32_spawnvp(mode, cmdname, argv);
1894 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1896 return do_aspawn(vreally, vmark, vsp);
1900 PerlProcLastHost(struct IPerlProc* piPerl)
1903 CPerlHost *h = (CPerlHost*)w32_internal_host;
1904 return h->LastHost();
1907 struct IPerlProc perlProc =
1944 PerlProcGetTimeOfDay
1952 CPerlHost::CPerlHost(void)
1954 /* Construct a host from scratch */
1955 InterlockedIncrement(&num_hosts);
1956 m_pvDir = new VDir();
1957 m_pVMem = new VMem();
1958 m_pVMemShared = new VMem();
1959 m_pVMemParse = new VMem();
1961 m_pvDir->Init(NULL, m_pVMem);
1964 m_lppEnvList = NULL;
1967 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1968 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1969 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1970 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1971 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1972 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1973 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1974 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1975 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1977 m_pHostperlMem = &m_hostperlMem;
1978 m_pHostperlMemShared = &m_hostperlMemShared;
1979 m_pHostperlMemParse = &m_hostperlMemParse;
1980 m_pHostperlEnv = &m_hostperlEnv;
1981 m_pHostperlStdIO = &m_hostperlStdIO;
1982 m_pHostperlLIO = &m_hostperlLIO;
1983 m_pHostperlDir = &m_hostperlDir;
1984 m_pHostperlSock = &m_hostperlSock;
1985 m_pHostperlProc = &m_hostperlProc;
1988 #define SETUPEXCHANGE(xptr, iptr, table) \
1999 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
2000 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
2001 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
2002 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
2003 struct IPerlProc** ppProc)
2005 InterlockedIncrement(&num_hosts);
2006 m_pvDir = new VDir(0);
2007 m_pVMem = new VMem();
2008 m_pVMemShared = new VMem();
2009 m_pVMemParse = new VMem();
2011 m_pvDir->Init(NULL, m_pVMem);
2014 m_lppEnvList = NULL;
2015 m_bTopLevel = FALSE;
2017 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2018 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2019 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2020 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2021 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2022 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2023 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2024 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2025 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2027 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
2028 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
2029 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
2030 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
2031 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
2032 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
2033 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
2034 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
2035 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
2037 #undef SETUPEXCHANGE
2039 CPerlHost::CPerlHost(CPerlHost& host)
2041 /* Construct a host from another host */
2042 InterlockedIncrement(&num_hosts);
2043 m_pVMem = new VMem();
2044 m_pVMemShared = host.GetMemShared();
2045 m_pVMemParse = host.GetMemParse();
2047 /* duplicate directory info */
2048 m_pvDir = new VDir(0);
2049 m_pvDir->Init(host.GetDir(), m_pVMem);
2051 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2052 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2053 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2054 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2055 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2056 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2057 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2058 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2059 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2060 m_pHostperlMem = &m_hostperlMem;
2061 m_pHostperlMemShared = &m_hostperlMemShared;
2062 m_pHostperlMemParse = &m_hostperlMemParse;
2063 m_pHostperlEnv = &m_hostperlEnv;
2064 m_pHostperlStdIO = &m_hostperlStdIO;
2065 m_pHostperlLIO = &m_hostperlLIO;
2066 m_pHostperlDir = &m_hostperlDir;
2067 m_pHostperlSock = &m_hostperlSock;
2068 m_pHostperlProc = &m_hostperlProc;
2071 m_lppEnvList = NULL;
2072 m_bTopLevel = FALSE;
2074 /* duplicate environment info */
2077 while(lpPtr = host.GetIndex(dwIndex))
2081 CPerlHost::~CPerlHost(void)
2084 InterlockedDecrement(&num_hosts);
2086 m_pVMemParse->Release();
2087 m_pVMemShared->Release();
2092 CPerlHost::Find(LPCSTR lpStr)
2095 LPSTR* lppPtr = Lookup(lpStr);
2096 if(lppPtr != NULL) {
2097 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2109 lookup(const void *arg1, const void *arg2)
2110 { // Compare strings
2114 ptr1 = *(char**)arg1;
2115 ptr2 = *(char**)arg2;
2119 if(c1 == '\0' || c1 == '=') {
2120 if(c2 == '\0' || c2 == '=')
2123 return -1; // string 1 < string 2
2125 else if(c2 == '\0' || c2 == '=')
2126 return 1; // string 1 > string 2
2132 return -1; // string 1 < string 2
2134 return 1; // string 1 > string 2
2142 CPerlHost::Lookup(LPCSTR lpStr)
2144 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2148 compare(const void *arg1, const void *arg2)
2149 { // Compare strings
2153 ptr1 = *(char**)arg1;
2154 ptr2 = *(char**)arg2;
2158 if(c1 == '\0' || c1 == '=') {
2162 return -1; // string 1 < string 2
2164 else if(c2 == '\0' || c2 == '=')
2165 return 1; // string 1 > string 2
2171 return -1; // string 1 < string 2
2173 return 1; // string 1 > string 2
2181 CPerlHost::Add(LPCSTR lpStr)
2184 char szBuffer[1024];
2186 int index, length = strlen(lpStr)+1;
2188 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2189 szBuffer[index] = lpStr[index];
2191 szBuffer[index] = '\0';
2194 lpPtr = Lookup(szBuffer);
2196 Renew(*lpPtr, length, char);
2197 strcpy(*lpPtr, lpStr);
2201 Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2202 New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2203 if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2204 strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2205 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2213 CPerlHost::CalculateEnvironmentSpace(void)
2217 for(index = 0; index < m_dwEnvCount; ++index)
2218 dwSize += strlen(m_lppEnvList[index]) + 1;
2224 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2231 CPerlHost::GetChildDir(void)
2236 New(0, ptr, MAX_PATH+1, char);
2238 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2239 length = strlen(ptr);
2241 if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2249 CPerlHost::FreeChildDir(char* pStr)
2256 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2259 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2260 DWORD dwSize, dwEnvIndex;
2261 int nLength, compVal;
2263 // get the process environment strings
2264 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2266 // step over current directory stuff
2267 while(*lpTmp == '=')
2268 lpTmp += strlen(lpTmp) + 1;
2270 // save the start of the environment strings
2272 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2273 // calculate the size of the environment strings
2274 dwSize += strlen(lpTmp) + 1;
2277 // add the size of current directories
2278 dwSize += vDir.CalculateEnvironmentSpace();
2280 // add the additional space used by changes made to the environment
2281 dwSize += CalculateEnvironmentSpace();
2283 New(1, lpStr, dwSize, char);
2286 // build the local environment
2287 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2290 lpLocalEnv = GetIndex(dwEnvIndex);
2291 while(*lpEnvPtr != '\0') {
2293 // all environment overrides have been added
2294 // so copy string into place
2295 strcpy(lpStr, lpEnvPtr);
2296 nLength = strlen(lpEnvPtr) + 1;
2298 lpEnvPtr += nLength;
2301 // determine which string to copy next
2302 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2304 strcpy(lpStr, lpEnvPtr);
2305 nLength = strlen(lpEnvPtr) + 1;
2307 lpEnvPtr += nLength;
2310 char *ptr = strchr(lpLocalEnv, '=');
2312 strcpy(lpStr, lpLocalEnv);
2313 lpStr += strlen(lpLocalEnv) + 1;
2315 lpLocalEnv = GetIndex(dwEnvIndex);
2317 // this string was replaced
2318 lpEnvPtr += strlen(lpEnvPtr) + 1;
2325 // still have environment overrides to add
2326 // so copy the strings into place if not an override
2327 char *ptr = strchr(lpLocalEnv, '=');
2329 strcpy(lpStr, lpLocalEnv);
2330 lpStr += strlen(lpLocalEnv) + 1;
2332 lpLocalEnv = GetIndex(dwEnvIndex);
2339 // release the process environment strings
2340 FreeEnvironmentStrings(lpAllocPtr);
2346 CPerlHost::Reset(void)
2349 if(m_lppEnvList != NULL) {
2350 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2351 Safefree(m_lppEnvList[index]);
2352 m_lppEnvList[index] = NULL;
2359 CPerlHost::Clearenv(void)
2363 LPSTR lpPtr, lpStr, lpEnvPtr;
2364 if (m_lppEnvList != NULL) {
2365 /* set every entry to an empty string */
2366 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2367 char* ptr = strchr(m_lppEnvList[index], '=');
2374 /* get the process environment strings */
2375 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2377 /* step over current directory stuff */
2378 while(*lpStr == '=')
2379 lpStr += strlen(lpStr) + 1;
2382 lpPtr = strchr(lpStr, '=');
2388 (void)win32_putenv(lpStr);
2391 lpStr += strlen(lpStr) + 1;
2394 FreeEnvironmentStrings(lpEnvPtr);
2399 CPerlHost::Getenv(const char *varname)
2403 char *pEnv = Find(varname);
2407 return win32_getenv(varname);
2411 CPerlHost::Putenv(const char *envstring)
2416 return win32_putenv(envstring);
2422 CPerlHost::Chdir(const char *dirname)
2431 WCHAR wBuffer[MAX_PATH];
2432 A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2433 ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2436 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2443 #endif /* ___PerlHost_H___ */