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