This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Win32-ize socketpair test
[perl5.git] / win32 / perlhost.h
CommitLineData
7766f137
GS
1/* perlhost.h
2 *
f3dccfae 3 * (c) 1999 Microsoft Corporation. All rights reserved.
7766f137
GS
4 * Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/
5 *
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.
8 */
9
10#ifndef ___PerlHost_H___
11#define ___PerlHost_H___
12
71d280e3 13#include <signal.h>
7766f137
GS
14#include "iperlsys.h"
15#include "vmem.h"
16#include "vdir.h"
17
7766f137 18START_EXTERN_C
4ea817c6
GS
19extern char * g_win32_get_privlib(const char *pl);
20extern char * g_win32_get_sitelib(const char *pl);
21extern char * g_win32_get_vendorlib(const char *pl);
7766f137
GS
22extern char * g_getlogin(void);
23extern int do_spawn2(char *cmd, int exectype);
7766f137 24END_EXTERN_C
7766f137
GS
25
26class CPerlHost
27{
28public:
5f1a76d0 29 /* Constructors */
7766f137
GS
30 CPerlHost(void);
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);
37 ~CPerlHost(void);
38
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);
48
49 BOOL PerlCreate(void);
50 int PerlParse(int argc, char** argv, char** env);
51 int PerlRun(void);
52 void PerlDestroy(void);
53
54/* IPerlMem */
f3dccfae 55 /* Locks provided but should be unnecessary as this is private pool */
7766f137
GS
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)
60 {
61 size_t count = num*size;
62 void* lpVoid = Malloc(count);
63 if (lpVoid)
64 ZeroMemory(lpVoid, count);
65 return lpVoid;
66 };
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(); };
70
71/* IPerlMemShared */
f3dccfae
NIS
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(); };
7766f137
GS
76 inline void* MallocShared(size_t size)
77 {
f3dccfae
NIS
78 void *result;
79 GetLockShared();
80 result = m_pVMemShared->Malloc(size);
7fcdafbd 81 FreeLockShared();
f3dccfae
NIS
82 return result;
83 };
84 inline void* ReallocShared(void* ptr, size_t size)
85 {
86 void *result;
87 GetLockShared();
88 result = m_pVMemShared->Realloc(ptr, size);
7fcdafbd 89 FreeLockShared();
f3dccfae
NIS
90 return result;
91 };
92 inline void FreeShared(void* ptr)
93 {
94 GetLockShared();
95 m_pVMemShared->Free(ptr);
7fcdafbd 96 FreeLockShared();
7766f137 97 };
7766f137
GS
98 inline void* CallocShared(size_t num, size_t size)
99 {
100 size_t count = num*size;
101 void* lpVoid = MallocShared(count);
102 if (lpVoid)
103 ZeroMemory(lpVoid, count);
104 return lpVoid;
105 };
7766f137
GS
106
107/* IPerlMemParse */
f3dccfae
NIS
108 /* Assume something else is using locks to mangaging serialize
109 on a batch basis
110 */
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(); };
7766f137
GS
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)
118 {
119 size_t count = num*size;
120 void* lpVoid = MallocParse(count);
121 if (lpVoid)
122 ZeroMemory(lpVoid, count);
123 return lpVoid;
124 };
7766f137
GS
125
126/* IPerlEnv */
127 char *Getenv(const char *varname);
128 int Putenv(const char *envstring);
129 inline char *Getenv(const char *varname, unsigned long *len)
130 {
131 *len = 0;
132 char *e = Getenv(varname);
133 if (e)
134 *len = strlen(e);
135 return e;
136 }
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);
141 void Reset(void);
142 void Clearenv(void);
143
144 inline LPSTR GetIndex(DWORD &dwIndex)
145 {
146 if(dwIndex < m_dwEnvCount)
147 {
148 ++dwIndex;
149 return m_lppEnvList[dwIndex-1];
150 }
151 return NULL;
152 };
153
154protected:
155 LPSTR Find(LPCSTR lpStr);
156 void Add(LPCSTR lpStr);
157
158 LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
159 void FreeLocalEnvironmentStrings(LPSTR lpStr);
160 LPSTR* Lookup(LPCSTR lpStr);
161 DWORD CalculateEnvironmentSpace(void);
162
163public:
164
165/* IPerlDIR */
166 virtual int Chdir(const char *dirname);
167
168/* IPerllProc */
169 void Abort(void);
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);
175
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; };
179
180public:
181
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;
191
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;
201
202 inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
203 inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
204protected:
205
206 VDir* m_pvDir;
207 VMem* m_pVMem;
208 VMem* m_pVMemShared;
209 VMem* m_pVMemParse;
210
211 DWORD m_dwEnvCount;
212 LPSTR* m_lppEnvList;
52cbf511 213 BOOL m_bTopLevel; // is this a toplevel host?
5f1a76d0
NIS
214 static long num_hosts;
215public:
216 inline int LastHost(void) { return num_hosts == 1L; };
7766f137
GS
217};
218
5f1a76d0
NIS
219long CPerlHost::num_hosts = 0L;
220
7766f137
GS
221
222#define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
223
224inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
225{
226 return STRUCT2PTR(piPerl, m_hostperlMem);
227}
228
229inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
230{
231 return STRUCT2PTR(piPerl, m_hostperlMemShared);
232}
233
234inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
235{
236 return STRUCT2PTR(piPerl, m_hostperlMemParse);
237}
238
239inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
240{
241 return STRUCT2PTR(piPerl, m_hostperlEnv);
242}
243
244inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
245{
246 return STRUCT2PTR(piPerl, m_hostperlStdIO);
247}
248
249inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
250{
251 return STRUCT2PTR(piPerl, m_hostperlLIO);
252}
253
254inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
255{
256 return STRUCT2PTR(piPerl, m_hostperlDir);
257}
258
259inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
260{
261 return STRUCT2PTR(piPerl, m_hostperlSock);
262}
263
264inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
265{
266 return STRUCT2PTR(piPerl, m_hostperlProc);
267}
268
269
270
271#undef IPERL2HOST
272#define IPERL2HOST(x) IPerlMem2Host(x)
273
274/* IPerlMem */
275void*
276PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
277{
278 return IPERL2HOST(piPerl)->Malloc(size);
279}
280void*
281PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
282{
283 return IPERL2HOST(piPerl)->Realloc(ptr, size);
284}
285void
286PerlMemFree(struct IPerlMem* piPerl, void* ptr)
287{
288 IPERL2HOST(piPerl)->Free(ptr);
289}
290void*
291PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
292{
293 return IPERL2HOST(piPerl)->Calloc(num, size);
294}
295
296void
297PerlMemGetLock(struct IPerlMem* piPerl)
298{
299 IPERL2HOST(piPerl)->GetLock();
300}
301
302void
303PerlMemFreeLock(struct IPerlMem* piPerl)
304{
305 IPERL2HOST(piPerl)->FreeLock();
306}
307
308int
309PerlMemIsLocked(struct IPerlMem* piPerl)
310{
311 return IPERL2HOST(piPerl)->IsLocked();
312}
313
314struct IPerlMem perlMem =
315{
316 PerlMemMalloc,
317 PerlMemRealloc,
318 PerlMemFree,
319 PerlMemCalloc,
320 PerlMemGetLock,
321 PerlMemFreeLock,
322 PerlMemIsLocked,
323};
324
325#undef IPERL2HOST
326#define IPERL2HOST(x) IPerlMemShared2Host(x)
327
328/* IPerlMemShared */
329void*
330PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
331{
332 return IPERL2HOST(piPerl)->MallocShared(size);
333}
334void*
335PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
336{
337 return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
338}
339void
340PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
341{
342 IPERL2HOST(piPerl)->FreeShared(ptr);
343}
344void*
345PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
346{
347 return IPERL2HOST(piPerl)->CallocShared(num, size);
348}
349
350void
351PerlMemSharedGetLock(struct IPerlMem* piPerl)
352{
353 IPERL2HOST(piPerl)->GetLockShared();
354}
355
356void
357PerlMemSharedFreeLock(struct IPerlMem* piPerl)
358{
359 IPERL2HOST(piPerl)->FreeLockShared();
360}
361
362int
363PerlMemSharedIsLocked(struct IPerlMem* piPerl)
364{
365 return IPERL2HOST(piPerl)->IsLockedShared();
366}
367
368struct IPerlMem perlMemShared =
369{
370 PerlMemSharedMalloc,
371 PerlMemSharedRealloc,
372 PerlMemSharedFree,
373 PerlMemSharedCalloc,
374 PerlMemSharedGetLock,
375 PerlMemSharedFreeLock,
376 PerlMemSharedIsLocked,
377};
378
379#undef IPERL2HOST
380#define IPERL2HOST(x) IPerlMemParse2Host(x)
381
382/* IPerlMemParse */
383void*
384PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
385{
386 return IPERL2HOST(piPerl)->MallocParse(size);
387}
388void*
389PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
390{
391 return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
392}
393void
394PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
395{
396 IPERL2HOST(piPerl)->FreeParse(ptr);
397}
398void*
399PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
400{
401 return IPERL2HOST(piPerl)->CallocParse(num, size);
402}
403
404void
405PerlMemParseGetLock(struct IPerlMem* piPerl)
406{
407 IPERL2HOST(piPerl)->GetLockParse();
408}
409
410void
411PerlMemParseFreeLock(struct IPerlMem* piPerl)
412{
413 IPERL2HOST(piPerl)->FreeLockParse();
414}
415
416int
417PerlMemParseIsLocked(struct IPerlMem* piPerl)
418{
419 return IPERL2HOST(piPerl)->IsLockedParse();
420}
421
422struct IPerlMem perlMemParse =
423{
424 PerlMemParseMalloc,
425 PerlMemParseRealloc,
426 PerlMemParseFree,
427 PerlMemParseCalloc,
428 PerlMemParseGetLock,
429 PerlMemParseFreeLock,
430 PerlMemParseIsLocked,
431};
432
433
434#undef IPERL2HOST
435#define IPERL2HOST(x) IPerlEnv2Host(x)
436
437/* IPerlEnv */
438char*
439PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
440{
441 return IPERL2HOST(piPerl)->Getenv(varname);
442};
443
444int
445PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
446{
447 return IPERL2HOST(piPerl)->Putenv(envstring);
448};
449
450char*
451PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
452{
453 return IPERL2HOST(piPerl)->Getenv(varname, len);
454}
455
456int
457PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
458{
459 return win32_uname(name);
460}
461
462void
463PerlEnvClearenv(struct IPerlEnv* piPerl)
464{
465 IPERL2HOST(piPerl)->Clearenv();
466}
467
468void*
469PerlEnvGetChildenv(struct IPerlEnv* piPerl)
470{
471 return IPERL2HOST(piPerl)->CreateChildEnv();
472}
473
474void
475PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
476{
477 IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
478}
479
480char*
481PerlEnvGetChilddir(struct IPerlEnv* piPerl)
482{
483 return IPERL2HOST(piPerl)->GetChildDir();
484}
485
486void
487PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
488{
489 IPERL2HOST(piPerl)->FreeChildDir(childDir);
490}
491
492unsigned long
493PerlEnvOsId(struct IPerlEnv* piPerl)
494{
495 return win32_os_id();
496}
497
498char*
4ea817c6 499PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
7766f137
GS
500{
501 return g_win32_get_privlib(pl);
502}
503
504char*
4ea817c6 505PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
7766f137
GS
506{
507 return g_win32_get_sitelib(pl);
508}
509
4ea817c6
GS
510char*
511PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
512{
513 return g_win32_get_vendorlib(pl);
514}
515
635bbe87
GS
516void
517PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
518{
519 win32_get_child_IO(ptr);
520}
521
f3dccfae 522struct IPerlEnv perlEnv =
7766f137
GS
523{
524 PerlEnvGetenv,
525 PerlEnvPutenv,
526 PerlEnvGetenv_len,
527 PerlEnvUname,
528 PerlEnvClearenv,
529 PerlEnvGetChildenv,
530 PerlEnvFreeChildenv,
531 PerlEnvGetChilddir,
532 PerlEnvFreeChilddir,
533 PerlEnvOsId,
534 PerlEnvLibPath,
535 PerlEnvSiteLibPath,
4ea817c6 536 PerlEnvVendorLibPath,
635bbe87 537 PerlEnvGetChildIO,
7766f137
GS
538};
539
540#undef IPERL2HOST
541#define IPERL2HOST(x) IPerlStdIO2Host(x)
542
543/* PerlStdIO */
adb71456 544FILE*
7766f137
GS
545PerlStdIOStdin(struct IPerlStdIO* piPerl)
546{
adb71456 547 return win32_stdin();
7766f137
GS
548}
549
adb71456 550FILE*
7766f137
GS
551PerlStdIOStdout(struct IPerlStdIO* piPerl)
552{
adb71456 553 return win32_stdout();
7766f137
GS
554}
555
adb71456 556FILE*
7766f137
GS
557PerlStdIOStderr(struct IPerlStdIO* piPerl)
558{
adb71456 559 return win32_stderr();
7766f137
GS
560}
561
adb71456 562FILE*
7766f137
GS
563PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
564{
adb71456 565 return win32_fopen(path, mode);
7766f137
GS
566}
567
568int
adb71456 569PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 570{
adb71456 571 return win32_fclose((pf));
7766f137
GS
572}
573
574int
adb71456 575PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 576{
adb71456 577 return win32_feof(pf);
7766f137
GS
578}
579
580int
adb71456 581PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 582{
adb71456 583 return win32_ferror(pf);
7766f137
GS
584}
585
586void
adb71456 587PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 588{
adb71456 589 win32_clearerr(pf);
7766f137
GS
590}
591
592int
adb71456 593PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 594{
adb71456 595 return win32_getc(pf);
7766f137
GS
596}
597
598char*
adb71456 599PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf)
7766f137
GS
600{
601#ifdef FILE_base
adb71456 602 FILE *f = pf;
7766f137
GS
603 return FILE_base(f);
604#else
605 return Nullch;
606#endif
607}
608
609int
adb71456 610PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf)
7766f137
GS
611{
612#ifdef FILE_bufsiz
adb71456 613 FILE *f = pf;
7766f137
GS
614 return FILE_bufsiz(f);
615#else
616 return (-1);
617#endif
618}
619
620int
adb71456 621PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf)
7766f137
GS
622{
623#ifdef USE_STDIO_PTR
adb71456 624 FILE *f = pf;
7766f137
GS
625 return FILE_cnt(f);
626#else
627 return (-1);
628#endif
629}
630
631char*
adb71456 632PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
7766f137
GS
633{
634#ifdef USE_STDIO_PTR
adb71456 635 FILE *f = pf;
7766f137
GS
636 return FILE_ptr(f);
637#else
638 return Nullch;
639#endif
640}
641
642char*
adb71456 643PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n)
7766f137 644{
adb71456 645 return win32_fgets(s, n, pf);
7766f137
GS
646}
647
648int
adb71456 649PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c)
7766f137 650{
adb71456 651 return win32_fputc(c, pf);
7766f137
GS
652}
653
654int
adb71456 655PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s)
7766f137 656{
adb71456 657 return win32_fputs(s, pf);
7766f137
GS
658}
659
660int
adb71456 661PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 662{
adb71456 663 return win32_fflush(pf);
7766f137
GS
664}
665
666int
adb71456 667PerlStdIOUngetc(struct IPerlStdIO* piPerl,int c, FILE* pf)
7766f137 668{
adb71456 669 return win32_ungetc(c, pf);
7766f137
GS
670}
671
672int
adb71456 673PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 674{
adb71456 675 return win32_fileno(pf);
7766f137
GS
676}
677
adb71456 678FILE*
7766f137
GS
679PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
680{
adb71456 681 return win32_fdopen(fd, mode);
7766f137
GS
682}
683
adb71456
NIS
684FILE*
685PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf)
7766f137 686{
adb71456 687 return win32_freopen(path, mode, (FILE*)pf);
7766f137
GS
688}
689
690SSize_t
adb71456 691PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf)
7766f137 692{
adb71456 693 return win32_fread(buffer, size, count, pf);
7766f137
GS
694}
695
696SSize_t
adb71456 697PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf)
7766f137 698{
adb71456 699 return win32_fwrite(buffer, size, count, pf);
7766f137
GS
700}
701
702void
adb71456 703PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer)
7766f137 704{
adb71456 705 win32_setbuf(pf, buffer);
7766f137
GS
706}
707
708int
adb71456 709PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size)
7766f137 710{
adb71456 711 return win32_setvbuf(pf, buffer, type, size);
7766f137
GS
712}
713
714void
adb71456 715PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n)
7766f137
GS
716{
717#ifdef STDIO_CNT_LVALUE
adb71456 718 FILE *f = pf;
7766f137
GS
719 FILE_cnt(f) = n;
720#endif
721}
722
723void
adb71456 724PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr)
7766f137
GS
725{
726#ifdef STDIO_PTR_LVALUE
adb71456 727 FILE *f = pf;
7766f137 728 FILE_ptr(f) = ptr;
7766f137
GS
729#endif
730}
731
732void
adb71456 733PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 734{
adb71456 735 win32_setvbuf(pf, NULL, _IOLBF, 0);
7766f137
GS
736}
737
738int
adb71456 739PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...)
7766f137
GS
740{
741 va_list(arglist);
742 va_start(arglist, format);
adb71456 743 return win32_vfprintf(pf, format, arglist);
7766f137
GS
744}
745
746int
adb71456 747PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist)
7766f137 748{
adb71456 749 return win32_vfprintf(pf, format, arglist);
7766f137
GS
750}
751
752long
adb71456 753PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 754{
adb71456 755 return win32_ftell(pf);
7766f137
GS
756}
757
758int
adb71456 759PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, off_t offset, int origin)
7766f137 760{
adb71456 761 return win32_fseek(pf, offset, origin);
7766f137
GS
762}
763
764void
adb71456 765PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 766{
adb71456 767 win32_rewind(pf);
7766f137
GS
768}
769
adb71456 770FILE*
7766f137
GS
771PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
772{
adb71456 773 return win32_tmpfile();
7766f137
GS
774}
775
776int
adb71456 777PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p)
7766f137 778{
adb71456 779 return win32_fgetpos(pf, p);
7766f137
GS
780}
781
782int
adb71456 783PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p)
7766f137 784{
adb71456 785 return win32_fsetpos(pf, p);
7766f137
GS
786}
787void
788PerlStdIOInit(struct IPerlStdIO* piPerl)
789{
790}
791
792void
793PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
794{
795 Perl_init_os_extras();
796}
797
798int
799PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags)
800{
801 return win32_open_osfhandle(osfhandle, flags);
802}
803
804int
805PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
806{
807 return win32_get_osfhandle(filenum);
808}
809
adb71456
NIS
810FILE*
811PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 812{
adb71456 813 FILE* pfdup;
7766f137
GS
814 fpos_t pos;
815 char mode[3];
adb71456 816 int fileno = win32_dup(win32_fileno(pf));
7766f137
GS
817
818 /* open the file in the same mode */
4ce4f76e 819#ifdef __BORLANDC__
adb71456 820 if((pf)->flags & _F_READ) {
4ce4f76e
GS
821 mode[0] = 'r';
822 mode[1] = 0;
823 }
adb71456 824 else if((pf)->flags & _F_WRIT) {
4ce4f76e
GS
825 mode[0] = 'a';
826 mode[1] = 0;
827 }
adb71456 828 else if((pf)->flags & _F_RDWR) {
4ce4f76e
GS
829 mode[0] = 'r';
830 mode[1] = '+';
831 mode[2] = 0;
832 }
833#else
adb71456 834 if((pf)->_flag & _IOREAD) {
7766f137
GS
835 mode[0] = 'r';
836 mode[1] = 0;
837 }
adb71456 838 else if((pf)->_flag & _IOWRT) {
7766f137
GS
839 mode[0] = 'a';
840 mode[1] = 0;
841 }
adb71456 842 else if((pf)->_flag & _IORW) {
7766f137
GS
843 mode[0] = 'r';
844 mode[1] = '+';
845 mode[2] = 0;
846 }
4ce4f76e 847#endif
7766f137 848
f3dccfae 849 /* it appears that the binmode is attached to the
7766f137
GS
850 * file descriptor so binmode files will be handled
851 * correctly
852 */
adb71456 853 pfdup = win32_fdopen(fileno, mode);
7766f137
GS
854
855 /* move the file pointer to the same position */
adb71456
NIS
856 if (!fgetpos(pf, &pos)) {
857 fsetpos(pfdup, &pos);
7766f137
GS
858 }
859 return pfdup;
860}
861
f3dccfae 862struct IPerlStdIO perlStdIO =
7766f137
GS
863{
864 PerlStdIOStdin,
865 PerlStdIOStdout,
866 PerlStdIOStderr,
867 PerlStdIOOpen,
868 PerlStdIOClose,
869 PerlStdIOEof,
870 PerlStdIOError,
871 PerlStdIOClearerr,
872 PerlStdIOGetc,
873 PerlStdIOGetBase,
874 PerlStdIOGetBufsiz,
875 PerlStdIOGetCnt,
876 PerlStdIOGetPtr,
877 PerlStdIOGets,
878 PerlStdIOPutc,
879 PerlStdIOPuts,
880 PerlStdIOFlush,
881 PerlStdIOUngetc,
882 PerlStdIOFileno,
883 PerlStdIOFdopen,
884 PerlStdIOReopen,
885 PerlStdIORead,
886 PerlStdIOWrite,
887 PerlStdIOSetBuf,
888 PerlStdIOSetVBuf,
889 PerlStdIOSetCnt,
adb71456 890 PerlStdIOSetPtr,
7766f137
GS
891 PerlStdIOSetlinebuf,
892 PerlStdIOPrintf,
893 PerlStdIOVprintf,
894 PerlStdIOTell,
895 PerlStdIOSeek,
896 PerlStdIORewind,
897 PerlStdIOTmpfile,
898 PerlStdIOGetpos,
899 PerlStdIOSetpos,
900 PerlStdIOInit,
901 PerlStdIOInitOSExtras,
902 PerlStdIOFdupopen,
903};
904
905
906#undef IPERL2HOST
907#define IPERL2HOST(x) IPerlLIO2Host(x)
908
909/* IPerlLIO */
910int
911PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
912{
913 return win32_access(path, mode);
914}
915
916int
917PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
918{
919 return win32_chmod(filename, pmode);
920}
921
922int
923PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
924{
925 return chown(filename, owner, group);
926}
927
928int
929PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
930{
931 return chsize(handle, size);
932}
933
934int
935PerlLIOClose(struct IPerlLIO* piPerl, int handle)
936{
937 return win32_close(handle);
938}
939
940int
941PerlLIODup(struct IPerlLIO* piPerl, int handle)
942{
943 return win32_dup(handle);
944}
945
946int
947PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
948{
949 return win32_dup2(handle1, handle2);
950}
951
952int
953PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
954{
955 return win32_flock(fd, oper);
956}
957
958int
959PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
960{
1889e8b0 961 return win32_fstat(handle, buffer);
7766f137
GS
962}
963
964int
965PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
966{
967 return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
968}
969
970int
971PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
972{
973 return isatty(fd);
974}
975
976int
977PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
978{
979 return win32_link(oldname, newname);
980}
981
982long
983PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
984{
985 return win32_lseek(handle, offset, origin);
986}
987
988int
989PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
990{
991 return win32_stat(path, buffer);
992}
993
994char*
995PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
996{
997 return mktemp(Template);
998}
999
1000int
1001PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
1002{
1003 return win32_open(filename, oflag);
1004}
1005
1006int
1007PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
1008{
1009 return win32_open(filename, oflag, pmode);
1010}
1011
1012int
1013PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
1014{
1015 return win32_read(handle, buffer, count);
1016}
1017
1018int
1019PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
1020{
1021 return win32_rename(OldFileName, newname);
1022}
1023
1024int
1025PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1026{
1027 return win32_setmode(handle, mode);
1028}
1029
1030int
1031PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
1032{
1033 return win32_stat(path, buffer);
1034}
1035
1036char*
1037PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1038{
1039 return tmpnam(string);
1040}
1041
1042int
1043PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1044{
1045 return umask(pmode);
1046}
1047
1048int
1049PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1050{
1051 return win32_unlink(filename);
1052}
1053
1054int
1055PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
1056{
1057 return win32_utime(filename, times);
1058}
1059
1060int
1061PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1062{
1063 return win32_write(handle, buffer, count);
1064}
1065
1066struct IPerlLIO perlLIO =
1067{
1068 PerlLIOAccess,
1069 PerlLIOChmod,
1070 PerlLIOChown,
1071 PerlLIOChsize,
1072 PerlLIOClose,
1073 PerlLIODup,
1074 PerlLIODup2,
1075 PerlLIOFlock,
1076 PerlLIOFileStat,
1077 PerlLIOIOCtl,
1078 PerlLIOIsatty,
1079 PerlLIOLink,
1080 PerlLIOLseek,
1081 PerlLIOLstat,
1082 PerlLIOMktemp,
1083 PerlLIOOpen,
1084 PerlLIOOpen3,
1085 PerlLIORead,
1086 PerlLIORename,
1087 PerlLIOSetmode,
1088 PerlLIONameStat,
1089 PerlLIOTmpnam,
1090 PerlLIOUmask,
1091 PerlLIOUnlink,
1092 PerlLIOUtime,
1093 PerlLIOWrite,
1094};
1095
1096
1097#undef IPERL2HOST
1098#define IPERL2HOST(x) IPerlDir2Host(x)
1099
1100/* IPerlDIR */
1101int
1102PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1103{
1104 return win32_mkdir(dirname, mode);
1105}
1106
1107int
1108PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1109{
1110 return IPERL2HOST(piPerl)->Chdir(dirname);
1111}
1112
1113int
1114PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1115{
1116 return win32_rmdir(dirname);
1117}
1118
1119int
1120PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1121{
1122 return win32_closedir(dirp);
1123}
1124
1125DIR*
1126PerlDirOpen(struct IPerlDir* piPerl, char *filename)
1127{
1128 return win32_opendir(filename);
1129}
1130
1131struct direct *
1132PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1133{
1134 return win32_readdir(dirp);
1135}
1136
1137void
1138PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1139{
1140 win32_rewinddir(dirp);
1141}
1142
1143void
1144PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1145{
1146 win32_seekdir(dirp, loc);
1147}
1148
1149long
1150PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1151{
1152 return win32_telldir(dirp);
1153}
1154
1155char*
1156PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1157{
1158 return IPERL2HOST(piPerl)->MapPathA(path);
1159}
1160
1161WCHAR*
1162PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1163{
1164 return IPERL2HOST(piPerl)->MapPathW(path);
1165}
1166
1167struct IPerlDir perlDir =
1168{
1169 PerlDirMakedir,
1170 PerlDirChdir,
1171 PerlDirRmdir,
1172 PerlDirClose,
1173 PerlDirOpen,
1174 PerlDirRead,
1175 PerlDirRewind,
1176 PerlDirSeek,
1177 PerlDirTell,
1178 PerlDirMapPathA,
1179 PerlDirMapPathW,
1180};
1181
1182
1183/* IPerlSock */
1184u_long
1185PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1186{
1187 return win32_htonl(hostlong);
1188}
1189
1190u_short
1191PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1192{
1193 return win32_htons(hostshort);
1194}
1195
1196u_long
1197PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1198{
1199 return win32_ntohl(netlong);
1200}
1201
1202u_short
1203PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1204{
1205 return win32_ntohs(netshort);
1206}
1207
1208SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1209{
1210 return win32_accept(s, addr, addrlen);
1211}
1212
1213int
1214PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1215{
1216 return win32_bind(s, name, namelen);
1217}
1218
1219int
1220PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1221{
1222 return win32_connect(s, name, namelen);
1223}
1224
1225void
1226PerlSockEndhostent(struct IPerlSock* piPerl)
1227{
1228 win32_endhostent();
1229}
1230
1231void
1232PerlSockEndnetent(struct IPerlSock* piPerl)
1233{
1234 win32_endnetent();
1235}
1236
1237void
1238PerlSockEndprotoent(struct IPerlSock* piPerl)
1239{
1240 win32_endprotoent();
1241}
1242
1243void
1244PerlSockEndservent(struct IPerlSock* piPerl)
1245{
1246 win32_endservent();
1247}
1248
1249struct hostent*
1250PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1251{
1252 return win32_gethostbyaddr(addr, len, type);
1253}
1254
1255struct hostent*
1256PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1257{
1258 return win32_gethostbyname(name);
1259}
1260
1261struct hostent*
1262PerlSockGethostent(struct IPerlSock* piPerl)
1263{
acfe0abc 1264 dTHX;
7766f137
GS
1265 Perl_croak(aTHX_ "gethostent not implemented!\n");
1266 return NULL;
1267}
1268
1269int
1270PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1271{
1272 return win32_gethostname(name, namelen);
1273}
1274
1275struct netent *
1276PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1277{
1278 return win32_getnetbyaddr(net, type);
1279}
1280
1281struct netent *
1282PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1283{
1284 return win32_getnetbyname((char*)name);
1285}
1286
1287struct netent *
1288PerlSockGetnetent(struct IPerlSock* piPerl)
1289{
1290 return win32_getnetent();
1291}
1292
1293int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1294{
1295 return win32_getpeername(s, name, namelen);
1296}
1297
1298struct protoent*
1299PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1300{
1301 return win32_getprotobyname(name);
1302}
1303
1304struct protoent*
1305PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1306{
1307 return win32_getprotobynumber(number);
1308}
1309
1310struct protoent*
1311PerlSockGetprotoent(struct IPerlSock* piPerl)
1312{
1313 return win32_getprotoent();
1314}
1315
1316struct servent*
1317PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1318{
1319 return win32_getservbyname(name, proto);
1320}
1321
1322struct servent*
1323PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1324{
1325 return win32_getservbyport(port, proto);
1326}
1327
1328struct servent*
1329PerlSockGetservent(struct IPerlSock* piPerl)
1330{
1331 return win32_getservent();
1332}
1333
1334int
1335PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1336{
1337 return win32_getsockname(s, name, namelen);
1338}
1339
1340int
1341PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1342{
1343 return win32_getsockopt(s, level, optname, optval, optlen);
1344}
1345
1346unsigned long
1347PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1348{
1349 return win32_inet_addr(cp);
1350}
1351
1352char*
1353PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1354{
1355 return win32_inet_ntoa(in);
1356}
1357
1358int
1359PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1360{
1361 return win32_listen(s, backlog);
1362}
1363
1364int
1365PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1366{
1367 return win32_recv(s, buffer, len, flags);
1368}
1369
1370int
1371PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1372{
1373 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1374}
1375
1376int
1377PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1378{
1379 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1380}
1381
1382int
1383PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1384{
1385 return win32_send(s, buffer, len, flags);
1386}
1387
1388int
1389PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1390{
1391 return win32_sendto(s, buffer, len, flags, to, tolen);
1392}
1393
1394void
1395PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1396{
1397 win32_sethostent(stayopen);
1398}
1399
1400void
1401PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1402{
1403 win32_setnetent(stayopen);
1404}
1405
1406void
1407PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1408{
1409 win32_setprotoent(stayopen);
1410}
1411
1412void
1413PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1414{
1415 win32_setservent(stayopen);
1416}
1417
1418int
1419PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1420{
1421 return win32_setsockopt(s, level, optname, optval, optlen);
1422}
1423
1424int
1425PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1426{
1427 return win32_shutdown(s, how);
1428}
1429
1430SOCKET
1431PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1432{
1433 return win32_socket(af, type, protocol);
1434}
1435
1436int
1437PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1438{
e10bb1e9 1439 return Perl_my_socketpair(domain, type, protocol, fds);
7766f137
GS
1440}
1441
1442int
1443PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1444{
1445 return win32_closesocket(s);
1446}
1447
1448int
1449PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1450{
1451 return win32_ioctlsocket(s, cmd, argp);
1452}
1453
1454struct IPerlSock perlSock =
1455{
1456 PerlSockHtonl,
1457 PerlSockHtons,
1458 PerlSockNtohl,
1459 PerlSockNtohs,
1460 PerlSockAccept,
1461 PerlSockBind,
1462 PerlSockConnect,
1463 PerlSockEndhostent,
1464 PerlSockEndnetent,
1465 PerlSockEndprotoent,
1466 PerlSockEndservent,
1467 PerlSockGethostname,
1468 PerlSockGetpeername,
1469 PerlSockGethostbyaddr,
1470 PerlSockGethostbyname,
1471 PerlSockGethostent,
1472 PerlSockGetnetbyaddr,
1473 PerlSockGetnetbyname,
1474 PerlSockGetnetent,
1475 PerlSockGetprotobyname,
1476 PerlSockGetprotobynumber,
1477 PerlSockGetprotoent,
1478 PerlSockGetservbyname,
1479 PerlSockGetservbyport,
1480 PerlSockGetservent,
1481 PerlSockGetsockname,
1482 PerlSockGetsockopt,
1483 PerlSockInetAddr,
1484 PerlSockInetNtoa,
1485 PerlSockListen,
1486 PerlSockRecv,
1487 PerlSockRecvfrom,
1488 PerlSockSelect,
1489 PerlSockSend,
1490 PerlSockSendto,
1491 PerlSockSethostent,
1492 PerlSockSetnetent,
1493 PerlSockSetprotoent,
1494 PerlSockSetservent,
1495 PerlSockSetsockopt,
1496 PerlSockShutdown,
1497 PerlSockSocket,
1498 PerlSockSocketpair,
1499 PerlSockClosesocket,
1500};
1501
1502
1503/* IPerlProc */
1504
1505#define EXECF_EXEC 1
1506#define EXECF_SPAWN 2
1507
1508void
1509PerlProcAbort(struct IPerlProc* piPerl)
1510{
1511 win32_abort();
1512}
1513
1514char *
1515PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1516{
1517 return win32_crypt(clear, salt);
1518}
1519
1520void
1521PerlProcExit(struct IPerlProc* piPerl, int status)
1522{
1523 exit(status);
1524}
1525
1526void
1527PerlProc_Exit(struct IPerlProc* piPerl, int status)
1528{
1529 _exit(status);
1530}
1531
1532int
1533PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1534{
1535 return execl(cmdname, arg0, arg1, arg2, arg3);
1536}
1537
1538int
1539PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1540{
1541 return win32_execvp(cmdname, argv);
1542}
1543
1544int
1545PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1546{
1547 return win32_execvp(cmdname, argv);
1548}
1549
1550uid_t
1551PerlProcGetuid(struct IPerlProc* piPerl)
1552{
1553 return getuid();
1554}
1555
1556uid_t
1557PerlProcGeteuid(struct IPerlProc* piPerl)
1558{
1559 return geteuid();
1560}
1561
1562gid_t
1563PerlProcGetgid(struct IPerlProc* piPerl)
1564{
1565 return getgid();
1566}
1567
1568gid_t
1569PerlProcGetegid(struct IPerlProc* piPerl)
1570{
1571 return getegid();
1572}
1573
1574char *
1575PerlProcGetlogin(struct IPerlProc* piPerl)
1576{
1577 return g_getlogin();
1578}
1579
1580int
1581PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1582{
1583 return win32_kill(pid, sig);
1584}
1585
1586int
1587PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1588{
acfe0abc 1589 dTHX;
7766f137
GS
1590 Perl_croak(aTHX_ "killpg not implemented!\n");
1591 return 0;
1592}
1593
1594int
1595PerlProcPauseProc(struct IPerlProc* piPerl)
1596{
1597 return win32_sleep((32767L << 16) + 32767);
1598}
1599
1600PerlIO*
1601PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1602{
acfe0abc 1603 dTHX;
7766f137 1604 PERL_FLUSHALL_FOR_CHILD;
adb71456 1605 return win32_popen(command, mode);
7766f137
GS
1606}
1607
8c0134a8
NIS
1608PerlIO*
1609PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
1610{
acfe0abc 1611 dTHX;
8c0134a8
NIS
1612 PERL_FLUSHALL_FOR_CHILD;
1613 return win32_popenlist(mode, narg, args);
1614}
1615
7766f137
GS
1616int
1617PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1618{
adb71456 1619 return win32_pclose(stream);
7766f137
GS
1620}
1621
1622int
1623PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1624{
1625 return win32_pipe(phandles, 512, O_BINARY);
1626}
1627
1628int
1629PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1630{
1631 return setuid(u);
1632}
1633
1634int
1635PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1636{
1637 return setgid(g);
1638}
1639
1640int
1641PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1642{
1643 return win32_sleep(s);
1644}
1645
1646int
1647PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1648{
1649 return win32_times(timebuf);
1650}
1651
1652int
1653PerlProcWait(struct IPerlProc* piPerl, int *status)
1654{
1655 return win32_wait(status);
1656}
1657
1658int
1659PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1660{
1661 return win32_waitpid(pid, status, flags);
1662}
1663
1664Sighandler_t
1665PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1666{
71d280e3 1667 return signal(sig, subcode);
7766f137
GS
1668}
1669
8454a2ba 1670#ifdef USE_ITHREADS
c00206c8 1671static THREAD_RET_TYPE
7766f137
GS
1672win32_start_child(LPVOID arg)
1673{
1674 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1675 GV *tmpgv;
1676 int status;
7766f137
GS
1677#ifdef PERL_SYNC_FORK
1678 static long sync_fork_id = 0;
1679 long id = ++sync_fork_id;
1680#endif
1681
1682
ba869deb 1683 PERL_SET_THX(my_perl);
7766f137
GS
1684
1685 /* set $$ to pseudo id */
1686#ifdef PERL_SYNC_FORK
1687 w32_pseudo_id = id;
1688#else
1689 w32_pseudo_id = GetCurrentThreadId();
922b1888
GS
1690 if (IsWin95()) {
1691 int pid = (int)w32_pseudo_id;
1692 if (pid < 0)
1693 w32_pseudo_id = -pid;
1694 }
7766f137 1695#endif
e10bb1e9
NIS
1696 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) {
1697 SV *sv = GvSV(tmpgv);
1698 SvREADONLY_off(sv);
1699 sv_setiv(sv, -(IV)w32_pseudo_id);
1700 SvREADONLY_on(sv);
1701 }
7766f137
GS
1702 hv_clear(PL_pidstatus);
1703
1704 /* push a zero on the stack (we are the child) */
1705 {
39644a26 1706 dSP;
7766f137
GS
1707 dTARGET;
1708 PUSHi(0);
1709 PUTBACK;
1710 }
1711
1712 /* continue from next op */
1713 PL_op = PL_op->op_next;
1714
1715 {
1716 dJMPENV;
5db10396 1717 volatile int oldscope = PL_scopestack_ix;
7766f137
GS
1718
1719restart:
1720 JMPENV_PUSH(status);
1721 switch (status) {
1722 case 0:
1723 CALLRUNOPS(aTHX);
1724 status = 0;
1725 break;
1726 case 2:
1727 while (PL_scopestack_ix > oldscope)
1728 LEAVE;
1729 FREETMPS;
1730 PL_curstash = PL_defstash;
1731 if (PL_endav && !PL_minus_c)
1732 call_list(oldscope, PL_endav);
1733 status = STATUS_NATIVE_EXPORT;
1734 break;
1735 case 3:
1736 if (PL_restartop) {
1737 POPSTACK_TO(PL_mainstack);
1738 PL_op = PL_restartop;
1739 PL_restartop = Nullop;
1740 goto restart;
1741 }
1742 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1743 FREETMPS;
1744 status = 1;
1745 break;
1746 }
1747 JMPENV_POP;
1748
1749 /* XXX hack to avoid perl_destruct() freeing optree */
1750 PL_main_root = Nullop;
1751 }
1752
1c0ca838
GS
1753 /* close the std handles to avoid fd leaks */
1754 {
1755 do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
1756 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE);
1757 do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE);
1758 }
1759
7766f137
GS
1760 /* destroy everything (waits for any pseudo-forked children) */
1761 perl_destruct(my_perl);
1762 perl_free(my_perl);
1763
1764#ifdef PERL_SYNC_FORK
1765 return id;
1766#else
1767 return (DWORD)status;
1768#endif
1769}
8454a2ba 1770#endif /* USE_ITHREADS */
7766f137
GS
1771
1772int
1773PerlProcFork(struct IPerlProc* piPerl)
1774{
acfe0abc 1775 dTHX;
8454a2ba 1776#ifdef USE_ITHREADS
7766f137
GS
1777 DWORD id;
1778 HANDLE handle;
7a955601
GS
1779 CPerlHost *h;
1780
1781 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1782 errno = EAGAIN;
1783 return -1;
1784 }
1785 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
acfe0abc 1786 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 1,
7766f137
GS
1787 h->m_pHostperlMem,
1788 h->m_pHostperlMemShared,
1789 h->m_pHostperlMemParse,
1790 h->m_pHostperlEnv,
1791 h->m_pHostperlStdIO,
1792 h->m_pHostperlLIO,
1793 h->m_pHostperlDir,
1794 h->m_pHostperlSock,
1795 h->m_pHostperlProc
1796 );
ad4e2db7 1797 new_perl->Isys_intern.internal_host = h;
8454a2ba 1798# ifdef PERL_SYNC_FORK
7766f137 1799 id = win32_start_child((LPVOID)new_perl);
acfe0abc 1800 PERL_SET_THX(aTHX);
8454a2ba 1801# else
c00206c8
GS
1802# ifdef USE_RTL_THREAD_API
1803 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1804 (void*)new_perl, 0, (unsigned*)&id);
1805# else
7766f137
GS
1806 handle = CreateThread(NULL, 0, win32_start_child,
1807 (LPVOID)new_perl, 0, &id);
c00206c8 1808# endif
acfe0abc 1809 PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
60fa28ff
GS
1810 if (!handle) {
1811 errno = EAGAIN;
1812 return -1;
1813 }
922b1888
GS
1814 if (IsWin95()) {
1815 int pid = (int)id;
1816 if (pid < 0)
1817 id = -pid;
1818 }
7766f137
GS
1819 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1820 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1821 ++w32_num_pseudo_children;
8454a2ba 1822# endif
7766f137 1823 return -(int)id;
8454a2ba
GS
1824#else
1825 Perl_croak(aTHX_ "fork() not implemented!\n");
1826 return -1;
1827#endif /* USE_ITHREADS */
7766f137
GS
1828}
1829
1830int
1831PerlProcGetpid(struct IPerlProc* piPerl)
1832{
1833 return win32_getpid();
1834}
1835
1836void*
1837PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1838{
1839 return win32_dynaload(filename);
1840}
1841
1842void
1843PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1844{
1845 win32_str_os_error(sv, dwErr);
1846}
1847
1848BOOL
1849PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1850{
1851 do_spawn2(cmd, EXECF_EXEC);
1852 return FALSE;
1853}
1854
1855int
1856PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1857{
1858 return do_spawn2(cmds, EXECF_SPAWN);
1859}
1860
1861int
1862PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1863{
1864 return win32_spawnvp(mode, cmdname, argv);
1865}
1866
1867int
1868PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1869{
1870 return do_aspawn(vreally, vmark, vsp);
1871}
1872
5f1a76d0
NIS
1873int
1874PerlProcLastHost(struct IPerlProc* piPerl)
1875{
acfe0abc 1876 dTHX;
5f1a76d0
NIS
1877 CPerlHost *h = (CPerlHost*)w32_internal_host;
1878 return h->LastHost();
1879}
1880
7766f137
GS
1881struct IPerlProc perlProc =
1882{
1883 PerlProcAbort,
1884 PerlProcCrypt,
1885 PerlProcExit,
1886 PerlProc_Exit,
1887 PerlProcExecl,
1888 PerlProcExecv,
1889 PerlProcExecvp,
1890 PerlProcGetuid,
1891 PerlProcGeteuid,
1892 PerlProcGetgid,
1893 PerlProcGetegid,
1894 PerlProcGetlogin,
1895 PerlProcKill,
1896 PerlProcKillpg,
1897 PerlProcPauseProc,
1898 PerlProcPopen,
1899 PerlProcPclose,
1900 PerlProcPipe,
1901 PerlProcSetuid,
1902 PerlProcSetgid,
1903 PerlProcSleep,
1904 PerlProcTimes,
1905 PerlProcWait,
1906 PerlProcWaitpid,
1907 PerlProcSignal,
1908 PerlProcFork,
1909 PerlProcGetpid,
1910 PerlProcDynaLoader,
1911 PerlProcGetOSError,
1912 PerlProcDoCmd,
1913 PerlProcSpawn,
1914 PerlProcSpawnvp,
1915 PerlProcASpawn,
8c0134a8
NIS
1916 PerlProcLastHost,
1917 PerlProcPopenList
7766f137
GS
1918};
1919
1920
1921/*
1922 * CPerlHost
1923 */
1924
1925CPerlHost::CPerlHost(void)
1926{
5f1a76d0
NIS
1927 /* Construct a host from scratch */
1928 InterlockedIncrement(&num_hosts);
7766f137
GS
1929 m_pvDir = new VDir();
1930 m_pVMem = new VMem();
1931 m_pVMemShared = new VMem();
1932 m_pVMemParse = new VMem();
1933
1934 m_pvDir->Init(NULL, m_pVMem);
1935
1936 m_dwEnvCount = 0;
1937 m_lppEnvList = NULL;
85fdc8b6 1938 m_bTopLevel = TRUE;
7766f137
GS
1939
1940 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1941 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1942 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1943 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1944 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1945 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1946 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1947 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1948 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1949
1950 m_pHostperlMem = &m_hostperlMem;
1951 m_pHostperlMemShared = &m_hostperlMemShared;
1952 m_pHostperlMemParse = &m_hostperlMemParse;
1953 m_pHostperlEnv = &m_hostperlEnv;
1954 m_pHostperlStdIO = &m_hostperlStdIO;
1955 m_pHostperlLIO = &m_hostperlLIO;
1956 m_pHostperlDir = &m_hostperlDir;
1957 m_pHostperlSock = &m_hostperlSock;
1958 m_pHostperlProc = &m_hostperlProc;
1959}
1960
1961#define SETUPEXCHANGE(xptr, iptr, table) \
1962 STMT_START { \
1963 if (xptr) { \
1964 iptr = *xptr; \
1965 *xptr = &table; \
1966 } \
1967 else { \
1968 iptr = &table; \
1969 } \
1970 } STMT_END
1971
1972CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1973 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1974 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1975 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1976 struct IPerlProc** ppProc)
1977{
5f1a76d0 1978 InterlockedIncrement(&num_hosts);
f7aeb604 1979 m_pvDir = new VDir(0);
7766f137
GS
1980 m_pVMem = new VMem();
1981 m_pVMemShared = new VMem();
1982 m_pVMemParse = new VMem();
1983
1984 m_pvDir->Init(NULL, m_pVMem);
1985
1986 m_dwEnvCount = 0;
1987 m_lppEnvList = NULL;
85fdc8b6 1988 m_bTopLevel = FALSE;
7766f137
GS
1989
1990 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1991 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1992 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1993 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1994 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1995 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1996 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1997 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1998 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1999
2000 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
2001 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
2002 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
2003 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
2004 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
2005 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
2006 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
2007 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
2008 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
2009}
2010#undef SETUPEXCHANGE
2011
2012CPerlHost::CPerlHost(CPerlHost& host)
2013{
5f1a76d0
NIS
2014 /* Construct a host from another host */
2015 InterlockedIncrement(&num_hosts);
7766f137
GS
2016 m_pVMem = new VMem();
2017 m_pVMemShared = host.GetMemShared();
2018 m_pVMemParse = host.GetMemParse();
2019
2020 /* duplicate directory info */
f7aeb604 2021 m_pvDir = new VDir(0);
7766f137
GS
2022 m_pvDir->Init(host.GetDir(), m_pVMem);
2023
2024 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2025 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2026 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2027 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2028 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2029 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2030 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2031 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2032 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
ad4e2db7
GS
2033 m_pHostperlMem = &m_hostperlMem;
2034 m_pHostperlMemShared = &m_hostperlMemShared;
2035 m_pHostperlMemParse = &m_hostperlMemParse;
2036 m_pHostperlEnv = &m_hostperlEnv;
2037 m_pHostperlStdIO = &m_hostperlStdIO;
2038 m_pHostperlLIO = &m_hostperlLIO;
2039 m_pHostperlDir = &m_hostperlDir;
2040 m_pHostperlSock = &m_hostperlSock;
2041 m_pHostperlProc = &m_hostperlProc;
7766f137
GS
2042
2043 m_dwEnvCount = 0;
2044 m_lppEnvList = NULL;
85fdc8b6 2045 m_bTopLevel = FALSE;
7766f137
GS
2046
2047 /* duplicate environment info */
2048 LPSTR lpPtr;
2049 DWORD dwIndex = 0;
2050 while(lpPtr = host.GetIndex(dwIndex))
2051 Add(lpPtr);
2052}
2053
2054CPerlHost::~CPerlHost(void)
2055{
52cbf511 2056// Reset();
5f1a76d0 2057 InterlockedDecrement(&num_hosts);
7766f137
GS
2058 delete m_pvDir;
2059 m_pVMemParse->Release();
2060 m_pVMemShared->Release();
2061 m_pVMem->Release();
2062}
2063
2064LPSTR
2065CPerlHost::Find(LPCSTR lpStr)
2066{
2067 LPSTR lpPtr;
2068 LPSTR* lppPtr = Lookup(lpStr);
2069 if(lppPtr != NULL) {
2070 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2071 ;
2072
2073 if(*lpPtr == '=')
2074 ++lpPtr;
2075
2076 return lpPtr;
2077 }
2078 return NULL;
2079}
2080
2081int
2082lookup(const void *arg1, const void *arg2)
52cbf511 2083{ // Compare strings
7766f137
GS
2084 char*ptr1, *ptr2;
2085 char c1,c2;
2086
2087 ptr1 = *(char**)arg1;
2088 ptr2 = *(char**)arg2;
2089 for(;;) {
2090 c1 = *ptr1++;
2091 c2 = *ptr2++;
2092 if(c1 == '\0' || c1 == '=') {
2093 if(c2 == '\0' || c2 == '=')
2094 break;
2095
52cbf511 2096 return -1; // string 1 < string 2
7766f137
GS
2097 }
2098 else if(c2 == '\0' || c2 == '=')
52cbf511 2099 return 1; // string 1 > string 2
7766f137
GS
2100 else if(c1 != c2) {
2101 c1 = toupper(c1);
2102 c2 = toupper(c2);
2103 if(c1 != c2) {
2104 if(c1 < c2)
52cbf511 2105 return -1; // string 1 < string 2
7766f137 2106
52cbf511 2107 return 1; // string 1 > string 2
7766f137
GS
2108 }
2109 }
2110 }
2111 return 0;
2112}
2113
2114LPSTR*
2115CPerlHost::Lookup(LPCSTR lpStr)
2116{
2117 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2118}
2119
2120int
2121compare(const void *arg1, const void *arg2)
52cbf511 2122{ // Compare strings
7766f137
GS
2123 char*ptr1, *ptr2;
2124 char c1,c2;
2125
2126 ptr1 = *(char**)arg1;
2127 ptr2 = *(char**)arg2;
2128 for(;;) {
2129 c1 = *ptr1++;
2130 c2 = *ptr2++;
2131 if(c1 == '\0' || c1 == '=') {
2132 if(c1 == c2)
2133 break;
2134
52cbf511 2135 return -1; // string 1 < string 2
7766f137
GS
2136 }
2137 else if(c2 == '\0' || c2 == '=')
52cbf511 2138 return 1; // string 1 > string 2
7766f137
GS
2139 else if(c1 != c2) {
2140 c1 = toupper(c1);
2141 c2 = toupper(c2);
2142 if(c1 != c2) {
2143 if(c1 < c2)
52cbf511 2144 return -1; // string 1 < string 2
f3dccfae 2145
52cbf511 2146 return 1; // string 1 > string 2
7766f137
GS
2147 }
2148 }
2149 }
2150 return 0;
2151}
2152
2153void
2154CPerlHost::Add(LPCSTR lpStr)
2155{
acfe0abc 2156 dTHX;
7766f137
GS
2157 char szBuffer[1024];
2158 LPSTR *lpPtr;
2159 int index, length = strlen(lpStr)+1;
2160
2161 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2162 szBuffer[index] = lpStr[index];
2163
2164 szBuffer[index] = '\0';
2165
52cbf511 2166 // replacing ?
7766f137
GS
2167 lpPtr = Lookup(szBuffer);
2168 if(lpPtr != NULL) {
2169 Renew(*lpPtr, length, char);
2170 strcpy(*lpPtr, lpStr);
2171 }
2172 else {
2173 ++m_dwEnvCount;
2174 Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2175 New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2176 if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2177 strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2178 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2179 }
2180 else
2181 --m_dwEnvCount;
2182 }
2183}
2184
2185DWORD
2186CPerlHost::CalculateEnvironmentSpace(void)
2187{
2188 DWORD index;
2189 DWORD dwSize = 0;
2190 for(index = 0; index < m_dwEnvCount; ++index)
2191 dwSize += strlen(m_lppEnvList[index]) + 1;
2192
2193 return dwSize;
2194}
2195
2196void
2197CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2198{
acfe0abc 2199 dTHX;
7766f137
GS
2200 Safefree(lpStr);
2201}
2202
2203char*
2204CPerlHost::GetChildDir(void)
2205{
acfe0abc 2206 dTHX;
7766f137
GS
2207 int length;
2208 char* ptr;
2209 New(0, ptr, MAX_PATH+1, char);
2210 if(ptr) {
2211 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
17e29069
JH
2212 length = strlen(ptr);
2213 if (length > 3) {
2214 if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2215 ptr[length-1] = 0;
7766f137
GS
2216 }
2217 }
2218 return ptr;
2219}
2220
2221void
2222CPerlHost::FreeChildDir(char* pStr)
2223{
acfe0abc 2224 dTHX;
7766f137
GS
2225 Safefree(pStr);
2226}
2227
2228LPSTR
2229CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2230{
acfe0abc 2231 dTHX;
7766f137
GS
2232 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2233 DWORD dwSize, dwEnvIndex;
2234 int nLength, compVal;
2235
52cbf511 2236 // get the process environment strings
7766f137
GS
2237 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2238
52cbf511 2239 // step over current directory stuff
7766f137
GS
2240 while(*lpTmp == '=')
2241 lpTmp += strlen(lpTmp) + 1;
2242
52cbf511 2243 // save the start of the environment strings
7766f137
GS
2244 lpEnvPtr = lpTmp;
2245 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
52cbf511 2246 // calculate the size of the environment strings
7766f137
GS
2247 dwSize += strlen(lpTmp) + 1;
2248 }
2249
52cbf511 2250 // add the size of current directories
7766f137
GS
2251 dwSize += vDir.CalculateEnvironmentSpace();
2252
52cbf511 2253 // add the additional space used by changes made to the environment
7766f137
GS
2254 dwSize += CalculateEnvironmentSpace();
2255
2256 New(1, lpStr, dwSize, char);
2257 lpPtr = lpStr;
2258 if(lpStr != NULL) {
52cbf511 2259 // build the local environment
7766f137
GS
2260 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2261
2262 dwEnvIndex = 0;
2263 lpLocalEnv = GetIndex(dwEnvIndex);
2264 while(*lpEnvPtr != '\0') {
ec00bdd8 2265 if(!lpLocalEnv) {
52cbf511
JH
2266 // all environment overrides have been added
2267 // so copy string into place
7766f137
GS
2268 strcpy(lpStr, lpEnvPtr);
2269 nLength = strlen(lpEnvPtr) + 1;
2270 lpStr += nLength;
2271 lpEnvPtr += nLength;
2272 }
2273 else {
52cbf511 2274 // determine which string to copy next
7766f137
GS
2275 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2276 if(compVal < 0) {
2277 strcpy(lpStr, lpEnvPtr);
2278 nLength = strlen(lpEnvPtr) + 1;
2279 lpStr += nLength;
2280 lpEnvPtr += nLength;
2281 }
2282 else {
2283 char *ptr = strchr(lpLocalEnv, '=');
2284 if(ptr && ptr[1]) {
2285 strcpy(lpStr, lpLocalEnv);
2286 lpStr += strlen(lpLocalEnv) + 1;
2287 }
2288 lpLocalEnv = GetIndex(dwEnvIndex);
2289 if(compVal == 0) {
52cbf511 2290 // this string was replaced
7766f137
GS
2291 lpEnvPtr += strlen(lpEnvPtr) + 1;
2292 }
2293 }
2294 }
2295 }
2296
ec00bdd8 2297 while(lpLocalEnv) {
52cbf511
JH
2298 // still have environment overrides to add
2299 // so copy the strings into place if not an override
1784c7b8
JH
2300 char *ptr = strchr(lpLocalEnv, '=');
2301 if(ptr && ptr[1]) {
2302 strcpy(lpStr, lpLocalEnv);
2303 lpStr += strlen(lpLocalEnv) + 1;
2304 }
ec00bdd8
GS
2305 lpLocalEnv = GetIndex(dwEnvIndex);
2306 }
2307
52cbf511 2308 // add final NULL
7766f137
GS
2309 *lpStr = '\0';
2310 }
2311
52cbf511 2312 // release the process environment strings
7766f137
GS
2313 FreeEnvironmentStrings(lpAllocPtr);
2314
2315 return lpPtr;
2316}
2317
2318void
2319CPerlHost::Reset(void)
2320{
acfe0abc 2321 dTHX;
7766f137
GS
2322 if(m_lppEnvList != NULL) {
2323 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2324 Safefree(m_lppEnvList[index]);
2325 m_lppEnvList[index] = NULL;
2326 }
2327 }
2328 m_dwEnvCount = 0;
2329}
2330
2331void
2332CPerlHost::Clearenv(void)
2333{
acfe0abc 2334 dTHX;
7766f137
GS
2335 char ch;
2336 LPSTR lpPtr, lpStr, lpEnvPtr;
2fb9ab56 2337 if (m_lppEnvList != NULL) {
7766f137
GS
2338 /* set every entry to an empty string */
2339 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2340 char* ptr = strchr(m_lppEnvList[index], '=');
2341 if(ptr) {
2342 *++ptr = 0;
2343 }
2344 }
2345 }
2346
2347 /* get the process environment strings */
2348 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2349
2350 /* step over current directory stuff */
2351 while(*lpStr == '=')
2352 lpStr += strlen(lpStr) + 1;
2353
2354 while(*lpStr) {
2355 lpPtr = strchr(lpStr, '=');
2356 if(lpPtr) {
2357 ch = *++lpPtr;
2358 *lpPtr = 0;
2359 Add(lpStr);
85fdc8b6 2360 if (m_bTopLevel)
2fb9ab56 2361 (void)win32_putenv(lpStr);
7766f137
GS
2362 *lpPtr = ch;
2363 }
2364 lpStr += strlen(lpStr) + 1;
2365 }
2366
2367 FreeEnvironmentStrings(lpEnvPtr);
2368}
2369
2370
2371char*
2372CPerlHost::Getenv(const char *varname)
2373{
acfe0abc 2374 dTHX;
85fdc8b6 2375 if (!m_bTopLevel) {
2fb9ab56 2376 char *pEnv = Find(varname);
4354e59a 2377 if (pEnv && *pEnv)
2fb9ab56 2378 return pEnv;
7766f137 2379 }
2fb9ab56 2380 return win32_getenv(varname);
7766f137
GS
2381}
2382
2383int
2384CPerlHost::Putenv(const char *envstring)
2385{
acfe0abc 2386 dTHX;
7766f137 2387 Add(envstring);
85fdc8b6 2388 if (m_bTopLevel)
2fb9ab56
NIS
2389 return win32_putenv(envstring);
2390
7766f137
GS
2391 return 0;
2392}
2393
2394int
2395CPerlHost::Chdir(const char *dirname)
2396{
acfe0abc 2397 dTHX;
7766f137 2398 int ret;
9ec3348a
JH
2399 if (!dirname) {
2400 errno = ENOENT;
2401 return -1;
2402 }
7766f137
GS
2403 if (USING_WIDE()) {
2404 WCHAR wBuffer[MAX_PATH];
2405 A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2406 ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2407 }
2408 else
2409 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2410 if(ret < 0) {
2411 errno = ENOENT;
2412 }
2413 return ret;
2414}
2415
2416#endif /* ___PerlHost_H___ */