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