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