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 #ifndef ___PerlHost_H___
11 #define ___PerlHost_H___
17 #if !defined(PERL_OBJECT)
20 extern char * g_win32_get_privlib(const char *pl);
21 extern char * g_win32_get_sitelib(const char *pl);
22 extern char * g_win32_get_vendorlib(const char *pl);
23 extern char * g_getlogin(void);
24 extern int do_spawn2(char *cmd, int exectype);
25 #if !defined(PERL_OBJECT)
30 extern int g_do_aspawn(void *vreally, void **vmark, void **vsp);
31 #define do_aspawn g_do_aspawn
38 CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
39 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
40 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
41 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
42 struct IPerlProc** ppProc);
43 CPerlHost(CPerlHost& host);
46 static CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl);
47 static CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl);
48 static CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl);
49 static CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl);
50 static CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl);
51 static CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl);
52 static CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl);
53 static CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl);
54 static CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl);
56 BOOL PerlCreate(void);
57 int PerlParse(int argc, char** argv, char** env);
59 void PerlDestroy(void);
62 inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
63 inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
64 inline void Free(void* ptr) { m_pVMem->Free(ptr); };
65 inline void* Calloc(size_t num, size_t size)
67 size_t count = num*size;
68 void* lpVoid = Malloc(count);
70 ZeroMemory(lpVoid, count);
73 inline void GetLock(void) { m_pVMem->GetLock(); };
74 inline void FreeLock(void) { m_pVMem->FreeLock(); };
75 inline int IsLocked(void) { return m_pVMem->IsLocked(); };
78 inline void* MallocShared(size_t size)
80 return m_pVMemShared->Malloc(size);
82 inline void* ReallocShared(void* ptr, size_t size) { return m_pVMemShared->Realloc(ptr, size); };
83 inline void FreeShared(void* ptr) { m_pVMemShared->Free(ptr); };
84 inline void* CallocShared(size_t num, size_t size)
86 size_t count = num*size;
87 void* lpVoid = MallocShared(count);
89 ZeroMemory(lpVoid, count);
92 inline void GetLockShared(void) { m_pVMem->GetLock(); };
93 inline void FreeLockShared(void) { m_pVMem->FreeLock(); };
94 inline int IsLockedShared(void) { return m_pVMem->IsLocked(); };
97 inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
98 inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
99 inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
100 inline void* CallocParse(size_t num, size_t size)
102 size_t count = num*size;
103 void* lpVoid = MallocParse(count);
105 ZeroMemory(lpVoid, count);
108 inline void GetLockParse(void) { m_pVMem->GetLock(); };
109 inline void FreeLockParse(void) { m_pVMem->FreeLock(); };
110 inline int IsLockedParse(void) { return m_pVMem->IsLocked(); };
113 char *Getenv(const char *varname);
114 int Putenv(const char *envstring);
115 inline char *Getenv(const char *varname, unsigned long *len)
118 char *e = Getenv(varname);
123 void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
124 void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
125 char* GetChildDir(void);
126 void FreeChildDir(char* pStr);
130 inline LPSTR GetIndex(DWORD &dwIndex)
132 if(dwIndex < m_dwEnvCount)
135 return m_lppEnvList[dwIndex-1];
141 LPSTR Find(LPCSTR lpStr);
142 void Add(LPCSTR lpStr);
144 LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
145 void FreeLocalEnvironmentStrings(LPSTR lpStr);
146 LPSTR* Lookup(LPCSTR lpStr);
147 DWORD CalculateEnvironmentSpace(void);
152 virtual int Chdir(const char *dirname);
156 void Exit(int status);
157 void _Exit(int status);
158 int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
159 int Execv(const char *cmdname, const char *const *argv);
160 int Execvp(const char *cmdname, const char *const *argv);
162 inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
163 inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
164 inline VDir* GetDir(void) { return m_pvDir; };
168 struct IPerlMem m_hostperlMem;
169 struct IPerlMem m_hostperlMemShared;
170 struct IPerlMem m_hostperlMemParse;
171 struct IPerlEnv m_hostperlEnv;
172 struct IPerlStdIO m_hostperlStdIO;
173 struct IPerlLIO m_hostperlLIO;
174 struct IPerlDir m_hostperlDir;
175 struct IPerlSock m_hostperlSock;
176 struct IPerlProc m_hostperlProc;
178 struct IPerlMem* m_pHostperlMem;
179 struct IPerlMem* m_pHostperlMemShared;
180 struct IPerlMem* m_pHostperlMemParse;
181 struct IPerlEnv* m_pHostperlEnv;
182 struct IPerlStdIO* m_pHostperlStdIO;
183 struct IPerlLIO* m_pHostperlLIO;
184 struct IPerlDir* m_pHostperlDir;
185 struct IPerlSock* m_pHostperlSock;
186 struct IPerlProc* m_pHostperlProc;
188 inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
189 inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
202 #define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
204 inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
206 return STRUCT2PTR(piPerl, m_hostperlMem);
209 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
211 return STRUCT2PTR(piPerl, m_hostperlMemShared);
214 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
216 return STRUCT2PTR(piPerl, m_hostperlMemParse);
219 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
221 return STRUCT2PTR(piPerl, m_hostperlEnv);
224 inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
226 return STRUCT2PTR(piPerl, m_hostperlStdIO);
229 inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
231 return STRUCT2PTR(piPerl, m_hostperlLIO);
234 inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
236 return STRUCT2PTR(piPerl, m_hostperlDir);
239 inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
241 return STRUCT2PTR(piPerl, m_hostperlSock);
244 inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
246 return STRUCT2PTR(piPerl, m_hostperlProc);
252 #define IPERL2HOST(x) IPerlMem2Host(x)
256 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
258 return IPERL2HOST(piPerl)->Malloc(size);
261 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
263 return IPERL2HOST(piPerl)->Realloc(ptr, size);
266 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
268 IPERL2HOST(piPerl)->Free(ptr);
271 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
273 return IPERL2HOST(piPerl)->Calloc(num, size);
277 PerlMemGetLock(struct IPerlMem* piPerl)
279 IPERL2HOST(piPerl)->GetLock();
283 PerlMemFreeLock(struct IPerlMem* piPerl)
285 IPERL2HOST(piPerl)->FreeLock();
289 PerlMemIsLocked(struct IPerlMem* piPerl)
291 return IPERL2HOST(piPerl)->IsLocked();
294 struct IPerlMem perlMem =
306 #define IPERL2HOST(x) IPerlMemShared2Host(x)
310 PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
312 return IPERL2HOST(piPerl)->MallocShared(size);
315 PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
317 return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
320 PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
322 IPERL2HOST(piPerl)->FreeShared(ptr);
325 PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
327 return IPERL2HOST(piPerl)->CallocShared(num, size);
331 PerlMemSharedGetLock(struct IPerlMem* piPerl)
333 IPERL2HOST(piPerl)->GetLockShared();
337 PerlMemSharedFreeLock(struct IPerlMem* piPerl)
339 IPERL2HOST(piPerl)->FreeLockShared();
343 PerlMemSharedIsLocked(struct IPerlMem* piPerl)
345 return IPERL2HOST(piPerl)->IsLockedShared();
348 struct IPerlMem perlMemShared =
351 PerlMemSharedRealloc,
354 PerlMemSharedGetLock,
355 PerlMemSharedFreeLock,
356 PerlMemSharedIsLocked,
360 #define IPERL2HOST(x) IPerlMemParse2Host(x)
364 PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
366 return IPERL2HOST(piPerl)->MallocParse(size);
369 PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
371 return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
374 PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
376 IPERL2HOST(piPerl)->FreeParse(ptr);
379 PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
381 return IPERL2HOST(piPerl)->CallocParse(num, size);
385 PerlMemParseGetLock(struct IPerlMem* piPerl)
387 IPERL2HOST(piPerl)->GetLockParse();
391 PerlMemParseFreeLock(struct IPerlMem* piPerl)
393 IPERL2HOST(piPerl)->FreeLockParse();
397 PerlMemParseIsLocked(struct IPerlMem* piPerl)
399 return IPERL2HOST(piPerl)->IsLockedParse();
402 struct IPerlMem perlMemParse =
409 PerlMemParseFreeLock,
410 PerlMemParseIsLocked,
415 #define IPERL2HOST(x) IPerlEnv2Host(x)
419 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
421 return IPERL2HOST(piPerl)->Getenv(varname);
425 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
427 return IPERL2HOST(piPerl)->Putenv(envstring);
431 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
433 return IPERL2HOST(piPerl)->Getenv(varname, len);
437 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
439 return win32_uname(name);
443 PerlEnvClearenv(struct IPerlEnv* piPerl)
445 IPERL2HOST(piPerl)->Clearenv();
449 PerlEnvGetChildenv(struct IPerlEnv* piPerl)
451 return IPERL2HOST(piPerl)->CreateChildEnv();
455 PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
457 IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
461 PerlEnvGetChilddir(struct IPerlEnv* piPerl)
463 return IPERL2HOST(piPerl)->GetChildDir();
467 PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
469 IPERL2HOST(piPerl)->FreeChildDir(childDir);
473 PerlEnvOsId(struct IPerlEnv* piPerl)
475 return win32_os_id();
479 PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
481 return g_win32_get_privlib(pl);
485 PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
487 return g_win32_get_sitelib(pl);
491 PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
493 return g_win32_get_vendorlib(pl);
497 PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
499 win32_get_child_IO(ptr);
502 struct IPerlEnv perlEnv =
516 PerlEnvVendorLibPath,
521 #define IPERL2HOST(x) IPerlStdIO2Host(x)
525 PerlStdIOStdin(struct IPerlStdIO* piPerl)
527 return (PerlIO*)win32_stdin();
531 PerlStdIOStdout(struct IPerlStdIO* piPerl)
533 return (PerlIO*)win32_stdout();
537 PerlStdIOStderr(struct IPerlStdIO* piPerl)
539 return (PerlIO*)win32_stderr();
543 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
545 return (PerlIO*)win32_fopen(path, mode);
549 PerlStdIOClose(struct IPerlStdIO* piPerl, PerlIO* pf)
551 return win32_fclose(((FILE*)pf));
555 PerlStdIOEof(struct IPerlStdIO* piPerl, PerlIO* pf)
557 return win32_feof((FILE*)pf);
561 PerlStdIOError(struct IPerlStdIO* piPerl, PerlIO* pf)
563 return win32_ferror((FILE*)pf);
567 PerlStdIOClearerr(struct IPerlStdIO* piPerl, PerlIO* pf)
569 win32_clearerr((FILE*)pf);
573 PerlStdIOGetc(struct IPerlStdIO* piPerl, PerlIO* pf)
575 return win32_getc((FILE*)pf);
579 PerlStdIOGetBase(struct IPerlStdIO* piPerl, PerlIO* pf)
590 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, PerlIO* pf)
594 return FILE_bufsiz(f);
601 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, PerlIO* pf)
612 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, PerlIO* pf)
623 PerlStdIOGets(struct IPerlStdIO* piPerl, PerlIO* pf, char* s, int n)
625 return win32_fgets(s, n, (FILE*)pf);
629 PerlStdIOPutc(struct IPerlStdIO* piPerl, PerlIO* pf, int c)
631 return win32_fputc(c, (FILE*)pf);
635 PerlStdIOPuts(struct IPerlStdIO* piPerl, PerlIO* pf, const char *s)
637 return win32_fputs(s, (FILE*)pf);
641 PerlStdIOFlush(struct IPerlStdIO* piPerl, PerlIO* pf)
643 return win32_fflush((FILE*)pf);
647 PerlStdIOUngetc(struct IPerlStdIO* piPerl, PerlIO* pf,int c)
649 return win32_ungetc(c, (FILE*)pf);
653 PerlStdIOFileno(struct IPerlStdIO* piPerl, PerlIO* pf)
655 return win32_fileno((FILE*)pf);
659 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
661 return (PerlIO*)win32_fdopen(fd, mode);
665 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, PerlIO* pf)
667 return (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
671 PerlStdIORead(struct IPerlStdIO* piPerl, PerlIO* pf, void *buffer, Size_t size)
673 return win32_fread(buffer, 1, size, (FILE*)pf);
677 PerlStdIOWrite(struct IPerlStdIO* piPerl, PerlIO* pf, const void *buffer, Size_t size)
679 return win32_fwrite(buffer, 1, size, (FILE*)pf);
683 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, PerlIO* pf, char* buffer)
685 win32_setbuf((FILE*)pf, buffer);
689 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, PerlIO* pf, char* buffer, int type, Size_t size)
691 return win32_setvbuf((FILE*)pf, buffer, type, size);
695 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, PerlIO* pf, int n)
697 #ifdef STDIO_CNT_LVALUE
704 PerlStdIOSetPtrCnt(struct IPerlStdIO* piPerl, PerlIO* pf, char * ptr, int n)
706 #ifdef STDIO_PTR_LVALUE
714 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, PerlIO* pf)
716 win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
720 PerlStdIOPrintf(struct IPerlStdIO* piPerl, PerlIO* pf, const char *format,...)
723 va_start(arglist, format);
724 return win32_vfprintf((FILE*)pf, format, arglist);
728 PerlStdIOVprintf(struct IPerlStdIO* piPerl, PerlIO* pf, const char *format, va_list arglist)
730 return win32_vfprintf((FILE*)pf, format, arglist);
734 PerlStdIOTell(struct IPerlStdIO* piPerl, PerlIO* pf)
736 return win32_ftell((FILE*)pf);
740 PerlStdIOSeek(struct IPerlStdIO* piPerl, PerlIO* pf, off_t offset, int origin)
742 return win32_fseek((FILE*)pf, offset, origin);
746 PerlStdIORewind(struct IPerlStdIO* piPerl, PerlIO* pf)
748 win32_rewind((FILE*)pf);
752 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
754 return (PerlIO*)win32_tmpfile();
758 PerlStdIOGetpos(struct IPerlStdIO* piPerl, PerlIO* pf, Fpos_t *p)
760 return win32_fgetpos((FILE*)pf, p);
764 PerlStdIOSetpos(struct IPerlStdIO* piPerl, PerlIO* pf, const Fpos_t *p)
766 return win32_fsetpos((FILE*)pf, p);
769 PerlStdIOInit(struct IPerlStdIO* piPerl)
774 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
776 Perl_init_os_extras();
780 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags)
782 return win32_open_osfhandle(osfhandle, flags);
786 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
788 return win32_get_osfhandle(filenum);
792 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, PerlIO* pf)
797 int fileno = win32_dup(win32_fileno((FILE*)pf));
799 /* open the file in the same mode */
801 if(((FILE*)pf)->flags & _F_READ) {
805 else if(((FILE*)pf)->flags & _F_WRIT) {
809 else if(((FILE*)pf)->flags & _F_RDWR) {
815 if(((FILE*)pf)->_flag & _IOREAD) {
819 else if(((FILE*)pf)->_flag & _IOWRT) {
823 else if(((FILE*)pf)->_flag & _IORW) {
830 /* it appears that the binmode is attached to the
831 * file descriptor so binmode files will be handled
834 pfdup = (PerlIO*)win32_fdopen(fileno, mode);
836 /* move the file pointer to the same position */
837 if (!fgetpos((FILE*)pf, &pos)) {
838 fsetpos((FILE*)pfdup, &pos);
843 struct IPerlStdIO perlStdIO =
882 PerlStdIOInitOSExtras,
888 #define IPERL2HOST(x) IPerlLIO2Host(x)
892 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
894 return win32_access(path, mode);
898 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
900 return win32_chmod(filename, pmode);
904 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
906 return chown(filename, owner, group);
910 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
912 return chsize(handle, size);
916 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
918 return win32_close(handle);
922 PerlLIODup(struct IPerlLIO* piPerl, int handle)
924 return win32_dup(handle);
928 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
930 return win32_dup2(handle1, handle2);
934 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
936 return win32_flock(fd, oper);
940 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
942 return fstat(handle, buffer);
946 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
948 return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
952 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
958 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
960 return win32_link(oldname, newname);
964 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
966 return win32_lseek(handle, offset, origin);
970 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
972 return win32_stat(path, buffer);
976 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
978 return mktemp(Template);
982 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
984 return win32_open(filename, oflag);
988 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
990 return win32_open(filename, oflag, pmode);
994 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
996 return win32_read(handle, buffer, count);
1000 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
1002 return win32_rename(OldFileName, newname);
1006 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1008 return win32_setmode(handle, mode);
1012 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
1014 return win32_stat(path, buffer);
1018 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1020 return tmpnam(string);
1024 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1026 return umask(pmode);
1030 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1032 return win32_unlink(filename);
1036 PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
1038 return win32_utime(filename, times);
1042 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1044 return win32_write(handle, buffer, count);
1047 struct IPerlLIO perlLIO =
1079 #define IPERL2HOST(x) IPerlDir2Host(x)
1083 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1085 return win32_mkdir(dirname, mode);
1089 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1091 return IPERL2HOST(piPerl)->Chdir(dirname);
1095 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1097 return win32_rmdir(dirname);
1101 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1103 return win32_closedir(dirp);
1107 PerlDirOpen(struct IPerlDir* piPerl, char *filename)
1109 return win32_opendir(filename);
1113 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1115 return win32_readdir(dirp);
1119 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1121 win32_rewinddir(dirp);
1125 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1127 win32_seekdir(dirp, loc);
1131 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1133 return win32_telldir(dirp);
1137 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1139 return IPERL2HOST(piPerl)->MapPathA(path);
1143 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1145 return IPERL2HOST(piPerl)->MapPathW(path);
1148 struct IPerlDir perlDir =
1166 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1168 return win32_htonl(hostlong);
1172 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1174 return win32_htons(hostshort);
1178 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1180 return win32_ntohl(netlong);
1184 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1186 return win32_ntohs(netshort);
1189 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1191 return win32_accept(s, addr, addrlen);
1195 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1197 return win32_bind(s, name, namelen);
1201 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1203 return win32_connect(s, name, namelen);
1207 PerlSockEndhostent(struct IPerlSock* piPerl)
1213 PerlSockEndnetent(struct IPerlSock* piPerl)
1219 PerlSockEndprotoent(struct IPerlSock* piPerl)
1221 win32_endprotoent();
1225 PerlSockEndservent(struct IPerlSock* piPerl)
1231 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1233 return win32_gethostbyaddr(addr, len, type);
1237 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1239 return win32_gethostbyname(name);
1243 PerlSockGethostent(struct IPerlSock* piPerl)
1246 Perl_croak(aTHX_ "gethostent not implemented!\n");
1251 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1253 return win32_gethostname(name, namelen);
1257 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1259 return win32_getnetbyaddr(net, type);
1263 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1265 return win32_getnetbyname((char*)name);
1269 PerlSockGetnetent(struct IPerlSock* piPerl)
1271 return win32_getnetent();
1274 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1276 return win32_getpeername(s, name, namelen);
1280 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1282 return win32_getprotobyname(name);
1286 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1288 return win32_getprotobynumber(number);
1292 PerlSockGetprotoent(struct IPerlSock* piPerl)
1294 return win32_getprotoent();
1298 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1300 return win32_getservbyname(name, proto);
1304 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1306 return win32_getservbyport(port, proto);
1310 PerlSockGetservent(struct IPerlSock* piPerl)
1312 return win32_getservent();
1316 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1318 return win32_getsockname(s, name, namelen);
1322 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1324 return win32_getsockopt(s, level, optname, optval, optlen);
1328 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1330 return win32_inet_addr(cp);
1334 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1336 return win32_inet_ntoa(in);
1340 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1342 return win32_listen(s, backlog);
1346 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1348 return win32_recv(s, buffer, len, flags);
1352 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1354 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1358 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1360 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1364 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1366 return win32_send(s, buffer, len, flags);
1370 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1372 return win32_sendto(s, buffer, len, flags, to, tolen);
1376 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1378 win32_sethostent(stayopen);
1382 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1384 win32_setnetent(stayopen);
1388 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1390 win32_setprotoent(stayopen);
1394 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1396 win32_setservent(stayopen);
1400 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1402 return win32_setsockopt(s, level, optname, optval, optlen);
1406 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1408 return win32_shutdown(s, how);
1412 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1414 return win32_socket(af, type, protocol);
1418 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1421 Perl_croak(aTHX_ "socketpair not implemented!\n");
1426 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1428 return win32_closesocket(s);
1432 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1434 return win32_ioctlsocket(s, cmd, argp);
1437 struct IPerlSock perlSock =
1448 PerlSockEndprotoent,
1450 PerlSockGethostname,
1451 PerlSockGetpeername,
1452 PerlSockGethostbyaddr,
1453 PerlSockGethostbyname,
1455 PerlSockGetnetbyaddr,
1456 PerlSockGetnetbyname,
1458 PerlSockGetprotobyname,
1459 PerlSockGetprotobynumber,
1460 PerlSockGetprotoent,
1461 PerlSockGetservbyname,
1462 PerlSockGetservbyport,
1464 PerlSockGetsockname,
1476 PerlSockSetprotoent,
1482 PerlSockClosesocket,
1488 #define EXECF_EXEC 1
1489 #define EXECF_SPAWN 2
1492 PerlProcAbort(struct IPerlProc* piPerl)
1498 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1500 return win32_crypt(clear, salt);
1504 PerlProcExit(struct IPerlProc* piPerl, int status)
1510 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1516 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1518 return execl(cmdname, arg0, arg1, arg2, arg3);
1522 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1524 return win32_execvp(cmdname, argv);
1528 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1530 return win32_execvp(cmdname, argv);
1534 PerlProcGetuid(struct IPerlProc* piPerl)
1540 PerlProcGeteuid(struct IPerlProc* piPerl)
1546 PerlProcGetgid(struct IPerlProc* piPerl)
1552 PerlProcGetegid(struct IPerlProc* piPerl)
1558 PerlProcGetlogin(struct IPerlProc* piPerl)
1560 return g_getlogin();
1564 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1566 return win32_kill(pid, sig);
1570 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1573 Perl_croak(aTHX_ "killpg not implemented!\n");
1578 PerlProcPauseProc(struct IPerlProc* piPerl)
1580 return win32_sleep((32767L << 16) + 32767);
1584 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1587 PERL_FLUSHALL_FOR_CHILD;
1588 return (PerlIO*)win32_popen(command, mode);
1592 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1594 return win32_pclose((FILE*)stream);
1598 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1600 return win32_pipe(phandles, 512, O_BINARY);
1604 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1610 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1616 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1618 return win32_sleep(s);
1622 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1624 return win32_times(timebuf);
1628 PerlProcWait(struct IPerlProc* piPerl, int *status)
1630 return win32_wait(status);
1634 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1636 return win32_waitpid(pid, status, flags);
1640 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1646 static THREAD_RET_TYPE
1647 win32_start_child(LPVOID arg)
1649 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1653 CPerlObj *pPerl = (CPerlObj*)my_perl;
1655 #ifdef PERL_SYNC_FORK
1656 static long sync_fork_id = 0;
1657 long id = ++sync_fork_id;
1661 PERL_SET_THX(my_perl);
1663 /* set $$ to pseudo id */
1664 #ifdef PERL_SYNC_FORK
1667 w32_pseudo_id = GetCurrentThreadId();
1669 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
1670 sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
1671 hv_clear(PL_pidstatus);
1673 /* push a zero on the stack (we are the child) */
1681 /* continue from next op */
1682 PL_op = PL_op->op_next;
1686 volatile int oldscope = PL_scopestack_ix;
1689 JMPENV_PUSH(status);
1696 while (PL_scopestack_ix > oldscope)
1699 PL_curstash = PL_defstash;
1700 if (PL_endav && !PL_minus_c)
1701 call_list(oldscope, PL_endav);
1702 status = STATUS_NATIVE_EXPORT;
1706 POPSTACK_TO(PL_mainstack);
1707 PL_op = PL_restartop;
1708 PL_restartop = Nullop;
1711 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1718 /* XXX hack to avoid perl_destruct() freeing optree */
1719 PL_main_root = Nullop;
1722 /* close the std handles to avoid fd leaks */
1724 do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
1725 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE);
1726 do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE);
1729 /* destroy everything (waits for any pseudo-forked children) */
1730 perl_destruct(my_perl);
1733 #ifdef PERL_SYNC_FORK
1736 return (DWORD)status;
1739 #endif /* USE_ITHREADS */
1742 PerlProcFork(struct IPerlProc* piPerl)
1748 CPerlHost *h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1749 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHXo, 1,
1751 h->m_pHostperlMemShared,
1752 h->m_pHostperlMemParse,
1754 h->m_pHostperlStdIO,
1760 new_perl->Isys_intern.internal_host = h;
1761 # ifdef PERL_SYNC_FORK
1762 id = win32_start_child((LPVOID)new_perl);
1763 PERL_SET_THX(aTHXo);
1765 # ifdef USE_RTL_THREAD_API
1766 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1767 (void*)new_perl, 0, (unsigned*)&id);
1769 handle = CreateThread(NULL, 0, win32_start_child,
1770 (LPVOID)new_perl, 0, &id);
1772 PERL_SET_THX(aTHXo); /* XXX perl_clone*() set TLS */
1774 Perl_croak(aTHX_ "panic: pseudo fork() failed");
1775 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1776 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1777 ++w32_num_pseudo_children;
1781 Perl_croak(aTHX_ "fork() not implemented!\n");
1783 #endif /* USE_ITHREADS */
1787 PerlProcGetpid(struct IPerlProc* piPerl)
1789 return win32_getpid();
1793 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1795 return win32_dynaload(filename);
1799 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1801 win32_str_os_error(sv, dwErr);
1805 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1807 do_spawn2(cmd, EXECF_EXEC);
1812 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1814 return do_spawn2(cmds, EXECF_SPAWN);
1818 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1820 return win32_spawnvp(mode, cmdname, argv);
1824 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1826 return do_aspawn(vreally, vmark, vsp);
1829 struct IPerlProc perlProc =
1871 CPerlHost::CPerlHost(void)
1873 m_pvDir = new VDir();
1874 m_pVMem = new VMem();
1875 m_pVMemShared = new VMem();
1876 m_pVMemParse = new VMem();
1878 m_pvDir->Init(NULL, m_pVMem);
1881 m_lppEnvList = NULL;
1883 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1884 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1885 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1886 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1887 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1888 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1889 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1890 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1891 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1893 m_pHostperlMem = &m_hostperlMem;
1894 m_pHostperlMemShared = &m_hostperlMemShared;
1895 m_pHostperlMemParse = &m_hostperlMemParse;
1896 m_pHostperlEnv = &m_hostperlEnv;
1897 m_pHostperlStdIO = &m_hostperlStdIO;
1898 m_pHostperlLIO = &m_hostperlLIO;
1899 m_pHostperlDir = &m_hostperlDir;
1900 m_pHostperlSock = &m_hostperlSock;
1901 m_pHostperlProc = &m_hostperlProc;
1904 #define SETUPEXCHANGE(xptr, iptr, table) \
1915 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1916 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1917 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1918 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1919 struct IPerlProc** ppProc)
1921 m_pvDir = new VDir(0);
1922 m_pVMem = new VMem();
1923 m_pVMemShared = new VMem();
1924 m_pVMemParse = new VMem();
1926 m_pvDir->Init(NULL, m_pVMem);
1929 m_lppEnvList = NULL;
1931 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1932 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1933 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1934 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1935 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1936 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1937 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1938 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1939 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1941 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
1942 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
1943 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
1944 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
1945 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
1946 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
1947 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
1948 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
1949 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
1951 #undef SETUPEXCHANGE
1953 CPerlHost::CPerlHost(CPerlHost& host)
1955 m_pVMem = new VMem();
1956 m_pVMemShared = host.GetMemShared();
1957 m_pVMemParse = host.GetMemParse();
1959 /* duplicate directory info */
1960 m_pvDir = new VDir(0);
1961 m_pvDir->Init(host.GetDir(), m_pVMem);
1963 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1964 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1965 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1966 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1967 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1968 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1969 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1970 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1971 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 m_lppEnvList = NULL;
1985 /* duplicate environment info */
1988 while(lpPtr = host.GetIndex(dwIndex))
1992 CPerlHost::~CPerlHost(void)
1996 m_pVMemParse->Release();
1997 m_pVMemShared->Release();
2002 CPerlHost::Find(LPCSTR lpStr)
2005 LPSTR* lppPtr = Lookup(lpStr);
2006 if(lppPtr != NULL) {
2007 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2019 lookup(const void *arg1, const void *arg2)
2020 { // Compare strings
2024 ptr1 = *(char**)arg1;
2025 ptr2 = *(char**)arg2;
2029 if(c1 == '\0' || c1 == '=') {
2030 if(c2 == '\0' || c2 == '=')
2033 return -1; // string 1 < string 2
2035 else if(c2 == '\0' || c2 == '=')
2036 return 1; // string 1 > string 2
2042 return -1; // string 1 < string 2
2044 return 1; // string 1 > string 2
2052 CPerlHost::Lookup(LPCSTR lpStr)
2054 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2058 compare(const void *arg1, const void *arg2)
2059 { // Compare strings
2063 ptr1 = *(char**)arg1;
2064 ptr2 = *(char**)arg2;
2068 if(c1 == '\0' || c1 == '=') {
2072 return -1; // string 1 < string 2
2074 else if(c2 == '\0' || c2 == '=')
2075 return 1; // string 1 > string 2
2081 return -1; // string 1 < string 2
2083 return 1; // string 1 > string 2
2091 CPerlHost::Add(LPCSTR lpStr)
2094 char szBuffer[1024];
2096 int index, length = strlen(lpStr)+1;
2098 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2099 szBuffer[index] = lpStr[index];
2101 szBuffer[index] = '\0';
2104 lpPtr = Lookup(szBuffer);
2106 Renew(*lpPtr, length, char);
2107 strcpy(*lpPtr, lpStr);
2111 Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2112 New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2113 if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2114 strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2115 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2123 CPerlHost::CalculateEnvironmentSpace(void)
2127 for(index = 0; index < m_dwEnvCount; ++index)
2128 dwSize += strlen(m_lppEnvList[index]) + 1;
2134 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2141 CPerlHost::GetChildDir(void)
2146 New(0, ptr, MAX_PATH+1, char);
2148 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2149 length = strlen(ptr)-1;
2151 if((ptr[length] == '\\') || (ptr[length] == '/'))
2159 CPerlHost::FreeChildDir(char* pStr)
2166 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2169 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2170 DWORD dwSize, dwEnvIndex;
2171 int nLength, compVal;
2173 // get the process environment strings
2174 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2176 // step over current directory stuff
2177 while(*lpTmp == '=')
2178 lpTmp += strlen(lpTmp) + 1;
2180 // save the start of the environment strings
2182 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2183 // calculate the size of the environment strings
2184 dwSize += strlen(lpTmp) + 1;
2187 // add the size of current directories
2188 dwSize += vDir.CalculateEnvironmentSpace();
2190 // add the additional space used by changes made to the environment
2191 dwSize += CalculateEnvironmentSpace();
2193 New(1, lpStr, dwSize, char);
2196 // build the local environment
2197 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2200 lpLocalEnv = GetIndex(dwEnvIndex);
2201 while(*lpEnvPtr != '\0') {
2202 if(lpLocalEnv == NULL) {
2203 // all environment overrides have been added
2204 // so copy string into place
2205 strcpy(lpStr, lpEnvPtr);
2206 nLength = strlen(lpEnvPtr) + 1;
2208 lpEnvPtr += nLength;
2211 // determine which string to copy next
2212 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2214 strcpy(lpStr, lpEnvPtr);
2215 nLength = strlen(lpEnvPtr) + 1;
2217 lpEnvPtr += nLength;
2220 char *ptr = strchr(lpLocalEnv, '=');
2222 strcpy(lpStr, lpLocalEnv);
2223 lpStr += strlen(lpLocalEnv) + 1;
2225 lpLocalEnv = GetIndex(dwEnvIndex);
2227 // this string was replaced
2228 lpEnvPtr += strlen(lpEnvPtr) + 1;
2238 // release the process environment strings
2239 FreeEnvironmentStrings(lpAllocPtr);
2245 CPerlHost::Reset(void)
2248 if(m_lppEnvList != NULL) {
2249 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2250 Safefree(m_lppEnvList[index]);
2251 m_lppEnvList[index] = NULL;
2258 CPerlHost::Clearenv(void)
2261 LPSTR lpPtr, lpStr, lpEnvPtr;
2262 if(m_lppEnvList != NULL) {
2263 /* set every entry to an empty string */
2264 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2265 char* ptr = strchr(m_lppEnvList[index], '=');
2272 /* get the process environment strings */
2273 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2275 /* step over current directory stuff */
2276 while(*lpStr == '=')
2277 lpStr += strlen(lpStr) + 1;
2280 lpPtr = strchr(lpStr, '=');
2287 lpStr += strlen(lpStr) + 1;
2290 FreeEnvironmentStrings(lpEnvPtr);
2295 CPerlHost::Getenv(const char *varname)
2297 char* pEnv = Find(varname);
2299 pEnv = win32_getenv(varname);
2310 CPerlHost::Putenv(const char *envstring)
2317 CPerlHost::Chdir(const char *dirname)
2322 WCHAR wBuffer[MAX_PATH];
2323 A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2324 ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2327 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2334 #endif /* ___PerlHost_H___ */