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