This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[asperl] add AS patch#13
[perl5.git] / win32 / runperl.c
CommitLineData
76e3520e
GS
1
2#ifdef PERL_OBJECT
3#define USE_SOCKETS_AS_HANDLES
4#include "EXTERN.h"
5#include "perl.h"
6
565764a8 7#define NO_XSLOCKS
76e3520e 8#include "XSUB.H"
c69f6586
GS
9#include "Win32iop.h"
10
565764a8
DL
11#undef errno
12#if defined(_MT)
13_CRTIMP int * __cdecl _errno(void);
14#define errno (*_errno())
15#else
16_CRTIMP extern int errno;
17#endif
76e3520e 18
c69f6586
GS
19CPerlObj *pPerl;
20
21#include <fcntl.h>
76e3520e
GS
22#include <ipdir.h>
23#include <ipenv.h>
24#include <ipsock.h>
25#include <iplio.h>
26#include <ipmem.h>
27#include <ipproc.h>
c69f6586
GS
28#include <ipstdio.h>
29
30class IPerlStdIOWin : public IPerlStdIO
31{
32public:
33 virtual int OpenOSfhandle(long osfhandle, int flags) = 0;
34 virtual int GetOSfhandle(int filenum) = 0;
35};
36
37extern int g_closedir(DIR *dirp);
38extern DIR *g_opendir(char *filename);
39extern struct direct *g_readdir(DIR *dirp);
40extern void g_rewinddir(DIR *dirp);
41extern void g_seekdir(DIR *dirp, long loc);
42extern long g_telldir(DIR *dirp);
43class CPerlDir : public IPerlDir
44{
45public:
46 CPerlDir() {};
47 virtual int Makedir(const char *dirname, int mode, int &err)
48 {
49 return win32_mkdir(dirname, mode);
50 };
51 virtual int Chdir(const char *dirname, int &err)
52 {
53 return win32_chdir(dirname);
54 };
55 virtual int Rmdir(const char *dirname, int &err)
56 {
57 return win32_rmdir(dirname);
58 };
59 virtual int Close(DIR *dirp, int &err)
60 {
61 return g_closedir(dirp);
62 };
63 virtual DIR *Open(char *filename, int &err)
64 {
65 return g_opendir(filename);
66 };
67 virtual struct direct *Read(DIR *dirp, int &err)
68 {
69 return g_readdir(dirp);
70 };
71 virtual void Rewind(DIR *dirp, int &err)
72 {
73 g_rewinddir(dirp);
74 };
75 virtual void Seek(DIR *dirp, long loc, int &err)
76 {
77 g_seekdir(dirp, loc);
78 };
79 virtual long Tell(DIR *dirp, int &err)
80 {
81 return g_telldir(dirp);
82 };
83};
84
85
86extern char * g_win32_perllib_path(char *sfx,...);
87class CPerlEnv : public IPerlEnv
88{
89public:
90 CPerlEnv() {};
91 virtual char *Getenv(const char *varname, int &err)
92 {
93 return win32_getenv(varname);
94 };
95 virtual int Putenv(const char *envstring, int &err)
96 {
97 return _putenv(envstring);
98 };
99 virtual char* LibPath(char *sfx, ...)
100 {
101 LPSTR ptr1, ptr2, ptr3, ptr4, ptr5;
102 va_list ap;
103 va_start(ap,sfx);
104 ptr1 = va_arg(ap,char *);
105 ptr2 = va_arg(ap,char *);
106 ptr3 = va_arg(ap,char *);
107 ptr4 = va_arg(ap,char *);
108 ptr5 = va_arg(ap,char *);
109 return g_win32_perllib_path(sfx, ptr1, ptr2, ptr3, ptr4, ptr5);
110 };
111};
112
113#define PROCESS_AND_RETURN \
114 if(errno) \
115 err = errno; \
116 return r
117
118class CPerlSock : public IPerlSock
119{
120public:
121 CPerlSock() {};
122 virtual u_long Htonl(u_long hostlong)
123 {
124 return win32_htonl(hostlong);
125 };
126 virtual u_short Htons(u_short hostshort)
127 {
128 return win32_htons(hostshort);
129 };
130 virtual u_long Ntohl(u_long netlong)
131 {
132 return win32_ntohl(netlong);
133 };
134 virtual u_short Ntohs(u_short netshort)
135 {
136 return win32_ntohs(netshort);
137 }
138
139 virtual SOCKET Accept(SOCKET s, struct sockaddr* addr, int* addrlen, int &err)
140 {
141 SOCKET r = win32_accept(s, addr, addrlen);
142 PROCESS_AND_RETURN;
143 };
144 virtual int Bind(SOCKET s, const struct sockaddr* name, int namelen, int &err)
145 {
146 int r = win32_bind(s, name, namelen);
147 PROCESS_AND_RETURN;
148 };
149 virtual int Connect(SOCKET s, const struct sockaddr* name, int namelen, int &err)
150 {
151 int r = win32_connect(s, name, namelen);
152 PROCESS_AND_RETURN;
153 };
154 virtual void Endhostent(int &err)
155 {
156 win32_endhostent();
157 };
158 virtual void Endnetent(int &err)
159 {
160 win32_endnetent();
161 };
162 virtual void Endprotoent(int &err)
163 {
164 win32_endprotoent();
165 };
166 virtual void Endservent(int &err)
167 {
168 win32_endservent();
169 };
170 virtual struct hostent* Gethostbyaddr(const char* addr, int len, int type, int &err)
171 {
172 struct hostent *r = win32_gethostbyaddr(addr, len, type);
173 PROCESS_AND_RETURN;
174 };
175 virtual struct hostent* Gethostbyname(const char* name, int &err)
176 {
177 struct hostent *r = win32_gethostbyname(name);
178 PROCESS_AND_RETURN;
179 };
180 virtual struct hostent* Gethostent(int &err)
181 {
182 croak("gethostent not implemented!\n");
183 return NULL;
184 };
185 virtual int Gethostname(char* name, int namelen, int &err)
186 {
187 int r = win32_gethostname(name, namelen);
188 PROCESS_AND_RETURN;
189 };
190 virtual struct netent *Getnetbyaddr(long net, int type, int &err)
191 {
192 struct netent *r = win32_getnetbyaddr(net, type);
193 PROCESS_AND_RETURN;
194 };
195 virtual struct netent *Getnetbyname(const char *name, int &err)
196 {
197 struct netent *r = win32_getnetbyname((char*)name);
198 PROCESS_AND_RETURN;
199 };
200 virtual struct netent *Getnetent(int &err)
201 {
202 struct netent *r = win32_getnetent();
203 PROCESS_AND_RETURN;
204 };
205 virtual int Getpeername(SOCKET s, struct sockaddr* name, int* namelen, int &err)
206 {
207 int r = win32_getpeername(s, name, namelen);
208 PROCESS_AND_RETURN;
209 };
210 virtual struct protoent* Getprotobyname(const char* name, int &err)
211 {
212 struct protoent *r = win32_getprotobyname(name);
213 PROCESS_AND_RETURN;
214 };
215 virtual struct protoent* Getprotobynumber(int number, int &err)
216 {
217 struct protoent *r = win32_getprotobynumber(number);
218 PROCESS_AND_RETURN;
219 };
220 virtual struct protoent* Getprotoent(int &err)
221 {
222 struct protoent *r = win32_getprotoent();
223 PROCESS_AND_RETURN;
224 };
225 virtual struct servent* Getservbyname(const char* name, const char* proto, int &err)
226 {
227 struct servent *r = win32_getservbyname(name, proto);
228 PROCESS_AND_RETURN;
229 };
230 virtual struct servent* Getservbyport(int port, const char* proto, int &err)
231 {
232 struct servent *r = win32_getservbyport(port, proto);
233 PROCESS_AND_RETURN;
234 };
235 virtual struct servent* Getservent(int &err)
236 {
237 struct servent *r = win32_getservent();
238 PROCESS_AND_RETURN;
239 };
240 virtual int Getsockname(SOCKET s, struct sockaddr* name, int* namelen, int &err)
241 {
242 int r = win32_getsockname(s, name, namelen);
243 PROCESS_AND_RETURN;
244 };
245 virtual int Getsockopt(SOCKET s, int level, int optname, char* optval, int* optlen, int &err)
246 {
247 int r = win32_getsockopt(s, level, optname, optval, optlen);
248 PROCESS_AND_RETURN;
249 };
250 virtual unsigned long InetAddr(const char* cp, int &err)
251 {
252 unsigned long r = win32_inet_addr(cp);
253 PROCESS_AND_RETURN;
254 };
255 virtual char* InetNtoa(struct in_addr in, int &err)
256 {
257 char *r = win32_inet_ntoa(in);
258 PROCESS_AND_RETURN;
259 };
260 virtual int IoctlSocket(SOCKET s, long cmd, u_long *argp, int& err)
261 {
262 int r = win32_ioctlsocket(s, cmd, argp);
263 PROCESS_AND_RETURN;
264 };
265 virtual int Listen(SOCKET s, int backlog, int &err)
266 {
267 int r = win32_listen(s, backlog);
268 PROCESS_AND_RETURN;
269 };
270 virtual int Recvfrom(SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen, int &err)
271 {
272 int r = win32_recvfrom(s, buffer, len, flags, from, fromlen);
273 PROCESS_AND_RETURN;
274 };
275 virtual int Select(int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout, int &err)
276 {
277 int r = win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
278 PROCESS_AND_RETURN;
279 };
280 virtual int Send(SOCKET s, const char* buffer, int len, int flags, int &err)
281 {
282 int r = win32_send(s, buffer, len, flags);
283 PROCESS_AND_RETURN;
284 };
285 virtual int Sendto(SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen, int &err)
286 {
287 int r = win32_sendto(s, buffer, len, flags, to, tolen);
288 PROCESS_AND_RETURN;
289 };
290 virtual void Sethostent(int stayopen, int &err)
291 {
292 win32_sethostent(stayopen);
293 };
294 virtual void Setnetent(int stayopen, int &err)
295 {
296 win32_setnetent(stayopen);
297 };
298 virtual void Setprotoent(int stayopen, int &err)
299 {
300 win32_setprotoent(stayopen);
301 };
302 virtual void Setservent(int stayopen, int &err)
303 {
304 win32_setservent(stayopen);
305 };
306 virtual int Setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen, int &err)
307 {
308 int r = win32_setsockopt(s, level, optname, optval, optlen);
309 PROCESS_AND_RETURN;
310 };
311 virtual int Shutdown(SOCKET s, int how, int &err)
312 {
313 int r = win32_shutdown(s, how);
314 PROCESS_AND_RETURN;
315 };
316 virtual SOCKET Socket(int af, int type, int protocol, int &err)
317 {
318 SOCKET r = win32_socket(af, type, protocol);
319 PROCESS_AND_RETURN;
320 };
321 virtual int Socketpair(int domain, int type, int protocol, int* fds, int &err)
322 {
323 croak("socketpair not implemented!\n");
324 return 0;
325 };
326};
327
328
329#define CALLFUNCRET(x)\
330 int ret = x;\
331 if(ret)\
332 err = errno;\
333 return ret;
334
335#define CALLFUNCERR(x)\
336 int ret = x;\
337 if(errno)\
338 err = errno;\
339 return ret;
340
341#define LCALLFUNCERR(x)\
342 long ret = x;\
343 if(errno)\
344 err = errno;\
345 return ret;
346
347class CPerlLIO : public IPerlLIO
348{
349public:
350 CPerlLIO() {};
351 virtual int Access(const char *path, int mode, int &err)
352 {
353 CALLFUNCRET(access(path, mode))
354 };
355 virtual int Chmod(const char *filename, int pmode, int &err)
356 {
357 CALLFUNCRET(chmod(filename, pmode))
358 };
01f988be
GS
359 virtual int Chown(const char *filename, uid_t owner, gid_t group, int &err)
360 {
361 CALLFUNCERR(chown(filename, owner, group))
362 };
c69f6586
GS
363 virtual int Chsize(int handle, long size, int &err)
364 {
365 CALLFUNCRET(chsize(handle, size))
366 };
367 virtual int Close(int handle, int &err)
368 {
369 CALLFUNCRET(win32_close(handle))
370 };
371 virtual int Dup(int handle, int &err)
372 {
373 CALLFUNCERR(win32_dup(handle))
374 };
375 virtual int Dup2(int handle1, int handle2, int &err)
376 {
377 CALLFUNCERR(win32_dup2(handle1, handle2))
378 };
379 virtual int Flock(int fd, int oper, int &err)
380 {
381 CALLFUNCERR(win32_flock(fd, oper))
382 };
383 virtual int FileStat(int handle, struct stat *buffer, int &err)
384 {
385 CALLFUNCERR(fstat(handle, buffer))
386 };
387 virtual int IOCtl(int i, unsigned int u, char *data, int &err)
388 {
389 CALLFUNCERR(win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data))
390 };
391 virtual int Isatty(int fd, int &err)
392 {
393 return isatty(fd);
394 };
395 virtual long Lseek(int handle, long offset, int origin, int &err)
396 {
397 LCALLFUNCERR(win32_lseek(handle, offset, origin))
398 };
399 virtual int Lstat(const char *path, struct stat *buffer, int &err)
400 {
401 return NameStat(path, buffer, err);
402 };
403 virtual char *Mktemp(char *Template, int &err)
404 {
405 return mktemp(Template);
406 };
407 virtual int Open(const char *filename, int oflag, int &err)
408 {
409 CALLFUNCERR(win32_open(filename, oflag))
410 };
411 virtual int Open(const char *filename, int oflag, int pmode, int &err)
412 {
413 int ret;
414 if(stricmp(filename, "/dev/null") == 0)
415 ret = open("NUL", oflag, pmode);
416 else
417 ret = open(filename, oflag, pmode);
418
419 if(errno)
420 err = errno;
421 return ret;
422 };
423 virtual int Read(int handle, void *buffer, unsigned int count, int &err)
424 {
425 CALLFUNCERR(win32_read(handle, buffer, count))
426 };
427 virtual int Rename(const char *OldFileName, const char *newname, int &err)
428 {
429 char szNewWorkName[MAX_PATH+1];
430 WIN32_FIND_DATA fdOldFile, fdNewFile;
431 HANDLE handle;
432 char *ptr;
433
434 if((strchr(OldFileName, '\\') || strchr(OldFileName, '/'))
435 && strchr(newname, '\\') == NULL
436 && strchr(newname, '/') == NULL)
437 {
438 strcpy(szNewWorkName, OldFileName);
439 if((ptr = strrchr(szNewWorkName, '\\')) == NULL)
440 ptr = strrchr(szNewWorkName, '/');
441 strcpy(++ptr, newname);
442 }
443 else
444 strcpy(szNewWorkName, newname);
445
446 if(stricmp(OldFileName, szNewWorkName) != 0)
447 { // check that we're not being fooled by relative paths
448 // and only delete the new file
449 // 1) if it exists
450 // 2) it is not the same file as the old file
451 // 3) old file exist
452 // GetFullPathName does not return the long file name on some systems
453 handle = FindFirstFile(OldFileName, &fdOldFile);
454 if(handle != INVALID_HANDLE_VALUE)
455 {
456 FindClose(handle);
457
458 handle = FindFirstFile(szNewWorkName, &fdNewFile);
459
460 if(handle != INVALID_HANDLE_VALUE)
461 FindClose(handle);
462 else
463 fdNewFile.cFileName[0] = '\0';
464
465 if(strcmp(fdOldFile.cAlternateFileName, fdNewFile.cAlternateFileName) != 0
466 && strcmp(fdOldFile.cFileName, fdNewFile.cFileName) != 0)
467 { // file exists and not same file
468 DeleteFile(szNewWorkName);
469 }
470 }
471 }
472 int ret = rename(OldFileName, szNewWorkName);
473 if(ret)
474 err = errno;
475
476 return ret;
477 };
478 virtual int Setmode(int handle, int mode, int &err)
479 {
480 CALLFUNCRET(win32_setmode(handle, mode))
481 };
482 virtual int NameStat(const char *path, struct stat *buffer, int &err)
483 {
484 return win32_stat(path, buffer);
485 };
486 virtual char *Tmpnam(char *string, int &err)
487 {
488 return tmpnam(string);
489 };
490 virtual int Umask(int pmode, int &err)
491 {
492 return umask(pmode);
493 };
494 virtual int Unlink(const char *filename, int &err)
495 {
496 chmod(filename, _S_IREAD | _S_IWRITE);
497 CALLFUNCRET(unlink(filename))
498 };
499 virtual int Utime(char *filename, struct utimbuf *times, int &err)
500 {
501 CALLFUNCRET(win32_utime(filename, times))
502 };
503 virtual int Write(int handle, const void *buffer, unsigned int count, int &err)
504 {
505 CALLFUNCERR(win32_write(handle, buffer, count))
506 };
507};
508
509class CPerlMem : public IPerlMem
510{
511public:
512 CPerlMem() {};
513 virtual void* Malloc(size_t size)
514 {
515 return win32_malloc(size);
516 };
517 virtual void* Realloc(void* ptr, size_t size)
518 {
519 return win32_realloc(ptr, size);
520 };
521 virtual void Free(void* ptr)
522 {
523 win32_free(ptr);
524 };
525};
526
527#define EXECF_EXEC 1
528#define EXECF_SPAWN 2
529
530extern char *g_getlogin(void);
531extern int do_spawn2(char *cmd, int exectype);
532extern int g_do_aspawn(void *vreally, void **vmark, void **vsp);
533class CPerlProc : public IPerlProc
534{
535public:
536 CPerlProc() {};
537 virtual void Abort(void)
538 {
539 win32_abort();
540 };
541 virtual void Exit(int status)
542 {
543 exit(status);
544 };
545 virtual void _Exit(int status)
546 {
547 _exit(status);
548 };
549 virtual int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
550 {
551 return execl(cmdname, arg0, arg1, arg2, arg3);
552 };
553 virtual int Execv(const char *cmdname, const char *const *argv)
554 {
555 return win32_execvp(cmdname, argv);
556 };
557 virtual int Execvp(const char *cmdname, const char *const *argv)
558 {
559 return win32_execvp(cmdname, argv);
560 };
561 virtual uid_t Getuid(void)
562 {
563 return getuid();
564 };
565 virtual uid_t Geteuid(void)
566 {
567 return geteuid();
568 };
569 virtual gid_t Getgid(void)
570 {
571 return getgid();
572 };
573 virtual gid_t Getegid(void)
574 {
575 return getegid();
576 };
577 virtual char *Getlogin(void)
578 {
579 return g_getlogin();
580 };
581 virtual int Kill(int pid, int sig)
582 {
583 return kill(pid, sig);
584 };
585 virtual int Killpg(int pid, int sig)
586 {
587 croak("killpg not implemented!\n");
588 return 0;
589 };
590 virtual int PauseProc(void)
591 {
592 return win32_sleep((32767L << 16) + 32767);
593 };
594 virtual PerlIO* Popen(const char *command, const char *mode)
595 {
596 return (PerlIO*)win32_popen(command, mode);
597 };
598 virtual int Pclose(PerlIO *stream)
599 {
600 return win32_pclose((FILE*)stream);
601 };
602 virtual int Pipe(int *phandles)
603 {
604 return win32_pipe(phandles, 512, _O_BINARY);
605 };
606 virtual int Setuid(uid_t u)
607 {
608 return setuid(u);
609 };
610 virtual int Setgid(gid_t g)
611 {
612 return setgid(g);
613 };
614 virtual int Sleep(unsigned int s)
615 {
616 return win32_sleep(s);
617 };
618 virtual int Times(struct tms *timebuf)
619 {
620 return win32_times(timebuf);
621 };
622 virtual int Wait(int *status)
623 {
624 return win32_wait(status);
625 };
626 virtual Sighandler_t Signal(int sig, Sighandler_t subcode)
627 {
628 return 0;
629 };
630 virtual void GetSysMsg(char*& sMsg, DWORD& dwLen, DWORD dwErr)
631 {
632 dwLen = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER
633 |FORMAT_MESSAGE_IGNORE_INSERTS
634 |FORMAT_MESSAGE_FROM_SYSTEM, NULL,
635 dwErr, 0, (char *)&sMsg, 1, NULL);
636 if (0 < dwLen) {
637 while (0 < dwLen && isspace(sMsg[--dwLen]))
638 ;
639 if ('.' != sMsg[dwLen])
640 dwLen++;
641 sMsg[dwLen]= '\0';
642 }
643 if (0 == dwLen) {
644 sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
645 dwLen = sprintf(sMsg,
646 "Unknown error #0x%lX (lookup 0x%lX)",
647 dwErr, GetLastError());
648 }
649 };
650 virtual void FreeBuf(char* sMsg)
651 {
652 LocalFree(sMsg);
653 };
654 virtual BOOL DoCmd(char *cmd)
655 {
656 do_spawn2(cmd, EXECF_EXEC);
657 return FALSE;
658 };
659 virtual int Spawn(char* cmds)
660 {
661 return do_spawn2(cmds, EXECF_SPAWN);
662 };
663 virtual int Spawnvp(int mode, const char *cmdname, const char *const *argv)
664 {
665 return win32_spawnvp(mode, cmdname, argv);
666 };
667 virtual int ASpawn(void *vreally, void **vmark, void **vsp)
668 {
669 return g_do_aspawn(vreally, vmark, vsp);
670 };
671};
672
673
674class CPerlStdIO : public IPerlStdIOWin
675{
676public:
677 CPerlStdIO() {};
678 virtual PerlIO* Stdin(void)
679 {
680 return (PerlIO*)win32_stdin();
681 };
682 virtual PerlIO* Stdout(void)
683 {
684 return (PerlIO*)win32_stdout();
685 };
686 virtual PerlIO* Stderr(void)
687 {
688 return (PerlIO*)win32_stderr();
689 };
690 virtual PerlIO* Open(const char *path, const char *mode, int &err)
691 {
692 PerlIO*pf = (PerlIO*)win32_fopen(path, mode);
693 if(errno)
694 err = errno;
695 return pf;
696 };
697 virtual int Close(PerlIO* pf, int &err)
698 {
699 CALLFUNCERR(win32_fclose(((FILE*)pf)))
700 };
701 virtual int Eof(PerlIO* pf, int &err)
702 {
703 CALLFUNCERR(win32_feof((FILE*)pf))
704 };
705 virtual int Error(PerlIO* pf, int &err)
706 {
707 CALLFUNCERR(win32_ferror((FILE*)pf))
708 };
709 virtual void Clearerr(PerlIO* pf, int &err)
710 {
711 win32_clearerr((FILE*)pf);
712 };
713 virtual int Getc(PerlIO* pf, int &err)
714 {
715 CALLFUNCERR(win32_getc((FILE*)pf))
716 };
717 virtual char* GetBase(PerlIO* pf, int &err)
718 {
719 return ((FILE*)pf)->_base;
720 };
721 virtual int GetBufsiz(PerlIO* pf, int &err)
722 {
723 return ((FILE*)pf)->_bufsiz;
724 };
725 virtual int GetCnt(PerlIO* pf, int &err)
726 {
727 return ((FILE*)pf)->_cnt;
728 };
729 virtual char* GetPtr(PerlIO* pf, int &err)
730 {
731 return ((FILE*)pf)->_ptr;
732 };
733 virtual int Putc(PerlIO* pf, int c, int &err)
734 {
735 CALLFUNCERR(win32_fputc(c, (FILE*)pf))
736 };
737 virtual int Puts(PerlIO* pf, const char *s, int &err)
738 {
739 CALLFUNCERR(win32_fputs(s, (FILE*)pf))
740 };
741 virtual int Flush(PerlIO* pf, int &err)
742 {
743 CALLFUNCERR(win32_fflush((FILE*)pf))
744 };
745 virtual int Ungetc(PerlIO* pf,int c, int &err)
746 {
747 CALLFUNCERR(win32_ungetc(c, (FILE*)pf))
748 };
749 virtual int Fileno(PerlIO* pf, int &err)
750 {
751 CALLFUNCERR(win32_fileno((FILE*)pf))
752 };
753 virtual PerlIO* Fdopen(int fd, const char *mode, int &err)
754 {
755 PerlIO* pf = (PerlIO*)win32_fdopen(fd, mode);
756 if(errno)
757 err = errno;
758 return pf;
759 };
760 virtual PerlIO* Reopen(const char*path, const char*mode, PerlIO* pf, int &err)
761 {
762 PerlIO* newPf = (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
763 if(errno)
764 err = errno;
765 return newPf;
766 };
767 virtual SSize_t Read(PerlIO* pf, void *buffer, Size_t size, int &err)
768 {
fe9f1ed5 769 SSize_t i = win32_fread(buffer, 1, size, (FILE*)pf);
c69f6586
GS
770 if(errno)
771 err = errno;
772 return i;
773 };
774 virtual SSize_t Write(PerlIO* pf, const void *buffer, Size_t size, int &err)
775 {
fe9f1ed5 776 SSize_t i = win32_fwrite(buffer, 1, size, (FILE*)pf);
c69f6586
GS
777 if(errno)
778 err = errno;
779 return i;
780 };
781 virtual void SetBuf(PerlIO* pf, char* buffer, int &err)
782 {
783 win32_setbuf((FILE*)pf, buffer);
784 };
785 virtual int SetVBuf(PerlIO* pf, char* buffer, int type, Size_t size, int &err)
786 {
787 int i = win32_setvbuf((FILE*)pf, buffer, type, size);
788 if(errno)
789 err = errno;
790 return i;
791 };
792 virtual void SetCnt(PerlIO* pf, int n, int &err)
793 {
794 ((FILE*)pf)->_cnt = n;
795 };
796 virtual void SetPtrCnt(PerlIO* pf, char * ptr, int n, int& err)
797 {
798 ((FILE*)pf)->_ptr = ptr;
799 ((FILE*)pf)->_cnt = n;
800 };
801 virtual void Setlinebuf(PerlIO* pf, int &err)
802 {
803 win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
804 };
805 virtual int Printf(PerlIO* pf, int &err, const char *format,...)
806 {
807 va_list(arglist);
808 va_start(arglist, format);
809 int i = win32_vfprintf((FILE*)pf, format, arglist);
810 if(errno)
811 err = errno;
812 return i;
813 };
814 virtual int Vprintf(PerlIO* pf, int &err, const char *format, va_list arglist)
815 {
816 int i = win32_vfprintf((FILE*)pf, format, arglist);
817 if(errno)
818 err = errno;
819 return i;
820 };
821 virtual long Tell(PerlIO* pf, int &err)
822 {
823 long l = win32_ftell((FILE*)pf);
824 if(errno)
825 err = errno;
826 return l;
827 };
828 virtual int Seek(PerlIO* pf, off_t offset, int origin, int &err)
829 {
830 int i = win32_fseek((FILE*)pf, offset, origin);
831 if(errno)
832 err = errno;
833 return i;
834 };
835 virtual void Rewind(PerlIO* pf, int &err)
836 {
837 win32_rewind((FILE*)pf);
838 };
839 virtual PerlIO* Tmpfile(int &err)
840 {
841 PerlIO* pf = (PerlIO*)win32_tmpfile();
842 if(errno)
843 err = errno;
844 return pf;
845 };
846 virtual int Getpos(PerlIO* pf, Fpos_t *p, int &err)
847 {
848 int i = win32_fgetpos((FILE*)pf, p);
849 if(errno)
850 err = errno;
851 return i;
852 };
853 virtual int Setpos(PerlIO* pf, const Fpos_t *p, int &err)
854 {
855 int i = win32_fsetpos((FILE*)pf, p);
856 if(errno)
857 err = errno;
858 return i;
859 };
860 virtual void Init(int &err)
861 {
862 };
863 virtual void InitOSExtras(void* p)
864 {
865 Perl_init_os_extras();
866 };
867 virtual int OpenOSfhandle(long osfhandle, int flags)
868 {
869 return win32_open_osfhandle(osfhandle, flags);
870 }
871 virtual int GetOSfhandle(int filenum)
872 {
873 return win32_get_osfhandle(filenum);
874 }
875};
76e3520e 876
76e3520e
GS
877
878static void xs_init _((CPERLarg));
879#define stderr (&_iob[2])
880#undef fprintf
881#undef environ
882
883class CPerlHost
884{
885public:
c69f6586
GS
886 CPerlHost() { pPerl = NULL; };
887 inline BOOL PerlCreate(void)
888 {
889 try
76e3520e 890 {
c69f6586
GS
891 pPerl = perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO, &perlDir, &perlSock, &perlProc);
892 if(pPerl != NULL)
893 {
76e3520e
GS
894 try
895 {
c69f6586 896 pPerl->perl_construct();
76e3520e
GS
897 }
898 catch(...)
899 {
c69f6586
GS
900 fprintf(stderr, "%s\n", "Error: Unable to construct data structures");
901 pPerl->perl_free();
902 pPerl = NULL;
76e3520e 903 }
c69f6586
GS
904 }
905 }
906 catch(...)
76e3520e 907 {
c69f6586
GS
908 fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
909 pPerl = NULL;
910 }
911 return (pPerl != NULL);
912 };
913 inline int PerlParse(int argc, char** argv, char** env)
914 {
915 char* environ = NULL;
916 int retVal;
917 try
76e3520e 918 {
c69f6586
GS
919 retVal = pPerl->perl_parse(xs_init, argc, argv, (env == NULL || *env == NULL ? &environ : env));
920 }
921 catch(int x)
76e3520e 922 {
c69f6586
GS
923 // this is where exit() should arrive
924 retVal = x;
925 }
926 catch(...)
927 {
928 fprintf(stderr, "Error: Parse exception\n");
929 retVal = -1;
930 }
931 return retVal;
932 };
933 inline int PerlRun(void)
934 {
935 int retVal;
936 try
937 {
938 retVal = pPerl->perl_run();
939 }
940 catch(int x)
941 {
942 // this is where exit() should arrive
943 retVal = x;
944 }
945 catch(...)
946 {
947 fprintf(stderr, "Error: Runtime exception\n");
948 retVal = -1;
949 }
950 return retVal;
951 };
952 inline void PerlDestroy(void)
953 {
954 try
955 {
956 pPerl->perl_destruct();
957 pPerl->perl_free();
958 }
959 catch(...)
960 {
961 }
962 };
76e3520e
GS
963
964protected:
c69f6586
GS
965 CPerlDir perlDir;
966 CPerlEnv perlEnv;
967 CPerlLIO perlLIO;
968 CPerlMem perlMem;
969 CPerlProc perlProc;
970 CPerlSock perlSock;
971 CPerlStdIO perlStdIO;
76e3520e
GS
972};
973
974#undef PERL_SYS_INIT
975#define PERL_SYS_INIT(a, c)
976
977int
978main(int argc, char **argv, char **env)
979{
c69f6586
GS
980 CPerlHost host;
981 int exitstatus = 1;
76e3520e 982
c69f6586
GS
983 if(!host.PerlCreate())
984 exit(exitstatus);
76e3520e
GS
985
986
c69f6586 987 exitstatus = host.PerlParse(argc, argv, env);
76e3520e 988
c69f6586
GS
989 if (!exitstatus)
990 {
991 exitstatus = host.PerlRun();
76e3520e
GS
992 }
993
c69f6586 994 host.PerlDestroy();
76e3520e
GS
995
996 return exitstatus;
997}
998
c69f6586
GS
999char *staticlinkmodules[] = {
1000 "DynaLoader",
1001 NULL,
1002};
76e3520e 1003
c69f6586 1004EXTERN_C void boot_DynaLoader _((CPERLarg_ CV* cv));
76e3520e 1005
c69f6586
GS
1006static void
1007xs_init(CPERLarg)
9d8a25dc 1008{
c69f6586
GS
1009 char *file = __FILE__;
1010 dXSUB_SYS;
1011 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
9d8a25dc
DL
1012}
1013
76e3520e
GS
1014#else /* PERL_OBJECT */
1015
390b85e7 1016/* Say NO to CPP! Hallelujah! */
a835ef8a 1017#ifdef __GNUC__
5b0d9cbe
NIS
1018/*
1019 * GNU C does not do __declspec()
1020 */
a835ef8a 1021#define __declspec(foo)
5b0d9cbe
NIS
1022
1023/* Mingw32 defaults to globing command line
1024 * This is inconsistent with other Win32 ports and
1025 * seems to cause trouble with passing -DXSVERSION=\"1.6\"
1026 * So we turn it off like this:
1027 */
1028int _CRT_glob = 0;
1029
a835ef8a 1030#endif
0a753a76 1031
5b0d9cbe 1032
390b85e7 1033__declspec(dllimport) int RunPerl(int argc, char **argv, char **env, void *ios);
0a753a76 1034
137443ea 1035int
0a753a76
PP
1036main(int argc, char **argv, char **env)
1037{
390b85e7 1038 return RunPerl(argc, argv, env, (void*)0);
0a753a76 1039}
76e3520e
GS
1040
1041#endif /* PERL_OBJECT */