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