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