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