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___
19 extern char * g_win32_get_privlib(const char *pl);
20 extern char * g_win32_get_sitelib(const char *pl);
21 extern char * g_win32_get_vendorlib(const char *pl);
22 extern char * g_getlogin(void);
23 extern int do_spawn2(char *cmd, int exectype);
31 CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
32 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
33 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
34 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
35 struct IPerlProc** ppProc);
36 CPerlHost(CPerlHost& host);
39 static CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl);
40 static CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl);
41 static CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl);
42 static CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl);
43 static CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl);
44 static CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl);
45 static CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl);
46 static CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl);
47 static CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl);
49 BOOL PerlCreate(void);
50 int PerlParse(int argc, char** argv, char** env);
52 void PerlDestroy(void);
55 /* Locks provided but should be unnecessary as this is private pool */
56 inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
57 inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
58 inline void Free(void* ptr) { m_pVMem->Free(ptr); };
59 inline void* Calloc(size_t num, size_t size)
61 size_t count = num*size;
62 void* lpVoid = Malloc(count);
64 ZeroMemory(lpVoid, count);
67 inline void GetLock(void) { m_pVMem->GetLock(); };
68 inline void FreeLock(void) { m_pVMem->FreeLock(); };
69 inline int IsLocked(void) { return m_pVMem->IsLocked(); };
72 /* Locks used to serialize access to the pool */
73 inline void GetLockShared(void) { m_pVMemShared->GetLock(); };
74 inline void FreeLockShared(void) { m_pVMemShared->FreeLock(); };
75 inline int IsLockedShared(void) { return m_pVMemShared->IsLocked(); };
76 inline void* MallocShared(size_t size)
80 result = m_pVMemShared->Malloc(size);
84 inline void* ReallocShared(void* ptr, size_t size)
88 result = m_pVMemShared->Realloc(ptr, size);
92 inline void FreeShared(void* ptr)
95 m_pVMemShared->Free(ptr);
98 inline void* CallocShared(size_t num, size_t size)
100 size_t count = num*size;
101 void* lpVoid = MallocShared(count);
103 ZeroMemory(lpVoid, count);
108 /* Assume something else is using locks to mangaging serialize
111 inline void GetLockParse(void) { m_pVMemParse->GetLock(); };
112 inline void FreeLockParse(void) { m_pVMemParse->FreeLock(); };
113 inline int IsLockedParse(void) { return m_pVMemParse->IsLocked(); };
114 inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
115 inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
116 inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
117 inline void* CallocParse(size_t num, size_t size)
119 size_t count = num*size;
120 void* lpVoid = MallocParse(count);
122 ZeroMemory(lpVoid, count);
127 char *Getenv(const char *varname);
128 int Putenv(const char *envstring);
129 inline char *Getenv(const char *varname, unsigned long *len)
132 char *e = Getenv(varname);
137 void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
138 void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
139 char* GetChildDir(void);
140 void FreeChildDir(char* pStr);
144 inline LPSTR GetIndex(DWORD &dwIndex)
146 if(dwIndex < m_dwEnvCount)
149 return m_lppEnvList[dwIndex-1];
155 LPSTR Find(LPCSTR lpStr);
156 void Add(LPCSTR lpStr);
158 LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
159 void FreeLocalEnvironmentStrings(LPSTR lpStr);
160 LPSTR* Lookup(LPCSTR lpStr);
161 DWORD CalculateEnvironmentSpace(void);
166 virtual int Chdir(const char *dirname);
170 void Exit(int status);
171 void _Exit(int status);
172 int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
173 int Execv(const char *cmdname, const char *const *argv);
174 int Execvp(const char *cmdname, const char *const *argv);
176 inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
177 inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
178 inline VDir* GetDir(void) { return m_pvDir; };
182 struct IPerlMem m_hostperlMem;
183 struct IPerlMem m_hostperlMemShared;
184 struct IPerlMem m_hostperlMemParse;
185 struct IPerlEnv m_hostperlEnv;
186 struct IPerlStdIO m_hostperlStdIO;
187 struct IPerlLIO m_hostperlLIO;
188 struct IPerlDir m_hostperlDir;
189 struct IPerlSock m_hostperlSock;
190 struct IPerlProc m_hostperlProc;
192 struct IPerlMem* m_pHostperlMem;
193 struct IPerlMem* m_pHostperlMemShared;
194 struct IPerlMem* m_pHostperlMemParse;
195 struct IPerlEnv* m_pHostperlEnv;
196 struct IPerlStdIO* m_pHostperlStdIO;
197 struct IPerlLIO* m_pHostperlLIO;
198 struct IPerlDir* m_pHostperlDir;
199 struct IPerlSock* m_pHostperlSock;
200 struct IPerlProc* m_pHostperlProc;
202 inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
203 inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
213 static long num_hosts;
215 inline int LastHost(void) { return num_hosts == 1L; };
218 long CPerlHost::num_hosts = 0L;
221 #define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
223 inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
225 return STRUCT2PTR(piPerl, m_hostperlMem);
228 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
230 return STRUCT2PTR(piPerl, m_hostperlMemShared);
233 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
235 return STRUCT2PTR(piPerl, m_hostperlMemParse);
238 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
240 return STRUCT2PTR(piPerl, m_hostperlEnv);
243 inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
245 return STRUCT2PTR(piPerl, m_hostperlStdIO);
248 inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
250 return STRUCT2PTR(piPerl, m_hostperlLIO);
253 inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
255 return STRUCT2PTR(piPerl, m_hostperlDir);
258 inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
260 return STRUCT2PTR(piPerl, m_hostperlSock);
263 inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
265 return STRUCT2PTR(piPerl, m_hostperlProc);
271 #define IPERL2HOST(x) IPerlMem2Host(x)
275 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
277 return IPERL2HOST(piPerl)->Malloc(size);
280 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
282 return IPERL2HOST(piPerl)->Realloc(ptr, size);
285 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
287 IPERL2HOST(piPerl)->Free(ptr);
290 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
292 return IPERL2HOST(piPerl)->Calloc(num, size);
296 PerlMemGetLock(struct IPerlMem* piPerl)
298 IPERL2HOST(piPerl)->GetLock();
302 PerlMemFreeLock(struct IPerlMem* piPerl)
304 IPERL2HOST(piPerl)->FreeLock();
308 PerlMemIsLocked(struct IPerlMem* piPerl)
310 return IPERL2HOST(piPerl)->IsLocked();
313 struct IPerlMem perlMem =
325 #define IPERL2HOST(x) IPerlMemShared2Host(x)
329 PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
331 return IPERL2HOST(piPerl)->MallocShared(size);
334 PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
336 return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
339 PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
341 IPERL2HOST(piPerl)->FreeShared(ptr);
344 PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
346 return IPERL2HOST(piPerl)->CallocShared(num, size);
350 PerlMemSharedGetLock(struct IPerlMem* piPerl)
352 IPERL2HOST(piPerl)->GetLockShared();
356 PerlMemSharedFreeLock(struct IPerlMem* piPerl)
358 IPERL2HOST(piPerl)->FreeLockShared();
362 PerlMemSharedIsLocked(struct IPerlMem* piPerl)
364 return IPERL2HOST(piPerl)->IsLockedShared();
367 struct IPerlMem perlMemShared =
370 PerlMemSharedRealloc,
373 PerlMemSharedGetLock,
374 PerlMemSharedFreeLock,
375 PerlMemSharedIsLocked,
379 #define IPERL2HOST(x) IPerlMemParse2Host(x)
383 PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
385 return IPERL2HOST(piPerl)->MallocParse(size);
388 PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
390 return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
393 PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
395 IPERL2HOST(piPerl)->FreeParse(ptr);
398 PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
400 return IPERL2HOST(piPerl)->CallocParse(num, size);
404 PerlMemParseGetLock(struct IPerlMem* piPerl)
406 IPERL2HOST(piPerl)->GetLockParse();
410 PerlMemParseFreeLock(struct IPerlMem* piPerl)
412 IPERL2HOST(piPerl)->FreeLockParse();
416 PerlMemParseIsLocked(struct IPerlMem* piPerl)
418 return IPERL2HOST(piPerl)->IsLockedParse();
421 struct IPerlMem perlMemParse =
428 PerlMemParseFreeLock,
429 PerlMemParseIsLocked,
434 #define IPERL2HOST(x) IPerlEnv2Host(x)
438 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
440 return IPERL2HOST(piPerl)->Getenv(varname);
444 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
446 return IPERL2HOST(piPerl)->Putenv(envstring);
450 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
452 return IPERL2HOST(piPerl)->Getenv(varname, len);
456 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
458 return win32_uname(name);
462 PerlEnvClearenv(struct IPerlEnv* piPerl)
464 IPERL2HOST(piPerl)->Clearenv();
468 PerlEnvGetChildenv(struct IPerlEnv* piPerl)
470 return IPERL2HOST(piPerl)->CreateChildEnv();
474 PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
476 IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
480 PerlEnvGetChilddir(struct IPerlEnv* piPerl)
482 return IPERL2HOST(piPerl)->GetChildDir();
486 PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
488 IPERL2HOST(piPerl)->FreeChildDir(childDir);
492 PerlEnvOsId(struct IPerlEnv* piPerl)
494 return win32_os_id();
498 PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
500 return g_win32_get_privlib(pl);
504 PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
506 return g_win32_get_sitelib(pl);
510 PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
512 return g_win32_get_vendorlib(pl);
516 PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
518 win32_get_child_IO(ptr);
521 struct IPerlEnv perlEnv =
535 PerlEnvVendorLibPath,
540 #define IPERL2HOST(x) IPerlStdIO2Host(x)
544 PerlStdIOStdin(struct IPerlStdIO* piPerl)
546 return win32_stdin();
550 PerlStdIOStdout(struct IPerlStdIO* piPerl)
552 return win32_stdout();
556 PerlStdIOStderr(struct IPerlStdIO* piPerl)
558 return win32_stderr();
562 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
564 return win32_fopen(path, mode);
568 PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf)
570 return win32_fclose((pf));
574 PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf)
576 return win32_feof(pf);
580 PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf)
582 return win32_ferror(pf);
586 PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf)
592 PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf)
594 return win32_getc(pf);
598 PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf)
609 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf)
613 return FILE_bufsiz(f);
620 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf)
631 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
642 PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n)
644 return win32_fgets(s, n, pf);
648 PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c)
650 return win32_fputc(c, pf);
654 PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s)
656 return win32_fputs(s, pf);
660 PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf)
662 return win32_fflush(pf);
666 PerlStdIOUngetc(struct IPerlStdIO* piPerl,int c, FILE* pf)
668 return win32_ungetc(c, pf);
672 PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf)
674 return win32_fileno(pf);
678 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
680 return win32_fdopen(fd, mode);
684 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf)
686 return win32_freopen(path, mode, (FILE*)pf);
690 PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf)
692 return win32_fread(buffer, size, count, pf);
696 PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf)
698 return win32_fwrite(buffer, size, count, pf);
702 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer)
704 win32_setbuf(pf, buffer);
708 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size)
710 return win32_setvbuf(pf, buffer, type, size);
714 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n)
716 #ifdef STDIO_CNT_LVALUE
723 PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr)
725 #ifdef STDIO_PTR_LVALUE
732 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf)
734 win32_setvbuf(pf, NULL, _IOLBF, 0);
738 PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...)
741 va_start(arglist, format);
742 return win32_vfprintf(pf, format, arglist);
746 PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist)
748 return win32_vfprintf(pf, format, arglist);
752 PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf)
754 return win32_ftell(pf);
758 PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, off_t offset, int origin)
760 return win32_fseek(pf, offset, origin);
764 PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf)
770 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
772 return win32_tmpfile();
776 PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p)
778 return win32_fgetpos(pf, p);
782 PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p)
784 return win32_fsetpos(pf, p);
787 PerlStdIOInit(struct IPerlStdIO* piPerl)
792 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
794 Perl_init_os_extras();
798 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags)
800 return win32_open_osfhandle(osfhandle, flags);
804 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
806 return win32_get_osfhandle(filenum);
810 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
815 int fileno = win32_dup(win32_fileno(pf));
817 /* open the file in the same mode */
819 if((pf)->flags & _F_READ) {
823 else if((pf)->flags & _F_WRIT) {
827 else if((pf)->flags & _F_RDWR) {
833 if((pf)->_flag & _IOREAD) {
837 else if((pf)->_flag & _IOWRT) {
841 else if((pf)->_flag & _IORW) {
848 /* it appears that the binmode is attached to the
849 * file descriptor so binmode files will be handled
852 pfdup = win32_fdopen(fileno, mode);
854 /* move the file pointer to the same position */
855 if (!fgetpos(pf, &pos)) {
856 fsetpos(pfdup, &pos);
861 struct IPerlStdIO perlStdIO =
900 PerlStdIOInitOSExtras,
906 #define IPERL2HOST(x) IPerlLIO2Host(x)
910 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
912 return win32_access(path, mode);
916 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
918 return win32_chmod(filename, pmode);
922 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
924 return chown(filename, owner, group);
928 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
930 return chsize(handle, size);
934 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
936 return win32_close(handle);
940 PerlLIODup(struct IPerlLIO* piPerl, int handle)
942 return win32_dup(handle);
946 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
948 return win32_dup2(handle1, handle2);
952 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
954 return win32_flock(fd, oper);
958 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
960 return win32_fstat(handle, buffer);
964 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
966 return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
970 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
976 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
978 return win32_link(oldname, newname);
982 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
984 return win32_lseek(handle, offset, origin);
988 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
990 return win32_stat(path, buffer);
994 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
996 return mktemp(Template);
1000 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
1002 return win32_open(filename, oflag);
1006 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
1008 return win32_open(filename, oflag, pmode);
1012 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
1014 return win32_read(handle, buffer, count);
1018 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
1020 return win32_rename(OldFileName, newname);
1024 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1026 return win32_setmode(handle, mode);
1030 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
1032 return win32_stat(path, buffer);
1036 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1038 return tmpnam(string);
1042 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1044 return umask(pmode);
1048 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1050 return win32_unlink(filename);
1054 PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
1056 return win32_utime(filename, times);
1060 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1062 return win32_write(handle, buffer, count);
1065 struct IPerlLIO perlLIO =
1097 #define IPERL2HOST(x) IPerlDir2Host(x)
1101 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1103 return win32_mkdir(dirname, mode);
1107 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1109 return IPERL2HOST(piPerl)->Chdir(dirname);
1113 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1115 return win32_rmdir(dirname);
1119 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1121 return win32_closedir(dirp);
1125 PerlDirOpen(struct IPerlDir* piPerl, char *filename)
1127 return win32_opendir(filename);
1131 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1133 return win32_readdir(dirp);
1137 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1139 win32_rewinddir(dirp);
1143 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1145 win32_seekdir(dirp, loc);
1149 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1151 return win32_telldir(dirp);
1155 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1157 return IPERL2HOST(piPerl)->MapPathA(path);
1161 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1163 return IPERL2HOST(piPerl)->MapPathW(path);
1166 struct IPerlDir perlDir =
1184 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1186 return win32_htonl(hostlong);
1190 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1192 return win32_htons(hostshort);
1196 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1198 return win32_ntohl(netlong);
1202 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1204 return win32_ntohs(netshort);
1207 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1209 return win32_accept(s, addr, addrlen);
1213 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1215 return win32_bind(s, name, namelen);
1219 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1221 return win32_connect(s, name, namelen);
1225 PerlSockEndhostent(struct IPerlSock* piPerl)
1231 PerlSockEndnetent(struct IPerlSock* piPerl)
1237 PerlSockEndprotoent(struct IPerlSock* piPerl)
1239 win32_endprotoent();
1243 PerlSockEndservent(struct IPerlSock* piPerl)
1249 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1251 return win32_gethostbyaddr(addr, len, type);
1255 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1257 return win32_gethostbyname(name);
1261 PerlSockGethostent(struct IPerlSock* piPerl)
1264 Perl_croak(aTHX_ "gethostent not implemented!\n");
1269 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1271 return win32_gethostname(name, namelen);
1275 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1277 return win32_getnetbyaddr(net, type);
1281 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1283 return win32_getnetbyname((char*)name);
1287 PerlSockGetnetent(struct IPerlSock* piPerl)
1289 return win32_getnetent();
1292 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1294 return win32_getpeername(s, name, namelen);
1298 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1300 return win32_getprotobyname(name);
1304 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1306 return win32_getprotobynumber(number);
1310 PerlSockGetprotoent(struct IPerlSock* piPerl)
1312 return win32_getprotoent();
1316 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1318 return win32_getservbyname(name, proto);
1322 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1324 return win32_getservbyport(port, proto);
1328 PerlSockGetservent(struct IPerlSock* piPerl)
1330 return win32_getservent();
1334 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1336 return win32_getsockname(s, name, namelen);
1340 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1342 return win32_getsockopt(s, level, optname, optval, optlen);
1346 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1348 return win32_inet_addr(cp);
1352 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1354 return win32_inet_ntoa(in);
1358 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1360 return win32_listen(s, backlog);
1364 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1366 return win32_recv(s, buffer, len, flags);
1370 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1372 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1376 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1378 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1382 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1384 return win32_send(s, buffer, len, flags);
1388 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1390 return win32_sendto(s, buffer, len, flags, to, tolen);
1394 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1396 win32_sethostent(stayopen);
1400 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1402 win32_setnetent(stayopen);
1406 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1408 win32_setprotoent(stayopen);
1412 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1414 win32_setservent(stayopen);
1418 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1420 return win32_setsockopt(s, level, optname, optval, optlen);
1424 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1426 return win32_shutdown(s, how);
1430 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1432 return win32_socket(af, type, protocol);
1436 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1439 Perl_croak(aTHX_ "socketpair not implemented!\n");
1444 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1446 return win32_closesocket(s);
1450 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1452 return win32_ioctlsocket(s, cmd, argp);
1455 struct IPerlSock perlSock =
1466 PerlSockEndprotoent,
1468 PerlSockGethostname,
1469 PerlSockGetpeername,
1470 PerlSockGethostbyaddr,
1471 PerlSockGethostbyname,
1473 PerlSockGetnetbyaddr,
1474 PerlSockGetnetbyname,
1476 PerlSockGetprotobyname,
1477 PerlSockGetprotobynumber,
1478 PerlSockGetprotoent,
1479 PerlSockGetservbyname,
1480 PerlSockGetservbyport,
1482 PerlSockGetsockname,
1494 PerlSockSetprotoent,
1500 PerlSockClosesocket,
1506 #define EXECF_EXEC 1
1507 #define EXECF_SPAWN 2
1510 PerlProcAbort(struct IPerlProc* piPerl)
1516 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1518 return win32_crypt(clear, salt);
1522 PerlProcExit(struct IPerlProc* piPerl, int status)
1528 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1534 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1536 return execl(cmdname, arg0, arg1, arg2, arg3);
1540 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1542 return win32_execvp(cmdname, argv);
1546 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1548 return win32_execvp(cmdname, argv);
1552 PerlProcGetuid(struct IPerlProc* piPerl)
1558 PerlProcGeteuid(struct IPerlProc* piPerl)
1564 PerlProcGetgid(struct IPerlProc* piPerl)
1570 PerlProcGetegid(struct IPerlProc* piPerl)
1576 PerlProcGetlogin(struct IPerlProc* piPerl)
1578 return g_getlogin();
1582 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1584 return win32_kill(pid, sig);
1588 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1591 Perl_croak(aTHX_ "killpg not implemented!\n");
1596 PerlProcPauseProc(struct IPerlProc* piPerl)
1598 return win32_sleep((32767L << 16) + 32767);
1602 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1605 PERL_FLUSHALL_FOR_CHILD;
1606 return win32_popen(command, mode);
1610 PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
1613 PERL_FLUSHALL_FOR_CHILD;
1614 return win32_popenlist(mode, narg, args);
1618 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1620 return win32_pclose(stream);
1624 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1626 return win32_pipe(phandles, 512, O_BINARY);
1630 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1636 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1642 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1644 return win32_sleep(s);
1648 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1650 return win32_times(timebuf);
1654 PerlProcWait(struct IPerlProc* piPerl, int *status)
1656 return win32_wait(status);
1660 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1662 return win32_waitpid(pid, status, flags);
1666 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1668 return signal(sig, subcode);
1672 static THREAD_RET_TYPE
1673 win32_start_child(LPVOID arg)
1675 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1678 #ifdef PERL_SYNC_FORK
1679 static long sync_fork_id = 0;
1680 long id = ++sync_fork_id;
1684 PERL_SET_THX(my_perl);
1686 /* set $$ to pseudo id */
1687 #ifdef PERL_SYNC_FORK
1690 w32_pseudo_id = GetCurrentThreadId();
1692 int pid = (int)w32_pseudo_id;
1694 w32_pseudo_id = -pid;
1697 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
1698 sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
1699 hv_clear(PL_pidstatus);
1701 /* push a zero on the stack (we are the child) */
1709 /* continue from next op */
1710 PL_op = PL_op->op_next;
1714 volatile int oldscope = PL_scopestack_ix;
1717 JMPENV_PUSH(status);
1724 while (PL_scopestack_ix > oldscope)
1727 PL_curstash = PL_defstash;
1728 if (PL_endav && !PL_minus_c)
1729 call_list(oldscope, PL_endav);
1730 status = STATUS_NATIVE_EXPORT;
1734 POPSTACK_TO(PL_mainstack);
1735 PL_op = PL_restartop;
1736 PL_restartop = Nullop;
1739 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1746 /* XXX hack to avoid perl_destruct() freeing optree */
1747 PL_main_root = Nullop;
1750 /* close the std handles to avoid fd leaks */
1752 do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
1753 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE);
1754 do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE);
1757 /* destroy everything (waits for any pseudo-forked children) */
1758 perl_destruct(my_perl);
1761 #ifdef PERL_SYNC_FORK
1764 return (DWORD)status;
1767 #endif /* USE_ITHREADS */
1770 PerlProcFork(struct IPerlProc* piPerl)
1778 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1782 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1783 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 1,
1785 h->m_pHostperlMemShared,
1786 h->m_pHostperlMemParse,
1788 h->m_pHostperlStdIO,
1794 new_perl->Isys_intern.internal_host = h;
1795 # ifdef PERL_SYNC_FORK
1796 id = win32_start_child((LPVOID)new_perl);
1799 # ifdef USE_RTL_THREAD_API
1800 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1801 (void*)new_perl, 0, (unsigned*)&id);
1803 handle = CreateThread(NULL, 0, win32_start_child,
1804 (LPVOID)new_perl, 0, &id);
1806 PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
1816 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1817 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1818 ++w32_num_pseudo_children;
1822 Perl_croak(aTHX_ "fork() not implemented!\n");
1824 #endif /* USE_ITHREADS */
1828 PerlProcGetpid(struct IPerlProc* piPerl)
1830 return win32_getpid();
1834 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1836 return win32_dynaload(filename);
1840 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1842 win32_str_os_error(sv, dwErr);
1846 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1848 do_spawn2(cmd, EXECF_EXEC);
1853 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1855 return do_spawn2(cmds, EXECF_SPAWN);
1859 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1861 return win32_spawnvp(mode, cmdname, argv);
1865 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1867 return do_aspawn(vreally, vmark, vsp);
1871 PerlProcLastHost(struct IPerlProc* piPerl)
1874 CPerlHost *h = (CPerlHost*)w32_internal_host;
1875 return h->LastHost();
1878 struct IPerlProc perlProc =
1922 CPerlHost::CPerlHost(void)
1924 /* Construct a host from scratch */
1925 InterlockedIncrement(&num_hosts);
1926 m_pvDir = new VDir();
1927 m_pVMem = new VMem();
1928 m_pVMemShared = new VMem();
1929 m_pVMemParse = new VMem();
1931 m_pvDir->Init(NULL, m_pVMem);
1934 m_lppEnvList = NULL;
1936 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1937 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1938 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1939 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1940 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1941 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1942 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1943 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1944 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1946 m_pHostperlMem = &m_hostperlMem;
1947 m_pHostperlMemShared = &m_hostperlMemShared;
1948 m_pHostperlMemParse = &m_hostperlMemParse;
1949 m_pHostperlEnv = &m_hostperlEnv;
1950 m_pHostperlStdIO = &m_hostperlStdIO;
1951 m_pHostperlLIO = &m_hostperlLIO;
1952 m_pHostperlDir = &m_hostperlDir;
1953 m_pHostperlSock = &m_hostperlSock;
1954 m_pHostperlProc = &m_hostperlProc;
1957 #define SETUPEXCHANGE(xptr, iptr, table) \
1968 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1969 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1970 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1971 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1972 struct IPerlProc** ppProc)
1974 InterlockedIncrement(&num_hosts);
1975 m_pvDir = new VDir(0);
1976 m_pVMem = new VMem();
1977 m_pVMemShared = new VMem();
1978 m_pVMemParse = new VMem();
1980 m_pvDir->Init(NULL, m_pVMem);
1983 m_lppEnvList = NULL;
1985 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1986 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1987 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1988 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1989 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1990 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1991 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1992 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1993 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1995 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
1996 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
1997 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
1998 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
1999 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
2000 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
2001 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
2002 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
2003 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
2005 #undef SETUPEXCHANGE
2007 CPerlHost::CPerlHost(CPerlHost& host)
2009 /* Construct a host from another host */
2010 InterlockedIncrement(&num_hosts);
2011 m_pVMem = new VMem();
2012 m_pVMemShared = host.GetMemShared();
2013 m_pVMemParse = host.GetMemParse();
2015 /* duplicate directory info */
2016 m_pvDir = new VDir(0);
2017 m_pvDir->Init(host.GetDir(), m_pVMem);
2019 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2020 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2021 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2022 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2023 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2024 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2025 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2026 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2027 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2028 m_pHostperlMem = &m_hostperlMem;
2029 m_pHostperlMemShared = &m_hostperlMemShared;
2030 m_pHostperlMemParse = &m_hostperlMemParse;
2031 m_pHostperlEnv = &m_hostperlEnv;
2032 m_pHostperlStdIO = &m_hostperlStdIO;
2033 m_pHostperlLIO = &m_hostperlLIO;
2034 m_pHostperlDir = &m_hostperlDir;
2035 m_pHostperlSock = &m_hostperlSock;
2036 m_pHostperlProc = &m_hostperlProc;
2039 m_lppEnvList = NULL;
2041 /* duplicate environment info */
2044 while(lpPtr = host.GetIndex(dwIndex))
2048 CPerlHost::~CPerlHost(void)
2051 InterlockedDecrement(&num_hosts);
2053 m_pVMemParse->Release();
2054 m_pVMemShared->Release();
2059 CPerlHost::Find(LPCSTR lpStr)
2062 LPSTR* lppPtr = Lookup(lpStr);
2063 if(lppPtr != NULL) {
2064 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2076 lookup(const void *arg1, const void *arg2)
2077 { // Compare strings
2081 ptr1 = *(char**)arg1;
2082 ptr2 = *(char**)arg2;
2086 if(c1 == '\0' || c1 == '=') {
2087 if(c2 == '\0' || c2 == '=')
2090 return -1; // string 1 < string 2
2092 else if(c2 == '\0' || c2 == '=')
2093 return 1; // string 1 > string 2
2099 return -1; // string 1 < string 2
2101 return 1; // string 1 > string 2
2109 CPerlHost::Lookup(LPCSTR lpStr)
2111 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2115 compare(const void *arg1, const void *arg2)
2116 { // Compare strings
2120 ptr1 = *(char**)arg1;
2121 ptr2 = *(char**)arg2;
2125 if(c1 == '\0' || c1 == '=') {
2129 return -1; // string 1 < string 2
2131 else if(c2 == '\0' || c2 == '=')
2132 return 1; // string 1 > string 2
2138 return -1; // string 1 < string 2
2140 return 1; // string 1 > string 2
2148 CPerlHost::Add(LPCSTR lpStr)
2151 char szBuffer[1024];
2153 int index, length = strlen(lpStr)+1;
2155 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2156 szBuffer[index] = lpStr[index];
2158 szBuffer[index] = '\0';
2161 lpPtr = Lookup(szBuffer);
2163 Renew(*lpPtr, length, char);
2164 strcpy(*lpPtr, lpStr);
2168 Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2169 New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2170 if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2171 strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2172 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2180 CPerlHost::CalculateEnvironmentSpace(void)
2184 for(index = 0; index < m_dwEnvCount; ++index)
2185 dwSize += strlen(m_lppEnvList[index]) + 1;
2191 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2198 CPerlHost::GetChildDir(void)
2203 New(0, ptr, MAX_PATH+1, char);
2205 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2206 length = strlen(ptr);
2208 if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2216 CPerlHost::FreeChildDir(char* pStr)
2223 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2226 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2227 DWORD dwSize, dwEnvIndex;
2228 int nLength, compVal;
2230 // get the process environment strings
2231 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2233 // step over current directory stuff
2234 while(*lpTmp == '=')
2235 lpTmp += strlen(lpTmp) + 1;
2237 // save the start of the environment strings
2239 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2240 // calculate the size of the environment strings
2241 dwSize += strlen(lpTmp) + 1;
2244 // add the size of current directories
2245 dwSize += vDir.CalculateEnvironmentSpace();
2247 // add the additional space used by changes made to the environment
2248 dwSize += CalculateEnvironmentSpace();
2250 New(1, lpStr, dwSize, char);
2253 // build the local environment
2254 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2257 lpLocalEnv = GetIndex(dwEnvIndex);
2258 while(*lpEnvPtr != '\0') {
2260 // all environment overrides have been added
2261 // so copy string into place
2262 strcpy(lpStr, lpEnvPtr);
2263 nLength = strlen(lpEnvPtr) + 1;
2265 lpEnvPtr += nLength;
2268 // determine which string to copy next
2269 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2271 strcpy(lpStr, lpEnvPtr);
2272 nLength = strlen(lpEnvPtr) + 1;
2274 lpEnvPtr += nLength;
2277 char *ptr = strchr(lpLocalEnv, '=');
2279 strcpy(lpStr, lpLocalEnv);
2280 lpStr += strlen(lpLocalEnv) + 1;
2282 lpLocalEnv = GetIndex(dwEnvIndex);
2284 // this string was replaced
2285 lpEnvPtr += strlen(lpEnvPtr) + 1;
2292 // still have environment overrides to add
2293 // so copy the strings into place if not an override
2294 char *ptr = strchr(lpLocalEnv, '=');
2296 strcpy(lpStr, lpLocalEnv);
2297 lpStr += strlen(lpLocalEnv) + 1;
2299 lpLocalEnv = GetIndex(dwEnvIndex);
2306 // release the process environment strings
2307 FreeEnvironmentStrings(lpAllocPtr);
2313 CPerlHost::Reset(void)
2316 if(m_lppEnvList != NULL) {
2317 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2318 Safefree(m_lppEnvList[index]);
2319 m_lppEnvList[index] = NULL;
2326 CPerlHost::Clearenv(void)
2330 LPSTR lpPtr, lpStr, lpEnvPtr;
2331 if (m_lppEnvList != NULL) {
2332 /* set every entry to an empty string */
2333 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2334 char* ptr = strchr(m_lppEnvList[index], '=');
2341 /* get the process environment strings */
2342 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2344 /* step over current directory stuff */
2345 while(*lpStr == '=')
2346 lpStr += strlen(lpStr) + 1;
2349 lpPtr = strchr(lpStr, '=');
2355 (void)win32_putenv(lpStr);
2358 lpStr += strlen(lpStr) + 1;
2361 FreeEnvironmentStrings(lpEnvPtr);
2366 CPerlHost::Getenv(const char *varname)
2369 if (w32_pseudo_id) {
2370 char *pEnv = Find(varname);
2374 return win32_getenv(varname);
2378 CPerlHost::Putenv(const char *envstring)
2383 return win32_putenv(envstring);
2389 CPerlHost::Chdir(const char *dirname)
2398 WCHAR wBuffer[MAX_PATH];
2399 A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2400 ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2403 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2410 #endif /* ___PerlHost_H___ */