win32/runperl.c

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