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___
18 #if !defined(PERL_OBJECT)
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);
26 #if !defined(PERL_OBJECT)
31 extern int g_do_aspawn(void *vreally, void **vmark, void **vsp);
32 #define do_aspawn g_do_aspawn
40 CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
41 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
42 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
43 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
44 struct IPerlProc** ppProc);
45 CPerlHost(CPerlHost& host);
48 static CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl);
49 static CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl);
50 static CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl);
51 static CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl);
52 static CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl);
53 static CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl);
54 static CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl);
55 static CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl);
56 static CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl);
58 BOOL PerlCreate(void);
59 int PerlParse(int argc, char** argv, char** env);
61 void PerlDestroy(void);
64 inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
65 inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
66 inline void Free(void* ptr) { m_pVMem->Free(ptr); };
67 inline void* Calloc(size_t num, size_t size)
69 size_t count = num*size;
70 void* lpVoid = Malloc(count);
72 ZeroMemory(lpVoid, count);
75 inline void GetLock(void) { m_pVMem->GetLock(); };
76 inline void FreeLock(void) { m_pVMem->FreeLock(); };
77 inline int IsLocked(void) { return m_pVMem->IsLocked(); };
80 inline void* MallocShared(size_t size)
82 return m_pVMemShared->Malloc(size);
84 inline void* ReallocShared(void* ptr, size_t size) { return m_pVMemShared->Realloc(ptr, size); };
85 inline void FreeShared(void* ptr) { m_pVMemShared->Free(ptr); };
86 inline void* CallocShared(size_t num, size_t size)
88 size_t count = num*size;
89 void* lpVoid = MallocShared(count);
91 ZeroMemory(lpVoid, count);
94 inline void GetLockShared(void) { m_pVMem->GetLock(); };
95 inline void FreeLockShared(void) { m_pVMem->FreeLock(); };
96 inline int IsLockedShared(void) { return m_pVMem->IsLocked(); };
99 inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
100 inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
101 inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
102 inline void* CallocParse(size_t num, size_t size)
104 size_t count = num*size;
105 void* lpVoid = MallocParse(count);
107 ZeroMemory(lpVoid, count);
110 inline void GetLockParse(void) { m_pVMem->GetLock(); };
111 inline void FreeLockParse(void) { m_pVMem->FreeLock(); };
112 inline int IsLockedParse(void) { return m_pVMem->IsLocked(); };
115 char *Getenv(const char *varname);
116 int Putenv(const char *envstring);
117 inline char *Getenv(const char *varname, unsigned long *len)
120 char *e = Getenv(varname);
125 void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
126 void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
127 char* GetChildDir(void);
128 void FreeChildDir(char* pStr);
132 inline LPSTR GetIndex(DWORD &dwIndex)
134 if(dwIndex < m_dwEnvCount)
137 return m_lppEnvList[dwIndex-1];
143 LPSTR Find(LPCSTR lpStr);
144 void Add(LPCSTR lpStr);
146 LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
147 void FreeLocalEnvironmentStrings(LPSTR lpStr);
148 LPSTR* Lookup(LPCSTR lpStr);
149 DWORD CalculateEnvironmentSpace(void);
154 virtual int Chdir(const char *dirname);
158 void Exit(int status);
159 void _Exit(int status);
160 int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
161 int Execv(const char *cmdname, const char *const *argv);
162 int Execvp(const char *cmdname, const char *const *argv);
164 inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
165 inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
166 inline VDir* GetDir(void) { return m_pvDir; };
170 struct IPerlMem m_hostperlMem;
171 struct IPerlMem m_hostperlMemShared;
172 struct IPerlMem m_hostperlMemParse;
173 struct IPerlEnv m_hostperlEnv;
174 struct IPerlStdIO m_hostperlStdIO;
175 struct IPerlLIO m_hostperlLIO;
176 struct IPerlDir m_hostperlDir;
177 struct IPerlSock m_hostperlSock;
178 struct IPerlProc m_hostperlProc;
180 struct IPerlMem* m_pHostperlMem;
181 struct IPerlMem* m_pHostperlMemShared;
182 struct IPerlMem* m_pHostperlMemParse;
183 struct IPerlEnv* m_pHostperlEnv;
184 struct IPerlStdIO* m_pHostperlStdIO;
185 struct IPerlLIO* m_pHostperlLIO;
186 struct IPerlDir* m_pHostperlDir;
187 struct IPerlSock* m_pHostperlSock;
188 struct IPerlProc* m_pHostperlProc;
190 inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
191 inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
201 static long num_hosts;
203 inline int LastHost(void) { return num_hosts == 1L; };
206 long CPerlHost::num_hosts = 0L;
209 #define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
211 inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
213 return STRUCT2PTR(piPerl, m_hostperlMem);
216 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
218 return STRUCT2PTR(piPerl, m_hostperlMemShared);
221 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
223 return STRUCT2PTR(piPerl, m_hostperlMemParse);
226 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
228 return STRUCT2PTR(piPerl, m_hostperlEnv);
231 inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
233 return STRUCT2PTR(piPerl, m_hostperlStdIO);
236 inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
238 return STRUCT2PTR(piPerl, m_hostperlLIO);
241 inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
243 return STRUCT2PTR(piPerl, m_hostperlDir);
246 inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
248 return STRUCT2PTR(piPerl, m_hostperlSock);
251 inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
253 return STRUCT2PTR(piPerl, m_hostperlProc);
259 #define IPERL2HOST(x) IPerlMem2Host(x)
263 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
265 return IPERL2HOST(piPerl)->Malloc(size);
268 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
270 return IPERL2HOST(piPerl)->Realloc(ptr, size);
273 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
275 IPERL2HOST(piPerl)->Free(ptr);
278 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
280 return IPERL2HOST(piPerl)->Calloc(num, size);
284 PerlMemGetLock(struct IPerlMem* piPerl)
286 IPERL2HOST(piPerl)->GetLock();
290 PerlMemFreeLock(struct IPerlMem* piPerl)
292 IPERL2HOST(piPerl)->FreeLock();
296 PerlMemIsLocked(struct IPerlMem* piPerl)
298 return IPERL2HOST(piPerl)->IsLocked();
301 struct IPerlMem perlMem =
313 #define IPERL2HOST(x) IPerlMemShared2Host(x)
317 PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
319 return IPERL2HOST(piPerl)->MallocShared(size);
322 PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
324 return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
327 PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
329 IPERL2HOST(piPerl)->FreeShared(ptr);
332 PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
334 return IPERL2HOST(piPerl)->CallocShared(num, size);
338 PerlMemSharedGetLock(struct IPerlMem* piPerl)
340 IPERL2HOST(piPerl)->GetLockShared();
344 PerlMemSharedFreeLock(struct IPerlMem* piPerl)
346 IPERL2HOST(piPerl)->FreeLockShared();
350 PerlMemSharedIsLocked(struct IPerlMem* piPerl)
352 return IPERL2HOST(piPerl)->IsLockedShared();
355 struct IPerlMem perlMemShared =
358 PerlMemSharedRealloc,
361 PerlMemSharedGetLock,
362 PerlMemSharedFreeLock,
363 PerlMemSharedIsLocked,
367 #define IPERL2HOST(x) IPerlMemParse2Host(x)
371 PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
373 return IPERL2HOST(piPerl)->MallocParse(size);
376 PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
378 return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
381 PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
383 IPERL2HOST(piPerl)->FreeParse(ptr);
386 PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
388 return IPERL2HOST(piPerl)->CallocParse(num, size);
392 PerlMemParseGetLock(struct IPerlMem* piPerl)
394 IPERL2HOST(piPerl)->GetLockParse();
398 PerlMemParseFreeLock(struct IPerlMem* piPerl)
400 IPERL2HOST(piPerl)->FreeLockParse();
404 PerlMemParseIsLocked(struct IPerlMem* piPerl)
406 return IPERL2HOST(piPerl)->IsLockedParse();
409 struct IPerlMem perlMemParse =
416 PerlMemParseFreeLock,
417 PerlMemParseIsLocked,
422 #define IPERL2HOST(x) IPerlEnv2Host(x)
426 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
428 return IPERL2HOST(piPerl)->Getenv(varname);
432 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
434 return IPERL2HOST(piPerl)->Putenv(envstring);
438 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
440 return IPERL2HOST(piPerl)->Getenv(varname, len);
444 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
446 return win32_uname(name);
450 PerlEnvClearenv(struct IPerlEnv* piPerl)
452 IPERL2HOST(piPerl)->Clearenv();
456 PerlEnvGetChildenv(struct IPerlEnv* piPerl)
458 return IPERL2HOST(piPerl)->CreateChildEnv();
462 PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
464 IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
468 PerlEnvGetChilddir(struct IPerlEnv* piPerl)
470 return IPERL2HOST(piPerl)->GetChildDir();
474 PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
476 IPERL2HOST(piPerl)->FreeChildDir(childDir);
480 PerlEnvOsId(struct IPerlEnv* piPerl)
482 return win32_os_id();
486 PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
488 return g_win32_get_privlib(pl);
492 PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
494 return g_win32_get_sitelib(pl);
498 PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
500 return g_win32_get_vendorlib(pl);
504 PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
506 win32_get_child_IO(ptr);
509 struct IPerlEnv perlEnv =
523 PerlEnvVendorLibPath,
528 #define IPERL2HOST(x) IPerlStdIO2Host(x)
532 PerlStdIOStdin(struct IPerlStdIO* piPerl)
534 return win32_stdin();
538 PerlStdIOStdout(struct IPerlStdIO* piPerl)
540 return win32_stdout();
544 PerlStdIOStderr(struct IPerlStdIO* piPerl)
546 return win32_stderr();
550 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
552 return win32_fopen(path, mode);
556 PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf)
558 return win32_fclose((pf));
562 PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf)
564 return win32_feof(pf);
568 PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf)
570 return win32_ferror(pf);
574 PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf)
580 PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf)
582 return win32_getc(pf);
586 PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf)
597 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf)
601 return FILE_bufsiz(f);
608 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf)
619 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
630 PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n)
632 return win32_fgets(s, n, pf);
636 PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c)
638 return win32_fputc(c, pf);
642 PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s)
644 return win32_fputs(s, pf);
648 PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf)
650 return win32_fflush(pf);
654 PerlStdIOUngetc(struct IPerlStdIO* piPerl,int c, FILE* pf)
656 return win32_ungetc(c, pf);
660 PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf)
662 return win32_fileno(pf);
666 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
668 return win32_fdopen(fd, mode);
672 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf)
674 return win32_freopen(path, mode, (FILE*)pf);
678 PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf)
680 return win32_fread(buffer, size, count, pf);
684 PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf)
686 return win32_fwrite(buffer, size, count, pf);
690 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer)
692 win32_setbuf(pf, buffer);
696 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size)
698 return win32_setvbuf(pf, buffer, type, size);
702 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n)
704 #ifdef STDIO_CNT_LVALUE
711 PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr)
713 #ifdef STDIO_PTR_LVALUE
720 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf)
722 win32_setvbuf(pf, NULL, _IOLBF, 0);
726 PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...)
729 va_start(arglist, format);
730 return win32_vfprintf(pf, format, arglist);
734 PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist)
736 return win32_vfprintf(pf, format, arglist);
740 PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf)
742 return win32_ftell(pf);
746 PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, off_t offset, int origin)
748 return win32_fseek(pf, offset, origin);
752 PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf)
758 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
760 return win32_tmpfile();
764 PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p)
766 return win32_fgetpos(pf, p);
770 PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p)
772 return win32_fsetpos(pf, p);
775 PerlStdIOInit(struct IPerlStdIO* piPerl)
780 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
782 Perl_init_os_extras();
786 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags)
788 return win32_open_osfhandle(osfhandle, flags);
792 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
794 return win32_get_osfhandle(filenum);
798 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
803 int fileno = win32_dup(win32_fileno(pf));
805 /* open the file in the same mode */
807 if((pf)->flags & _F_READ) {
811 else if((pf)->flags & _F_WRIT) {
815 else if((pf)->flags & _F_RDWR) {
821 if((pf)->_flag & _IOREAD) {
825 else if((pf)->_flag & _IOWRT) {
829 else if((pf)->_flag & _IORW) {
836 /* it appears that the binmode is attached to the
837 * file descriptor so binmode files will be handled
840 pfdup = win32_fdopen(fileno, mode);
842 /* move the file pointer to the same position */
843 if (!fgetpos(pf, &pos)) {
844 fsetpos(pfdup, &pos);
849 struct IPerlStdIO perlStdIO =
888 PerlStdIOInitOSExtras,
894 #define IPERL2HOST(x) IPerlLIO2Host(x)
898 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
900 return win32_access(path, mode);
904 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
906 return win32_chmod(filename, pmode);
910 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
912 return chown(filename, owner, group);
916 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
918 return chsize(handle, size);
922 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
924 return win32_close(handle);
928 PerlLIODup(struct IPerlLIO* piPerl, int handle)
930 return win32_dup(handle);
934 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
936 return win32_dup2(handle1, handle2);
940 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
942 return win32_flock(fd, oper);
946 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
948 return win32_fstat(handle, buffer);
952 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
954 return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
958 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
964 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
966 return win32_link(oldname, newname);
970 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
972 return win32_lseek(handle, offset, origin);
976 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
978 return win32_stat(path, buffer);
982 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
984 return mktemp(Template);
988 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
990 return win32_open(filename, oflag);
994 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
996 return win32_open(filename, oflag, pmode);
1000 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
1002 return win32_read(handle, buffer, count);
1006 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
1008 return win32_rename(OldFileName, newname);
1012 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1014 return win32_setmode(handle, mode);
1018 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
1020 return win32_stat(path, buffer);
1024 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1026 return tmpnam(string);
1030 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1032 return umask(pmode);
1036 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1038 return win32_unlink(filename);
1042 PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
1044 return win32_utime(filename, times);
1048 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1050 return win32_write(handle, buffer, count);
1053 struct IPerlLIO perlLIO =
1085 #define IPERL2HOST(x) IPerlDir2Host(x)
1089 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1091 return win32_mkdir(dirname, mode);
1095 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1097 return IPERL2HOST(piPerl)->Chdir(dirname);
1101 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1103 return win32_rmdir(dirname);
1107 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1109 return win32_closedir(dirp);
1113 PerlDirOpen(struct IPerlDir* piPerl, char *filename)
1115 return win32_opendir(filename);
1119 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1121 return win32_readdir(dirp);
1125 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1127 win32_rewinddir(dirp);
1131 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1133 win32_seekdir(dirp, loc);
1137 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1139 return win32_telldir(dirp);
1143 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1145 return IPERL2HOST(piPerl)->MapPathA(path);
1149 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1151 return IPERL2HOST(piPerl)->MapPathW(path);
1154 struct IPerlDir perlDir =
1172 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1174 return win32_htonl(hostlong);
1178 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1180 return win32_htons(hostshort);
1184 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1186 return win32_ntohl(netlong);
1190 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1192 return win32_ntohs(netshort);
1195 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1197 return win32_accept(s, addr, addrlen);
1201 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1203 return win32_bind(s, name, namelen);
1207 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1209 return win32_connect(s, name, namelen);
1213 PerlSockEndhostent(struct IPerlSock* piPerl)
1219 PerlSockEndnetent(struct IPerlSock* piPerl)
1225 PerlSockEndprotoent(struct IPerlSock* piPerl)
1227 win32_endprotoent();
1231 PerlSockEndservent(struct IPerlSock* piPerl)
1237 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1239 return win32_gethostbyaddr(addr, len, type);
1243 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1245 return win32_gethostbyname(name);
1249 PerlSockGethostent(struct IPerlSock* piPerl)
1252 Perl_croak(aTHX_ "gethostent not implemented!\n");
1257 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1259 return win32_gethostname(name, namelen);
1263 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1265 return win32_getnetbyaddr(net, type);
1269 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1271 return win32_getnetbyname((char*)name);
1275 PerlSockGetnetent(struct IPerlSock* piPerl)
1277 return win32_getnetent();
1280 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1282 return win32_getpeername(s, name, namelen);
1286 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1288 return win32_getprotobyname(name);
1292 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1294 return win32_getprotobynumber(number);
1298 PerlSockGetprotoent(struct IPerlSock* piPerl)
1300 return win32_getprotoent();
1304 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1306 return win32_getservbyname(name, proto);
1310 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1312 return win32_getservbyport(port, proto);
1316 PerlSockGetservent(struct IPerlSock* piPerl)
1318 return win32_getservent();
1322 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1324 return win32_getsockname(s, name, namelen);
1328 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1330 return win32_getsockopt(s, level, optname, optval, optlen);
1334 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1336 return win32_inet_addr(cp);
1340 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1342 return win32_inet_ntoa(in);
1346 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1348 return win32_listen(s, backlog);
1352 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1354 return win32_recv(s, buffer, len, flags);
1358 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1360 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1364 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1366 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1370 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1372 return win32_send(s, buffer, len, flags);
1376 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1378 return win32_sendto(s, buffer, len, flags, to, tolen);
1382 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1384 win32_sethostent(stayopen);
1388 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1390 win32_setnetent(stayopen);
1394 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1396 win32_setprotoent(stayopen);
1400 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1402 win32_setservent(stayopen);
1406 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1408 return win32_setsockopt(s, level, optname, optval, optlen);
1412 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1414 return win32_shutdown(s, how);
1418 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1420 return win32_socket(af, type, protocol);
1424 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1427 Perl_croak(aTHX_ "socketpair not implemented!\n");
1432 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1434 return win32_closesocket(s);
1438 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1440 return win32_ioctlsocket(s, cmd, argp);
1443 struct IPerlSock perlSock =
1454 PerlSockEndprotoent,
1456 PerlSockGethostname,
1457 PerlSockGetpeername,
1458 PerlSockGethostbyaddr,
1459 PerlSockGethostbyname,
1461 PerlSockGetnetbyaddr,
1462 PerlSockGetnetbyname,
1464 PerlSockGetprotobyname,
1465 PerlSockGetprotobynumber,
1466 PerlSockGetprotoent,
1467 PerlSockGetservbyname,
1468 PerlSockGetservbyport,
1470 PerlSockGetsockname,
1482 PerlSockSetprotoent,
1488 PerlSockClosesocket,
1494 #define EXECF_EXEC 1
1495 #define EXECF_SPAWN 2
1498 PerlProcAbort(struct IPerlProc* piPerl)
1504 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1506 return win32_crypt(clear, salt);
1510 PerlProcExit(struct IPerlProc* piPerl, int status)
1516 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1522 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1524 return execl(cmdname, arg0, arg1, arg2, arg3);
1528 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1530 return win32_execvp(cmdname, argv);
1534 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1536 return win32_execvp(cmdname, argv);
1540 PerlProcGetuid(struct IPerlProc* piPerl)
1546 PerlProcGeteuid(struct IPerlProc* piPerl)
1552 PerlProcGetgid(struct IPerlProc* piPerl)
1558 PerlProcGetegid(struct IPerlProc* piPerl)
1564 PerlProcGetlogin(struct IPerlProc* piPerl)
1566 return g_getlogin();
1570 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1572 return win32_kill(pid, sig);
1576 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1579 Perl_croak(aTHX_ "killpg not implemented!\n");
1584 PerlProcPauseProc(struct IPerlProc* piPerl)
1586 return win32_sleep((32767L << 16) + 32767);
1590 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1593 PERL_FLUSHALL_FOR_CHILD;
1594 return win32_popen(command, mode);
1598 PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
1601 PERL_FLUSHALL_FOR_CHILD;
1602 return win32_popenlist(mode, narg, args);
1606 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1608 return win32_pclose(stream);
1612 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1614 return win32_pipe(phandles, 512, O_BINARY);
1618 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1624 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1630 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1632 return win32_sleep(s);
1636 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1638 return win32_times(timebuf);
1642 PerlProcWait(struct IPerlProc* piPerl, int *status)
1644 return win32_wait(status);
1648 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1650 return win32_waitpid(pid, status, flags);
1654 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1656 return signal(sig, subcode);
1660 static THREAD_RET_TYPE
1661 win32_start_child(LPVOID arg)
1663 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1667 CPerlObj *pPerl = (CPerlObj*)my_perl;
1669 #ifdef PERL_SYNC_FORK
1670 static long sync_fork_id = 0;
1671 long id = ++sync_fork_id;
1675 PERL_SET_THX(my_perl);
1677 /* set $$ to pseudo id */
1678 #ifdef PERL_SYNC_FORK
1681 w32_pseudo_id = GetCurrentThreadId();
1683 int pid = (int)w32_pseudo_id;
1685 w32_pseudo_id = -pid;
1688 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
1689 sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
1690 hv_clear(PL_pidstatus);
1692 /* push a zero on the stack (we are the child) */
1700 /* continue from next op */
1701 PL_op = PL_op->op_next;
1705 volatile int oldscope = PL_scopestack_ix;
1708 JMPENV_PUSH(status);
1715 while (PL_scopestack_ix > oldscope)
1718 PL_curstash = PL_defstash;
1719 if (PL_endav && !PL_minus_c)
1720 call_list(oldscope, PL_endav);
1721 status = STATUS_NATIVE_EXPORT;
1725 POPSTACK_TO(PL_mainstack);
1726 PL_op = PL_restartop;
1727 PL_restartop = Nullop;
1730 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1737 /* XXX hack to avoid perl_destruct() freeing optree */
1738 PL_main_root = Nullop;
1741 /* close the std handles to avoid fd leaks */
1743 do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
1744 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE);
1745 do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE);
1748 /* destroy everything (waits for any pseudo-forked children) */
1749 perl_destruct(my_perl);
1752 #ifdef PERL_SYNC_FORK
1755 return (DWORD)status;
1758 #endif /* USE_ITHREADS */
1761 PerlProcFork(struct IPerlProc* piPerl)
1769 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1773 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1774 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHXo, 1,
1776 h->m_pHostperlMemShared,
1777 h->m_pHostperlMemParse,
1779 h->m_pHostperlStdIO,
1785 new_perl->Isys_intern.internal_host = h;
1786 # ifdef PERL_SYNC_FORK
1787 id = win32_start_child((LPVOID)new_perl);
1788 PERL_SET_THX(aTHXo);
1790 # ifdef USE_RTL_THREAD_API
1791 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1792 (void*)new_perl, 0, (unsigned*)&id);
1794 handle = CreateThread(NULL, 0, win32_start_child,
1795 (LPVOID)new_perl, 0, &id);
1797 PERL_SET_THX(aTHXo); /* XXX perl_clone*() set TLS */
1807 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1808 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1809 ++w32_num_pseudo_children;
1813 Perl_croak(aTHX_ "fork() not implemented!\n");
1815 #endif /* USE_ITHREADS */
1819 PerlProcGetpid(struct IPerlProc* piPerl)
1821 return win32_getpid();
1825 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1827 return win32_dynaload(filename);
1831 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1833 win32_str_os_error(sv, dwErr);
1837 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1839 do_spawn2(cmd, EXECF_EXEC);
1844 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1846 return do_spawn2(cmds, EXECF_SPAWN);
1850 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1852 return win32_spawnvp(mode, cmdname, argv);
1856 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1858 return do_aspawn(vreally, vmark, vsp);
1862 PerlProcLastHost(struct IPerlProc* piPerl)
1865 CPerlHost *h = (CPerlHost*)w32_internal_host;
1866 return h->LastHost();
1869 struct IPerlProc perlProc =
1913 CPerlHost::CPerlHost(void)
1915 /* Construct a host from scratch */
1916 InterlockedIncrement(&num_hosts);
1917 m_pvDir = new VDir();
1918 m_pVMem = new VMem();
1919 m_pVMemShared = new VMem();
1920 m_pVMemParse = new VMem();
1922 m_pvDir->Init(NULL, m_pVMem);
1925 m_lppEnvList = NULL;
1927 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1928 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1929 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1930 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1931 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1932 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1933 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1934 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1935 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1937 m_pHostperlMem = &m_hostperlMem;
1938 m_pHostperlMemShared = &m_hostperlMemShared;
1939 m_pHostperlMemParse = &m_hostperlMemParse;
1940 m_pHostperlEnv = &m_hostperlEnv;
1941 m_pHostperlStdIO = &m_hostperlStdIO;
1942 m_pHostperlLIO = &m_hostperlLIO;
1943 m_pHostperlDir = &m_hostperlDir;
1944 m_pHostperlSock = &m_hostperlSock;
1945 m_pHostperlProc = &m_hostperlProc;
1948 #define SETUPEXCHANGE(xptr, iptr, table) \
1959 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1960 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1961 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1962 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1963 struct IPerlProc** ppProc)
1965 InterlockedIncrement(&num_hosts);
1966 m_pvDir = new VDir(0);
1967 m_pVMem = new VMem();
1968 m_pVMemShared = new VMem();
1969 m_pVMemParse = new VMem();
1971 m_pvDir->Init(NULL, m_pVMem);
1974 m_lppEnvList = NULL;
1976 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1977 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1978 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1979 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1980 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1981 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1982 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1983 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1984 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1986 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
1987 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
1988 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
1989 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
1990 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
1991 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
1992 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
1993 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
1994 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
1996 #undef SETUPEXCHANGE
1998 CPerlHost::CPerlHost(CPerlHost& host)
2000 /* Construct a host from another host */
2001 InterlockedIncrement(&num_hosts);
2002 m_pVMem = new VMem();
2003 m_pVMemShared = host.GetMemShared();
2004 m_pVMemParse = host.GetMemParse();
2006 /* duplicate directory info */
2007 m_pvDir = new VDir(0);
2008 m_pvDir->Init(host.GetDir(), m_pVMem);
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));
2019 m_pHostperlMem = &m_hostperlMem;
2020 m_pHostperlMemShared = &m_hostperlMemShared;
2021 m_pHostperlMemParse = &m_hostperlMemParse;
2022 m_pHostperlEnv = &m_hostperlEnv;
2023 m_pHostperlStdIO = &m_hostperlStdIO;
2024 m_pHostperlLIO = &m_hostperlLIO;
2025 m_pHostperlDir = &m_hostperlDir;
2026 m_pHostperlSock = &m_hostperlSock;
2027 m_pHostperlProc = &m_hostperlProc;
2030 m_lppEnvList = NULL;
2032 /* duplicate environment info */
2035 while(lpPtr = host.GetIndex(dwIndex))
2039 CPerlHost::~CPerlHost(void)
2042 InterlockedDecrement(&num_hosts);
2044 m_pVMemParse->Release();
2045 m_pVMemShared->Release();
2050 CPerlHost::Find(LPCSTR lpStr)
2053 LPSTR* lppPtr = Lookup(lpStr);
2054 if(lppPtr != NULL) {
2055 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2067 lookup(const void *arg1, const void *arg2)
2068 { // Compare strings
2072 ptr1 = *(char**)arg1;
2073 ptr2 = *(char**)arg2;
2077 if(c1 == '\0' || c1 == '=') {
2078 if(c2 == '\0' || c2 == '=')
2081 return -1; // string 1 < string 2
2083 else if(c2 == '\0' || c2 == '=')
2084 return 1; // string 1 > string 2
2090 return -1; // string 1 < string 2
2092 return 1; // string 1 > string 2
2100 CPerlHost::Lookup(LPCSTR lpStr)
2102 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2106 compare(const void *arg1, const void *arg2)
2107 { // Compare strings
2111 ptr1 = *(char**)arg1;
2112 ptr2 = *(char**)arg2;
2116 if(c1 == '\0' || c1 == '=') {
2120 return -1; // string 1 < string 2
2122 else if(c2 == '\0' || c2 == '=')
2123 return 1; // string 1 > string 2
2129 return -1; // string 1 < string 2
2131 return 1; // string 1 > string 2
2139 CPerlHost::Add(LPCSTR lpStr)
2142 char szBuffer[1024];
2144 int index, length = strlen(lpStr)+1;
2146 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2147 szBuffer[index] = lpStr[index];
2149 szBuffer[index] = '\0';
2152 lpPtr = Lookup(szBuffer);
2154 Renew(*lpPtr, length, char);
2155 strcpy(*lpPtr, lpStr);
2159 Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2160 New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2161 if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2162 strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2163 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2171 CPerlHost::CalculateEnvironmentSpace(void)
2175 for(index = 0; index < m_dwEnvCount; ++index)
2176 dwSize += strlen(m_lppEnvList[index]) + 1;
2182 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2189 CPerlHost::GetChildDir(void)
2194 New(0, ptr, MAX_PATH+1, char);
2196 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2197 length = strlen(ptr);
2199 if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2207 CPerlHost::FreeChildDir(char* pStr)
2214 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2217 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2218 DWORD dwSize, dwEnvIndex;
2219 int nLength, compVal;
2221 // get the process environment strings
2222 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2224 // step over current directory stuff
2225 while(*lpTmp == '=')
2226 lpTmp += strlen(lpTmp) + 1;
2228 // save the start of the environment strings
2230 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2231 // calculate the size of the environment strings
2232 dwSize += strlen(lpTmp) + 1;
2235 // add the size of current directories
2236 dwSize += vDir.CalculateEnvironmentSpace();
2238 // add the additional space used by changes made to the environment
2239 dwSize += CalculateEnvironmentSpace();
2241 New(1, lpStr, dwSize, char);
2244 // build the local environment
2245 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2248 lpLocalEnv = GetIndex(dwEnvIndex);
2249 while(*lpEnvPtr != '\0') {
2251 // all environment overrides have been added
2252 // so copy string into place
2253 strcpy(lpStr, lpEnvPtr);
2254 nLength = strlen(lpEnvPtr) + 1;
2256 lpEnvPtr += nLength;
2259 // determine which string to copy next
2260 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2262 strcpy(lpStr, lpEnvPtr);
2263 nLength = strlen(lpEnvPtr) + 1;
2265 lpEnvPtr += nLength;
2268 char *ptr = strchr(lpLocalEnv, '=');
2270 strcpy(lpStr, lpLocalEnv);
2271 lpStr += strlen(lpLocalEnv) + 1;
2273 lpLocalEnv = GetIndex(dwEnvIndex);
2275 // this string was replaced
2276 lpEnvPtr += strlen(lpEnvPtr) + 1;
2283 // still have environment overrides to add
2284 // so copy the strings into place
2285 strcpy(lpStr, lpLocalEnv);
2286 nLength = strlen(lpLocalEnv) + 1;
2288 lpEnvPtr += nLength;
2289 lpLocalEnv = GetIndex(dwEnvIndex);
2296 // release the process environment strings
2297 FreeEnvironmentStrings(lpAllocPtr);
2303 CPerlHost::Reset(void)
2306 if(m_lppEnvList != NULL) {
2307 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2308 Safefree(m_lppEnvList[index]);
2309 m_lppEnvList[index] = NULL;
2316 CPerlHost::Clearenv(void)
2320 LPSTR lpPtr, lpStr, lpEnvPtr;
2321 if (m_lppEnvList != NULL) {
2322 /* set every entry to an empty string */
2323 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2324 char* ptr = strchr(m_lppEnvList[index], '=');
2331 /* get the process environment strings */
2332 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2334 /* step over current directory stuff */
2335 while(*lpStr == '=')
2336 lpStr += strlen(lpStr) + 1;
2339 lpPtr = strchr(lpStr, '=');
2345 (void)win32_putenv(lpStr);
2348 lpStr += strlen(lpStr) + 1;
2351 FreeEnvironmentStrings(lpEnvPtr);
2356 CPerlHost::Getenv(const char *varname)
2359 if (w32_pseudo_id) {
2360 char *pEnv = Find(varname);
2364 return win32_getenv(varname);
2368 CPerlHost::Putenv(const char *envstring)
2373 return win32_putenv(envstring);
2379 CPerlHost::Chdir(const char *dirname)
2384 WCHAR wBuffer[MAX_PATH];
2385 A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2386 ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2389 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2396 #endif /* ___PerlHost_H___ */