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