win32/perlhost.h

   1
   2 #include "iperlsys.h"
   3
   4 extern CPerlObj *pPerl;
   5
   6 #define CALLFUNC0RET(x)\
   7     int ret = x;\
   8     if (ret < 0)\
   9         err = errno;\
  10     return ret;
  11
  12 #define PROCESS_AND_RETURN  \
  13     if (errno)              \
  14         err = errno;        \
  15     return r
  16
  17 #define CALLFUNCRET(x)\
  18     int ret = x;\
  19     if (ret)\
  20         err = errno;\
  21     return ret;
  22
  23 #define CALLFUNCERR(x)\
  24     int ret = x;\
  25     if (errno)\
  26         err = errno;\
  27     return ret;
  28
  29 #define LCALLFUNCERR(x)\
  30     long ret = x;\
  31     if (errno)\
  32         err = errno;\
  33     return ret;
  34
  35 class CPerlDir : public IPerlDir
  36 {
  37 public:
  38     CPerlDir() {};
  39     virtual int Makedir(const char *dirname, int mode, int &err)
  40     {
  41         CALLFUNC0RET(win32_mkdir(dirname, mode));
  42     };
  43     virtual int Chdir(const char *dirname, int &err)
  44     {
  45         CALLFUNC0RET(win32_chdir(dirname));
  46     };
  47     virtual int Rmdir(const char *dirname, int &err)
  48     {
  49         CALLFUNC0RET(win32_rmdir(dirname));
  50     };
  51     virtual int Close(DIR *dirp, int &err)
  52     {
  53         return win32_closedir(dirp);
  54     };
  55     virtual DIR *Open(char *filename, int &err)
  56     {
  57         return win32_opendir(filename);
  58     };
  59     virtual struct direct *Read(DIR *dirp, int &err)
  60     {
  61         return win32_readdir(dirp);
  62     };
  63     virtual void Rewind(DIR *dirp, int &err)
  64     {
  65         win32_rewinddir(dirp);
  66     };
  67     virtual void Seek(DIR *dirp, long loc, int &err)
  68     {
  69         win32_seekdir(dirp, loc);
  70     };
  71     virtual long Tell(DIR *dirp, int &err)
  72     {
  73         return win32_telldir(dirp);
  74     };
  75 };
  76
  77
  78 extern char *           g_win32_get_privlib(char *pl);
  79 extern char *           g_win32_get_sitelib(char *pl);
  80
  81 class CPerlEnv : public IPerlEnv
  82 {
  83 public:
  84     CPerlEnv() {};
  85     virtual char *Getenv(const char *varname, int &err)
  86     {
  87         return win32_getenv(varname);
  88     };
  89     virtual int Putenv(const char *envstring, int &err)
  90     {
  91         return putenv(envstring);
  92     };
  93     virtual char* LibPath(char *pl)
  94     {
  95         return g_win32_get_privlib(pl);
  96     };
  97     virtual char* SiteLibPath(char *pl)
  98     {
  99         return g_win32_get_sitelib(pl);
 100     };
 101 };
 102
 103 class CPerlSock : public IPerlSock
 104 {
 105 public:
 106     CPerlSock() {};
 107     virtual u_long Htonl(u_long hostlong)
 108     {
 109         return win32_htonl(hostlong);
 110     };
 111     virtual u_short Htons(u_short hostshort)
 112     {
 113         return win32_htons(hostshort);
 114     };
 115     virtual u_long Ntohl(u_long netlong)
 116     {
 117         return win32_ntohl(netlong);
 118     };
 119     virtual u_short Ntohs(u_short netshort)
 120     {
 121         return win32_ntohs(netshort);
 122     }
 123
 124     virtual SOCKET Accept(SOCKET s, struct sockaddr* addr, int* addrlen, int &err)
 125     {
 126         SOCKET r = win32_accept(s, addr, addrlen);
 127         PROCESS_AND_RETURN;
 128     };
 129     virtual int Bind(SOCKET s, const struct sockaddr* name, int namelen, int &err)
 130     {
 131         int r = win32_bind(s, name, namelen);
 132         PROCESS_AND_RETURN;
 133     };
 134     virtual int Connect(SOCKET s, const struct sockaddr* name, int namelen, int &err)
 135     {
 136         int r = win32_connect(s, name, namelen);
 137         PROCESS_AND_RETURN;
 138     };
 139     virtual void Endhostent(int &err)
 140     {
 141         win32_endhostent();
 142     };
 143     virtual void Endnetent(int &err)
 144     {
 145         win32_endnetent();
 146     };
 147     virtual void Endprotoent(int &err)
 148     {
 149         win32_endprotoent();
 150     };
 151     virtual void Endservent(int &err)
 152     {
 153         win32_endservent();
 154     };
 155     virtual struct hostent* Gethostbyaddr(const char* addr, int len, int type, int &err)
 156     {
 157         struct hostent *r = win32_gethostbyaddr(addr, len, type);
 158         PROCESS_AND_RETURN;
 159     };
 160     virtual struct hostent* Gethostbyname(const char* name, int &err)
 161     {
 162         struct hostent *r = win32_gethostbyname(name);
 163         PROCESS_AND_RETURN;
 164     };
 165     virtual struct hostent* Gethostent(int &err)
 166     {
 167         croak("gethostent not implemented!\n");
 168         return NULL;
 169     };
 170     virtual int Gethostname(char* name, int namelen, int &err)
 171     {
 172         int r = win32_gethostname(name, namelen);
 173         PROCESS_AND_RETURN;
 174     };
 175     virtual struct netent *Getnetbyaddr(long net, int type, int &err)
 176     {
 177         struct netent *r = win32_getnetbyaddr(net, type);
 178         PROCESS_AND_RETURN;
 179     };
 180     virtual struct netent *Getnetbyname(const char *name, int &err)
 181     {
 182         struct netent *r = win32_getnetbyname((char*)name);
 183         PROCESS_AND_RETURN;
 184     };
 185     virtual struct netent *Getnetent(int &err)
 186     {
 187         struct netent *r = win32_getnetent();
 188         PROCESS_AND_RETURN;
 189     };
 190     virtual int Getpeername(SOCKET s, struct sockaddr* name, int* namelen, int &err)
 191     {
 192         int r = win32_getpeername(s, name, namelen);
 193         PROCESS_AND_RETURN;
 194     };
 195     virtual struct protoent* Getprotobyname(const char* name, int &err)
 196     {
 197         struct protoent *r = win32_getprotobyname(name);
 198         PROCESS_AND_RETURN;
 199     };
 200     virtual struct protoent* Getprotobynumber(int number, int &err)
 201     {
 202         struct protoent *r = win32_getprotobynumber(number);
 203         PROCESS_AND_RETURN;
 204     };
 205     virtual struct protoent* Getprotoent(int &err)
 206     {
 207         struct protoent *r = win32_getprotoent();
 208         PROCESS_AND_RETURN;
 209     };
 210     virtual struct servent* Getservbyname(const char* name, const char* proto, int &err)
 211     {
 212         struct servent *r = win32_getservbyname(name, proto);
 213         PROCESS_AND_RETURN;
 214     };
 215     virtual struct servent* Getservbyport(int port, const char* proto, int &err)
 216     {
 217         struct servent *r = win32_getservbyport(port, proto);
 218         PROCESS_AND_RETURN;
 219     };
 220     virtual struct servent* Getservent(int &err)
 221     {
 222         struct servent *r = win32_getservent();
 223         PROCESS_AND_RETURN;
 224     };
 225     virtual int Getsockname(SOCKET s, struct sockaddr* name, int* namelen, int &err)
 226     {
 227         int r = win32_getsockname(s, name, namelen);
 228         PROCESS_AND_RETURN;
 229     };
 230     virtual int Getsockopt(SOCKET s, int level, int optname, char* optval, int* optlen, int &err)
 231     {
 232         int r = win32_getsockopt(s, level, optname, optval, optlen);
 233         PROCESS_AND_RETURN;
 234     };
 235     virtual unsigned long InetAddr(const char* cp, int &err)
 236     {
 237         unsigned long r = win32_inet_addr(cp);
 238         PROCESS_AND_RETURN;
 239     };
 240     virtual char* InetNtoa(struct in_addr in, int &err)
 241     {
 242         char *r = win32_inet_ntoa(in);
 243         PROCESS_AND_RETURN;
 244     };
 245     virtual int Listen(SOCKET s, int backlog, int &err)
 246     {
 247         int r = win32_listen(s, backlog);
 248         PROCESS_AND_RETURN;
 249     };
 250     virtual int Recv(SOCKET s, char* buffer, int len, int flags, int &err)
 251     {
 252         int r = win32_recv(s, buffer, len, flags);
 253         PROCESS_AND_RETURN;
 254     };
 255     virtual int Recvfrom(SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen, int &err)
 256     {
 257         int r = win32_recvfrom(s, buffer, len, flags, from, fromlen);
 258         PROCESS_AND_RETURN;
 259     };
 260     virtual int Select(int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout, int &err)
 261     {
 262         int r = win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
 263         PROCESS_AND_RETURN;
 264     };
 265     virtual int Send(SOCKET s, const char* buffer, int len, int flags, int &err)
 266     {
 267         int r = win32_send(s, buffer, len, flags);
 268         PROCESS_AND_RETURN;
 269     };
 270     virtual int Sendto(SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen, int &err)
 271     {
 272         int r = win32_sendto(s, buffer, len, flags, to, tolen);
 273         PROCESS_AND_RETURN;
 274     };
 275     virtual void Sethostent(int stayopen, int &err)
 276     {
 277         win32_sethostent(stayopen);
 278     };
 279     virtual void Setnetent(int stayopen, int &err)
 280     {
 281         win32_setnetent(stayopen);
 282     };
 283     virtual void Setprotoent(int stayopen, int &err)
 284     {
 285         win32_setprotoent(stayopen);
 286     };
 287     virtual void Setservent(int stayopen, int &err)
 288     {
 289         win32_setservent(stayopen);
 290     };
 291     virtual int Setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen, int &err)
 292     {
 293         int r = win32_setsockopt(s, level, optname, optval, optlen);
 294         PROCESS_AND_RETURN;
 295     };
 296     virtual int Shutdown(SOCKET s, int how, int &err)
 297     {
 298         int r = win32_shutdown(s, how);
 299         PROCESS_AND_RETURN;
 300     };
 301     virtual SOCKET Socket(int af, int type, int protocol, int &err)
 302     {
 303         SOCKET r = win32_socket(af, type, protocol);
 304         PROCESS_AND_RETURN;
 305     };
 306     virtual int Socketpair(int domain, int type, int protocol, int* fds, int &err)
 307     {
 308         croak("socketpair not implemented!\n");
 309         return 0;
 310     };
 311     virtual int Closesocket(SOCKET s, int& err)
 312     {
 313         int r = win32_closesocket(s);
 314         PROCESS_AND_RETURN;
 315     };
 316     virtual int Ioctlsocket(SOCKET s, long cmd, u_long *argp, int& err)
 317     {
 318         int r = win32_ioctlsocket(s, cmd, argp);
 319         PROCESS_AND_RETURN;
 320     };
 321 };
 322
 323 class CPerlLIO : public IPerlLIO
 324 {
 325 public:
 326     CPerlLIO() {};
 327     virtual int Access(const char *path, int mode, int &err)
 328     {
 329         CALLFUNCRET(access(path, mode))
 330     };
 331     virtual int Chmod(const char *filename, int pmode, int &err)
 332     {
 333         CALLFUNCRET(chmod(filename, pmode))
 334     };
 335     virtual int Chown(const char *filename, uid_t owner, gid_t group, int &err)
 336     {
 337         CALLFUNCERR(chown(filename, owner, group))
 338     };
 339     virtual int Chsize(int handle, long size, int &err)
 340     {
 341         CALLFUNCRET(chsize(handle, size))
 342     };
 343     virtual int Close(int handle, int &err)
 344     {
 345         CALLFUNCRET(win32_close(handle))
 346     };
 347     virtual int Dup(int handle, int &err)
 348     {
 349         CALLFUNCERR(win32_dup(handle))
 350     };
 351     virtual int Dup2(int handle1, int handle2, int &err)
 352     {
 353         CALLFUNCERR(win32_dup2(handle1, handle2))
 354     };
 355     virtual int Flock(int fd, int oper, int &err)
 356     {
 357         CALLFUNCERR(win32_flock(fd, oper))
 358     };
 359     virtual int FileStat(int handle, struct stat *buffer, int &err)
 360     {
 361         CALLFUNCERR(fstat(handle, buffer))
 362     };
 363     virtual int IOCtl(int i, unsigned int u, char *data, int &err)
 364     {
 365         CALLFUNCERR(win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data))
 366     };
 367     virtual int Isatty(int fd, int &err)
 368     {
 369         return isatty(fd);
 370     };
 371     virtual long Lseek(int handle, long offset, int origin, int &err)
 372     {
 373         LCALLFUNCERR(win32_lseek(handle, offset, origin))
 374     };
 375     virtual int Lstat(const char *path, struct stat *buffer, int &err)
 376     {
 377         return NameStat(path, buffer, err);
 378     };
 379     virtual char *Mktemp(char *Template, int &err)
 380     {
 381         return mktemp(Template);
 382     };
 383     virtual int Open(const char *filename, int oflag, int &err)
 384     {
 385         CALLFUNCERR(win32_open(filename, oflag))
 386     };
 387     virtual int Open(const char *filename, int oflag, int pmode, int &err)
 388     {
 389         int ret;
 390         if(stricmp(filename, "/dev/null") == 0)
 391             ret = open("NUL", oflag, pmode);
 392         else
 393             ret = open(filename, oflag, pmode);
 394
 395         if(errno)
 396             err = errno;
 397         return ret;
 398     };
 399     virtual int Read(int handle, void *buffer, unsigned int count, int &err)
 400     {
 401         CALLFUNCERR(win32_read(handle, buffer, count))
 402     };
 403     virtual int Rename(const char *OldFileName, const char *newname, int &err)
 404     {
 405         char szNewWorkName[MAX_PATH+1];
 406         WIN32_FIND_DATA fdOldFile, fdNewFile;
 407         HANDLE handle;
 408         char *ptr;
 409
 410         if((strchr(OldFileName, '\\') || strchr(OldFileName, '/'))
 411                 && strchr(newname, '\\') == NULL
 412                         && strchr(newname, '/') == NULL)
 413         {
 414             strcpy(szNewWorkName, OldFileName);
 415             if((ptr = strrchr(szNewWorkName, '\\')) == NULL)
 416                 ptr = strrchr(szNewWorkName, '/');
 417             strcpy(++ptr, newname);
 418         }
 419         else
 420             strcpy(szNewWorkName, newname);
 421
 422         if(stricmp(OldFileName, szNewWorkName) != 0)
 423         {   // check that we're not being fooled by relative paths
 424             // and only delete the new file
 425             //  1) if it exists
 426             //  2) it is not the same file as the old file
 427             //  3) old file exist
 428             // GetFullPathName does not return the long file name on some systems
 429             handle = FindFirstFile(OldFileName, &fdOldFile);
 430             if(handle != INVALID_HANDLE_VALUE)
 431             {
 432                 FindClose(handle);
 433
 434                 handle = FindFirstFile(szNewWorkName, &fdNewFile);
 435
 436                 if(handle != INVALID_HANDLE_VALUE)
 437                     FindClose(handle);
 438                 else
 439                     fdNewFile.cFileName[0] = '\0';
 440
 441                 if(strcmp(fdOldFile.cAlternateFileName, fdNewFile.cAlternateFileName) != 0
 442                         && strcmp(fdOldFile.cFileName, fdNewFile.cFileName) != 0)
 443                 {   // file exists and not same file
 444                     DeleteFile(szNewWorkName);
 445                 }
 446             }
 447         }
 448         int ret = rename(OldFileName, szNewWorkName);
 449         if(ret)
 450             err = errno;
 451
 452         return ret;
 453     };
 454     virtual int Setmode(int handle, int mode, int &err)
 455     {
 456         CALLFUNCRET(win32_setmode(handle, mode))
 457     };
 458     virtual int NameStat(const char *path, struct stat *buffer, int &err)
 459     {
 460         return win32_stat(path, buffer);
 461     };
 462     virtual char *Tmpnam(char *string, int &err)
 463     {
 464         return tmpnam(string);
 465     };
 466     virtual int Umask(int pmode, int &err)
 467     {
 468         return umask(pmode);
 469     };
 470     virtual int Unlink(const char *filename, int &err)
 471     {
 472         chmod(filename, S_IREAD | S_IWRITE);
 473         CALLFUNCRET(unlink(filename))
 474     };
 475     virtual int Utime(char *filename, struct utimbuf *times, int &err)
 476     {
 477         CALLFUNCRET(win32_utime(filename, times))
 478     };
 479     virtual int Write(int handle, const void *buffer, unsigned int count, int &err)
 480     {
 481         CALLFUNCERR(win32_write(handle, buffer, count))
 482     };
 483 };
 484
 485 class CPerlMem : public IPerlMem
 486 {
 487 public:
 488     CPerlMem() {};
 489     virtual void* Malloc(size_t size)
 490     {
 491         return win32_malloc(size);
 492     };
 493     virtual void* Realloc(void* ptr, size_t size)
 494     {
 495         return win32_realloc(ptr, size);
 496     };
 497     virtual void Free(void* ptr)
 498     {
 499         win32_free(ptr);
 500     };
 501 };
 502
 503 #define EXECF_EXEC 1
 504 #define EXECF_SPAWN 2
 505
 506 extern char *           g_getlogin(void);
 507 extern int              do_spawn2(char *cmd, int exectype);
 508 extern int              g_do_aspawn(void *vreally, void **vmark, void **vsp);
 509
 510 class CPerlProc : public IPerlProc
 511 {
 512 public:
 513     CPerlProc() {};
 514     virtual void Abort(void)
 515     {
 516         win32_abort();
 517     };
 518     virtual void Exit(int status)
 519     {
 520         exit(status);
 521     };
 522     virtual void _Exit(int status)
 523     {
 524         _exit(status);
 525     };
 526     virtual int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
 527     {
 528         return execl(cmdname, arg0, arg1, arg2, arg3);
 529     };
 530     virtual int Execv(const char *cmdname, const char *const *argv)
 531     {
 532         return win32_execvp(cmdname, argv);
 533     };
 534     virtual int Execvp(const char *cmdname, const char *const *argv)
 535     {
 536         return win32_execvp(cmdname, argv);
 537     };
 538     virtual uid_t Getuid(void)
 539     {
 540         return getuid();
 541     };
 542     virtual uid_t Geteuid(void)
 543     {
 544         return geteuid();
 545     };
 546     virtual gid_t Getgid(void)
 547     {
 548         return getgid();
 549     };
 550     virtual gid_t Getegid(void)
 551     {
 552         return getegid();
 553     };
 554     virtual char *Getlogin(void)
 555     {
 556         return g_getlogin();
 557     };
 558     virtual int Kill(int pid, int sig)
 559     {
 560         return win32_kill(pid, sig);
 561     };
 562     virtual int Killpg(int pid, int sig)
 563     {
 564         croak("killpg not implemented!\n");
 565         return 0;
 566     };
 567     virtual int PauseProc(void)
 568     {
 569         return win32_sleep((32767L << 16) + 32767);
 570     };
 571     virtual PerlIO* Popen(const char *command, const char *mode)
 572     {
 573         win32_fflush(stdout);
 574         win32_fflush(stderr);
 575         return (PerlIO*)win32_popen(command, mode);
 576     };
 577     virtual int Pclose(PerlIO *stream)
 578     {
 579         return win32_pclose((FILE*)stream);
 580     };
 581     virtual int Pipe(int *phandles)
 582     {
 583         return win32_pipe(phandles, 512, O_BINARY);
 584     };
 585     virtual int Setuid(uid_t u)
 586     {
 587         return setuid(u);
 588     };
 589     virtual int Setgid(gid_t g)
 590     {
 591         return setgid(g);
 592     };
 593     virtual int Sleep(unsigned int s)
 594     {
 595         return win32_sleep(s);
 596     };
 597     virtual int Times(struct tms *timebuf)
 598     {
 599         return win32_times(timebuf);
 600     };
 601     virtual int Wait(int *status)
 602     {
 603         return win32_wait(status);
 604     };
 605     virtual int Waitpid(int pid, int *status, int flags)
 606     {
 607         return win32_waitpid(pid, status, flags);
 608     };
 609     virtual Sighandler_t Signal(int sig, Sighandler_t subcode)
 610     {
 611         return 0;
 612     };
 613     virtual void GetSysMsg(char*& sMsg, DWORD& dwLen, DWORD dwErr)
 614     {
 615         dwLen = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER
 616                           |FORMAT_MESSAGE_IGNORE_INSERTS
 617                           |FORMAT_MESSAGE_FROM_SYSTEM, NULL,
 618                            dwErr, 0, (char *)&sMsg, 1, NULL);
 619         if (0 < dwLen) {
 620             while (0 < dwLen  &&  isspace(sMsg[--dwLen]))
 621                 ;
 622             if ('.' != sMsg[dwLen])
 623                 dwLen++;
 624             sMsg[dwLen]= '\0';
 625         }
 626         if (0 == dwLen) {
 627             sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
 628             dwLen = sprintf(sMsg,
 629                         "Unknown error #0x%lX (lookup 0x%lX)",
 630                         dwErr, GetLastError());
 631         }
 632     };
 633     virtual void FreeBuf(char* sMsg)
 634     {
 635         LocalFree(sMsg);
 636     };
 637     virtual BOOL DoCmd(char *cmd)
 638     {
 639         do_spawn2(cmd, EXECF_EXEC);
 640         return FALSE;
 641     };
 642     virtual int Spawn(char* cmds)
 643     {
 644         return do_spawn2(cmds, EXECF_SPAWN);
 645     };
 646     virtual int Spawnvp(int mode, const char *cmdname, const char *const *argv)
 647     {
 648         return win32_spawnvp(mode, cmdname, argv);
 649     };
 650     virtual int ASpawn(void *vreally, void **vmark, void **vsp)
 651     {
 652         return g_do_aspawn(vreally, vmark, vsp);
 653     };
 654 };
 655
 656
 657 class CPerlStdIO : public IPerlStdIO
 658 {
 659 public:
 660     CPerlStdIO() {};
 661     virtual PerlIO* Stdin(void)
 662     {
 663         return (PerlIO*)win32_stdin();
 664     };
 665     virtual PerlIO* Stdout(void)
 666     {
 667         return (PerlIO*)win32_stdout();
 668     };
 669     virtual PerlIO* Stderr(void)
 670     {
 671         return (PerlIO*)win32_stderr();
 672     };
 673     virtual PerlIO* Open(const char *path, const char *mode, int &err)
 674     {
 675         PerlIO*pf = (PerlIO*)win32_fopen(path, mode);
 676         if(errno)
 677             err = errno;
 678         return pf;
 679     };
 680     virtual int Close(PerlIO* pf, int &err)
 681     {
 682         CALLFUNCERR(win32_fclose(((FILE*)pf)))
 683     };
 684     virtual int Eof(PerlIO* pf, int &err)
 685     {
 686         CALLFUNCERR(win32_feof((FILE*)pf))
 687     };
 688     virtual int Error(PerlIO* pf, int &err)
 689     {
 690         CALLFUNCERR(win32_ferror((FILE*)pf))
 691     };
 692     virtual void Clearerr(PerlIO* pf, int &err)
 693     {
 694         win32_clearerr((FILE*)pf);
 695     };
 696     virtual int Getc(PerlIO* pf, int &err)
 697     {
 698         CALLFUNCERR(win32_getc((FILE*)pf))
 699     };
 700     virtual char* GetBase(PerlIO* pf, int &err)
 701     {
 702         FILE *f = (FILE*)pf;
 703         return FILE_base(f);
 704     };
 705     virtual int GetBufsiz(PerlIO* pf, int &err)
 706     {
 707         FILE *f = (FILE*)pf;
 708         return FILE_bufsiz(f);
 709     };
 710     virtual int GetCnt(PerlIO* pf, int &err)
 711     {
 712         FILE *f = (FILE*)pf;
 713         return FILE_cnt(f);
 714     };
 715     virtual char* GetPtr(PerlIO* pf, int &err)
 716     {
 717         FILE *f = (FILE*)pf;
 718         return FILE_ptr(f);
 719     };
 720     virtual char* Gets(PerlIO* pf, char* s, int n, int& err)
 721     {
 722         char* ret = win32_fgets(s, n, (FILE*)pf);
 723         if(errno)
 724             err = errno;
 725         return ret;
 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     {
 763         SSize_t i = win32_fread(buffer, 1, size, (FILE*)pf);
 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     {
 770         SSize_t i = win32_fwrite(buffer, 1, size, (FILE*)pf);
 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     {
 788         FILE *f = (FILE*)pf;
 789         FILE_cnt(f) = n;
 790     };
 791     virtual void SetPtrCnt(PerlIO* pf, char * ptr, int n, int& err)
 792     {
 793         FILE *f = (FILE*)pf;
 794         FILE_ptr(f) = ptr;
 795         FILE_cnt(f) = n;
 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 };
 872
 873 class CPerlHost
 874 {
 875 public:
 876     CPerlHost() { pPerl = NULL; };
 877     inline BOOL PerlCreate(void)
 878     {
 879         try
 880         {
 881             pPerl = perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO,
 882                                &perlDir, &perlSock, &perlProc);
 883             if(pPerl != NULL)
 884             {
 885                 try
 886                 {
 887                     pPerl->perl_construct();
 888                 }
 889                 catch(...)
 890                 {
 891                     win32_fprintf(stderr, "%s\n",
 892                                   "Error: Unable to construct data structures");
 893                     pPerl->perl_free();
 894                     pPerl = NULL;
 895                 }
 896             }
 897         }
 898         catch(...)
 899         {
 900             win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
 901             pPerl = NULL;
 902         }
 903         return (pPerl != NULL);
 904     };
 905     inline int PerlParse(void (*xs_init)(CPerlObj*), int argc, char** argv, char** env)
 906     {
 907         int retVal;
 908         try
 909         {
 910             retVal = pPerl->perl_parse(xs_init, argc, argv, env);
 911         }
 912         catch(int x)
 913         {
 914             // this is where exit() should arrive
 915             retVal = x;
 916         }
 917         catch(...)
 918         {
 919             win32_fprintf(stderr, "Error: Parse exception\n");
 920             retVal = -1;
 921         }
 922         *win32_errno() = 0;
 923         return retVal;
 924     };
 925     inline int PerlRun(void)
 926     {
 927         int retVal;
 928         try
 929         {
 930             retVal = pPerl->perl_run();
 931         }
 932         catch(int x)
 933         {
 934             // this is where exit() should arrive
 935             retVal = x;
 936         }
 937         catch(...)
 938         {
 939             win32_fprintf(stderr, "Error: Runtime exception\n");
 940             retVal = -1;
 941         }
 942         return retVal;
 943     };
 944     inline void PerlDestroy(void)
 945     {
 946         try
 947         {
 948             pPerl->perl_destruct();
 949             pPerl->perl_free();
 950         }
 951         catch(...)
 952         {
 953         }
 954     };
 955
 956 protected:
 957     CPerlDir    perlDir;
 958     CPerlEnv    perlEnv;
 959     CPerlLIO    perlLIO;
 960     CPerlMem    perlMem;
 961     CPerlProc   perlProc;
 962     CPerlSock   perlSock;
 963     CPerlStdIO  perlStdIO;
 964 };