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