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, long 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, struct stat *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, long offset, int origin)
999 return win32_lseek(handle, offset, origin);
1003 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *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, struct stat *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 static THREAD_RET_TYPE
1686 win32_start_child(LPVOID arg)
1688 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1691 #ifdef PERL_SYNC_FORK
1692 static long sync_fork_id = 0;
1693 long id = ++sync_fork_id;
1697 PERL_SET_THX(my_perl);
1698 win32_checkTLS(my_perl);
1700 /* set $$ to pseudo id */
1701 #ifdef PERL_SYNC_FORK
1704 w32_pseudo_id = GetCurrentThreadId();
1706 int pid = (int)w32_pseudo_id;
1708 w32_pseudo_id = -pid;
1711 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) {
1712 SV *sv = GvSV(tmpgv);
1714 sv_setiv(sv, -(IV)w32_pseudo_id);
1717 hv_clear(PL_pidstatus);
1719 /* push a zero on the stack (we are the child) */
1727 /* continue from next op */
1728 PL_op = PL_op->op_next;
1732 volatile int oldscope = PL_scopestack_ix;
1735 JMPENV_PUSH(status);
1742 while (PL_scopestack_ix > oldscope)
1745 PL_curstash = PL_defstash;
1746 if (PL_endav && !PL_minus_c)
1747 call_list(oldscope, PL_endav);
1748 status = STATUS_NATIVE_EXPORT;
1752 POPSTACK_TO(PL_mainstack);
1753 PL_op = PL_restartop;
1754 PL_restartop = Nullop;
1757 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1764 /* XXX hack to avoid perl_destruct() freeing optree */
1765 win32_checkTLS(my_perl);
1766 PL_main_root = Nullop;
1769 win32_checkTLS(my_perl);
1770 /* close the std handles to avoid fd leaks */
1772 do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
1773 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE);
1774 do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE);
1777 /* destroy everything (waits for any pseudo-forked children) */
1778 win32_checkTLS(my_perl);
1779 perl_destruct(my_perl);
1780 win32_checkTLS(my_perl);
1783 #ifdef PERL_SYNC_FORK
1786 return (DWORD)status;
1789 #endif /* USE_ITHREADS */
1792 PerlProcFork(struct IPerlProc* piPerl)
1800 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1804 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1805 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 1,
1807 h->m_pHostperlMemShared,
1808 h->m_pHostperlMemParse,
1810 h->m_pHostperlStdIO,
1816 new_perl->Isys_intern.internal_host = h;
1817 h->host_perl = new_perl;
1818 # ifdef PERL_SYNC_FORK
1819 id = win32_start_child((LPVOID)new_perl);
1822 # ifdef USE_RTL_THREAD_API
1823 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1824 (void*)new_perl, 0, (unsigned*)&id);
1826 handle = CreateThread(NULL, 0, win32_start_child,
1827 (LPVOID)new_perl, 0, &id);
1829 PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
1839 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1840 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1841 ++w32_num_pseudo_children;
1845 Perl_croak(aTHX_ "fork() not implemented!\n");
1847 #endif /* USE_ITHREADS */
1851 PerlProcGetpid(struct IPerlProc* piPerl)
1853 return win32_getpid();
1857 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1859 return win32_dynaload(filename);
1863 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1865 win32_str_os_error(sv, dwErr);
1869 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1871 do_spawn2(cmd, EXECF_EXEC);
1876 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1878 return do_spawn2(cmds, EXECF_SPAWN);
1882 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1884 return win32_spawnvp(mode, cmdname, argv);
1888 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1890 return do_aspawn(vreally, vmark, vsp);
1894 PerlProcLastHost(struct IPerlProc* piPerl)
1897 CPerlHost *h = (CPerlHost*)w32_internal_host;
1898 return h->LastHost();
1901 struct IPerlProc perlProc =
1945 CPerlHost::CPerlHost(void)
1947 /* Construct a host from scratch */
1948 InterlockedIncrement(&num_hosts);
1949 m_pvDir = new VDir();
1950 m_pVMem = new VMem();
1951 m_pVMemShared = new VMem();
1952 m_pVMemParse = new VMem();
1954 m_pvDir->Init(NULL, m_pVMem);
1957 m_lppEnvList = NULL;
1960 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1961 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1962 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1963 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1964 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1965 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1966 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1967 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1968 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1970 m_pHostperlMem = &m_hostperlMem;
1971 m_pHostperlMemShared = &m_hostperlMemShared;
1972 m_pHostperlMemParse = &m_hostperlMemParse;
1973 m_pHostperlEnv = &m_hostperlEnv;
1974 m_pHostperlStdIO = &m_hostperlStdIO;
1975 m_pHostperlLIO = &m_hostperlLIO;
1976 m_pHostperlDir = &m_hostperlDir;
1977 m_pHostperlSock = &m_hostperlSock;
1978 m_pHostperlProc = &m_hostperlProc;
1981 #define SETUPEXCHANGE(xptr, iptr, table) \
1992 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1993 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1994 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1995 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1996 struct IPerlProc** ppProc)
1998 InterlockedIncrement(&num_hosts);
1999 m_pvDir = new VDir(0);
2000 m_pVMem = new VMem();
2001 m_pVMemShared = new VMem();
2002 m_pVMemParse = new VMem();
2004 m_pvDir->Init(NULL, m_pVMem);
2007 m_lppEnvList = NULL;
2008 m_bTopLevel = FALSE;
2010 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2011 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2012 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2013 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2014 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2015 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2016 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2017 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2018 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2020 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
2021 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
2022 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
2023 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
2024 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
2025 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
2026 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
2027 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
2028 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
2030 #undef SETUPEXCHANGE
2032 CPerlHost::CPerlHost(CPerlHost& host)
2034 /* Construct a host from another host */
2035 InterlockedIncrement(&num_hosts);
2036 m_pVMem = new VMem();
2037 m_pVMemShared = host.GetMemShared();
2038 m_pVMemParse = host.GetMemParse();
2040 /* duplicate directory info */
2041 m_pvDir = new VDir(0);
2042 m_pvDir->Init(host.GetDir(), m_pVMem);
2044 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2045 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2046 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2047 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2048 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2049 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2050 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2051 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2052 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2053 m_pHostperlMem = &m_hostperlMem;
2054 m_pHostperlMemShared = &m_hostperlMemShared;
2055 m_pHostperlMemParse = &m_hostperlMemParse;
2056 m_pHostperlEnv = &m_hostperlEnv;
2057 m_pHostperlStdIO = &m_hostperlStdIO;
2058 m_pHostperlLIO = &m_hostperlLIO;
2059 m_pHostperlDir = &m_hostperlDir;
2060 m_pHostperlSock = &m_hostperlSock;
2061 m_pHostperlProc = &m_hostperlProc;
2064 m_lppEnvList = NULL;
2065 m_bTopLevel = FALSE;
2067 /* duplicate environment info */
2070 while(lpPtr = host.GetIndex(dwIndex))
2074 CPerlHost::~CPerlHost(void)
2077 InterlockedDecrement(&num_hosts);
2079 m_pVMemParse->Release();
2080 m_pVMemShared->Release();
2085 CPerlHost::Find(LPCSTR lpStr)
2088 LPSTR* lppPtr = Lookup(lpStr);
2089 if(lppPtr != NULL) {
2090 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2102 lookup(const void *arg1, const void *arg2)
2103 { // Compare strings
2107 ptr1 = *(char**)arg1;
2108 ptr2 = *(char**)arg2;
2112 if(c1 == '\0' || c1 == '=') {
2113 if(c2 == '\0' || c2 == '=')
2116 return -1; // string 1 < string 2
2118 else if(c2 == '\0' || c2 == '=')
2119 return 1; // string 1 > string 2
2125 return -1; // string 1 < string 2
2127 return 1; // string 1 > string 2
2135 CPerlHost::Lookup(LPCSTR lpStr)
2137 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2141 compare(const void *arg1, const void *arg2)
2142 { // Compare strings
2146 ptr1 = *(char**)arg1;
2147 ptr2 = *(char**)arg2;
2151 if(c1 == '\0' || c1 == '=') {
2155 return -1; // string 1 < string 2
2157 else if(c2 == '\0' || c2 == '=')
2158 return 1; // string 1 > string 2
2164 return -1; // string 1 < string 2
2166 return 1; // string 1 > string 2
2174 CPerlHost::Add(LPCSTR lpStr)
2177 char szBuffer[1024];
2179 int index, length = strlen(lpStr)+1;
2181 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2182 szBuffer[index] = lpStr[index];
2184 szBuffer[index] = '\0';
2187 lpPtr = Lookup(szBuffer);
2189 Renew(*lpPtr, length, char);
2190 strcpy(*lpPtr, lpStr);
2194 Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2195 New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2196 if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2197 strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2198 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2206 CPerlHost::CalculateEnvironmentSpace(void)
2210 for(index = 0; index < m_dwEnvCount; ++index)
2211 dwSize += strlen(m_lppEnvList[index]) + 1;
2217 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2224 CPerlHost::GetChildDir(void)
2229 New(0, ptr, MAX_PATH+1, char);
2231 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2232 length = strlen(ptr);
2234 if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2242 CPerlHost::FreeChildDir(char* pStr)
2249 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2252 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2253 DWORD dwSize, dwEnvIndex;
2254 int nLength, compVal;
2256 // get the process environment strings
2257 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2259 // step over current directory stuff
2260 while(*lpTmp == '=')
2261 lpTmp += strlen(lpTmp) + 1;
2263 // save the start of the environment strings
2265 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2266 // calculate the size of the environment strings
2267 dwSize += strlen(lpTmp) + 1;
2270 // add the size of current directories
2271 dwSize += vDir.CalculateEnvironmentSpace();
2273 // add the additional space used by changes made to the environment
2274 dwSize += CalculateEnvironmentSpace();
2276 New(1, lpStr, dwSize, char);
2279 // build the local environment
2280 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2283 lpLocalEnv = GetIndex(dwEnvIndex);
2284 while(*lpEnvPtr != '\0') {
2286 // all environment overrides have been added
2287 // so copy string into place
2288 strcpy(lpStr, lpEnvPtr);
2289 nLength = strlen(lpEnvPtr) + 1;
2291 lpEnvPtr += nLength;
2294 // determine which string to copy next
2295 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2297 strcpy(lpStr, lpEnvPtr);
2298 nLength = strlen(lpEnvPtr) + 1;
2300 lpEnvPtr += nLength;
2303 char *ptr = strchr(lpLocalEnv, '=');
2305 strcpy(lpStr, lpLocalEnv);
2306 lpStr += strlen(lpLocalEnv) + 1;
2308 lpLocalEnv = GetIndex(dwEnvIndex);
2310 // this string was replaced
2311 lpEnvPtr += strlen(lpEnvPtr) + 1;
2318 // still have environment overrides to add
2319 // so copy the strings into place if not an override
2320 char *ptr = strchr(lpLocalEnv, '=');
2322 strcpy(lpStr, lpLocalEnv);
2323 lpStr += strlen(lpLocalEnv) + 1;
2325 lpLocalEnv = GetIndex(dwEnvIndex);
2332 // release the process environment strings
2333 FreeEnvironmentStrings(lpAllocPtr);
2339 CPerlHost::Reset(void)
2342 if(m_lppEnvList != NULL) {
2343 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2344 Safefree(m_lppEnvList[index]);
2345 m_lppEnvList[index] = NULL;
2352 CPerlHost::Clearenv(void)
2356 LPSTR lpPtr, lpStr, lpEnvPtr;
2357 if (m_lppEnvList != NULL) {
2358 /* set every entry to an empty string */
2359 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2360 char* ptr = strchr(m_lppEnvList[index], '=');
2367 /* get the process environment strings */
2368 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2370 /* step over current directory stuff */
2371 while(*lpStr == '=')
2372 lpStr += strlen(lpStr) + 1;
2375 lpPtr = strchr(lpStr, '=');
2381 (void)win32_putenv(lpStr);
2384 lpStr += strlen(lpStr) + 1;
2387 FreeEnvironmentStrings(lpEnvPtr);
2392 CPerlHost::Getenv(const char *varname)
2396 char *pEnv = Find(varname);
2400 return win32_getenv(varname);
2404 CPerlHost::Putenv(const char *envstring)
2409 return win32_putenv(envstring);
2415 CPerlHost::Chdir(const char *dirname)
2424 WCHAR wBuffer[MAX_PATH];
2425 A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2426 ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2429 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2436 #endif /* ___PerlHost_H___ */