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(char *pl);
21 extern char * g_win32_get_sitelib(char *pl);
22 extern char * g_getlogin(void);
23 extern int do_spawn2(char *cmd, int exectype);
24 #if !defined(PERL_OBJECT)
29 extern int g_do_aspawn(void *vreally, void **vmark, void **vsp);
30 #define do_aspawn g_do_aspawn
37 CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
38 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
39 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
40 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
41 struct IPerlProc** ppProc);
42 CPerlHost(CPerlHost& host);
45 static CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl);
46 static CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl);
47 static CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl);
48 static CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl);
49 static CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl);
50 static CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl);
51 static CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl);
52 static CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl);
53 static CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl);
55 BOOL PerlCreate(void);
56 int PerlParse(int argc, char** argv, char** env);
58 void PerlDestroy(void);
61 inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
62 inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
63 inline void Free(void* ptr) { m_pVMem->Free(ptr); };
64 inline void* Calloc(size_t num, size_t size)
66 size_t count = num*size;
67 void* lpVoid = Malloc(count);
69 ZeroMemory(lpVoid, count);
72 inline void GetLock(void) { m_pVMem->GetLock(); };
73 inline void FreeLock(void) { m_pVMem->FreeLock(); };
74 inline int IsLocked(void) { return m_pVMem->IsLocked(); };
77 inline void* MallocShared(size_t size)
79 return m_pVMemShared->Malloc(size);
81 inline void* ReallocShared(void* ptr, size_t size) { return m_pVMemShared->Realloc(ptr, size); };
82 inline void FreeShared(void* ptr) { m_pVMemShared->Free(ptr); };
83 inline void* CallocShared(size_t num, size_t size)
85 size_t count = num*size;
86 void* lpVoid = MallocShared(count);
88 ZeroMemory(lpVoid, count);
91 inline void GetLockShared(void) { m_pVMem->GetLock(); };
92 inline void FreeLockShared(void) { m_pVMem->FreeLock(); };
93 inline int IsLockedShared(void) { return m_pVMem->IsLocked(); };
96 inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
97 inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
98 inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
99 inline void* CallocParse(size_t num, size_t size)
101 size_t count = num*size;
102 void* lpVoid = MallocParse(count);
104 ZeroMemory(lpVoid, count);
107 inline void GetLockParse(void) { m_pVMem->GetLock(); };
108 inline void FreeLockParse(void) { m_pVMem->FreeLock(); };
109 inline int IsLockedParse(void) { return m_pVMem->IsLocked(); };
112 char *Getenv(const char *varname);
113 int Putenv(const char *envstring);
114 inline char *Getenv(const char *varname, unsigned long *len)
117 char *e = Getenv(varname);
122 void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
123 void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
124 char* GetChildDir(void);
125 void FreeChildDir(char* pStr);
129 inline LPSTR GetIndex(DWORD &dwIndex)
131 if(dwIndex < m_dwEnvCount)
134 return m_lppEnvList[dwIndex-1];
140 LPSTR Find(LPCSTR lpStr);
141 void Add(LPCSTR lpStr);
143 LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
144 void FreeLocalEnvironmentStrings(LPSTR lpStr);
145 LPSTR* Lookup(LPCSTR lpStr);
146 DWORD CalculateEnvironmentSpace(void);
151 virtual int Chdir(const char *dirname);
155 void Exit(int status);
156 void _Exit(int status);
157 int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
158 int Execv(const char *cmdname, const char *const *argv);
159 int Execvp(const char *cmdname, const char *const *argv);
161 inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
162 inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
163 inline VDir* GetDir(void) { return m_pvDir; };
167 struct IPerlMem m_hostperlMem;
168 struct IPerlMem m_hostperlMemShared;
169 struct IPerlMem m_hostperlMemParse;
170 struct IPerlEnv m_hostperlEnv;
171 struct IPerlStdIO m_hostperlStdIO;
172 struct IPerlLIO m_hostperlLIO;
173 struct IPerlDir m_hostperlDir;
174 struct IPerlSock m_hostperlSock;
175 struct IPerlProc m_hostperlProc;
177 struct IPerlMem* m_pHostperlMem;
178 struct IPerlMem* m_pHostperlMemShared;
179 struct IPerlMem* m_pHostperlMemParse;
180 struct IPerlEnv* m_pHostperlEnv;
181 struct IPerlStdIO* m_pHostperlStdIO;
182 struct IPerlLIO* m_pHostperlLIO;
183 struct IPerlDir* m_pHostperlDir;
184 struct IPerlSock* m_pHostperlSock;
185 struct IPerlProc* m_pHostperlProc;
187 inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
188 inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
201 #define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
203 inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
205 return STRUCT2PTR(piPerl, m_hostperlMem);
208 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
210 return STRUCT2PTR(piPerl, m_hostperlMemShared);
213 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
215 return STRUCT2PTR(piPerl, m_hostperlMemParse);
218 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
220 return STRUCT2PTR(piPerl, m_hostperlEnv);
223 inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
225 return STRUCT2PTR(piPerl, m_hostperlStdIO);
228 inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
230 return STRUCT2PTR(piPerl, m_hostperlLIO);
233 inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
235 return STRUCT2PTR(piPerl, m_hostperlDir);
238 inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
240 return STRUCT2PTR(piPerl, m_hostperlSock);
243 inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
245 return STRUCT2PTR(piPerl, m_hostperlProc);
251 #define IPERL2HOST(x) IPerlMem2Host(x)
255 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
257 return IPERL2HOST(piPerl)->Malloc(size);
260 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
262 return IPERL2HOST(piPerl)->Realloc(ptr, size);
265 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
267 IPERL2HOST(piPerl)->Free(ptr);
270 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
272 return IPERL2HOST(piPerl)->Calloc(num, size);
276 PerlMemGetLock(struct IPerlMem* piPerl)
278 IPERL2HOST(piPerl)->GetLock();
282 PerlMemFreeLock(struct IPerlMem* piPerl)
284 IPERL2HOST(piPerl)->FreeLock();
288 PerlMemIsLocked(struct IPerlMem* piPerl)
290 return IPERL2HOST(piPerl)->IsLocked();
293 struct IPerlMem perlMem =
305 #define IPERL2HOST(x) IPerlMemShared2Host(x)
309 PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
311 return IPERL2HOST(piPerl)->MallocShared(size);
314 PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
316 return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
319 PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
321 IPERL2HOST(piPerl)->FreeShared(ptr);
324 PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
326 return IPERL2HOST(piPerl)->CallocShared(num, size);
330 PerlMemSharedGetLock(struct IPerlMem* piPerl)
332 IPERL2HOST(piPerl)->GetLockShared();
336 PerlMemSharedFreeLock(struct IPerlMem* piPerl)
338 IPERL2HOST(piPerl)->FreeLockShared();
342 PerlMemSharedIsLocked(struct IPerlMem* piPerl)
344 return IPERL2HOST(piPerl)->IsLockedShared();
347 struct IPerlMem perlMemShared =
350 PerlMemSharedRealloc,
353 PerlMemSharedGetLock,
354 PerlMemSharedFreeLock,
355 PerlMemSharedIsLocked,
359 #define IPERL2HOST(x) IPerlMemParse2Host(x)
363 PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
365 return IPERL2HOST(piPerl)->MallocParse(size);
368 PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
370 return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
373 PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
375 IPERL2HOST(piPerl)->FreeParse(ptr);
378 PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
380 return IPERL2HOST(piPerl)->CallocParse(num, size);
384 PerlMemParseGetLock(struct IPerlMem* piPerl)
386 IPERL2HOST(piPerl)->GetLockParse();
390 PerlMemParseFreeLock(struct IPerlMem* piPerl)
392 IPERL2HOST(piPerl)->FreeLockParse();
396 PerlMemParseIsLocked(struct IPerlMem* piPerl)
398 return IPERL2HOST(piPerl)->IsLockedParse();
401 struct IPerlMem perlMemParse =
408 PerlMemParseFreeLock,
409 PerlMemParseIsLocked,
414 #define IPERL2HOST(x) IPerlEnv2Host(x)
418 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
420 return IPERL2HOST(piPerl)->Getenv(varname);
424 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
426 return IPERL2HOST(piPerl)->Putenv(envstring);
430 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
432 return IPERL2HOST(piPerl)->Getenv(varname, len);
436 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
438 return win32_uname(name);
442 PerlEnvClearenv(struct IPerlEnv* piPerl)
444 IPERL2HOST(piPerl)->Clearenv();
448 PerlEnvGetChildenv(struct IPerlEnv* piPerl)
450 return IPERL2HOST(piPerl)->CreateChildEnv();
454 PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
456 IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
460 PerlEnvGetChilddir(struct IPerlEnv* piPerl)
462 return IPERL2HOST(piPerl)->GetChildDir();
466 PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
468 IPERL2HOST(piPerl)->FreeChildDir(childDir);
472 PerlEnvOsId(struct IPerlEnv* piPerl)
474 return win32_os_id();
478 PerlEnvLibPath(struct IPerlEnv* piPerl, char *pl)
480 return g_win32_get_privlib(pl);
484 PerlEnvSiteLibPath(struct IPerlEnv* piPerl, char *pl)
486 return g_win32_get_sitelib(pl);
490 PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
492 win32_get_child_IO(ptr);
495 struct IPerlEnv perlEnv =
513 #define IPERL2HOST(x) IPerlStdIO2Host(x)
517 PerlStdIOStdin(struct IPerlStdIO* piPerl)
519 return (PerlIO*)win32_stdin();
523 PerlStdIOStdout(struct IPerlStdIO* piPerl)
525 return (PerlIO*)win32_stdout();
529 PerlStdIOStderr(struct IPerlStdIO* piPerl)
531 return (PerlIO*)win32_stderr();
535 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
537 return (PerlIO*)win32_fopen(path, mode);
541 PerlStdIOClose(struct IPerlStdIO* piPerl, PerlIO* pf)
543 return win32_fclose(((FILE*)pf));
547 PerlStdIOEof(struct IPerlStdIO* piPerl, PerlIO* pf)
549 return win32_feof((FILE*)pf);
553 PerlStdIOError(struct IPerlStdIO* piPerl, PerlIO* pf)
555 return win32_ferror((FILE*)pf);
559 PerlStdIOClearerr(struct IPerlStdIO* piPerl, PerlIO* pf)
561 win32_clearerr((FILE*)pf);
565 PerlStdIOGetc(struct IPerlStdIO* piPerl, PerlIO* pf)
567 return win32_getc((FILE*)pf);
571 PerlStdIOGetBase(struct IPerlStdIO* piPerl, PerlIO* pf)
582 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, PerlIO* pf)
586 return FILE_bufsiz(f);
593 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, PerlIO* pf)
604 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, PerlIO* pf)
615 PerlStdIOGets(struct IPerlStdIO* piPerl, PerlIO* pf, char* s, int n)
617 return win32_fgets(s, n, (FILE*)pf);
621 PerlStdIOPutc(struct IPerlStdIO* piPerl, PerlIO* pf, int c)
623 return win32_fputc(c, (FILE*)pf);
627 PerlStdIOPuts(struct IPerlStdIO* piPerl, PerlIO* pf, const char *s)
629 return win32_fputs(s, (FILE*)pf);
633 PerlStdIOFlush(struct IPerlStdIO* piPerl, PerlIO* pf)
635 return win32_fflush((FILE*)pf);
639 PerlStdIOUngetc(struct IPerlStdIO* piPerl, PerlIO* pf,int c)
641 return win32_ungetc(c, (FILE*)pf);
645 PerlStdIOFileno(struct IPerlStdIO* piPerl, PerlIO* pf)
647 return win32_fileno((FILE*)pf);
651 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
653 return (PerlIO*)win32_fdopen(fd, mode);
657 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, PerlIO* pf)
659 return (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
663 PerlStdIORead(struct IPerlStdIO* piPerl, PerlIO* pf, void *buffer, Size_t size)
665 return win32_fread(buffer, 1, size, (FILE*)pf);
669 PerlStdIOWrite(struct IPerlStdIO* piPerl, PerlIO* pf, const void *buffer, Size_t size)
671 return win32_fwrite(buffer, 1, size, (FILE*)pf);
675 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, PerlIO* pf, char* buffer)
677 win32_setbuf((FILE*)pf, buffer);
681 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, PerlIO* pf, char* buffer, int type, Size_t size)
683 return win32_setvbuf((FILE*)pf, buffer, type, size);
687 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, PerlIO* pf, int n)
689 #ifdef STDIO_CNT_LVALUE
696 PerlStdIOSetPtrCnt(struct IPerlStdIO* piPerl, PerlIO* pf, char * ptr, int n)
698 #ifdef STDIO_PTR_LVALUE
706 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, PerlIO* pf)
708 win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
712 PerlStdIOPrintf(struct IPerlStdIO* piPerl, PerlIO* pf, const char *format,...)
715 va_start(arglist, format);
716 return win32_vfprintf((FILE*)pf, format, arglist);
720 PerlStdIOVprintf(struct IPerlStdIO* piPerl, PerlIO* pf, const char *format, va_list arglist)
722 return win32_vfprintf((FILE*)pf, format, arglist);
726 PerlStdIOTell(struct IPerlStdIO* piPerl, PerlIO* pf)
728 return win32_ftell((FILE*)pf);
732 PerlStdIOSeek(struct IPerlStdIO* piPerl, PerlIO* pf, off_t offset, int origin)
734 return win32_fseek((FILE*)pf, offset, origin);
738 PerlStdIORewind(struct IPerlStdIO* piPerl, PerlIO* pf)
740 win32_rewind((FILE*)pf);
744 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
746 return (PerlIO*)win32_tmpfile();
750 PerlStdIOGetpos(struct IPerlStdIO* piPerl, PerlIO* pf, Fpos_t *p)
752 return win32_fgetpos((FILE*)pf, p);
756 PerlStdIOSetpos(struct IPerlStdIO* piPerl, PerlIO* pf, const Fpos_t *p)
758 return win32_fsetpos((FILE*)pf, p);
761 PerlStdIOInit(struct IPerlStdIO* piPerl)
766 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
768 Perl_init_os_extras();
772 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags)
774 return win32_open_osfhandle(osfhandle, flags);
778 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
780 return win32_get_osfhandle(filenum);
784 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, PerlIO* pf)
789 int fileno = win32_dup(win32_fileno((FILE*)pf));
791 /* open the file in the same mode */
793 if(((FILE*)pf)->flags & _F_READ) {
797 else if(((FILE*)pf)->flags & _F_WRIT) {
801 else if(((FILE*)pf)->flags & _F_RDWR) {
807 if(((FILE*)pf)->_flag & _IOREAD) {
811 else if(((FILE*)pf)->_flag & _IOWRT) {
815 else if(((FILE*)pf)->_flag & _IORW) {
822 /* it appears that the binmode is attached to the
823 * file descriptor so binmode files will be handled
826 pfdup = (PerlIO*)win32_fdopen(fileno, mode);
828 /* move the file pointer to the same position */
829 if (!fgetpos((FILE*)pf, &pos)) {
830 fsetpos((FILE*)pfdup, &pos);
835 struct IPerlStdIO perlStdIO =
874 PerlStdIOInitOSExtras,
880 #define IPERL2HOST(x) IPerlLIO2Host(x)
884 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
886 return win32_access(path, mode);
890 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
892 return win32_chmod(filename, pmode);
896 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
898 return chown(filename, owner, group);
902 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
904 return chsize(handle, size);
908 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
910 return win32_close(handle);
914 PerlLIODup(struct IPerlLIO* piPerl, int handle)
916 return win32_dup(handle);
920 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
922 return win32_dup2(handle1, handle2);
926 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
928 return win32_flock(fd, oper);
932 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
934 return fstat(handle, buffer);
938 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
940 return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
944 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
950 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
952 return win32_link(oldname, newname);
956 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
958 return win32_lseek(handle, offset, origin);
962 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
964 return win32_stat(path, buffer);
968 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
970 return mktemp(Template);
974 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
976 return win32_open(filename, oflag);
980 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
982 return win32_open(filename, oflag, pmode);
986 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
988 return win32_read(handle, buffer, count);
992 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
994 return win32_rename(OldFileName, newname);
998 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1000 return win32_setmode(handle, mode);
1004 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
1006 return win32_stat(path, buffer);
1010 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1012 return tmpnam(string);
1016 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1018 return umask(pmode);
1022 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1024 return win32_unlink(filename);
1028 PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
1030 return win32_utime(filename, times);
1034 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1036 return win32_write(handle, buffer, count);
1039 struct IPerlLIO perlLIO =
1071 #define IPERL2HOST(x) IPerlDir2Host(x)
1075 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1077 return win32_mkdir(dirname, mode);
1081 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1083 return IPERL2HOST(piPerl)->Chdir(dirname);
1087 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1089 return win32_rmdir(dirname);
1093 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1095 return win32_closedir(dirp);
1099 PerlDirOpen(struct IPerlDir* piPerl, char *filename)
1101 return win32_opendir(filename);
1105 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1107 return win32_readdir(dirp);
1111 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1113 win32_rewinddir(dirp);
1117 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1119 win32_seekdir(dirp, loc);
1123 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1125 return win32_telldir(dirp);
1129 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1131 return IPERL2HOST(piPerl)->MapPathA(path);
1135 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1137 return IPERL2HOST(piPerl)->MapPathW(path);
1140 struct IPerlDir perlDir =
1158 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1160 return win32_htonl(hostlong);
1164 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1166 return win32_htons(hostshort);
1170 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1172 return win32_ntohl(netlong);
1176 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1178 return win32_ntohs(netshort);
1181 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1183 return win32_accept(s, addr, addrlen);
1187 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1189 return win32_bind(s, name, namelen);
1193 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1195 return win32_connect(s, name, namelen);
1199 PerlSockEndhostent(struct IPerlSock* piPerl)
1205 PerlSockEndnetent(struct IPerlSock* piPerl)
1211 PerlSockEndprotoent(struct IPerlSock* piPerl)
1213 win32_endprotoent();
1217 PerlSockEndservent(struct IPerlSock* piPerl)
1223 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1225 return win32_gethostbyaddr(addr, len, type);
1229 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1231 return win32_gethostbyname(name);
1235 PerlSockGethostent(struct IPerlSock* piPerl)
1238 Perl_croak(aTHX_ "gethostent not implemented!\n");
1243 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1245 return win32_gethostname(name, namelen);
1249 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1251 return win32_getnetbyaddr(net, type);
1255 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1257 return win32_getnetbyname((char*)name);
1261 PerlSockGetnetent(struct IPerlSock* piPerl)
1263 return win32_getnetent();
1266 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1268 return win32_getpeername(s, name, namelen);
1272 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1274 return win32_getprotobyname(name);
1278 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1280 return win32_getprotobynumber(number);
1284 PerlSockGetprotoent(struct IPerlSock* piPerl)
1286 return win32_getprotoent();
1290 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1292 return win32_getservbyname(name, proto);
1296 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1298 return win32_getservbyport(port, proto);
1302 PerlSockGetservent(struct IPerlSock* piPerl)
1304 return win32_getservent();
1308 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1310 return win32_getsockname(s, name, namelen);
1314 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1316 return win32_getsockopt(s, level, optname, optval, optlen);
1320 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1322 return win32_inet_addr(cp);
1326 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1328 return win32_inet_ntoa(in);
1332 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1334 return win32_listen(s, backlog);
1338 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1340 return win32_recv(s, buffer, len, flags);
1344 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1346 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1350 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1352 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1356 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1358 return win32_send(s, buffer, len, flags);
1362 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1364 return win32_sendto(s, buffer, len, flags, to, tolen);
1368 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1370 win32_sethostent(stayopen);
1374 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1376 win32_setnetent(stayopen);
1380 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1382 win32_setprotoent(stayopen);
1386 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1388 win32_setservent(stayopen);
1392 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1394 return win32_setsockopt(s, level, optname, optval, optlen);
1398 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1400 return win32_shutdown(s, how);
1404 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1406 return win32_socket(af, type, protocol);
1410 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1413 Perl_croak(aTHX_ "socketpair not implemented!\n");
1418 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1420 return win32_closesocket(s);
1424 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1426 return win32_ioctlsocket(s, cmd, argp);
1429 struct IPerlSock perlSock =
1440 PerlSockEndprotoent,
1442 PerlSockGethostname,
1443 PerlSockGetpeername,
1444 PerlSockGethostbyaddr,
1445 PerlSockGethostbyname,
1447 PerlSockGetnetbyaddr,
1448 PerlSockGetnetbyname,
1450 PerlSockGetprotobyname,
1451 PerlSockGetprotobynumber,
1452 PerlSockGetprotoent,
1453 PerlSockGetservbyname,
1454 PerlSockGetservbyport,
1456 PerlSockGetsockname,
1468 PerlSockSetprotoent,
1474 PerlSockClosesocket,
1480 #define EXECF_EXEC 1
1481 #define EXECF_SPAWN 2
1484 PerlProcAbort(struct IPerlProc* piPerl)
1490 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1492 return win32_crypt(clear, salt);
1496 PerlProcExit(struct IPerlProc* piPerl, int status)
1502 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1508 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1510 return execl(cmdname, arg0, arg1, arg2, arg3);
1514 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1516 return win32_execvp(cmdname, argv);
1520 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1522 return win32_execvp(cmdname, argv);
1526 PerlProcGetuid(struct IPerlProc* piPerl)
1532 PerlProcGeteuid(struct IPerlProc* piPerl)
1538 PerlProcGetgid(struct IPerlProc* piPerl)
1544 PerlProcGetegid(struct IPerlProc* piPerl)
1550 PerlProcGetlogin(struct IPerlProc* piPerl)
1552 return g_getlogin();
1556 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1558 return win32_kill(pid, sig);
1562 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1565 Perl_croak(aTHX_ "killpg not implemented!\n");
1570 PerlProcPauseProc(struct IPerlProc* piPerl)
1572 return win32_sleep((32767L << 16) + 32767);
1576 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1579 PERL_FLUSHALL_FOR_CHILD;
1580 return (PerlIO*)win32_popen(command, mode);
1584 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1586 return win32_pclose((FILE*)stream);
1590 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1592 return win32_pipe(phandles, 512, O_BINARY);
1596 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1602 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1608 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1610 return win32_sleep(s);
1614 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1616 return win32_times(timebuf);
1620 PerlProcWait(struct IPerlProc* piPerl, int *status)
1622 return win32_wait(status);
1626 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1628 return win32_waitpid(pid, status, flags);
1632 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1638 static THREAD_RET_TYPE
1639 win32_start_child(LPVOID arg)
1641 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1645 CPerlObj *pPerl = (CPerlObj*)my_perl;
1647 #ifdef PERL_SYNC_FORK
1648 static long sync_fork_id = 0;
1649 long id = ++sync_fork_id;
1653 PERL_SET_THX(my_perl);
1655 /* set $$ to pseudo id */
1656 #ifdef PERL_SYNC_FORK
1659 w32_pseudo_id = GetCurrentThreadId();
1661 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
1662 sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
1663 hv_clear(PL_pidstatus);
1665 /* push a zero on the stack (we are the child) */
1673 /* continue from next op */
1674 PL_op = PL_op->op_next;
1678 volatile int oldscope = PL_scopestack_ix;
1681 JMPENV_PUSH(status);
1688 while (PL_scopestack_ix > oldscope)
1691 PL_curstash = PL_defstash;
1692 if (PL_endav && !PL_minus_c)
1693 call_list(oldscope, PL_endav);
1694 status = STATUS_NATIVE_EXPORT;
1698 POPSTACK_TO(PL_mainstack);
1699 PL_op = PL_restartop;
1700 PL_restartop = Nullop;
1703 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1710 /* XXX hack to avoid perl_destruct() freeing optree */
1711 PL_main_root = Nullop;
1714 /* destroy everything (waits for any pseudo-forked children) */
1715 perl_destruct(my_perl);
1718 #ifdef PERL_SYNC_FORK
1721 return (DWORD)status;
1724 #endif /* USE_ITHREADS */
1727 PerlProcFork(struct IPerlProc* piPerl)
1733 CPerlHost *h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1734 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHXo, 1,
1736 h->m_pHostperlMemShared,
1737 h->m_pHostperlMemParse,
1739 h->m_pHostperlStdIO,
1745 new_perl->Isys_intern.internal_host = h;
1746 # ifdef PERL_SYNC_FORK
1747 id = win32_start_child((LPVOID)new_perl);
1748 PERL_SET_THX(aTHXo);
1750 # ifdef USE_RTL_THREAD_API
1751 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1752 (void*)new_perl, 0, (unsigned*)&id);
1754 handle = CreateThread(NULL, 0, win32_start_child,
1755 (LPVOID)new_perl, 0, &id);
1757 PERL_SET_THX(aTHXo); /* XXX perl_clone*() set TLS */
1759 Perl_croak(aTHX_ "panic: pseudo fork() failed");
1760 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1761 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1762 ++w32_num_pseudo_children;
1766 Perl_croak(aTHX_ "fork() not implemented!\n");
1768 #endif /* USE_ITHREADS */
1772 PerlProcGetpid(struct IPerlProc* piPerl)
1774 return win32_getpid();
1778 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1780 return win32_dynaload(filename);
1784 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1786 win32_str_os_error(sv, dwErr);
1790 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1792 do_spawn2(cmd, EXECF_EXEC);
1797 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1799 return do_spawn2(cmds, EXECF_SPAWN);
1803 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1805 return win32_spawnvp(mode, cmdname, argv);
1809 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1811 return do_aspawn(vreally, vmark, vsp);
1814 struct IPerlProc perlProc =
1856 CPerlHost::CPerlHost(void)
1858 m_pvDir = new VDir();
1859 m_pVMem = new VMem();
1860 m_pVMemShared = new VMem();
1861 m_pVMemParse = new VMem();
1863 m_pvDir->Init(NULL, m_pVMem);
1866 m_lppEnvList = NULL;
1868 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1869 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1870 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1871 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1872 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1873 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1874 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1875 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1876 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1878 m_pHostperlMem = &m_hostperlMem;
1879 m_pHostperlMemShared = &m_hostperlMemShared;
1880 m_pHostperlMemParse = &m_hostperlMemParse;
1881 m_pHostperlEnv = &m_hostperlEnv;
1882 m_pHostperlStdIO = &m_hostperlStdIO;
1883 m_pHostperlLIO = &m_hostperlLIO;
1884 m_pHostperlDir = &m_hostperlDir;
1885 m_pHostperlSock = &m_hostperlSock;
1886 m_pHostperlProc = &m_hostperlProc;
1889 #define SETUPEXCHANGE(xptr, iptr, table) \
1900 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1901 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1902 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1903 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1904 struct IPerlProc** ppProc)
1906 m_pvDir = new VDir(0);
1907 m_pVMem = new VMem();
1908 m_pVMemShared = new VMem();
1909 m_pVMemParse = new VMem();
1911 m_pvDir->Init(NULL, m_pVMem);
1914 m_lppEnvList = NULL;
1916 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1917 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1918 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1919 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1920 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1921 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1922 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1923 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1924 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1926 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
1927 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
1928 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
1929 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
1930 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
1931 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
1932 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
1933 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
1934 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
1936 #undef SETUPEXCHANGE
1938 CPerlHost::CPerlHost(CPerlHost& host)
1940 m_pVMem = new VMem();
1941 m_pVMemShared = host.GetMemShared();
1942 m_pVMemParse = host.GetMemParse();
1944 /* duplicate directory info */
1945 m_pvDir = new VDir(0);
1946 m_pvDir->Init(host.GetDir(), m_pVMem);
1948 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1949 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1950 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1951 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1952 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1953 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1954 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1955 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1956 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1957 m_pHostperlMem = &m_hostperlMem;
1958 m_pHostperlMemShared = &m_hostperlMemShared;
1959 m_pHostperlMemParse = &m_hostperlMemParse;
1960 m_pHostperlEnv = &m_hostperlEnv;
1961 m_pHostperlStdIO = &m_hostperlStdIO;
1962 m_pHostperlLIO = &m_hostperlLIO;
1963 m_pHostperlDir = &m_hostperlDir;
1964 m_pHostperlSock = &m_hostperlSock;
1965 m_pHostperlProc = &m_hostperlProc;
1968 m_lppEnvList = NULL;
1970 /* duplicate environment info */
1973 while(lpPtr = host.GetIndex(dwIndex))
1977 CPerlHost::~CPerlHost(void)
1981 m_pVMemParse->Release();
1982 m_pVMemShared->Release();
1987 CPerlHost::Find(LPCSTR lpStr)
1990 LPSTR* lppPtr = Lookup(lpStr);
1991 if(lppPtr != NULL) {
1992 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2004 lookup(const void *arg1, const void *arg2)
2005 { // Compare strings
2009 ptr1 = *(char**)arg1;
2010 ptr2 = *(char**)arg2;
2014 if(c1 == '\0' || c1 == '=') {
2015 if(c2 == '\0' || c2 == '=')
2018 return -1; // string 1 < string 2
2020 else if(c2 == '\0' || c2 == '=')
2021 return 1; // string 1 > string 2
2027 return -1; // string 1 < string 2
2029 return 1; // string 1 > string 2
2037 CPerlHost::Lookup(LPCSTR lpStr)
2039 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2043 compare(const void *arg1, const void *arg2)
2044 { // Compare strings
2048 ptr1 = *(char**)arg1;
2049 ptr2 = *(char**)arg2;
2053 if(c1 == '\0' || c1 == '=') {
2057 return -1; // string 1 < string 2
2059 else if(c2 == '\0' || c2 == '=')
2060 return 1; // string 1 > string 2
2066 return -1; // string 1 < string 2
2068 return 1; // string 1 > string 2
2076 CPerlHost::Add(LPCSTR lpStr)
2079 char szBuffer[1024];
2081 int index, length = strlen(lpStr)+1;
2083 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2084 szBuffer[index] = lpStr[index];
2086 szBuffer[index] = '\0';
2089 lpPtr = Lookup(szBuffer);
2091 Renew(*lpPtr, length, char);
2092 strcpy(*lpPtr, lpStr);
2096 Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2097 New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2098 if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2099 strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2100 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2108 CPerlHost::CalculateEnvironmentSpace(void)
2112 for(index = 0; index < m_dwEnvCount; ++index)
2113 dwSize += strlen(m_lppEnvList[index]) + 1;
2119 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2126 CPerlHost::GetChildDir(void)
2131 New(0, ptr, MAX_PATH+1, char);
2133 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2134 length = strlen(ptr)-1;
2136 if((ptr[length] == '\\') || (ptr[length] == '/'))
2144 CPerlHost::FreeChildDir(char* pStr)
2151 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2154 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2155 DWORD dwSize, dwEnvIndex;
2156 int nLength, compVal;
2158 // get the process environment strings
2159 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2161 // step over current directory stuff
2162 while(*lpTmp == '=')
2163 lpTmp += strlen(lpTmp) + 1;
2165 // save the start of the environment strings
2167 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2168 // calculate the size of the environment strings
2169 dwSize += strlen(lpTmp) + 1;
2172 // add the size of current directories
2173 dwSize += vDir.CalculateEnvironmentSpace();
2175 // add the additional space used by changes made to the environment
2176 dwSize += CalculateEnvironmentSpace();
2178 New(1, lpStr, dwSize, char);
2181 // build the local environment
2182 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2185 lpLocalEnv = GetIndex(dwEnvIndex);
2186 while(*lpEnvPtr != '\0') {
2187 if(lpLocalEnv == NULL) {
2188 // all environment overrides have been added
2189 // so copy string into place
2190 strcpy(lpStr, lpEnvPtr);
2191 nLength = strlen(lpEnvPtr) + 1;
2193 lpEnvPtr += nLength;
2196 // determine which string to copy next
2197 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2199 strcpy(lpStr, lpEnvPtr);
2200 nLength = strlen(lpEnvPtr) + 1;
2202 lpEnvPtr += nLength;
2205 char *ptr = strchr(lpLocalEnv, '=');
2207 strcpy(lpStr, lpLocalEnv);
2208 lpStr += strlen(lpLocalEnv) + 1;
2210 lpLocalEnv = GetIndex(dwEnvIndex);
2212 // this string was replaced
2213 lpEnvPtr += strlen(lpEnvPtr) + 1;
2223 // release the process environment strings
2224 FreeEnvironmentStrings(lpAllocPtr);
2230 CPerlHost::Reset(void)
2233 if(m_lppEnvList != NULL) {
2234 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2235 Safefree(m_lppEnvList[index]);
2236 m_lppEnvList[index] = NULL;
2243 CPerlHost::Clearenv(void)
2246 LPSTR lpPtr, lpStr, lpEnvPtr;
2247 if(m_lppEnvList != NULL) {
2248 /* set every entry to an empty string */
2249 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2250 char* ptr = strchr(m_lppEnvList[index], '=');
2257 /* get the process environment strings */
2258 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2260 /* step over current directory stuff */
2261 while(*lpStr == '=')
2262 lpStr += strlen(lpStr) + 1;
2265 lpPtr = strchr(lpStr, '=');
2272 lpStr += strlen(lpStr) + 1;
2275 FreeEnvironmentStrings(lpEnvPtr);
2280 CPerlHost::Getenv(const char *varname)
2282 char* pEnv = Find(varname);
2284 pEnv = win32_getenv(varname);
2295 CPerlHost::Putenv(const char *envstring)
2302 CPerlHost::Chdir(const char *dirname)
2307 WCHAR wBuffer[MAX_PATH];
2308 A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2309 ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2312 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2319 #endif /* ___PerlHost_H___ */