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
39 CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
40 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
41 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
42 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
43 struct IPerlProc** ppProc);
44 CPerlHost(CPerlHost& host);
47 static CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl);
48 static CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl);
49 static CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl);
50 static CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl);
51 static CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl);
52 static CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl);
53 static CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl);
54 static CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl);
55 static CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl);
57 BOOL PerlCreate(void);
58 int PerlParse(int argc, char** argv, char** env);
60 void PerlDestroy(void);
63 inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
64 inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
65 inline void Free(void* ptr) { m_pVMem->Free(ptr); };
66 inline void* Calloc(size_t num, size_t size)
68 size_t count = num*size;
69 void* lpVoid = Malloc(count);
71 ZeroMemory(lpVoid, count);
74 inline void GetLock(void) { m_pVMem->GetLock(); };
75 inline void FreeLock(void) { m_pVMem->FreeLock(); };
76 inline int IsLocked(void) { return m_pVMem->IsLocked(); };
79 inline void* MallocShared(size_t size)
81 return m_pVMemShared->Malloc(size);
83 inline void* ReallocShared(void* ptr, size_t size) { return m_pVMemShared->Realloc(ptr, size); };
84 inline void FreeShared(void* ptr) { m_pVMemShared->Free(ptr); };
85 inline void* CallocShared(size_t num, size_t size)
87 size_t count = num*size;
88 void* lpVoid = MallocShared(count);
90 ZeroMemory(lpVoid, count);
93 inline void GetLockShared(void) { m_pVMem->GetLock(); };
94 inline void FreeLockShared(void) { m_pVMem->FreeLock(); };
95 inline int IsLockedShared(void) { return m_pVMem->IsLocked(); };
98 inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
99 inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
100 inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
101 inline void* CallocParse(size_t num, size_t size)
103 size_t count = num*size;
104 void* lpVoid = MallocParse(count);
106 ZeroMemory(lpVoid, count);
109 inline void GetLockParse(void) { m_pVMem->GetLock(); };
110 inline void FreeLockParse(void) { m_pVMem->FreeLock(); };
111 inline int IsLockedParse(void) { return m_pVMem->IsLocked(); };
114 char *Getenv(const char *varname);
115 int Putenv(const char *envstring);
116 inline char *Getenv(const char *varname, unsigned long *len)
119 char *e = Getenv(varname);
124 void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
125 void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
126 char* GetChildDir(void);
127 void FreeChildDir(char* pStr);
131 inline LPSTR GetIndex(DWORD &dwIndex)
133 if(dwIndex < m_dwEnvCount)
136 return m_lppEnvList[dwIndex-1];
142 LPSTR Find(LPCSTR lpStr);
143 void Add(LPCSTR lpStr);
145 LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
146 void FreeLocalEnvironmentStrings(LPSTR lpStr);
147 LPSTR* Lookup(LPCSTR lpStr);
148 DWORD CalculateEnvironmentSpace(void);
153 virtual int Chdir(const char *dirname);
157 void Exit(int status);
158 void _Exit(int status);
159 int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
160 int Execv(const char *cmdname, const char *const *argv);
161 int Execvp(const char *cmdname, const char *const *argv);
163 inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
164 inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
165 inline VDir* GetDir(void) { return m_pvDir; };
169 struct IPerlMem m_hostperlMem;
170 struct IPerlMem m_hostperlMemShared;
171 struct IPerlMem m_hostperlMemParse;
172 struct IPerlEnv m_hostperlEnv;
173 struct IPerlStdIO m_hostperlStdIO;
174 struct IPerlLIO m_hostperlLIO;
175 struct IPerlDir m_hostperlDir;
176 struct IPerlSock m_hostperlSock;
177 struct IPerlProc m_hostperlProc;
179 struct IPerlMem* m_pHostperlMem;
180 struct IPerlMem* m_pHostperlMemShared;
181 struct IPerlMem* m_pHostperlMemParse;
182 struct IPerlEnv* m_pHostperlEnv;
183 struct IPerlStdIO* m_pHostperlStdIO;
184 struct IPerlLIO* m_pHostperlLIO;
185 struct IPerlDir* m_pHostperlDir;
186 struct IPerlSock* m_pHostperlSock;
187 struct IPerlProc* m_pHostperlProc;
189 inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
190 inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
203 #define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
205 inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
207 return STRUCT2PTR(piPerl, m_hostperlMem);
210 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
212 return STRUCT2PTR(piPerl, m_hostperlMemShared);
215 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
217 return STRUCT2PTR(piPerl, m_hostperlMemParse);
220 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
222 return STRUCT2PTR(piPerl, m_hostperlEnv);
225 inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
227 return STRUCT2PTR(piPerl, m_hostperlStdIO);
230 inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
232 return STRUCT2PTR(piPerl, m_hostperlLIO);
235 inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
237 return STRUCT2PTR(piPerl, m_hostperlDir);
240 inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
242 return STRUCT2PTR(piPerl, m_hostperlSock);
245 inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
247 return STRUCT2PTR(piPerl, m_hostperlProc);
253 #define IPERL2HOST(x) IPerlMem2Host(x)
257 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
259 return IPERL2HOST(piPerl)->Malloc(size);
262 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
264 return IPERL2HOST(piPerl)->Realloc(ptr, size);
267 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
269 IPERL2HOST(piPerl)->Free(ptr);
272 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
274 return IPERL2HOST(piPerl)->Calloc(num, size);
278 PerlMemGetLock(struct IPerlMem* piPerl)
280 IPERL2HOST(piPerl)->GetLock();
284 PerlMemFreeLock(struct IPerlMem* piPerl)
286 IPERL2HOST(piPerl)->FreeLock();
290 PerlMemIsLocked(struct IPerlMem* piPerl)
292 return IPERL2HOST(piPerl)->IsLocked();
295 struct IPerlMem perlMem =
307 #define IPERL2HOST(x) IPerlMemShared2Host(x)
311 PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
313 return IPERL2HOST(piPerl)->MallocShared(size);
316 PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
318 return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
321 PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
323 IPERL2HOST(piPerl)->FreeShared(ptr);
326 PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
328 return IPERL2HOST(piPerl)->CallocShared(num, size);
332 PerlMemSharedGetLock(struct IPerlMem* piPerl)
334 IPERL2HOST(piPerl)->GetLockShared();
338 PerlMemSharedFreeLock(struct IPerlMem* piPerl)
340 IPERL2HOST(piPerl)->FreeLockShared();
344 PerlMemSharedIsLocked(struct IPerlMem* piPerl)
346 return IPERL2HOST(piPerl)->IsLockedShared();
349 struct IPerlMem perlMemShared =
352 PerlMemSharedRealloc,
355 PerlMemSharedGetLock,
356 PerlMemSharedFreeLock,
357 PerlMemSharedIsLocked,
361 #define IPERL2HOST(x) IPerlMemParse2Host(x)
365 PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
367 return IPERL2HOST(piPerl)->MallocParse(size);
370 PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
372 return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
375 PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
377 IPERL2HOST(piPerl)->FreeParse(ptr);
380 PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
382 return IPERL2HOST(piPerl)->CallocParse(num, size);
386 PerlMemParseGetLock(struct IPerlMem* piPerl)
388 IPERL2HOST(piPerl)->GetLockParse();
392 PerlMemParseFreeLock(struct IPerlMem* piPerl)
394 IPERL2HOST(piPerl)->FreeLockParse();
398 PerlMemParseIsLocked(struct IPerlMem* piPerl)
400 return IPERL2HOST(piPerl)->IsLockedParse();
403 struct IPerlMem perlMemParse =
410 PerlMemParseFreeLock,
411 PerlMemParseIsLocked,
416 #define IPERL2HOST(x) IPerlEnv2Host(x)
420 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
422 return IPERL2HOST(piPerl)->Getenv(varname);
426 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
428 return IPERL2HOST(piPerl)->Putenv(envstring);
432 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
434 return IPERL2HOST(piPerl)->Getenv(varname, len);
438 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
440 return win32_uname(name);
444 PerlEnvClearenv(struct IPerlEnv* piPerl)
446 IPERL2HOST(piPerl)->Clearenv();
450 PerlEnvGetChildenv(struct IPerlEnv* piPerl)
452 return IPERL2HOST(piPerl)->CreateChildEnv();
456 PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
458 IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
462 PerlEnvGetChilddir(struct IPerlEnv* piPerl)
464 return IPERL2HOST(piPerl)->GetChildDir();
468 PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
470 IPERL2HOST(piPerl)->FreeChildDir(childDir);
474 PerlEnvOsId(struct IPerlEnv* piPerl)
476 return win32_os_id();
480 PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
482 return g_win32_get_privlib(pl);
486 PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
488 return g_win32_get_sitelib(pl);
492 PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
494 return g_win32_get_vendorlib(pl);
498 PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
500 win32_get_child_IO(ptr);
503 struct IPerlEnv perlEnv =
517 PerlEnvVendorLibPath,
522 #define IPERL2HOST(x) IPerlStdIO2Host(x)
526 PerlStdIOStdin(struct IPerlStdIO* piPerl)
528 return (PerlIO*)win32_stdin();
532 PerlStdIOStdout(struct IPerlStdIO* piPerl)
534 return (PerlIO*)win32_stdout();
538 PerlStdIOStderr(struct IPerlStdIO* piPerl)
540 return (PerlIO*)win32_stderr();
544 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
546 return (PerlIO*)win32_fopen(path, mode);
550 PerlStdIOClose(struct IPerlStdIO* piPerl, PerlIO* pf)
552 return win32_fclose(((FILE*)pf));
556 PerlStdIOEof(struct IPerlStdIO* piPerl, PerlIO* pf)
558 return win32_feof((FILE*)pf);
562 PerlStdIOError(struct IPerlStdIO* piPerl, PerlIO* pf)
564 return win32_ferror((FILE*)pf);
568 PerlStdIOClearerr(struct IPerlStdIO* piPerl, PerlIO* pf)
570 win32_clearerr((FILE*)pf);
574 PerlStdIOGetc(struct IPerlStdIO* piPerl, PerlIO* pf)
576 return win32_getc((FILE*)pf);
580 PerlStdIOGetBase(struct IPerlStdIO* piPerl, PerlIO* pf)
591 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, PerlIO* pf)
595 return FILE_bufsiz(f);
602 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, PerlIO* pf)
613 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, PerlIO* pf)
624 PerlStdIOGets(struct IPerlStdIO* piPerl, PerlIO* pf, char* s, int n)
626 return win32_fgets(s, n, (FILE*)pf);
630 PerlStdIOPutc(struct IPerlStdIO* piPerl, PerlIO* pf, int c)
632 return win32_fputc(c, (FILE*)pf);
636 PerlStdIOPuts(struct IPerlStdIO* piPerl, PerlIO* pf, const char *s)
638 return win32_fputs(s, (FILE*)pf);
642 PerlStdIOFlush(struct IPerlStdIO* piPerl, PerlIO* pf)
644 return win32_fflush((FILE*)pf);
648 PerlStdIOUngetc(struct IPerlStdIO* piPerl, PerlIO* pf,int c)
650 return win32_ungetc(c, (FILE*)pf);
654 PerlStdIOFileno(struct IPerlStdIO* piPerl, PerlIO* pf)
656 return win32_fileno((FILE*)pf);
660 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
662 return (PerlIO*)win32_fdopen(fd, mode);
666 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, PerlIO* pf)
668 return (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
672 PerlStdIORead(struct IPerlStdIO* piPerl, PerlIO* pf, void *buffer, Size_t size)
674 return win32_fread(buffer, 1, size, (FILE*)pf);
678 PerlStdIOWrite(struct IPerlStdIO* piPerl, PerlIO* pf, const void *buffer, Size_t size)
680 return win32_fwrite(buffer, 1, size, (FILE*)pf);
684 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, PerlIO* pf, char* buffer)
686 win32_setbuf((FILE*)pf, buffer);
690 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, PerlIO* pf, char* buffer, int type, Size_t size)
692 return win32_setvbuf((FILE*)pf, buffer, type, size);
696 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, PerlIO* pf, int n)
698 #ifdef STDIO_CNT_LVALUE
705 PerlStdIOSetPtrCnt(struct IPerlStdIO* piPerl, PerlIO* pf, char * ptr, int n)
707 #ifdef STDIO_PTR_LVALUE
715 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, PerlIO* pf)
717 win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
721 PerlStdIOPrintf(struct IPerlStdIO* piPerl, PerlIO* pf, const char *format,...)
724 va_start(arglist, format);
725 return win32_vfprintf((FILE*)pf, format, arglist);
729 PerlStdIOVprintf(struct IPerlStdIO* piPerl, PerlIO* pf, const char *format, va_list arglist)
731 return win32_vfprintf((FILE*)pf, format, arglist);
735 PerlStdIOTell(struct IPerlStdIO* piPerl, PerlIO* pf)
737 return win32_ftell((FILE*)pf);
741 PerlStdIOSeek(struct IPerlStdIO* piPerl, PerlIO* pf, off_t offset, int origin)
743 return win32_fseek((FILE*)pf, offset, origin);
747 PerlStdIORewind(struct IPerlStdIO* piPerl, PerlIO* pf)
749 win32_rewind((FILE*)pf);
753 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
755 return (PerlIO*)win32_tmpfile();
759 PerlStdIOGetpos(struct IPerlStdIO* piPerl, PerlIO* pf, Fpos_t *p)
761 return win32_fgetpos((FILE*)pf, p);
765 PerlStdIOSetpos(struct IPerlStdIO* piPerl, PerlIO* pf, const Fpos_t *p)
767 return win32_fsetpos((FILE*)pf, p);
770 PerlStdIOInit(struct IPerlStdIO* piPerl)
775 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
777 Perl_init_os_extras();
781 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags)
783 return win32_open_osfhandle(osfhandle, flags);
787 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
789 return win32_get_osfhandle(filenum);
793 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, PerlIO* pf)
798 int fileno = win32_dup(win32_fileno((FILE*)pf));
800 /* open the file in the same mode */
802 if(((FILE*)pf)->flags & _F_READ) {
806 else if(((FILE*)pf)->flags & _F_WRIT) {
810 else if(((FILE*)pf)->flags & _F_RDWR) {
816 if(((FILE*)pf)->_flag & _IOREAD) {
820 else if(((FILE*)pf)->_flag & _IOWRT) {
824 else if(((FILE*)pf)->_flag & _IORW) {
831 /* it appears that the binmode is attached to the
832 * file descriptor so binmode files will be handled
835 pfdup = (PerlIO*)win32_fdopen(fileno, mode);
837 /* move the file pointer to the same position */
838 if (!fgetpos((FILE*)pf, &pos)) {
839 fsetpos((FILE*)pfdup, &pos);
844 struct IPerlStdIO perlStdIO =
883 PerlStdIOInitOSExtras,
889 #define IPERL2HOST(x) IPerlLIO2Host(x)
893 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
895 return win32_access(path, mode);
899 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
901 return win32_chmod(filename, pmode);
905 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
907 return chown(filename, owner, group);
911 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
913 return chsize(handle, size);
917 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
919 return win32_close(handle);
923 PerlLIODup(struct IPerlLIO* piPerl, int handle)
925 return win32_dup(handle);
929 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
931 return win32_dup2(handle1, handle2);
935 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
937 return win32_flock(fd, oper);
941 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
943 return win32_fstat(handle, buffer);
947 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
949 return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
953 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
959 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
961 return win32_link(oldname, newname);
965 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
967 return win32_lseek(handle, offset, origin);
971 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
973 return win32_stat(path, buffer);
977 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
979 return mktemp(Template);
983 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
985 return win32_open(filename, oflag);
989 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
991 return win32_open(filename, oflag, pmode);
995 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
997 return win32_read(handle, buffer, count);
1001 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
1003 return win32_rename(OldFileName, newname);
1007 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1009 return win32_setmode(handle, mode);
1013 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
1015 return win32_stat(path, buffer);
1019 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1021 return tmpnam(string);
1025 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1027 return umask(pmode);
1031 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1033 return win32_unlink(filename);
1037 PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
1039 return win32_utime(filename, times);
1043 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1045 return win32_write(handle, buffer, count);
1048 struct IPerlLIO perlLIO =
1080 #define IPERL2HOST(x) IPerlDir2Host(x)
1084 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1086 return win32_mkdir(dirname, mode);
1090 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1092 return IPERL2HOST(piPerl)->Chdir(dirname);
1096 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1098 return win32_rmdir(dirname);
1102 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1104 return win32_closedir(dirp);
1108 PerlDirOpen(struct IPerlDir* piPerl, char *filename)
1110 return win32_opendir(filename);
1114 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1116 return win32_readdir(dirp);
1120 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1122 win32_rewinddir(dirp);
1126 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1128 win32_seekdir(dirp, loc);
1132 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1134 return win32_telldir(dirp);
1138 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1140 return IPERL2HOST(piPerl)->MapPathA(path);
1144 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1146 return IPERL2HOST(piPerl)->MapPathW(path);
1149 struct IPerlDir perlDir =
1167 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1169 return win32_htonl(hostlong);
1173 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1175 return win32_htons(hostshort);
1179 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1181 return win32_ntohl(netlong);
1185 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1187 return win32_ntohs(netshort);
1190 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1192 return win32_accept(s, addr, addrlen);
1196 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1198 return win32_bind(s, name, namelen);
1202 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1204 return win32_connect(s, name, namelen);
1208 PerlSockEndhostent(struct IPerlSock* piPerl)
1214 PerlSockEndnetent(struct IPerlSock* piPerl)
1220 PerlSockEndprotoent(struct IPerlSock* piPerl)
1222 win32_endprotoent();
1226 PerlSockEndservent(struct IPerlSock* piPerl)
1232 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1234 return win32_gethostbyaddr(addr, len, type);
1238 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1240 return win32_gethostbyname(name);
1244 PerlSockGethostent(struct IPerlSock* piPerl)
1247 Perl_croak(aTHX_ "gethostent not implemented!\n");
1252 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1254 return win32_gethostname(name, namelen);
1258 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1260 return win32_getnetbyaddr(net, type);
1264 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1266 return win32_getnetbyname((char*)name);
1270 PerlSockGetnetent(struct IPerlSock* piPerl)
1272 return win32_getnetent();
1275 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1277 return win32_getpeername(s, name, namelen);
1281 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1283 return win32_getprotobyname(name);
1287 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1289 return win32_getprotobynumber(number);
1293 PerlSockGetprotoent(struct IPerlSock* piPerl)
1295 return win32_getprotoent();
1299 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1301 return win32_getservbyname(name, proto);
1305 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1307 return win32_getservbyport(port, proto);
1311 PerlSockGetservent(struct IPerlSock* piPerl)
1313 return win32_getservent();
1317 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1319 return win32_getsockname(s, name, namelen);
1323 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1325 return win32_getsockopt(s, level, optname, optval, optlen);
1329 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1331 return win32_inet_addr(cp);
1335 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1337 return win32_inet_ntoa(in);
1341 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1343 return win32_listen(s, backlog);
1347 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1349 return win32_recv(s, buffer, len, flags);
1353 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1355 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1359 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1361 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1365 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1367 return win32_send(s, buffer, len, flags);
1371 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1373 return win32_sendto(s, buffer, len, flags, to, tolen);
1377 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1379 win32_sethostent(stayopen);
1383 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1385 win32_setnetent(stayopen);
1389 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1391 win32_setprotoent(stayopen);
1395 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1397 win32_setservent(stayopen);
1401 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1403 return win32_setsockopt(s, level, optname, optval, optlen);
1407 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1409 return win32_shutdown(s, how);
1413 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1415 return win32_socket(af, type, protocol);
1419 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1422 Perl_croak(aTHX_ "socketpair not implemented!\n");
1427 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1429 return win32_closesocket(s);
1433 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1435 return win32_ioctlsocket(s, cmd, argp);
1438 struct IPerlSock perlSock =
1449 PerlSockEndprotoent,
1451 PerlSockGethostname,
1452 PerlSockGetpeername,
1453 PerlSockGethostbyaddr,
1454 PerlSockGethostbyname,
1456 PerlSockGetnetbyaddr,
1457 PerlSockGetnetbyname,
1459 PerlSockGetprotobyname,
1460 PerlSockGetprotobynumber,
1461 PerlSockGetprotoent,
1462 PerlSockGetservbyname,
1463 PerlSockGetservbyport,
1465 PerlSockGetsockname,
1477 PerlSockSetprotoent,
1483 PerlSockClosesocket,
1489 #define EXECF_EXEC 1
1490 #define EXECF_SPAWN 2
1493 PerlProcAbort(struct IPerlProc* piPerl)
1499 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1501 return win32_crypt(clear, salt);
1505 PerlProcExit(struct IPerlProc* piPerl, int status)
1511 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1517 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1519 return execl(cmdname, arg0, arg1, arg2, arg3);
1523 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1525 return win32_execvp(cmdname, argv);
1529 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1531 return win32_execvp(cmdname, argv);
1535 PerlProcGetuid(struct IPerlProc* piPerl)
1541 PerlProcGeteuid(struct IPerlProc* piPerl)
1547 PerlProcGetgid(struct IPerlProc* piPerl)
1553 PerlProcGetegid(struct IPerlProc* piPerl)
1559 PerlProcGetlogin(struct IPerlProc* piPerl)
1561 return g_getlogin();
1565 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1567 return win32_kill(pid, sig);
1571 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1574 Perl_croak(aTHX_ "killpg not implemented!\n");
1579 PerlProcPauseProc(struct IPerlProc* piPerl)
1581 return win32_sleep((32767L << 16) + 32767);
1585 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1588 PERL_FLUSHALL_FOR_CHILD;
1589 return (PerlIO*)win32_popen(command, mode);
1593 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1595 return win32_pclose((FILE*)stream);
1599 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1601 return win32_pipe(phandles, 512, O_BINARY);
1605 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1611 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1617 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1619 return win32_sleep(s);
1623 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1625 return win32_times(timebuf);
1629 PerlProcWait(struct IPerlProc* piPerl, int *status)
1631 return win32_wait(status);
1635 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1637 return win32_waitpid(pid, status, flags);
1641 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1643 return signal(sig, subcode);
1647 static THREAD_RET_TYPE
1648 win32_start_child(LPVOID arg)
1650 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1654 CPerlObj *pPerl = (CPerlObj*)my_perl;
1656 #ifdef PERL_SYNC_FORK
1657 static long sync_fork_id = 0;
1658 long id = ++sync_fork_id;
1662 PERL_SET_THX(my_perl);
1664 /* set $$ to pseudo id */
1665 #ifdef PERL_SYNC_FORK
1668 w32_pseudo_id = GetCurrentThreadId();
1670 int pid = (int)w32_pseudo_id;
1672 w32_pseudo_id = -pid;
1675 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
1676 sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
1677 hv_clear(PL_pidstatus);
1679 /* push a zero on the stack (we are the child) */
1687 /* continue from next op */
1688 PL_op = PL_op->op_next;
1692 volatile int oldscope = PL_scopestack_ix;
1695 JMPENV_PUSH(status);
1702 while (PL_scopestack_ix > oldscope)
1705 PL_curstash = PL_defstash;
1706 if (PL_endav && !PL_minus_c)
1707 call_list(oldscope, PL_endav);
1708 status = STATUS_NATIVE_EXPORT;
1712 POPSTACK_TO(PL_mainstack);
1713 PL_op = PL_restartop;
1714 PL_restartop = Nullop;
1717 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1724 /* XXX hack to avoid perl_destruct() freeing optree */
1725 PL_main_root = Nullop;
1728 /* close the std handles to avoid fd leaks */
1730 do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
1731 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE);
1732 do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE);
1735 /* destroy everything (waits for any pseudo-forked children) */
1736 perl_destruct(my_perl);
1739 #ifdef PERL_SYNC_FORK
1742 return (DWORD)status;
1745 #endif /* USE_ITHREADS */
1748 PerlProcFork(struct IPerlProc* piPerl)
1756 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1760 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1761 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHXo, 1,
1763 h->m_pHostperlMemShared,
1764 h->m_pHostperlMemParse,
1766 h->m_pHostperlStdIO,
1772 new_perl->Isys_intern.internal_host = h;
1773 # ifdef PERL_SYNC_FORK
1774 id = win32_start_child((LPVOID)new_perl);
1775 PERL_SET_THX(aTHXo);
1777 # ifdef USE_RTL_THREAD_API
1778 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1779 (void*)new_perl, 0, (unsigned*)&id);
1781 handle = CreateThread(NULL, 0, win32_start_child,
1782 (LPVOID)new_perl, 0, &id);
1784 PERL_SET_THX(aTHXo); /* XXX perl_clone*() set TLS */
1794 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1795 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1796 ++w32_num_pseudo_children;
1800 Perl_croak(aTHX_ "fork() not implemented!\n");
1802 #endif /* USE_ITHREADS */
1806 PerlProcGetpid(struct IPerlProc* piPerl)
1808 return win32_getpid();
1812 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1814 return win32_dynaload(filename);
1818 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1820 win32_str_os_error(sv, dwErr);
1824 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1826 do_spawn2(cmd, EXECF_EXEC);
1831 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1833 return do_spawn2(cmds, EXECF_SPAWN);
1837 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1839 return win32_spawnvp(mode, cmdname, argv);
1843 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1845 return do_aspawn(vreally, vmark, vsp);
1848 struct IPerlProc perlProc =
1890 CPerlHost::CPerlHost(void)
1892 m_pvDir = new VDir();
1893 m_pVMem = new VMem();
1894 m_pVMemShared = new VMem();
1895 m_pVMemParse = new VMem();
1897 m_pvDir->Init(NULL, m_pVMem);
1900 m_lppEnvList = NULL;
1902 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1903 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1904 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1905 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1906 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1907 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1908 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1909 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1910 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1912 m_pHostperlMem = &m_hostperlMem;
1913 m_pHostperlMemShared = &m_hostperlMemShared;
1914 m_pHostperlMemParse = &m_hostperlMemParse;
1915 m_pHostperlEnv = &m_hostperlEnv;
1916 m_pHostperlStdIO = &m_hostperlStdIO;
1917 m_pHostperlLIO = &m_hostperlLIO;
1918 m_pHostperlDir = &m_hostperlDir;
1919 m_pHostperlSock = &m_hostperlSock;
1920 m_pHostperlProc = &m_hostperlProc;
1923 #define SETUPEXCHANGE(xptr, iptr, table) \
1934 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1935 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1936 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1937 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1938 struct IPerlProc** ppProc)
1940 m_pvDir = new VDir(0);
1941 m_pVMem = new VMem();
1942 m_pVMemShared = new VMem();
1943 m_pVMemParse = new VMem();
1945 m_pvDir->Init(NULL, m_pVMem);
1948 m_lppEnvList = NULL;
1950 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1951 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1952 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1953 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1954 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1955 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1956 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1957 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1958 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1960 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
1961 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
1962 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
1963 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
1964 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
1965 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
1966 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
1967 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
1968 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
1970 #undef SETUPEXCHANGE
1972 CPerlHost::CPerlHost(CPerlHost& host)
1974 m_pVMem = new VMem();
1975 m_pVMemShared = host.GetMemShared();
1976 m_pVMemParse = host.GetMemParse();
1978 /* duplicate directory info */
1979 m_pvDir = new VDir(0);
1980 m_pvDir->Init(host.GetDir(), m_pVMem);
1982 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1983 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1984 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1985 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1986 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1987 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1988 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1989 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1990 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1991 m_pHostperlMem = &m_hostperlMem;
1992 m_pHostperlMemShared = &m_hostperlMemShared;
1993 m_pHostperlMemParse = &m_hostperlMemParse;
1994 m_pHostperlEnv = &m_hostperlEnv;
1995 m_pHostperlStdIO = &m_hostperlStdIO;
1996 m_pHostperlLIO = &m_hostperlLIO;
1997 m_pHostperlDir = &m_hostperlDir;
1998 m_pHostperlSock = &m_hostperlSock;
1999 m_pHostperlProc = &m_hostperlProc;
2002 m_lppEnvList = NULL;
2004 /* duplicate environment info */
2007 while(lpPtr = host.GetIndex(dwIndex))
2011 CPerlHost::~CPerlHost(void)
2015 m_pVMemParse->Release();
2016 m_pVMemShared->Release();
2021 CPerlHost::Find(LPCSTR lpStr)
2024 LPSTR* lppPtr = Lookup(lpStr);
2025 if(lppPtr != NULL) {
2026 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2038 lookup(const void *arg1, const void *arg2)
2039 { // Compare strings
2043 ptr1 = *(char**)arg1;
2044 ptr2 = *(char**)arg2;
2048 if(c1 == '\0' || c1 == '=') {
2049 if(c2 == '\0' || c2 == '=')
2052 return -1; // string 1 < string 2
2054 else if(c2 == '\0' || c2 == '=')
2055 return 1; // string 1 > string 2
2061 return -1; // string 1 < string 2
2063 return 1; // string 1 > string 2
2071 CPerlHost::Lookup(LPCSTR lpStr)
2073 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2077 compare(const void *arg1, const void *arg2)
2078 { // Compare strings
2082 ptr1 = *(char**)arg1;
2083 ptr2 = *(char**)arg2;
2087 if(c1 == '\0' || c1 == '=') {
2091 return -1; // string 1 < string 2
2093 else if(c2 == '\0' || c2 == '=')
2094 return 1; // string 1 > string 2
2100 return -1; // string 1 < string 2
2102 return 1; // string 1 > string 2
2110 CPerlHost::Add(LPCSTR lpStr)
2113 char szBuffer[1024];
2115 int index, length = strlen(lpStr)+1;
2117 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2118 szBuffer[index] = lpStr[index];
2120 szBuffer[index] = '\0';
2123 lpPtr = Lookup(szBuffer);
2125 Renew(*lpPtr, length, char);
2126 strcpy(*lpPtr, lpStr);
2130 Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2131 New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2132 if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2133 strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2134 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2142 CPerlHost::CalculateEnvironmentSpace(void)
2146 for(index = 0; index < m_dwEnvCount; ++index)
2147 dwSize += strlen(m_lppEnvList[index]) + 1;
2153 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2160 CPerlHost::GetChildDir(void)
2165 New(0, ptr, MAX_PATH+1, char);
2167 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2168 length = strlen(ptr)-1;
2170 if((ptr[length] == '\\') || (ptr[length] == '/'))
2178 CPerlHost::FreeChildDir(char* pStr)
2185 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2188 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2189 DWORD dwSize, dwEnvIndex;
2190 int nLength, compVal;
2192 // get the process environment strings
2193 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2195 // step over current directory stuff
2196 while(*lpTmp == '=')
2197 lpTmp += strlen(lpTmp) + 1;
2199 // save the start of the environment strings
2201 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2202 // calculate the size of the environment strings
2203 dwSize += strlen(lpTmp) + 1;
2206 // add the size of current directories
2207 dwSize += vDir.CalculateEnvironmentSpace();
2209 // add the additional space used by changes made to the environment
2210 dwSize += CalculateEnvironmentSpace();
2212 New(1, lpStr, dwSize, char);
2215 // build the local environment
2216 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2219 lpLocalEnv = GetIndex(dwEnvIndex);
2220 while(*lpEnvPtr != '\0') {
2222 // all environment overrides have been added
2223 // so copy string into place
2224 strcpy(lpStr, lpEnvPtr);
2225 nLength = strlen(lpEnvPtr) + 1;
2227 lpEnvPtr += nLength;
2230 // determine which string to copy next
2231 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2233 strcpy(lpStr, lpEnvPtr);
2234 nLength = strlen(lpEnvPtr) + 1;
2236 lpEnvPtr += nLength;
2239 char *ptr = strchr(lpLocalEnv, '=');
2241 strcpy(lpStr, lpLocalEnv);
2242 lpStr += strlen(lpLocalEnv) + 1;
2244 lpLocalEnv = GetIndex(dwEnvIndex);
2246 // this string was replaced
2247 lpEnvPtr += strlen(lpEnvPtr) + 1;
2254 // still have environment overrides to add
2255 // so copy the strings into place
2256 strcpy(lpStr, lpLocalEnv);
2257 nLength = strlen(lpLocalEnv) + 1;
2259 lpEnvPtr += nLength;
2260 lpLocalEnv = GetIndex(dwEnvIndex);
2267 // release the process environment strings
2268 FreeEnvironmentStrings(lpAllocPtr);
2274 CPerlHost::Reset(void)
2277 if(m_lppEnvList != NULL) {
2278 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2279 Safefree(m_lppEnvList[index]);
2280 m_lppEnvList[index] = NULL;
2287 CPerlHost::Clearenv(void)
2290 LPSTR lpPtr, lpStr, lpEnvPtr;
2291 if(m_lppEnvList != NULL) {
2292 /* set every entry to an empty string */
2293 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2294 char* ptr = strchr(m_lppEnvList[index], '=');
2301 /* get the process environment strings */
2302 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2304 /* step over current directory stuff */
2305 while(*lpStr == '=')
2306 lpStr += strlen(lpStr) + 1;
2309 lpPtr = strchr(lpStr, '=');
2316 lpStr += strlen(lpStr) + 1;
2319 FreeEnvironmentStrings(lpEnvPtr);
2324 CPerlHost::Getenv(const char *varname)
2326 char* pEnv = Find(varname);
2328 pEnv = win32_getenv(varname);
2339 CPerlHost::Putenv(const char *envstring)
2346 CPerlHost::Chdir(const char *dirname)
2351 WCHAR wBuffer[MAX_PATH];
2352 A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2353 ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2356 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2363 #endif /* ___PerlHost_H___ */