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