This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
More Cwd tidy up
[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;
cb69f87a 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{
acfe0abc 1439 dTHX;
7766f137
GS
1440 Perl_croak(aTHX_ "socketpair not implemented!\n");
1441 return 0;
1442}
1443
1444int
1445PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1446{
1447 return win32_closesocket(s);
1448}
1449
1450int
1451PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1452{
1453 return win32_ioctlsocket(s, cmd, argp);
1454}
1455
1456struct IPerlSock perlSock =
1457{
1458 PerlSockHtonl,
1459 PerlSockHtons,
1460 PerlSockNtohl,
1461 PerlSockNtohs,
1462 PerlSockAccept,
1463 PerlSockBind,
1464 PerlSockConnect,
1465 PerlSockEndhostent,
1466 PerlSockEndnetent,
1467 PerlSockEndprotoent,
1468 PerlSockEndservent,
1469 PerlSockGethostname,
1470 PerlSockGetpeername,
1471 PerlSockGethostbyaddr,
1472 PerlSockGethostbyname,
1473 PerlSockGethostent,
1474 PerlSockGetnetbyaddr,
1475 PerlSockGetnetbyname,
1476 PerlSockGetnetent,
1477 PerlSockGetprotobyname,
1478 PerlSockGetprotobynumber,
1479 PerlSockGetprotoent,
1480 PerlSockGetservbyname,
1481 PerlSockGetservbyport,
1482 PerlSockGetservent,
1483 PerlSockGetsockname,
1484 PerlSockGetsockopt,
1485 PerlSockInetAddr,
1486 PerlSockInetNtoa,
1487 PerlSockListen,
1488 PerlSockRecv,
1489 PerlSockRecvfrom,
1490 PerlSockSelect,
1491 PerlSockSend,
1492 PerlSockSendto,
1493 PerlSockSethostent,
1494 PerlSockSetnetent,
1495 PerlSockSetprotoent,
1496 PerlSockSetservent,
1497 PerlSockSetsockopt,
1498 PerlSockShutdown,
1499 PerlSockSocket,
1500 PerlSockSocketpair,
1501 PerlSockClosesocket,
1502};
1503
1504
1505/* IPerlProc */
1506
1507#define EXECF_EXEC 1
1508#define EXECF_SPAWN 2
1509
1510void
1511PerlProcAbort(struct IPerlProc* piPerl)
1512{
1513 win32_abort();
1514}
1515
1516char *
1517PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1518{
1519 return win32_crypt(clear, salt);
1520}
1521
1522void
1523PerlProcExit(struct IPerlProc* piPerl, int status)
1524{
1525 exit(status);
1526}
1527
1528void
1529PerlProc_Exit(struct IPerlProc* piPerl, int status)
1530{
1531 _exit(status);
1532}
1533
1534int
1535PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1536{
1537 return execl(cmdname, arg0, arg1, arg2, arg3);
1538}
1539
1540int
1541PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1542{
1543 return win32_execvp(cmdname, argv);
1544}
1545
1546int
1547PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1548{
1549 return win32_execvp(cmdname, argv);
1550}
1551
1552uid_t
1553PerlProcGetuid(struct IPerlProc* piPerl)
1554{
1555 return getuid();
1556}
1557
1558uid_t
1559PerlProcGeteuid(struct IPerlProc* piPerl)
1560{
1561 return geteuid();
1562}
1563
1564gid_t
1565PerlProcGetgid(struct IPerlProc* piPerl)
1566{
1567 return getgid();
1568}
1569
1570gid_t
1571PerlProcGetegid(struct IPerlProc* piPerl)
1572{
1573 return getegid();
1574}
1575
1576char *
1577PerlProcGetlogin(struct IPerlProc* piPerl)
1578{
1579 return g_getlogin();
1580}
1581
1582int
1583PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1584{
1585 return win32_kill(pid, sig);
1586}
1587
1588int
1589PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1590{
acfe0abc 1591 dTHX;
7766f137
GS
1592 Perl_croak(aTHX_ "killpg not implemented!\n");
1593 return 0;
1594}
1595
1596int
1597PerlProcPauseProc(struct IPerlProc* piPerl)
1598{
1599 return win32_sleep((32767L << 16) + 32767);
1600}
1601
1602PerlIO*
1603PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1604{
acfe0abc 1605 dTHX;
7766f137 1606 PERL_FLUSHALL_FOR_CHILD;
adb71456 1607 return win32_popen(command, mode);
7766f137
GS
1608}
1609
8c0134a8
NIS
1610PerlIO*
1611PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
1612{
acfe0abc 1613 dTHX;
8c0134a8
NIS
1614 PERL_FLUSHALL_FOR_CHILD;
1615 return win32_popenlist(mode, narg, args);
1616}
1617
7766f137
GS
1618int
1619PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1620{
adb71456 1621 return win32_pclose(stream);
7766f137
GS
1622}
1623
1624int
1625PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1626{
1627 return win32_pipe(phandles, 512, O_BINARY);
1628}
1629
1630int
1631PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1632{
1633 return setuid(u);
1634}
1635
1636int
1637PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1638{
1639 return setgid(g);
1640}
1641
1642int
1643PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1644{
1645 return win32_sleep(s);
1646}
1647
1648int
1649PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1650{
1651 return win32_times(timebuf);
1652}
1653
1654int
1655PerlProcWait(struct IPerlProc* piPerl, int *status)
1656{
1657 return win32_wait(status);
1658}
1659
1660int
1661PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1662{
1663 return win32_waitpid(pid, status, flags);
1664}
1665
1666Sighandler_t
1667PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1668{
71d280e3 1669 return signal(sig, subcode);
7766f137
GS
1670}
1671
8454a2ba 1672#ifdef USE_ITHREADS
c00206c8 1673static THREAD_RET_TYPE
7766f137
GS
1674win32_start_child(LPVOID arg)
1675{
1676 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1677 GV *tmpgv;
1678 int status;
7766f137
GS
1679#ifdef PERL_SYNC_FORK
1680 static long sync_fork_id = 0;
1681 long id = ++sync_fork_id;
1682#endif
1683
1684
ba869deb 1685 PERL_SET_THX(my_perl);
7766f137
GS
1686
1687 /* set $$ to pseudo id */
1688#ifdef PERL_SYNC_FORK
1689 w32_pseudo_id = id;
1690#else
1691 w32_pseudo_id = GetCurrentThreadId();
922b1888
GS
1692 if (IsWin95()) {
1693 int pid = (int)w32_pseudo_id;
1694 if (pid < 0)
1695 w32_pseudo_id = -pid;
1696 }
7766f137
GS
1697#endif
1698 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
1699 sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
1700 hv_clear(PL_pidstatus);
1701
1702 /* push a zero on the stack (we are the child) */
1703 {
39644a26 1704 dSP;
7766f137
GS
1705 dTARGET;
1706 PUSHi(0);
1707 PUTBACK;
1708 }
1709
1710 /* continue from next op */
1711 PL_op = PL_op->op_next;
1712
1713 {
1714 dJMPENV;
5db10396 1715 volatile int oldscope = PL_scopestack_ix;
7766f137
GS
1716
1717restart:
1718 JMPENV_PUSH(status);
1719 switch (status) {
1720 case 0:
1721 CALLRUNOPS(aTHX);
1722 status = 0;
1723 break;
1724 case 2:
1725 while (PL_scopestack_ix > oldscope)
1726 LEAVE;
1727 FREETMPS;
1728 PL_curstash = PL_defstash;
1729 if (PL_endav && !PL_minus_c)
1730 call_list(oldscope, PL_endav);
1731 status = STATUS_NATIVE_EXPORT;
1732 break;
1733 case 3:
1734 if (PL_restartop) {
1735 POPSTACK_TO(PL_mainstack);
1736 PL_op = PL_restartop;
1737 PL_restartop = Nullop;
1738 goto restart;
1739 }
1740 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1741 FREETMPS;
1742 status = 1;
1743 break;
1744 }
1745 JMPENV_POP;
1746
1747 /* XXX hack to avoid perl_destruct() freeing optree */
1748 PL_main_root = Nullop;
1749 }
1750
1c0ca838
GS
1751 /* close the std handles to avoid fd leaks */
1752 {
1753 do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
1754 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE);
1755 do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE);
1756 }
1757
7766f137
GS
1758 /* destroy everything (waits for any pseudo-forked children) */
1759 perl_destruct(my_perl);
1760 perl_free(my_perl);
1761
1762#ifdef PERL_SYNC_FORK
1763 return id;
1764#else
1765 return (DWORD)status;
1766#endif
1767}
8454a2ba 1768#endif /* USE_ITHREADS */
7766f137
GS
1769
1770int
1771PerlProcFork(struct IPerlProc* piPerl)
1772{
acfe0abc 1773 dTHX;
8454a2ba 1774#ifdef USE_ITHREADS
7766f137
GS
1775 DWORD id;
1776 HANDLE handle;
7a955601
GS
1777 CPerlHost *h;
1778
1779 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1780 errno = EAGAIN;
1781 return -1;
1782 }
1783 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
acfe0abc 1784 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 1,
7766f137
GS
1785 h->m_pHostperlMem,
1786 h->m_pHostperlMemShared,
1787 h->m_pHostperlMemParse,
1788 h->m_pHostperlEnv,
1789 h->m_pHostperlStdIO,
1790 h->m_pHostperlLIO,
1791 h->m_pHostperlDir,
1792 h->m_pHostperlSock,
1793 h->m_pHostperlProc
1794 );
ad4e2db7 1795 new_perl->Isys_intern.internal_host = h;
8454a2ba 1796# ifdef PERL_SYNC_FORK
7766f137 1797 id = win32_start_child((LPVOID)new_perl);
acfe0abc 1798 PERL_SET_THX(aTHX);
8454a2ba 1799# else
c00206c8
GS
1800# ifdef USE_RTL_THREAD_API
1801 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1802 (void*)new_perl, 0, (unsigned*)&id);
1803# else
7766f137
GS
1804 handle = CreateThread(NULL, 0, win32_start_child,
1805 (LPVOID)new_perl, 0, &id);
c00206c8 1806# endif
acfe0abc 1807 PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
60fa28ff
GS
1808 if (!handle) {
1809 errno = EAGAIN;
1810 return -1;
1811 }
922b1888
GS
1812 if (IsWin95()) {
1813 int pid = (int)id;
1814 if (pid < 0)
1815 id = -pid;
1816 }
7766f137
GS
1817 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1818 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1819 ++w32_num_pseudo_children;
8454a2ba 1820# endif
7766f137 1821 return -(int)id;
8454a2ba
GS
1822#else
1823 Perl_croak(aTHX_ "fork() not implemented!\n");
1824 return -1;
1825#endif /* USE_ITHREADS */
7766f137
GS
1826}
1827
1828int
1829PerlProcGetpid(struct IPerlProc* piPerl)
1830{
1831 return win32_getpid();
1832}
1833
1834void*
1835PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1836{
1837 return win32_dynaload(filename);
1838}
1839
1840void
1841PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1842{
1843 win32_str_os_error(sv, dwErr);
1844}
1845
1846BOOL
1847PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1848{
1849 do_spawn2(cmd, EXECF_EXEC);
1850 return FALSE;
1851}
1852
1853int
1854PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1855{
1856 return do_spawn2(cmds, EXECF_SPAWN);
1857}
1858
1859int
1860PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1861{
1862 return win32_spawnvp(mode, cmdname, argv);
1863}
1864
1865int
1866PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1867{
1868 return do_aspawn(vreally, vmark, vsp);
1869}
1870
5f1a76d0
NIS
1871int
1872PerlProcLastHost(struct IPerlProc* piPerl)
1873{
acfe0abc 1874 dTHX;
5f1a76d0
NIS
1875 CPerlHost *h = (CPerlHost*)w32_internal_host;
1876 return h->LastHost();
1877}
1878
7766f137
GS
1879struct IPerlProc perlProc =
1880{
1881 PerlProcAbort,
1882 PerlProcCrypt,
1883 PerlProcExit,
1884 PerlProc_Exit,
1885 PerlProcExecl,
1886 PerlProcExecv,
1887 PerlProcExecvp,
1888 PerlProcGetuid,
1889 PerlProcGeteuid,
1890 PerlProcGetgid,
1891 PerlProcGetegid,
1892 PerlProcGetlogin,
1893 PerlProcKill,
1894 PerlProcKillpg,
1895 PerlProcPauseProc,
1896 PerlProcPopen,
1897 PerlProcPclose,
1898 PerlProcPipe,
1899 PerlProcSetuid,
1900 PerlProcSetgid,
1901 PerlProcSleep,
1902 PerlProcTimes,
1903 PerlProcWait,
1904 PerlProcWaitpid,
1905 PerlProcSignal,
1906 PerlProcFork,
1907 PerlProcGetpid,
1908 PerlProcDynaLoader,
1909 PerlProcGetOSError,
1910 PerlProcDoCmd,
1911 PerlProcSpawn,
1912 PerlProcSpawnvp,
1913 PerlProcASpawn,
8c0134a8
NIS
1914 PerlProcLastHost,
1915 PerlProcPopenList
7766f137
GS
1916};
1917
1918
1919/*
1920 * CPerlHost
1921 */
1922
1923CPerlHost::CPerlHost(void)
1924{
5f1a76d0
NIS
1925 /* Construct a host from scratch */
1926 InterlockedIncrement(&num_hosts);
7766f137
GS
1927 m_pvDir = new VDir();
1928 m_pVMem = new VMem();
1929 m_pVMemShared = new VMem();
1930 m_pVMemParse = new VMem();
1931
1932 m_pvDir->Init(NULL, m_pVMem);
1933
1934 m_dwEnvCount = 0;
1935 m_lppEnvList = NULL;
85fdc8b6 1936 m_bTopLevel = TRUE;
7766f137
GS
1937
1938 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1939 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1940 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1941 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1942 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1943 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1944 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1945 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1946 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1947
1948 m_pHostperlMem = &m_hostperlMem;
1949 m_pHostperlMemShared = &m_hostperlMemShared;
1950 m_pHostperlMemParse = &m_hostperlMemParse;
1951 m_pHostperlEnv = &m_hostperlEnv;
1952 m_pHostperlStdIO = &m_hostperlStdIO;
1953 m_pHostperlLIO = &m_hostperlLIO;
1954 m_pHostperlDir = &m_hostperlDir;
1955 m_pHostperlSock = &m_hostperlSock;
1956 m_pHostperlProc = &m_hostperlProc;
1957}
1958
1959#define SETUPEXCHANGE(xptr, iptr, table) \
1960 STMT_START { \
1961 if (xptr) { \
1962 iptr = *xptr; \
1963 *xptr = &table; \
1964 } \
1965 else { \
1966 iptr = &table; \
1967 } \
1968 } STMT_END
1969
1970CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1971 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1972 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1973 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1974 struct IPerlProc** ppProc)
1975{
5f1a76d0 1976 InterlockedIncrement(&num_hosts);
f7aeb604 1977 m_pvDir = new VDir(0);
7766f137
GS
1978 m_pVMem = new VMem();
1979 m_pVMemShared = new VMem();
1980 m_pVMemParse = new VMem();
1981
1982 m_pvDir->Init(NULL, m_pVMem);
1983
1984 m_dwEnvCount = 0;
1985 m_lppEnvList = NULL;
85fdc8b6 1986 m_bTopLevel = FALSE;
7766f137
GS
1987
1988 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1989 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1990 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1991 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1992 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1993 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1994 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1995 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1996 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1997
1998 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
1999 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
2000 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
2001 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
2002 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
2003 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
2004 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
2005 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
2006 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
2007}
2008#undef SETUPEXCHANGE
2009
2010CPerlHost::CPerlHost(CPerlHost& host)
2011{
5f1a76d0
NIS
2012 /* Construct a host from another host */
2013 InterlockedIncrement(&num_hosts);
7766f137
GS
2014 m_pVMem = new VMem();
2015 m_pVMemShared = host.GetMemShared();
2016 m_pVMemParse = host.GetMemParse();
2017
2018 /* duplicate directory info */
f7aeb604 2019 m_pvDir = new VDir(0);
7766f137
GS
2020 m_pvDir->Init(host.GetDir(), m_pVMem);
2021
2022 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2023 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2024 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2025 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2026 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2027 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2028 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2029 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2030 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
ad4e2db7
GS
2031 m_pHostperlMem = &m_hostperlMem;
2032 m_pHostperlMemShared = &m_hostperlMemShared;
2033 m_pHostperlMemParse = &m_hostperlMemParse;
2034 m_pHostperlEnv = &m_hostperlEnv;
2035 m_pHostperlStdIO = &m_hostperlStdIO;
2036 m_pHostperlLIO = &m_hostperlLIO;
2037 m_pHostperlDir = &m_hostperlDir;
2038 m_pHostperlSock = &m_hostperlSock;
2039 m_pHostperlProc = &m_hostperlProc;
7766f137
GS
2040
2041 m_dwEnvCount = 0;
2042 m_lppEnvList = NULL;
85fdc8b6 2043 m_bTopLevel = FALSE;
7766f137
GS
2044
2045 /* duplicate environment info */
2046 LPSTR lpPtr;
2047 DWORD dwIndex = 0;
2048 while(lpPtr = host.GetIndex(dwIndex))
2049 Add(lpPtr);
2050}
2051
2052CPerlHost::~CPerlHost(void)
2053{
cb69f87a 2054/* Reset(); */
5f1a76d0 2055 InterlockedDecrement(&num_hosts);
7766f137
GS
2056 delete m_pvDir;
2057 m_pVMemParse->Release();
2058 m_pVMemShared->Release();
2059 m_pVMem->Release();
2060}
2061
2062LPSTR
2063CPerlHost::Find(LPCSTR lpStr)
2064{
2065 LPSTR lpPtr;
2066 LPSTR* lppPtr = Lookup(lpStr);
2067 if(lppPtr != NULL) {
2068 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2069 ;
2070
2071 if(*lpPtr == '=')
2072 ++lpPtr;
2073
2074 return lpPtr;
2075 }
2076 return NULL;
2077}
2078
2079int
2080lookup(const void *arg1, const void *arg2)
cb69f87a 2081{ /* Compare strings */
7766f137
GS
2082 char*ptr1, *ptr2;
2083 char c1,c2;
2084
2085 ptr1 = *(char**)arg1;
2086 ptr2 = *(char**)arg2;
2087 for(;;) {
2088 c1 = *ptr1++;
2089 c2 = *ptr2++;
2090 if(c1 == '\0' || c1 == '=') {
2091 if(c2 == '\0' || c2 == '=')
2092 break;
2093
cb69f87a 2094 return -1; /* string 1 < string 2 */
7766f137
GS
2095 }
2096 else if(c2 == '\0' || c2 == '=')
cb69f87a 2097 return 1; /* string 1 > string 2 */
7766f137
GS
2098 else if(c1 != c2) {
2099 c1 = toupper(c1);
2100 c2 = toupper(c2);
2101 if(c1 != c2) {
2102 if(c1 < c2)
cb69f87a 2103 return -1; /* string 1 < string 2 */
7766f137 2104
cb69f87a 2105 return 1; /* string 1 > string 2 */
7766f137
GS
2106 }
2107 }
2108 }
2109 return 0;
2110}
2111
2112LPSTR*
2113CPerlHost::Lookup(LPCSTR lpStr)
2114{
2115 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2116}
2117
2118int
2119compare(const void *arg1, const void *arg2)
cb69f87a 2120{ /* Compare strings */
7766f137
GS
2121 char*ptr1, *ptr2;
2122 char c1,c2;
2123
2124 ptr1 = *(char**)arg1;
2125 ptr2 = *(char**)arg2;
2126 for(;;) {
2127 c1 = *ptr1++;
2128 c2 = *ptr2++;
2129 if(c1 == '\0' || c1 == '=') {
2130 if(c1 == c2)
2131 break;
2132
cb69f87a 2133 return -1; /* string 1 < string 2 */
7766f137
GS
2134 }
2135 else if(c2 == '\0' || c2 == '=')
cb69f87a 2136 return 1; /* string 1 > string 2 */
7766f137
GS
2137 else if(c1 != c2) {
2138 c1 = toupper(c1);
2139 c2 = toupper(c2);
2140 if(c1 != c2) {
2141 if(c1 < c2)
cb69f87a 2142 return -1; /* string 1 < string 2 */
f3dccfae 2143
cb69f87a 2144 return 1; /* string 1 > string 2 */
7766f137
GS
2145 }
2146 }
2147 }
2148 return 0;
2149}
2150
2151void
2152CPerlHost::Add(LPCSTR lpStr)
2153{
acfe0abc 2154 dTHX;
7766f137
GS
2155 char szBuffer[1024];
2156 LPSTR *lpPtr;
2157 int index, length = strlen(lpStr)+1;
2158
2159 for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2160 szBuffer[index] = lpStr[index];
2161
2162 szBuffer[index] = '\0';
2163
cb69f87a 2164 /* replacing ? */
7766f137
GS
2165 lpPtr = Lookup(szBuffer);
2166 if(lpPtr != NULL) {
2167 Renew(*lpPtr, length, char);
2168 strcpy(*lpPtr, lpStr);
2169 }
2170 else {
2171 ++m_dwEnvCount;
2172 Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2173 New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2174 if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2175 strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2176 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2177 }
2178 else
2179 --m_dwEnvCount;
2180 }
2181}
2182
2183DWORD
2184CPerlHost::CalculateEnvironmentSpace(void)
2185{
2186 DWORD index;
2187 DWORD dwSize = 0;
2188 for(index = 0; index < m_dwEnvCount; ++index)
2189 dwSize += strlen(m_lppEnvList[index]) + 1;
2190
2191 return dwSize;
2192}
2193
2194void
2195CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2196{
acfe0abc 2197 dTHX;
7766f137
GS
2198 Safefree(lpStr);
2199}
2200
2201char*
2202CPerlHost::GetChildDir(void)
2203{
acfe0abc 2204 dTHX;
7766f137
GS
2205 int length;
2206 char* ptr;
2207 New(0, ptr, MAX_PATH+1, char);
2208 if(ptr) {
2209 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
17e29069
JH
2210 length = strlen(ptr);
2211 if (length > 3) {
2212 if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2213 ptr[length-1] = 0;
7766f137
GS
2214 }
2215 }
2216 return ptr;
2217}
2218
2219void
2220CPerlHost::FreeChildDir(char* pStr)
2221{
acfe0abc 2222 dTHX;
7766f137
GS
2223 Safefree(pStr);
2224}
2225
2226LPSTR
2227CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2228{
acfe0abc 2229 dTHX;
7766f137
GS
2230 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2231 DWORD dwSize, dwEnvIndex;
2232 int nLength, compVal;
2233
cb69f87a 2234 /* get the process environment strings */
7766f137
GS
2235 lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2236
cb69f87a 2237 /* step over current directory stuff */
7766f137
GS
2238 while(*lpTmp == '=')
2239 lpTmp += strlen(lpTmp) + 1;
2240
cb69f87a 2241 /* save the start of the environment strings */
7766f137
GS
2242 lpEnvPtr = lpTmp;
2243 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
cb69f87a 2244 /* calculate the size of the environment strings */
7766f137
GS
2245 dwSize += strlen(lpTmp) + 1;
2246 }
2247
cb69f87a 2248 /* add the size of current directories */
7766f137
GS
2249 dwSize += vDir.CalculateEnvironmentSpace();
2250
cb69f87a 2251 /* add the additional space used by changes made to the environment */
7766f137
GS
2252 dwSize += CalculateEnvironmentSpace();
2253
2254 New(1, lpStr, dwSize, char);
2255 lpPtr = lpStr;
2256 if(lpStr != NULL) {
cb69f87a 2257 /* build the local environment */
7766f137
GS
2258 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2259
2260 dwEnvIndex = 0;
2261 lpLocalEnv = GetIndex(dwEnvIndex);
2262 while(*lpEnvPtr != '\0') {
ec00bdd8 2263 if(!lpLocalEnv) {
cb69f87a
MB
2264 /* all environment overrides have been added */
2265 /* so copy string into place */
7766f137
GS
2266 strcpy(lpStr, lpEnvPtr);
2267 nLength = strlen(lpEnvPtr) + 1;
2268 lpStr += nLength;
2269 lpEnvPtr += nLength;
2270 }
2271 else {
cb69f87a 2272 /* determine which string to copy next */
7766f137
GS
2273 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2274 if(compVal < 0) {
2275 strcpy(lpStr, lpEnvPtr);
2276 nLength = strlen(lpEnvPtr) + 1;
2277 lpStr += nLength;
2278 lpEnvPtr += nLength;
2279 }
2280 else {
2281 char *ptr = strchr(lpLocalEnv, '=');
2282 if(ptr && ptr[1]) {
2283 strcpy(lpStr, lpLocalEnv);
2284 lpStr += strlen(lpLocalEnv) + 1;
2285 }
2286 lpLocalEnv = GetIndex(dwEnvIndex);
2287 if(compVal == 0) {
cb69f87a 2288 /* this string was replaced */
7766f137
GS
2289 lpEnvPtr += strlen(lpEnvPtr) + 1;
2290 }
2291 }
2292 }
2293 }
2294
ec00bdd8 2295 while(lpLocalEnv) {
cb69f87a
MB
2296 /* still have environment overrides to add */
2297 /* so copy the strings into place if not an override */
1784c7b8
JH
2298 char *ptr = strchr(lpLocalEnv, '=');
2299 if(ptr && ptr[1]) {
2300 strcpy(lpStr, lpLocalEnv);
2301 lpStr += strlen(lpLocalEnv) + 1;
2302 }
ec00bdd8
GS
2303 lpLocalEnv = GetIndex(dwEnvIndex);
2304 }
2305
cb69f87a 2306 /* add final NULL */
7766f137
GS
2307 *lpStr = '\0';
2308 }
2309
cb69f87a 2310 /* release the process environment strings */
7766f137
GS
2311 FreeEnvironmentStrings(lpAllocPtr);
2312
2313 return lpPtr;
2314}
2315
2316void
2317CPerlHost::Reset(void)
2318{
acfe0abc 2319 dTHX;
7766f137
GS
2320 if(m_lppEnvList != NULL) {
2321 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2322 Safefree(m_lppEnvList[index]);
2323 m_lppEnvList[index] = NULL;
2324 }
2325 }
2326 m_dwEnvCount = 0;
2327}
2328
2329void
2330CPerlHost::Clearenv(void)
2331{
acfe0abc 2332 dTHX;
7766f137
GS
2333 char ch;
2334 LPSTR lpPtr, lpStr, lpEnvPtr;
2fb9ab56 2335 if (m_lppEnvList != NULL) {
7766f137
GS
2336 /* set every entry to an empty string */
2337 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2338 char* ptr = strchr(m_lppEnvList[index], '=');
2339 if(ptr) {
2340 *++ptr = 0;
2341 }
2342 }
2343 }
2344
2345 /* get the process environment strings */
2346 lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2347
2348 /* step over current directory stuff */
2349 while(*lpStr == '=')
2350 lpStr += strlen(lpStr) + 1;
2351
2352 while(*lpStr) {
2353 lpPtr = strchr(lpStr, '=');
2354 if(lpPtr) {
2355 ch = *++lpPtr;
2356 *lpPtr = 0;
2357 Add(lpStr);
85fdc8b6 2358 if (m_bTopLevel)
2fb9ab56 2359 (void)win32_putenv(lpStr);
7766f137
GS
2360 *lpPtr = ch;
2361 }
2362 lpStr += strlen(lpStr) + 1;
2363 }
2364
2365 FreeEnvironmentStrings(lpEnvPtr);
2366}
2367
2368
2369char*
2370CPerlHost::Getenv(const char *varname)
2371{
acfe0abc 2372 dTHX;
85fdc8b6 2373 if (!m_bTopLevel) {
2fb9ab56 2374 char *pEnv = Find(varname);
4354e59a 2375 if (pEnv && *pEnv)
2fb9ab56 2376 return pEnv;
7766f137 2377 }
2fb9ab56 2378 return win32_getenv(varname);
7766f137
GS
2379}
2380
2381int
2382CPerlHost::Putenv(const char *envstring)
2383{
acfe0abc 2384 dTHX;
7766f137 2385 Add(envstring);
85fdc8b6 2386 if (m_bTopLevel)
2fb9ab56
NIS
2387 return win32_putenv(envstring);
2388
7766f137
GS
2389 return 0;
2390}
2391
2392int
2393CPerlHost::Chdir(const char *dirname)
2394{
acfe0abc 2395 dTHX;
7766f137 2396 int ret;
9ec3348a
JH
2397 if (!dirname) {
2398 errno = ENOENT;
2399 return -1;
2400 }
7766f137
GS
2401 if (USING_WIDE()) {
2402 WCHAR wBuffer[MAX_PATH];
2403 A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2404 ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2405 }
2406 else
2407 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2408 if(ret < 0) {
2409 errno = ENOENT;
2410 }
2411 return ret;
2412}
2413
2414#endif /* ___PerlHost_H___ */