This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[win32] fix Liblist.pm to tolerate backslashen in paths
[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
e5a95ffb 75extern char * g_win32_get_privlib(char *pl);
00dc2f4f 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 {
e5a95ffb 91 return g_win32_get_privlib(pl);
00dc2f4f
GS
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 };
9e6b2b00 246 virtual int Listen(SOCKET s, int backlog, int &err)
c69f6586 247 {
9e6b2b00 248 int r = win32_listen(s, backlog);
c69f6586
GS
249 PROCESS_AND_RETURN;
250 };
9e6b2b00 251 virtual int Recv(SOCKET s, char* buffer, int len, int flags, int &err)
c69f6586 252 {
9e6b2b00 253 int r = win32_recv(s, buffer, len, flags);
c69f6586
GS
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 };
9e6b2b00
GS
312 virtual int Closesocket(SOCKET s, int& err)
313 {
314 int r = win32_closesocket(s);
315 PROCESS_AND_RETURN;
316 };
317 virtual int Ioctlsocket(SOCKET s, long cmd, u_long *argp, int& err)
318 {
319 int r = win32_ioctlsocket(s, cmd, argp);
320 PROCESS_AND_RETURN;
321 };
c69f6586
GS
322};
323
324
325#define CALLFUNCRET(x)\
326 int ret = x;\
327 if(ret)\
328 err = errno;\
329 return ret;
330
331#define CALLFUNCERR(x)\
332 int ret = x;\
333 if(errno)\
334 err = errno;\
335 return ret;
336
337#define LCALLFUNCERR(x)\
338 long ret = x;\
339 if(errno)\
340 err = errno;\
341 return ret;
342
343class CPerlLIO : public IPerlLIO
344{
345public:
346 CPerlLIO() {};
347 virtual int Access(const char *path, int mode, int &err)
348 {
349 CALLFUNCRET(access(path, mode))
350 };
351 virtual int Chmod(const char *filename, int pmode, int &err)
352 {
353 CALLFUNCRET(chmod(filename, pmode))
354 };
01f988be
GS
355 virtual int Chown(const char *filename, uid_t owner, gid_t group, int &err)
356 {
357 CALLFUNCERR(chown(filename, owner, group))
358 };
c69f6586
GS
359 virtual int Chsize(int handle, long size, int &err)
360 {
361 CALLFUNCRET(chsize(handle, size))
362 };
363 virtual int Close(int handle, int &err)
364 {
365 CALLFUNCRET(win32_close(handle))
366 };
367 virtual int Dup(int handle, int &err)
368 {
369 CALLFUNCERR(win32_dup(handle))
370 };
371 virtual int Dup2(int handle1, int handle2, int &err)
372 {
373 CALLFUNCERR(win32_dup2(handle1, handle2))
374 };
375 virtual int Flock(int fd, int oper, int &err)
376 {
377 CALLFUNCERR(win32_flock(fd, oper))
378 };
379 virtual int FileStat(int handle, struct stat *buffer, int &err)
380 {
381 CALLFUNCERR(fstat(handle, buffer))
382 };
383 virtual int IOCtl(int i, unsigned int u, char *data, int &err)
384 {
385 CALLFUNCERR(win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data))
386 };
387 virtual int Isatty(int fd, int &err)
388 {
389 return isatty(fd);
390 };
391 virtual long Lseek(int handle, long offset, int origin, int &err)
392 {
393 LCALLFUNCERR(win32_lseek(handle, offset, origin))
394 };
395 virtual int Lstat(const char *path, struct stat *buffer, int &err)
396 {
397 return NameStat(path, buffer, err);
398 };
399 virtual char *Mktemp(char *Template, int &err)
400 {
401 return mktemp(Template);
402 };
403 virtual int Open(const char *filename, int oflag, int &err)
404 {
405 CALLFUNCERR(win32_open(filename, oflag))
406 };
407 virtual int Open(const char *filename, int oflag, int pmode, int &err)
408 {
409 int ret;
410 if(stricmp(filename, "/dev/null") == 0)
411 ret = open("NUL", oflag, pmode);
412 else
413 ret = open(filename, oflag, pmode);
414
415 if(errno)
416 err = errno;
417 return ret;
418 };
419 virtual int Read(int handle, void *buffer, unsigned int count, int &err)
420 {
421 CALLFUNCERR(win32_read(handle, buffer, count))
422 };
423 virtual int Rename(const char *OldFileName, const char *newname, int &err)
424 {
425 char szNewWorkName[MAX_PATH+1];
426 WIN32_FIND_DATA fdOldFile, fdNewFile;
427 HANDLE handle;
428 char *ptr;
429
430 if((strchr(OldFileName, '\\') || strchr(OldFileName, '/'))
431 && strchr(newname, '\\') == NULL
432 && strchr(newname, '/') == NULL)
433 {
434 strcpy(szNewWorkName, OldFileName);
435 if((ptr = strrchr(szNewWorkName, '\\')) == NULL)
436 ptr = strrchr(szNewWorkName, '/');
437 strcpy(++ptr, newname);
438 }
439 else
440 strcpy(szNewWorkName, newname);
441
442 if(stricmp(OldFileName, szNewWorkName) != 0)
443 { // check that we're not being fooled by relative paths
444 // and only delete the new file
445 // 1) if it exists
446 // 2) it is not the same file as the old file
447 // 3) old file exist
448 // GetFullPathName does not return the long file name on some systems
449 handle = FindFirstFile(OldFileName, &fdOldFile);
450 if(handle != INVALID_HANDLE_VALUE)
451 {
452 FindClose(handle);
453
454 handle = FindFirstFile(szNewWorkName, &fdNewFile);
455
456 if(handle != INVALID_HANDLE_VALUE)
457 FindClose(handle);
458 else
459 fdNewFile.cFileName[0] = '\0';
460
461 if(strcmp(fdOldFile.cAlternateFileName, fdNewFile.cAlternateFileName) != 0
462 && strcmp(fdOldFile.cFileName, fdNewFile.cFileName) != 0)
463 { // file exists and not same file
464 DeleteFile(szNewWorkName);
465 }
466 }
467 }
468 int ret = rename(OldFileName, szNewWorkName);
469 if(ret)
470 err = errno;
471
472 return ret;
473 };
474 virtual int Setmode(int handle, int mode, int &err)
475 {
476 CALLFUNCRET(win32_setmode(handle, mode))
477 };
478 virtual int NameStat(const char *path, struct stat *buffer, int &err)
479 {
480 return win32_stat(path, buffer);
481 };
482 virtual char *Tmpnam(char *string, int &err)
483 {
484 return tmpnam(string);
485 };
486 virtual int Umask(int pmode, int &err)
487 {
488 return umask(pmode);
489 };
490 virtual int Unlink(const char *filename, int &err)
491 {
ac4c12e7 492 chmod(filename, S_IREAD | S_IWRITE);
c69f6586
GS
493 CALLFUNCRET(unlink(filename))
494 };
495 virtual int Utime(char *filename, struct utimbuf *times, int &err)
496 {
497 CALLFUNCRET(win32_utime(filename, times))
498 };
499 virtual int Write(int handle, const void *buffer, unsigned int count, int &err)
500 {
501 CALLFUNCERR(win32_write(handle, buffer, count))
502 };
503};
504
505class CPerlMem : public IPerlMem
506{
507public:
508 CPerlMem() {};
509 virtual void* Malloc(size_t size)
510 {
511 return win32_malloc(size);
512 };
513 virtual void* Realloc(void* ptr, size_t size)
514 {
515 return win32_realloc(ptr, size);
516 };
517 virtual void Free(void* ptr)
518 {
519 win32_free(ptr);
520 };
521};
522
523#define EXECF_EXEC 1
524#define EXECF_SPAWN 2
525
526extern char *g_getlogin(void);
527extern int do_spawn2(char *cmd, int exectype);
528extern int g_do_aspawn(void *vreally, void **vmark, void **vsp);
529class CPerlProc : public IPerlProc
530{
531public:
532 CPerlProc() {};
533 virtual void Abort(void)
534 {
535 win32_abort();
536 };
537 virtual void Exit(int status)
538 {
539 exit(status);
540 };
541 virtual void _Exit(int status)
542 {
543 _exit(status);
544 };
545 virtual int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
546 {
547 return execl(cmdname, arg0, arg1, arg2, arg3);
548 };
549 virtual int Execv(const char *cmdname, const char *const *argv)
550 {
551 return win32_execvp(cmdname, argv);
552 };
553 virtual int Execvp(const char *cmdname, const char *const *argv)
554 {
555 return win32_execvp(cmdname, argv);
556 };
557 virtual uid_t Getuid(void)
558 {
559 return getuid();
560 };
561 virtual uid_t Geteuid(void)
562 {
563 return geteuid();
564 };
565 virtual gid_t Getgid(void)
566 {
567 return getgid();
568 };
569 virtual gid_t Getegid(void)
570 {
571 return getegid();
572 };
573 virtual char *Getlogin(void)
574 {
575 return g_getlogin();
576 };
577 virtual int Kill(int pid, int sig)
578 {
579 return kill(pid, sig);
580 };
581 virtual int Killpg(int pid, int sig)
582 {
583 croak("killpg not implemented!\n");
584 return 0;
585 };
586 virtual int PauseProc(void)
587 {
588 return win32_sleep((32767L << 16) + 32767);
589 };
590 virtual PerlIO* Popen(const char *command, const char *mode)
591 {
ac4c12e7
GS
592 win32_fflush(stdout);
593 win32_fflush(stderr);
c69f6586
GS
594 return (PerlIO*)win32_popen(command, mode);
595 };
596 virtual int Pclose(PerlIO *stream)
597 {
598 return win32_pclose((FILE*)stream);
599 };
600 virtual int Pipe(int *phandles)
601 {
ac4c12e7 602 return win32_pipe(phandles, 512, O_BINARY);
c69f6586
GS
603 };
604 virtual int Setuid(uid_t u)
605 {
606 return setuid(u);
607 };
608 virtual int Setgid(gid_t g)
609 {
610 return setgid(g);
611 };
612 virtual int Sleep(unsigned int s)
613 {
614 return win32_sleep(s);
615 };
616 virtual int Times(struct tms *timebuf)
617 {
618 return win32_times(timebuf);
619 };
620 virtual int Wait(int *status)
621 {
622 return win32_wait(status);
623 };
624 virtual Sighandler_t Signal(int sig, Sighandler_t subcode)
625 {
626 return 0;
627 };
628 virtual void GetSysMsg(char*& sMsg, DWORD& dwLen, DWORD dwErr)
629 {
630 dwLen = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER
631 |FORMAT_MESSAGE_IGNORE_INSERTS
632 |FORMAT_MESSAGE_FROM_SYSTEM, NULL,
633 dwErr, 0, (char *)&sMsg, 1, NULL);
634 if (0 < dwLen) {
635 while (0 < dwLen && isspace(sMsg[--dwLen]))
636 ;
637 if ('.' != sMsg[dwLen])
638 dwLen++;
639 sMsg[dwLen]= '\0';
640 }
641 if (0 == dwLen) {
642 sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
643 dwLen = sprintf(sMsg,
644 "Unknown error #0x%lX (lookup 0x%lX)",
645 dwErr, GetLastError());
646 }
647 };
648 virtual void FreeBuf(char* sMsg)
649 {
650 LocalFree(sMsg);
651 };
652 virtual BOOL DoCmd(char *cmd)
653 {
654 do_spawn2(cmd, EXECF_EXEC);
655 return FALSE;
656 };
657 virtual int Spawn(char* cmds)
658 {
659 return do_spawn2(cmds, EXECF_SPAWN);
660 };
661 virtual int Spawnvp(int mode, const char *cmdname, const char *const *argv)
662 {
663 return win32_spawnvp(mode, cmdname, argv);
664 };
665 virtual int ASpawn(void *vreally, void **vmark, void **vsp)
666 {
667 return g_do_aspawn(vreally, vmark, vsp);
668 };
669};
670
671
e3b8966e 672class CPerlStdIO : public IPerlStdIO
c69f6586
GS
673{
674public:
675 CPerlStdIO() {};
676 virtual PerlIO* Stdin(void)
677 {
678 return (PerlIO*)win32_stdin();
679 };
680 virtual PerlIO* Stdout(void)
681 {
682 return (PerlIO*)win32_stdout();
683 };
684 virtual PerlIO* Stderr(void)
685 {
686 return (PerlIO*)win32_stderr();
687 };
688 virtual PerlIO* Open(const char *path, const char *mode, int &err)
689 {
690 PerlIO*pf = (PerlIO*)win32_fopen(path, mode);
691 if(errno)
692 err = errno;
693 return pf;
694 };
695 virtual int Close(PerlIO* pf, int &err)
696 {
697 CALLFUNCERR(win32_fclose(((FILE*)pf)))
698 };
699 virtual int Eof(PerlIO* pf, int &err)
700 {
701 CALLFUNCERR(win32_feof((FILE*)pf))
702 };
703 virtual int Error(PerlIO* pf, int &err)
704 {
705 CALLFUNCERR(win32_ferror((FILE*)pf))
706 };
707 virtual void Clearerr(PerlIO* pf, int &err)
708 {
709 win32_clearerr((FILE*)pf);
710 };
711 virtual int Getc(PerlIO* pf, int &err)
712 {
713 CALLFUNCERR(win32_getc((FILE*)pf))
714 };
715 virtual char* GetBase(PerlIO* pf, int &err)
716 {
ac4c12e7
GS
717 FILE *f = (FILE*)pf;
718 return FILE_base(f);
c69f6586
GS
719 };
720 virtual int GetBufsiz(PerlIO* pf, int &err)
721 {
ac4c12e7
GS
722 FILE *f = (FILE*)pf;
723 return FILE_bufsiz(f);
c69f6586
GS
724 };
725 virtual int GetCnt(PerlIO* pf, int &err)
726 {
ac4c12e7
GS
727 FILE *f = (FILE*)pf;
728 return FILE_cnt(f);
c69f6586
GS
729 };
730 virtual char* GetPtr(PerlIO* pf, int &err)
731 {
ac4c12e7
GS
732 FILE *f = (FILE*)pf;
733 return FILE_ptr(f);
c69f6586 734 };
9e6b2b00
GS
735 virtual char* Gets(PerlIO* pf, char* s, int n, int& err)
736 {
737 char* ret = win32_fgets(s, n, (FILE*)pf);
738 if(errno)
739 err = errno;
740 return ret;
741 };
c69f6586
GS
742 virtual int Putc(PerlIO* pf, int c, int &err)
743 {
744 CALLFUNCERR(win32_fputc(c, (FILE*)pf))
745 };
746 virtual int Puts(PerlIO* pf, const char *s, int &err)
747 {
748 CALLFUNCERR(win32_fputs(s, (FILE*)pf))
749 };
750 virtual int Flush(PerlIO* pf, int &err)
751 {
752 CALLFUNCERR(win32_fflush((FILE*)pf))
753 };
754 virtual int Ungetc(PerlIO* pf,int c, int &err)
755 {
756 CALLFUNCERR(win32_ungetc(c, (FILE*)pf))
757 };
758 virtual int Fileno(PerlIO* pf, int &err)
759 {
760 CALLFUNCERR(win32_fileno((FILE*)pf))
761 };
762 virtual PerlIO* Fdopen(int fd, const char *mode, int &err)
763 {
764 PerlIO* pf = (PerlIO*)win32_fdopen(fd, mode);
765 if(errno)
766 err = errno;
767 return pf;
768 };
769 virtual PerlIO* Reopen(const char*path, const char*mode, PerlIO* pf, int &err)
770 {
771 PerlIO* newPf = (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
772 if(errno)
773 err = errno;
774 return newPf;
775 };
776 virtual SSize_t Read(PerlIO* pf, void *buffer, Size_t size, int &err)
777 {
fe9f1ed5 778 SSize_t i = win32_fread(buffer, 1, size, (FILE*)pf);
c69f6586
GS
779 if(errno)
780 err = errno;
781 return i;
782 };
783 virtual SSize_t Write(PerlIO* pf, const void *buffer, Size_t size, int &err)
784 {
fe9f1ed5 785 SSize_t i = win32_fwrite(buffer, 1, size, (FILE*)pf);
c69f6586
GS
786 if(errno)
787 err = errno;
788 return i;
789 };
790 virtual void SetBuf(PerlIO* pf, char* buffer, int &err)
791 {
792 win32_setbuf((FILE*)pf, buffer);
793 };
794 virtual int SetVBuf(PerlIO* pf, char* buffer, int type, Size_t size, int &err)
795 {
796 int i = win32_setvbuf((FILE*)pf, buffer, type, size);
797 if(errno)
798 err = errno;
799 return i;
800 };
801 virtual void SetCnt(PerlIO* pf, int n, int &err)
802 {
ac4c12e7
GS
803 FILE *f = (FILE*)pf;
804 FILE_cnt(f) = n;
c69f6586
GS
805 };
806 virtual void SetPtrCnt(PerlIO* pf, char * ptr, int n, int& err)
807 {
ac4c12e7
GS
808 FILE *f = (FILE*)pf;
809 FILE_ptr(f) = ptr;
810 FILE_cnt(f) = n;
c69f6586
GS
811 };
812 virtual void Setlinebuf(PerlIO* pf, int &err)
813 {
814 win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
815 };
816 virtual int Printf(PerlIO* pf, int &err, const char *format,...)
817 {
818 va_list(arglist);
819 va_start(arglist, format);
820 int i = win32_vfprintf((FILE*)pf, format, arglist);
821 if(errno)
822 err = errno;
823 return i;
824 };
825 virtual int Vprintf(PerlIO* pf, int &err, const char *format, va_list arglist)
826 {
827 int i = win32_vfprintf((FILE*)pf, format, arglist);
828 if(errno)
829 err = errno;
830 return i;
831 };
832 virtual long Tell(PerlIO* pf, int &err)
833 {
834 long l = win32_ftell((FILE*)pf);
835 if(errno)
836 err = errno;
837 return l;
838 };
839 virtual int Seek(PerlIO* pf, off_t offset, int origin, int &err)
840 {
841 int i = win32_fseek((FILE*)pf, offset, origin);
842 if(errno)
843 err = errno;
844 return i;
845 };
846 virtual void Rewind(PerlIO* pf, int &err)
847 {
848 win32_rewind((FILE*)pf);
849 };
850 virtual PerlIO* Tmpfile(int &err)
851 {
852 PerlIO* pf = (PerlIO*)win32_tmpfile();
853 if(errno)
854 err = errno;
855 return pf;
856 };
857 virtual int Getpos(PerlIO* pf, Fpos_t *p, int &err)
858 {
859 int i = win32_fgetpos((FILE*)pf, p);
860 if(errno)
861 err = errno;
862 return i;
863 };
864 virtual int Setpos(PerlIO* pf, const Fpos_t *p, int &err)
865 {
866 int i = win32_fsetpos((FILE*)pf, p);
867 if(errno)
868 err = errno;
869 return i;
870 };
871 virtual void Init(int &err)
872 {
873 };
874 virtual void InitOSExtras(void* p)
875 {
876 Perl_init_os_extras();
877 };
878 virtual int OpenOSfhandle(long osfhandle, int flags)
879 {
880 return win32_open_osfhandle(osfhandle, flags);
881 }
882 virtual int GetOSfhandle(int filenum)
883 {
884 return win32_get_osfhandle(filenum);
885 }
886};
76e3520e 887
76e3520e
GS
888
889static void xs_init _((CPERLarg));
76e3520e
GS
890
891class CPerlHost
892{
893public:
c69f6586
GS
894 CPerlHost() { pPerl = NULL; };
895 inline BOOL PerlCreate(void)
896 {
897 try
76e3520e 898 {
c69f6586
GS
899 pPerl = perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO, &perlDir, &perlSock, &perlProc);
900 if(pPerl != NULL)
901 {
76e3520e
GS
902 try
903 {
c69f6586 904 pPerl->perl_construct();
76e3520e
GS
905 }
906 catch(...)
907 {
ac4c12e7 908 win32_fprintf(stderr, "%s\n", "Error: Unable to construct data structures");
c69f6586
GS
909 pPerl->perl_free();
910 pPerl = NULL;
76e3520e 911 }
c69f6586
GS
912 }
913 }
914 catch(...)
76e3520e 915 {
ac4c12e7 916 win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
c69f6586
GS
917 pPerl = NULL;
918 }
919 return (pPerl != NULL);
920 };
921 inline int PerlParse(int argc, char** argv, char** env)
922 {
c69f6586
GS
923 int retVal;
924 try
76e3520e 925 {
ab39fa9d 926 retVal = pPerl->perl_parse(xs_init, argc, argv, env);
c69f6586
GS
927 }
928 catch(int x)
76e3520e 929 {
c69f6586
GS
930 // this is where exit() should arrive
931 retVal = x;
932 }
933 catch(...)
934 {
ac4c12e7 935 win32_fprintf(stderr, "Error: Parse exception\n");
c69f6586
GS
936 retVal = -1;
937 }
e4319c1d 938 *win32_errno() = 0;
c69f6586
GS
939 return retVal;
940 };
941 inline int PerlRun(void)
942 {
943 int retVal;
944 try
945 {
946 retVal = pPerl->perl_run();
947 }
948 catch(int x)
949 {
950 // this is where exit() should arrive
951 retVal = x;
952 }
953 catch(...)
954 {
ac4c12e7 955 win32_fprintf(stderr, "Error: Runtime exception\n");
c69f6586
GS
956 retVal = -1;
957 }
958 return retVal;
959 };
960 inline void PerlDestroy(void)
961 {
962 try
963 {
964 pPerl->perl_destruct();
965 pPerl->perl_free();
966 }
967 catch(...)
968 {
969 }
970 };
76e3520e
GS
971
972protected:
c69f6586
GS
973 CPerlDir perlDir;
974 CPerlEnv perlEnv;
975 CPerlLIO perlLIO;
976 CPerlMem perlMem;
977 CPerlProc perlProc;
978 CPerlSock perlSock;
979 CPerlStdIO perlStdIO;
76e3520e
GS
980};
981
982#undef PERL_SYS_INIT
983#define PERL_SYS_INIT(a, c)
984
985int
986main(int argc, char **argv, char **env)
987{
c69f6586
GS
988 CPerlHost host;
989 int exitstatus = 1;
76e3520e 990
c69f6586
GS
991 if(!host.PerlCreate())
992 exit(exitstatus);
76e3520e
GS
993
994
ab39fa9d 995 exitstatus = host.PerlParse(argc, argv, NULL);
76e3520e 996
c69f6586
GS
997 if (!exitstatus)
998 {
999 exitstatus = host.PerlRun();
76e3520e
GS
1000 }
1001
c69f6586 1002 host.PerlDestroy();
76e3520e
GS
1003
1004 return exitstatus;
1005}
1006
c69f6586
GS
1007char *staticlinkmodules[] = {
1008 "DynaLoader",
1009 NULL,
1010};
76e3520e 1011
e3b8966e 1012EXTERN_C void boot_DynaLoader _((CV* cv _CPERLarg));
76e3520e 1013
c69f6586
GS
1014static void
1015xs_init(CPERLarg)
9d8a25dc 1016{
c69f6586
GS
1017 char *file = __FILE__;
1018 dXSUB_SYS;
1019 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
9d8a25dc
DL
1020}
1021
76e3520e
GS
1022#else /* PERL_OBJECT */
1023
a835ef8a 1024#ifdef __GNUC__
5b0d9cbe
NIS
1025/*
1026 * GNU C does not do __declspec()
1027 */
a835ef8a 1028#define __declspec(foo)
5b0d9cbe
NIS
1029
1030/* Mingw32 defaults to globing command line
1031 * This is inconsistent with other Win32 ports and
1032 * seems to cause trouble with passing -DXSVERSION=\"1.6\"
1033 * So we turn it off like this:
1034 */
1035int _CRT_glob = 0;
1036
a835ef8a 1037#endif
0a753a76 1038
5b0d9cbe 1039
390b85e7 1040__declspec(dllimport) int RunPerl(int argc, char **argv, char **env, void *ios);
0a753a76 1041
137443ea 1042int
0a753a76
PP
1043main(int argc, char **argv, char **env)
1044{
390b85e7 1045 return RunPerl(argc, argv, env, (void*)0);
0a753a76 1046}
76e3520e
GS
1047
1048#endif /* PERL_OBJECT */