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