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.
11 #define CHECK_HOST_INTERP
14 #ifndef ___PerlHost_H___
15 #define ___PerlHost_H___
24 #ifndef WC_NO_BEST_FIT_CHARS
25 # define WC_NO_BEST_FIT_CHARS 0x00000400
29 extern char * g_win32_get_privlib(const char *pl);
30 extern char * g_win32_get_sitelib(const char *pl);
31 extern char * g_win32_get_vendorlib(const char *pl);
32 extern char * g_getlogin(void);
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 /* Locks provided but should be unnecessary as this is private pool */
65 inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
66 inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
67 inline void Free(void* ptr) { m_pVMem->Free(ptr); };
68 inline void* Calloc(size_t num, size_t size)
70 size_t count = num*size;
71 void* lpVoid = Malloc(count);
73 ZeroMemory(lpVoid, count);
76 inline void GetLock(void) { m_pVMem->GetLock(); };
77 inline void FreeLock(void) { m_pVMem->FreeLock(); };
78 inline int IsLocked(void) { return m_pVMem->IsLocked(); };
81 /* Locks used to serialize access to the pool */
82 inline void GetLockShared(void) { m_pVMemShared->GetLock(); };
83 inline void FreeLockShared(void) { m_pVMemShared->FreeLock(); };
84 inline int IsLockedShared(void) { return m_pVMemShared->IsLocked(); };
85 inline void* MallocShared(size_t size)
89 result = m_pVMemShared->Malloc(size);
93 inline void* ReallocShared(void* ptr, size_t size)
97 result = m_pVMemShared->Realloc(ptr, size);
101 inline void FreeShared(void* ptr)
104 m_pVMemShared->Free(ptr);
107 inline void* CallocShared(size_t num, size_t size)
109 size_t count = num*size;
110 void* lpVoid = MallocShared(count);
112 ZeroMemory(lpVoid, count);
117 /* Assume something else is using locks to mangaging serialize
120 inline void GetLockParse(void) { m_pVMemParse->GetLock(); };
121 inline void FreeLockParse(void) { m_pVMemParse->FreeLock(); };
122 inline int IsLockedParse(void) { return m_pVMemParse->IsLocked(); };
123 inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
124 inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
125 inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
126 inline void* CallocParse(size_t num, size_t size)
128 size_t count = num*size;
129 void* lpVoid = MallocParse(count);
131 ZeroMemory(lpVoid, count);
136 char *Getenv(const char *varname);
137 int Putenv(const char *envstring);
138 inline char *Getenv(const char *varname, unsigned long *len)
141 char *e = Getenv(varname);
146 void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
147 void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
148 char* GetChildDir(void);
149 void FreeChildDir(char* pStr);
153 inline LPSTR GetIndex(DWORD &dwIndex)
155 if(dwIndex < m_dwEnvCount)
158 return m_lppEnvList[dwIndex-1];
164 LPSTR Find(LPCSTR lpStr);
165 void Add(LPCSTR lpStr);
167 LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
168 void FreeLocalEnvironmentStrings(LPSTR lpStr);
169 LPSTR* Lookup(LPCSTR lpStr);
170 DWORD CalculateEnvironmentSpace(void);
175 virtual int Chdir(const char *dirname);
179 void Exit(int status);
180 void _Exit(int status);
181 int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
182 int Execv(const char *cmdname, const char *const *argv);
183 int Execvp(const char *cmdname, const char *const *argv);
185 inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
186 inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
187 inline VDir* GetDir(void) { return m_pvDir; };
191 struct IPerlMem m_hostperlMem;
192 struct IPerlMem m_hostperlMemShared;
193 struct IPerlMem m_hostperlMemParse;
194 struct IPerlEnv m_hostperlEnv;
195 struct IPerlStdIO m_hostperlStdIO;
196 struct IPerlLIO m_hostperlLIO;
197 struct IPerlDir m_hostperlDir;
198 struct IPerlSock m_hostperlSock;
199 struct IPerlProc m_hostperlProc;
201 struct IPerlMem* m_pHostperlMem;
202 struct IPerlMem* m_pHostperlMemShared;
203 struct IPerlMem* m_pHostperlMemParse;
204 struct IPerlEnv* m_pHostperlEnv;
205 struct IPerlStdIO* m_pHostperlStdIO;
206 struct IPerlLIO* m_pHostperlLIO;
207 struct IPerlDir* m_pHostperlDir;
208 struct IPerlSock* m_pHostperlSock;
209 struct IPerlProc* m_pHostperlProc;
211 inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
212 inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
222 BOOL m_bTopLevel; // is this a toplevel host?
223 static long num_hosts;
225 inline int LastHost(void) { return num_hosts == 1L; };
226 struct interpreter *host_perl;
229 long CPerlHost::num_hosts = 0L;
231 extern "C" void win32_checkTLS(struct interpreter *host_perl);
233 #define STRUCT2RAWPTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
234 #ifdef CHECK_HOST_INTERP
235 inline CPerlHost* CheckInterp(CPerlHost *host)
237 win32_checkTLS(host->host_perl);
240 #define STRUCT2PTR(x, y) CheckInterp(STRUCT2RAWPTR(x, y))
242 #define STRUCT2PTR(x, y) STRUCT2RAWPTR(x, y)
245 inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
247 return STRUCT2RAWPTR(piPerl, m_hostperlMem);
250 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
252 return STRUCT2RAWPTR(piPerl, m_hostperlMemShared);
255 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
257 return STRUCT2RAWPTR(piPerl, m_hostperlMemParse);
260 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
262 return STRUCT2PTR(piPerl, m_hostperlEnv);
265 inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
267 return STRUCT2PTR(piPerl, m_hostperlStdIO);
270 inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
272 return STRUCT2PTR(piPerl, m_hostperlLIO);
275 inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
277 return STRUCT2PTR(piPerl, m_hostperlDir);
280 inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
282 return STRUCT2PTR(piPerl, m_hostperlSock);
285 inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
287 return STRUCT2PTR(piPerl, m_hostperlProc);
293 #define IPERL2HOST(x) IPerlMem2Host(x)
297 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
299 return IPERL2HOST(piPerl)->Malloc(size);
302 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
304 return IPERL2HOST(piPerl)->Realloc(ptr, size);
307 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
309 IPERL2HOST(piPerl)->Free(ptr);
312 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
314 return IPERL2HOST(piPerl)->Calloc(num, size);
318 PerlMemGetLock(struct IPerlMem* piPerl)
320 IPERL2HOST(piPerl)->GetLock();
324 PerlMemFreeLock(struct IPerlMem* piPerl)
326 IPERL2HOST(piPerl)->FreeLock();
330 PerlMemIsLocked(struct IPerlMem* piPerl)
332 return IPERL2HOST(piPerl)->IsLocked();
335 struct IPerlMem perlMem =
347 #define IPERL2HOST(x) IPerlMemShared2Host(x)
351 PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
353 return IPERL2HOST(piPerl)->MallocShared(size);
356 PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
358 return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
361 PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
363 IPERL2HOST(piPerl)->FreeShared(ptr);
366 PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
368 return IPERL2HOST(piPerl)->CallocShared(num, size);
372 PerlMemSharedGetLock(struct IPerlMem* piPerl)
374 IPERL2HOST(piPerl)->GetLockShared();
378 PerlMemSharedFreeLock(struct IPerlMem* piPerl)
380 IPERL2HOST(piPerl)->FreeLockShared();
384 PerlMemSharedIsLocked(struct IPerlMem* piPerl)
386 return IPERL2HOST(piPerl)->IsLockedShared();
389 struct IPerlMem perlMemShared =
392 PerlMemSharedRealloc,
395 PerlMemSharedGetLock,
396 PerlMemSharedFreeLock,
397 PerlMemSharedIsLocked,
401 #define IPERL2HOST(x) IPerlMemParse2Host(x)
405 PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
407 return IPERL2HOST(piPerl)->MallocParse(size);
410 PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
412 return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
415 PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
417 IPERL2HOST(piPerl)->FreeParse(ptr);
420 PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
422 return IPERL2HOST(piPerl)->CallocParse(num, size);
426 PerlMemParseGetLock(struct IPerlMem* piPerl)
428 IPERL2HOST(piPerl)->GetLockParse();
432 PerlMemParseFreeLock(struct IPerlMem* piPerl)
434 IPERL2HOST(piPerl)->FreeLockParse();
438 PerlMemParseIsLocked(struct IPerlMem* piPerl)
440 return IPERL2HOST(piPerl)->IsLockedParse();
443 struct IPerlMem perlMemParse =
450 PerlMemParseFreeLock,
451 PerlMemParseIsLocked,
456 #define IPERL2HOST(x) IPerlEnv2Host(x)
460 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
462 return IPERL2HOST(piPerl)->Getenv(varname);
466 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
468 return IPERL2HOST(piPerl)->Putenv(envstring);
472 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
474 return IPERL2HOST(piPerl)->Getenv(varname, len);
478 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
480 return win32_uname(name);
484 PerlEnvClearenv(struct IPerlEnv* piPerl)
486 IPERL2HOST(piPerl)->Clearenv();
490 PerlEnvGetChildenv(struct IPerlEnv* piPerl)
492 return IPERL2HOST(piPerl)->CreateChildEnv();
496 PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
498 IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
502 PerlEnvGetChilddir(struct IPerlEnv* piPerl)
504 return IPERL2HOST(piPerl)->GetChildDir();
508 PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
510 IPERL2HOST(piPerl)->FreeChildDir(childDir);
514 PerlEnvOsId(struct IPerlEnv* piPerl)
516 return win32_os_id();
520 PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
522 return g_win32_get_privlib(pl);
526 PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
528 return g_win32_get_sitelib(pl);
532 PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
534 return g_win32_get_vendorlib(pl);
538 PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
540 win32_get_child_IO(ptr);
543 struct IPerlEnv perlEnv =
557 PerlEnvVendorLibPath,
562 #define IPERL2HOST(x) IPerlStdIO2Host(x)
566 PerlStdIOStdin(struct IPerlStdIO* piPerl)
568 return win32_stdin();
572 PerlStdIOStdout(struct IPerlStdIO* piPerl)
574 return win32_stdout();
578 PerlStdIOStderr(struct IPerlStdIO* piPerl)
580 return win32_stderr();
584 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
586 return win32_fopen(path, mode);
590 PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf)
592 return win32_fclose((pf));
596 PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf)
598 return win32_feof(pf);
602 PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf)
604 return win32_ferror(pf);
608 PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf)
614 PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf)
616 return win32_getc(pf);
620 PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf)
631 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf)
635 return FILE_bufsiz(f);
642 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf)
653 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
664 PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n)
666 return win32_fgets(s, n, pf);
670 PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c)
672 return win32_fputc(c, pf);
676 PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s)
678 return win32_fputs(s, pf);
682 PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf)
684 return win32_fflush(pf);
688 PerlStdIOUngetc(struct IPerlStdIO* piPerl,int c, FILE* pf)
690 return win32_ungetc(c, pf);
694 PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf)
696 return win32_fileno(pf);
700 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
702 return win32_fdopen(fd, mode);
706 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf)
708 return win32_freopen(path, mode, (FILE*)pf);
712 PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf)
714 return win32_fread(buffer, size, count, pf);
718 PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf)
720 return win32_fwrite(buffer, size, count, pf);
724 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer)
726 win32_setbuf(pf, buffer);
730 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size)
732 return win32_setvbuf(pf, buffer, type, size);
736 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n)
738 #ifdef STDIO_CNT_LVALUE
745 PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr)
747 #ifdef STDIO_PTR_LVALUE
754 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf)
756 win32_setvbuf(pf, NULL, _IOLBF, 0);
760 PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...)
763 va_start(arglist, format);
764 return win32_vfprintf(pf, format, arglist);
768 PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist)
770 return win32_vfprintf(pf, format, arglist);
774 PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf)
776 return win32_ftell(pf);
780 PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, Off_t offset, int origin)
782 return win32_fseek(pf, offset, origin);
786 PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf)
792 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
794 return win32_tmpfile();
798 PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p)
800 return win32_fgetpos(pf, p);
804 PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p)
806 return win32_fsetpos(pf, p);
809 PerlStdIOInit(struct IPerlStdIO* piPerl)
814 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
816 Perl_init_os_extras();
820 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, intptr_t osfhandle, int flags)
822 return win32_open_osfhandle(osfhandle, flags);
826 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
828 return win32_get_osfhandle(filenum);
832 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
838 int fileno = win32_dup(win32_fileno(pf));
840 /* open the file in the same mode */
842 if((pf)->flags & _F_READ) {
846 else if((pf)->flags & _F_WRIT) {
850 else if((pf)->flags & _F_RDWR) {
856 if((pf)->_flag & _IOREAD) {
860 else if((pf)->_flag & _IOWRT) {
864 else if((pf)->_flag & _IORW) {
871 /* it appears that the binmode is attached to the
872 * file descriptor so binmode files will be handled
875 pfdup = win32_fdopen(fileno, mode);
877 /* move the file pointer to the same position */
878 if (!fgetpos(pf, &pos)) {
879 fsetpos(pfdup, &pos);
887 struct IPerlStdIO perlStdIO =
926 PerlStdIOInitOSExtras,
932 #define IPERL2HOST(x) IPerlLIO2Host(x)
936 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
938 return win32_access(path, mode);
942 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
944 return win32_chmod(filename, pmode);
948 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
950 return chown(filename, owner, group);
954 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, Off_t size)
956 return win32_chsize(handle, size);
960 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
962 return win32_close(handle);
966 PerlLIODup(struct IPerlLIO* piPerl, int handle)
968 return win32_dup(handle);
972 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
974 return win32_dup2(handle1, handle2);
978 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
980 return win32_flock(fd, oper);
984 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, Stat_t *buffer)
986 return win32_fstat(handle, buffer);
990 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
992 return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
996 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
1002 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
1004 return win32_link(oldname, newname);
1008 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, Off_t offset, int origin)
1010 return win32_lseek(handle, offset, origin);
1014 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer)
1016 return win32_stat(path, buffer);
1020 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
1022 return mktemp(Template);
1026 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
1028 return win32_open(filename, oflag);
1032 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
1034 return win32_open(filename, oflag, pmode);
1038 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
1040 return win32_read(handle, buffer, count);
1044 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
1046 return win32_rename(OldFileName, newname);
1050 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1052 return win32_setmode(handle, mode);
1056 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer)
1058 return win32_stat(path, buffer);
1062 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1064 return tmpnam(string);
1068 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1070 return umask(pmode);
1074 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1076 return win32_unlink(filename);
1080 PerlLIOUtime(struct IPerlLIO* piPerl, const char *filename, struct utimbuf *times)
1082 return win32_utime(filename, times);
1086 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1088 return win32_write(handle, buffer, count);
1091 struct IPerlLIO perlLIO =
1123 #define IPERL2HOST(x) IPerlDir2Host(x)
1127 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1129 return win32_mkdir(dirname, mode);
1133 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1135 return IPERL2HOST(piPerl)->Chdir(dirname);
1139 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1141 return win32_rmdir(dirname);
1145 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1147 return win32_closedir(dirp);
1151 PerlDirOpen(struct IPerlDir* piPerl, const char *filename)
1153 return win32_opendir(filename);
1157 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1159 return win32_readdir(dirp);
1163 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1165 win32_rewinddir(dirp);
1169 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1171 win32_seekdir(dirp, loc);
1175 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1177 return win32_telldir(dirp);
1181 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1183 return IPERL2HOST(piPerl)->MapPathA(path);
1187 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1189 return IPERL2HOST(piPerl)->MapPathW(path);
1192 struct IPerlDir perlDir =
1210 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1212 return win32_htonl(hostlong);
1216 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1218 return win32_htons(hostshort);
1222 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1224 return win32_ntohl(netlong);
1228 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1230 return win32_ntohs(netshort);
1233 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1235 return win32_accept(s, addr, addrlen);
1239 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1241 return win32_bind(s, name, namelen);
1245 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1247 return win32_connect(s, name, namelen);
1251 PerlSockEndhostent(struct IPerlSock* piPerl)
1257 PerlSockEndnetent(struct IPerlSock* piPerl)
1263 PerlSockEndprotoent(struct IPerlSock* piPerl)
1265 win32_endprotoent();
1269 PerlSockEndservent(struct IPerlSock* piPerl)
1275 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1277 return win32_gethostbyaddr(addr, len, type);
1281 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1283 return win32_gethostbyname(name);
1287 PerlSockGethostent(struct IPerlSock* piPerl)
1290 Perl_croak(aTHX_ "gethostent not implemented!\n");
1295 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1297 return win32_gethostname(name, namelen);
1301 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1303 return win32_getnetbyaddr(net, type);
1307 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1309 return win32_getnetbyname((char*)name);
1313 PerlSockGetnetent(struct IPerlSock* piPerl)
1315 return win32_getnetent();
1318 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1320 return win32_getpeername(s, name, namelen);
1324 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1326 return win32_getprotobyname(name);
1330 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1332 return win32_getprotobynumber(number);
1336 PerlSockGetprotoent(struct IPerlSock* piPerl)
1338 return win32_getprotoent();
1342 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1344 return win32_getservbyname(name, proto);
1348 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1350 return win32_getservbyport(port, proto);
1354 PerlSockGetservent(struct IPerlSock* piPerl)
1356 return win32_getservent();
1360 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1362 return win32_getsockname(s, name, namelen);
1366 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1368 return win32_getsockopt(s, level, optname, optval, optlen);
1372 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1374 return win32_inet_addr(cp);
1378 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1380 return win32_inet_ntoa(in);
1384 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1386 return win32_listen(s, backlog);
1390 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1392 return win32_recv(s, buffer, len, flags);
1396 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1398 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1402 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1404 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1408 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1410 return win32_send(s, buffer, len, flags);
1414 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1416 return win32_sendto(s, buffer, len, flags, to, tolen);
1420 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1422 win32_sethostent(stayopen);
1426 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1428 win32_setnetent(stayopen);
1432 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1434 win32_setprotoent(stayopen);
1438 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1440 win32_setservent(stayopen);
1444 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1446 return win32_setsockopt(s, level, optname, optval, optlen);
1450 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1452 return win32_shutdown(s, how);
1456 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1458 return win32_socket(af, type, protocol);
1462 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1464 return Perl_my_socketpair(domain, type, protocol, fds);
1468 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1470 return win32_closesocket(s);
1474 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1476 return win32_ioctlsocket(s, cmd, argp);
1479 struct IPerlSock perlSock =
1490 PerlSockEndprotoent,
1492 PerlSockGethostname,
1493 PerlSockGetpeername,
1494 PerlSockGethostbyaddr,
1495 PerlSockGethostbyname,
1497 PerlSockGetnetbyaddr,
1498 PerlSockGetnetbyname,
1500 PerlSockGetprotobyname,
1501 PerlSockGetprotobynumber,
1502 PerlSockGetprotoent,
1503 PerlSockGetservbyname,
1504 PerlSockGetservbyport,
1506 PerlSockGetsockname,
1518 PerlSockSetprotoent,
1524 PerlSockClosesocket,
1530 #define EXECF_EXEC 1
1531 #define EXECF_SPAWN 2
1534 PerlProcAbort(struct IPerlProc* piPerl)
1540 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1542 return win32_crypt(clear, salt);
1546 PerlProcExit(struct IPerlProc* piPerl, int status)
1552 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1558 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1560 return execl(cmdname, arg0, arg1, arg2, arg3);
1564 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1566 return win32_execvp(cmdname, argv);
1570 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1572 return win32_execvp(cmdname, argv);
1576 PerlProcGetuid(struct IPerlProc* piPerl)
1582 PerlProcGeteuid(struct IPerlProc* piPerl)
1588 PerlProcGetgid(struct IPerlProc* piPerl)
1594 PerlProcGetegid(struct IPerlProc* piPerl)
1600 PerlProcGetlogin(struct IPerlProc* piPerl)
1602 return g_getlogin();
1606 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1608 return win32_kill(pid, sig);
1612 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1614 return win32_kill(pid, -sig);
1618 PerlProcPauseProc(struct IPerlProc* piPerl)
1620 return win32_sleep((32767L << 16) + 32767);
1624 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1627 PERL_FLUSHALL_FOR_CHILD;
1628 return win32_popen(command, mode);
1632 PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
1635 PERL_FLUSHALL_FOR_CHILD;
1636 return win32_popenlist(mode, narg, args);
1640 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1642 return win32_pclose(stream);
1646 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1648 return win32_pipe(phandles, 512, O_BINARY);
1652 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1658 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1664 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1666 return win32_sleep(s);
1670 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1672 return win32_times(timebuf);
1676 PerlProcWait(struct IPerlProc* piPerl, int *status)
1678 return win32_wait(status);
1682 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1684 return win32_waitpid(pid, status, flags);
1688 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1690 return win32_signal(sig, subcode);
1694 PerlProcGetTimeOfDay(struct IPerlProc* piPerl, struct timeval *t, void *z)
1696 return win32_gettimeofday(t, z);
1700 static THREAD_RET_TYPE
1701 win32_start_child(LPVOID arg)
1703 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1706 HWND parent_message_hwnd;
1707 #ifdef PERL_SYNC_FORK
1708 static long sync_fork_id = 0;
1709 long id = ++sync_fork_id;
1713 PERL_SET_THX(my_perl);
1714 win32_checkTLS(my_perl);
1716 /* set $$ to pseudo id */
1717 #ifdef PERL_SYNC_FORK
1720 w32_pseudo_id = GetCurrentThreadId();
1722 int pid = (int)w32_pseudo_id;
1724 w32_pseudo_id = -pid;
1727 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) {
1728 SV *sv = GvSV(tmpgv);
1730 sv_setiv(sv, -(IV)w32_pseudo_id);
1733 #ifdef PERL_USES_PL_PIDSTATUS
1734 hv_clear(PL_pidstatus);
1737 /* create message window and tell parent about it */
1738 parent_message_hwnd = w32_message_hwnd;
1739 w32_message_hwnd = win32_create_message_window();
1740 if (parent_message_hwnd != NULL)
1741 PostMessage(parent_message_hwnd, WM_USER_MESSAGE, w32_pseudo_id, (LONG)w32_message_hwnd);
1743 /* push a zero on the stack (we are the child) */
1751 /* continue from next op */
1752 PL_op = PL_op->op_next;
1756 volatile int oldscope = PL_scopestack_ix;
1759 JMPENV_PUSH(status);
1766 while (PL_scopestack_ix > oldscope)
1769 PL_curstash = PL_defstash;
1770 if (PL_endav && !PL_minus_c)
1771 call_list(oldscope, PL_endav);
1772 status = STATUS_EXIT;
1776 POPSTACK_TO(PL_mainstack);
1777 PL_op = PL_restartop;
1778 PL_restartop = Nullop;
1781 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1788 /* XXX hack to avoid perl_destruct() freeing optree */
1789 win32_checkTLS(my_perl);
1790 PL_main_root = Nullop;
1793 win32_checkTLS(my_perl);
1794 /* close the std handles to avoid fd leaks */
1796 do_close(PL_stdingv, FALSE);
1797 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE); /* PL_stdoutgv - ISAGN */
1798 do_close(PL_stderrgv, FALSE);
1801 /* destroy everything (waits for any pseudo-forked children) */
1802 win32_checkTLS(my_perl);
1803 perl_destruct(my_perl);
1804 win32_checkTLS(my_perl);
1807 #ifdef PERL_SYNC_FORK
1810 return (DWORD)status;
1813 #endif /* USE_ITHREADS */
1816 PerlProcFork(struct IPerlProc* piPerl)
1824 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1828 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1829 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 1,
1831 h->m_pHostperlMemShared,
1832 h->m_pHostperlMemParse,
1834 h->m_pHostperlStdIO,
1840 new_perl->Isys_intern.internal_host = h;
1841 h->host_perl = new_perl;
1842 # ifdef PERL_SYNC_FORK
1843 id = win32_start_child((LPVOID)new_perl);
1846 if (w32_message_hwnd == INVALID_HANDLE_VALUE)
1847 w32_message_hwnd = win32_create_message_window();
1848 new_perl->Isys_intern.message_hwnd = w32_message_hwnd;
1849 w32_pseudo_child_message_hwnds[w32_num_pseudo_children] =
1850 (w32_message_hwnd == NULL) ? (HWND)NULL : (HWND)INVALID_HANDLE_VALUE;
1851 # ifdef USE_RTL_THREAD_API
1852 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1853 (void*)new_perl, 0, (unsigned*)&id);
1855 handle = CreateThread(NULL, 0, win32_start_child,
1856 (LPVOID)new_perl, 0, &id);
1858 PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
1868 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1869 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1870 ++w32_num_pseudo_children;
1874 Perl_croak(aTHX_ "fork() not implemented!\n");
1876 #endif /* USE_ITHREADS */
1880 PerlProcGetpid(struct IPerlProc* piPerl)
1882 return win32_getpid();
1886 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1888 return win32_dynaload(filename);
1892 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1894 win32_str_os_error(sv, dwErr);
1898 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1900 return win32_spawnvp(mode, cmdname, argv);
1904 PerlProcLastHost(struct IPerlProc* piPerl)
1907 CPerlHost *h = (CPerlHost*)w32_internal_host;
1908 return h->LastHost();
1911 struct IPerlProc perlProc =
1945 PerlProcGetTimeOfDay
1953 CPerlHost::CPerlHost(void)
1955 /* Construct a host from scratch */
1956 InterlockedIncrement(&num_hosts);
1957 m_pvDir = new VDir();
1958 m_pVMem = new VMem();
1959 m_pVMemShared = new VMem();
1960 m_pVMemParse = new VMem();
1962 m_pvDir->Init(NULL, m_pVMem);
1965 m_lppEnvList = NULL;
1968 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1969 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1970 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1971 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1972 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1973 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1974 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1975 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1976 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1978 m_pHostperlMem = &m_hostperlMem;
1979 m_pHostperlMemShared = &m_hostperlMemShared;
1980 m_pHostperlMemParse = &m_hostperlMemParse;
1981 m_pHostperlEnv = &m_hostperlEnv;
1982 m_pHostperlStdIO = &m_hostperlStdIO;
1983 m_pHostperlLIO = &m_hostperlLIO;
1984 m_pHostperlDir = &m_hostperlDir;
1985 m_pHostperlSock = &m_hostperlSock;
1986 m_pHostperlProc = &m_hostperlProc;
1989 #define SETUPEXCHANGE(xptr, iptr, table) \
2000 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
2001 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
2002 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
2003 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
2004 struct IPerlProc** ppProc)
2006 InterlockedIncrement(&num_hosts);
2007 m_pvDir = new VDir(0);
2008 m_pVMem = new VMem();
2009 m_pVMemShared = new VMem();
2010 m_pVMemParse = new VMem();
2012 m_pvDir->Init(NULL, m_pVMem);
2015 m_lppEnvList = NULL;
2016 m_bTopLevel = FALSE;
2018 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2019 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2020 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2021 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2022 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2023 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2024 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2025 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2026 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2028 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
2029 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
2030 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
2031 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
2032 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
2033 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
2034 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
2035 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
2036 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
2038 #undef SETUPEXCHANGE
2040 CPerlHost::CPerlHost(CPerlHost& host)
2042 /* Construct a host from another host */
2043 InterlockedIncrement(&num_hosts);
2044 m_pVMem = new VMem();
2045 m_pVMemShared = host.GetMemShared();
2046 m_pVMemParse = host.GetMemParse();
2048 /* duplicate directory info */
2049 m_pvDir = new VDir(0);
2050 m_pvDir->Init(host.GetDir(), m_pVMem);
2052 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2053 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2054 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2055 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2056 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2057 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2058 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2059 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2060 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2061 m_pHostperlMem = &m_hostperlMem;
2062 m_pHostperlMemShared = &m_hostperlMemShared;
2063 m_pHostperlMemParse = &m_hostperlMemParse;
2064 m_pHostperlEnv = &m_hostperlEnv;
2065 m_pHostperlStdIO = &m_hostperlStdIO;
2066 m_pHostperlLIO = &m_hostperlLIO;
2067 m_pHostperlDir = &m_hostperlDir;
2068 m_pHostperlSock = &m_hostperlSock;
2069 m_pHostperlProc = &m_hostperlProc;
2072 m_lppEnvList = NULL;
2073 m_bTopLevel = FALSE;
2075 /* duplicate environment info */
2078 while(lpPtr = host.GetIndex(dwIndex))
2082 CPerlHost::~CPerlHost(void)
2085 InterlockedDecrement(&num_hosts);
2087 m_pVMemParse->Release();
2088 m_pVMemShared->Release();
2093 CPerlHost::Find(LPCSTR lpStr)
2096 LPSTR* lppPtr = Lookup(lpStr);
2097 if(lppPtr != NULL) {
2098 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2110 lookup(const void *arg1, const void *arg2)
2111 { // Compare strings
2115 ptr1 = *(char**)arg1;
2116 ptr2 = *(char**)arg2;
2120 if(c1 == '\0' || c1 == '=') {
2121 if(c2 == '\0' || c2 == '=')
2124 return -1; // string 1 < string 2
2126 else if(c2 == '\0' || c2 == '=')
2127 return 1; // string 1 > string 2
2133 return -1; // string 1 < string 2
2135 return 1; // string 1 > string 2
2143 CPerlHost::Lookup(LPCSTR lpStr)
2146 if (!m_lppEnvList || !m_dwEnvCount)
2151 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2155 compare(const void *arg1, const void *arg2)
2156 { // Compare strings
2160 ptr1 = *(char**)arg1;
2161 ptr2 = *(char**)arg2;
2165 if(c1 == '\0' || c1 == '=') {
2169 return -1; // string 1 < string 2
2171 else if(c2 == '\0' || c2 == '=')
2172 return 1; // string 1 > string 2
2178 return -1; // string 1 < string 2
2180 return 1; // string 1 > string 2
2188 CPerlHost::Add(LPCSTR lpStr)
2191 char szBuffer[1024];
2193 int index, length = strlen(lpStr)+1;
2195 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2196 szBuffer[index] = lpStr[index];
2198 szBuffer[index] = '\0';
2201 lpPtr = Lookup(szBuffer);
2202 if (lpPtr != NULL) {
2203 // must allocate things via host memory allocation functions
2204 // rather than perl's Renew() et al, as the perl interpreter
2205 // may either not be initialized enough when we allocate these,
2206 // or may already be dead when we go to free these
2207 *lpPtr = (char*)Realloc(*lpPtr, length * sizeof(char));
2208 strcpy(*lpPtr, lpStr);
2211 m_lppEnvList = (LPSTR*)Realloc(m_lppEnvList, (m_dwEnvCount+1) * sizeof(LPSTR));
2213 m_lppEnvList[m_dwEnvCount] = (char*)Malloc(length * sizeof(char));
2214 if (m_lppEnvList[m_dwEnvCount] != NULL) {
2215 strcpy(m_lppEnvList[m_dwEnvCount], lpStr);
2217 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2224 CPerlHost::CalculateEnvironmentSpace(void)
2228 for(index = 0; index < m_dwEnvCount; ++index)
2229 dwSize += strlen(m_lppEnvList[index]) + 1;
2235 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2242 get_valid_filename(pTHX_ WCHAR *widename)
2245 BOOL use_default = FALSE;
2246 size_t widelen = wcslen(widename)+1;
2247 int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
2248 NULL, 0, NULL, NULL);
2249 Newx(name, len, char);
2250 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
2251 name, len, NULL, &use_default);
2254 DWORD shortlen = GetShortPathNameW(widename, NULL, 0);
2255 Newx(shortname, shortlen, WCHAR);
2256 shortlen = GetShortPathNameW(widename, shortname, shortlen)+1;
2257 len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
2258 NULL, 0, NULL, NULL);
2259 Renew(name, len, char);
2260 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
2261 name, len, NULL, NULL);
2262 Safefree(shortname);
2268 CPerlHost::GetChildDir(void)
2275 Newx(ptr, MAX_PATH+1, char);
2276 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2279 WCHAR path[MAX_PATH+1];
2280 m_pvDir->GetCurrentDirectoryW(MAX_PATH+1, path);
2281 ptr = get_valid_filename(aTHX_ path);
2283 length = strlen(ptr);
2285 if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2292 CPerlHost::FreeChildDir(char* pStr)
2299 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2302 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2303 DWORD dwSize, dwEnvIndex;
2304 int nLength, compVal;
2306 // get the process environment strings
2307 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2309 // step over current directory stuff
2310 while(*lpTmp == '=')
2311 lpTmp += strlen(lpTmp) + 1;
2313 // save the start of the environment strings
2315 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2316 // calculate the size of the environment strings
2317 dwSize += strlen(lpTmp) + 1;
2320 // add the size of current directories
2321 dwSize += vDir.CalculateEnvironmentSpace();
2323 // add the additional space used by changes made to the environment
2324 dwSize += CalculateEnvironmentSpace();
2326 Newx(lpStr, dwSize, char);
2329 // build the local environment
2330 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2333 lpLocalEnv = GetIndex(dwEnvIndex);
2334 while(*lpEnvPtr != '\0') {
2336 // all environment overrides have been added
2337 // so copy string into place
2338 strcpy(lpStr, lpEnvPtr);
2339 nLength = strlen(lpEnvPtr) + 1;
2341 lpEnvPtr += nLength;
2344 // determine which string to copy next
2345 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2347 strcpy(lpStr, lpEnvPtr);
2348 nLength = strlen(lpEnvPtr) + 1;
2350 lpEnvPtr += nLength;
2353 char *ptr = strchr(lpLocalEnv, '=');
2355 strcpy(lpStr, lpLocalEnv);
2356 lpStr += strlen(lpLocalEnv) + 1;
2358 lpLocalEnv = GetIndex(dwEnvIndex);
2360 // this string was replaced
2361 lpEnvPtr += strlen(lpEnvPtr) + 1;
2368 // still have environment overrides to add
2369 // so copy the strings into place if not an override
2370 char *ptr = strchr(lpLocalEnv, '=');
2372 strcpy(lpStr, lpLocalEnv);
2373 lpStr += strlen(lpLocalEnv) + 1;
2375 lpLocalEnv = GetIndex(dwEnvIndex);
2382 // release the process environment strings
2383 FreeEnvironmentStrings(lpAllocPtr);
2389 CPerlHost::Reset(void)
2392 if(m_lppEnvList != NULL) {
2393 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2394 Free(m_lppEnvList[index]);
2395 m_lppEnvList[index] = NULL;
2400 m_lppEnvList = NULL;
2404 CPerlHost::Clearenv(void)
2408 LPSTR lpPtr, lpStr, lpEnvPtr;
2409 if (m_lppEnvList != NULL) {
2410 /* set every entry to an empty string */
2411 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2412 char* ptr = strchr(m_lppEnvList[index], '=');
2419 /* get the process environment strings */
2420 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2422 /* step over current directory stuff */
2423 while(*lpStr == '=')
2424 lpStr += strlen(lpStr) + 1;
2427 lpPtr = strchr(lpStr, '=');
2433 (void)win32_putenv(lpStr);
2436 lpStr += strlen(lpStr) + 1;
2439 FreeEnvironmentStrings(lpEnvPtr);
2444 CPerlHost::Getenv(const char *varname)
2448 char *pEnv = Find(varname);
2452 return win32_getenv(varname);
2456 CPerlHost::Putenv(const char *envstring)
2461 return win32_putenv(envstring);
2467 CPerlHost::Chdir(const char *dirname)
2475 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2482 #endif /* ___PerlHost_H___ */