win32/perlhost.h

   1 /* perlhost.h
   2  *
   3  * (c) 1999 Microsoft Corporation. All rights reserved.
   4  * Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/
   5  *
   6  *    You may distribute under the terms of either the GNU General Public
   7  *    License or the Artistic License, as specified in the README file.
   8  */
   9
  10 #ifndef ___PerlHost_H___
  11 #define ___PerlHost_H___
  12
  13 #include <signal.h>
  14 #include "iperlsys.h"
  15 #include "vmem.h"
  16 #include "vdir.h"
  17
  18 START_EXTERN_C
  19 extern char *           g_win32_get_privlib(const char *pl);
  20 extern char *           g_win32_get_sitelib(const char *pl);
  21 extern char *           g_win32_get_vendorlib(const char *pl);
  22 extern char *           g_getlogin(void);
  23 extern int              do_spawn2(char *cmd, int exectype);
  24 END_EXTERN_C
  25
  26 class CPerlHost
  27 {
  28 public:
  29     /* Constructors */
  30     CPerlHost(void);
  31     CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
  32                  struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
  33                  struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
  34                  struct IPerlDir** ppDir, struct IPerlSock** ppSock,
  35                  struct IPerlProc** ppProc);
  36     CPerlHost(CPerlHost& host);
  37     ~CPerlHost(void);
  38
  39     static CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl);
  40     static CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl);
  41     static CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl);
  42     static CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl);
  43     static CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl);
  44     static CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl);
  45     static CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl);
  46     static CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl);
  47     static CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl);
  48
  49     BOOL PerlCreate(void);
  50     int PerlParse(int argc, char** argv, char** env);
  51     int PerlRun(void);
  52     void PerlDestroy(void);
  53
  54 /* IPerlMem */
  55     inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
  56     inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
  57     inline void Free(void* ptr) { m_pVMem->Free(ptr); };
  58     inline void* Calloc(size_t num, size_t size)
  59     {
  60         size_t count = num*size;
  61         void* lpVoid = Malloc(count);
  62         if (lpVoid)
  63             ZeroMemory(lpVoid, count);
  64         return lpVoid;
  65     };
  66     inline void GetLock(void) { m_pVMem->GetLock(); };
  67     inline void FreeLock(void) { m_pVMem->FreeLock(); };
  68     inline int IsLocked(void) { return m_pVMem->IsLocked(); };
  69
  70 /* IPerlMemShared */
  71     inline void* MallocShared(size_t size)
  72     {
  73         return m_pVMemShared->Malloc(size);
  74     };
  75     inline void* ReallocShared(void* ptr, size_t size) { return m_pVMemShared->Realloc(ptr, size); };
  76     inline void FreeShared(void* ptr) { m_pVMemShared->Free(ptr); };
  77     inline void* CallocShared(size_t num, size_t size)
  78     {
  79         size_t count = num*size;
  80         void* lpVoid = MallocShared(count);
  81         if (lpVoid)
  82             ZeroMemory(lpVoid, count);
  83         return lpVoid;
  84     };
  85     inline void GetLockShared(void) { m_pVMem->GetLock(); };
  86     inline void FreeLockShared(void) { m_pVMem->FreeLock(); };
  87     inline int IsLockedShared(void) { return m_pVMem->IsLocked(); };
  88
  89 /* IPerlMemParse */
  90     inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
  91     inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
  92     inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
  93     inline void* CallocParse(size_t num, size_t size)
  94     {
  95         size_t count = num*size;
  96         void* lpVoid = MallocParse(count);
  97         if (lpVoid)
  98             ZeroMemory(lpVoid, count);
  99         return lpVoid;
 100     };
 101     inline void GetLockParse(void) { m_pVMem->GetLock(); };
 102     inline void FreeLockParse(void) { m_pVMem->FreeLock(); };
 103     inline int IsLockedParse(void) { return m_pVMem->IsLocked(); };
 104
 105 /* IPerlEnv */
 106     char *Getenv(const char *varname);
 107     int Putenv(const char *envstring);
 108     inline char *Getenv(const char *varname, unsigned long *len)
 109     {
 110         *len = 0;
 111         char *e = Getenv(varname);
 112         if (e)
 113             *len = strlen(e);
 114         return e;
 115     }
 116     void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
 117     void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
 118     char* GetChildDir(void);
 119     void FreeChildDir(char* pStr);
 120     void Reset(void);
 121     void Clearenv(void);
 122
 123     inline LPSTR GetIndex(DWORD &dwIndex)
 124     {
 125         if(dwIndex < m_dwEnvCount)
 126         {
 127             ++dwIndex;
 128             return m_lppEnvList[dwIndex-1];
 129         }
 130         return NULL;
 131     };
 132
 133 protected:
 134     LPSTR Find(LPCSTR lpStr);
 135     void Add(LPCSTR lpStr);
 136
 137     LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
 138     void FreeLocalEnvironmentStrings(LPSTR lpStr);
 139     LPSTR* Lookup(LPCSTR lpStr);
 140     DWORD CalculateEnvironmentSpace(void);
 141
 142 public:
 143
 144 /* IPerlDIR */
 145     virtual int Chdir(const char *dirname);
 146
 147 /* IPerllProc */
 148     void Abort(void);
 149     void Exit(int status);
 150     void _Exit(int status);
 151     int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
 152     int Execv(const char *cmdname, const char *const *argv);
 153     int Execvp(const char *cmdname, const char *const *argv);
 154
 155     inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
 156     inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
 157     inline VDir* GetDir(void) { return m_pvDir; };
 158
 159 public:
 160
 161     struct IPerlMem         m_hostperlMem;
 162     struct IPerlMem         m_hostperlMemShared;
 163     struct IPerlMem         m_hostperlMemParse;
 164     struct IPerlEnv         m_hostperlEnv;
 165     struct IPerlStdIO       m_hostperlStdIO;
 166     struct IPerlLIO         m_hostperlLIO;
 167     struct IPerlDir         m_hostperlDir;
 168     struct IPerlSock        m_hostperlSock;
 169     struct IPerlProc        m_hostperlProc;
 170
 171     struct IPerlMem*        m_pHostperlMem;
 172     struct IPerlMem*        m_pHostperlMemShared;
 173     struct IPerlMem*        m_pHostperlMemParse;
 174     struct IPerlEnv*        m_pHostperlEnv;
 175     struct IPerlStdIO*      m_pHostperlStdIO;
 176     struct IPerlLIO*        m_pHostperlLIO;
 177     struct IPerlDir*        m_pHostperlDir;
 178     struct IPerlSock*       m_pHostperlSock;
 179     struct IPerlProc*       m_pHostperlProc;
 180
 181     inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
 182     inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
 183 protected:
 184
 185     VDir*   m_pvDir;
 186     VMem*   m_pVMem;
 187     VMem*   m_pVMemShared;
 188     VMem*   m_pVMemParse;
 189
 190     DWORD   m_dwEnvCount;
 191     LPSTR*  m_lppEnvList;
 192     static long num_hosts;
 193 public:
 194     inline  int LastHost(void) { return num_hosts == 1L; };
 195 };
 196
 197 long CPerlHost::num_hosts = 0L;
 198
 199
 200 #define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
 201
 202 inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
 203 {
 204     return STRUCT2PTR(piPerl, m_hostperlMem);
 205 }
 206
 207 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
 208 {
 209     return STRUCT2PTR(piPerl, m_hostperlMemShared);
 210 }
 211
 212 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
 213 {
 214     return STRUCT2PTR(piPerl, m_hostperlMemParse);
 215 }
 216
 217 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
 218 {
 219     return STRUCT2PTR(piPerl, m_hostperlEnv);
 220 }
 221
 222 inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
 223 {
 224     return STRUCT2PTR(piPerl, m_hostperlStdIO);
 225 }
 226
 227 inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
 228 {
 229     return STRUCT2PTR(piPerl, m_hostperlLIO);
 230 }
 231
 232 inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
 233 {
 234     return STRUCT2PTR(piPerl, m_hostperlDir);
 235 }
 236
 237 inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
 238 {
 239     return STRUCT2PTR(piPerl, m_hostperlSock);
 240 }
 241
 242 inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
 243 {
 244     return STRUCT2PTR(piPerl, m_hostperlProc);
 245 }
 246
 247
 248
 249 #undef IPERL2HOST
 250 #define IPERL2HOST(x) IPerlMem2Host(x)
 251
 252 /* IPerlMem */
 253 void*
 254 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
 255 {
 256     return IPERL2HOST(piPerl)->Malloc(size);
 257 }
 258 void*
 259 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
 260 {
 261     return IPERL2HOST(piPerl)->Realloc(ptr, size);
 262 }
 263 void
 264 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
 265 {
 266     IPERL2HOST(piPerl)->Free(ptr);
 267 }
 268 void*
 269 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
 270 {
 271     return IPERL2HOST(piPerl)->Calloc(num, size);
 272 }
 273
 274 void
 275 PerlMemGetLock(struct IPerlMem* piPerl)
 276 {
 277     IPERL2HOST(piPerl)->GetLock();
 278 }
 279
 280 void
 281 PerlMemFreeLock(struct IPerlMem* piPerl)
 282 {
 283     IPERL2HOST(piPerl)->FreeLock();
 284 }
 285
 286 int
 287 PerlMemIsLocked(struct IPerlMem* piPerl)
 288 {
 289     return IPERL2HOST(piPerl)->IsLocked();
 290 }
 291
 292 struct IPerlMem perlMem =
 293 {
 294     PerlMemMalloc,
 295     PerlMemRealloc,
 296     PerlMemFree,
 297     PerlMemCalloc,
 298     PerlMemGetLock,
 299     PerlMemFreeLock,
 300     PerlMemIsLocked,
 301 };
 302
 303 #undef IPERL2HOST
 304 #define IPERL2HOST(x) IPerlMemShared2Host(x)
 305
 306 /* IPerlMemShared */
 307 void*
 308 PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
 309 {
 310     return IPERL2HOST(piPerl)->MallocShared(size);
 311 }
 312 void*
 313 PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
 314 {
 315     return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
 316 }
 317 void
 318 PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
 319 {
 320     IPERL2HOST(piPerl)->FreeShared(ptr);
 321 }
 322 void*
 323 PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
 324 {
 325     return IPERL2HOST(piPerl)->CallocShared(num, size);
 326 }
 327
 328 void
 329 PerlMemSharedGetLock(struct IPerlMem* piPerl)
 330 {
 331     IPERL2HOST(piPerl)->GetLockShared();
 332 }
 333
 334 void
 335 PerlMemSharedFreeLock(struct IPerlMem* piPerl)
 336 {
 337     IPERL2HOST(piPerl)->FreeLockShared();
 338 }
 339
 340 int
 341 PerlMemSharedIsLocked(struct IPerlMem* piPerl)
 342 {
 343     return IPERL2HOST(piPerl)->IsLockedShared();
 344 }
 345
 346 struct IPerlMem perlMemShared =
 347 {
 348     PerlMemSharedMalloc,
 349     PerlMemSharedRealloc,
 350     PerlMemSharedFree,
 351     PerlMemSharedCalloc,
 352     PerlMemSharedGetLock,
 353     PerlMemSharedFreeLock,
 354     PerlMemSharedIsLocked,
 355 };
 356
 357 #undef IPERL2HOST
 358 #define IPERL2HOST(x) IPerlMemParse2Host(x)
 359
 360 /* IPerlMemParse */
 361 void*
 362 PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
 363 {
 364     return IPERL2HOST(piPerl)->MallocParse(size);
 365 }
 366 void*
 367 PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
 368 {
 369     return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
 370 }
 371 void
 372 PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
 373 {
 374     IPERL2HOST(piPerl)->FreeParse(ptr);
 375 }
 376 void*
 377 PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
 378 {
 379     return IPERL2HOST(piPerl)->CallocParse(num, size);
 380 }
 381
 382 void
 383 PerlMemParseGetLock(struct IPerlMem* piPerl)
 384 {
 385     IPERL2HOST(piPerl)->GetLockParse();
 386 }
 387
 388 void
 389 PerlMemParseFreeLock(struct IPerlMem* piPerl)
 390 {
 391     IPERL2HOST(piPerl)->FreeLockParse();
 392 }
 393
 394 int
 395 PerlMemParseIsLocked(struct IPerlMem* piPerl)
 396 {
 397     return IPERL2HOST(piPerl)->IsLockedParse();
 398 }
 399
 400 struct IPerlMem perlMemParse =
 401 {
 402     PerlMemParseMalloc,
 403     PerlMemParseRealloc,
 404     PerlMemParseFree,
 405     PerlMemParseCalloc,
 406     PerlMemParseGetLock,
 407     PerlMemParseFreeLock,
 408     PerlMemParseIsLocked,
 409 };
 410
 411
 412 #undef IPERL2HOST
 413 #define IPERL2HOST(x) IPerlEnv2Host(x)
 414
 415 /* IPerlEnv */
 416 char*
 417 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
 418 {
 419     return IPERL2HOST(piPerl)->Getenv(varname);
 420 };
 421
 422 int
 423 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
 424 {
 425     return IPERL2HOST(piPerl)->Putenv(envstring);
 426 };
 427
 428 char*
 429 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
 430 {
 431     return IPERL2HOST(piPerl)->Getenv(varname, len);
 432 }
 433
 434 int
 435 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
 436 {
 437     return win32_uname(name);
 438 }
 439
 440 void
 441 PerlEnvClearenv(struct IPerlEnv* piPerl)
 442 {
 443     IPERL2HOST(piPerl)->Clearenv();
 444 }
 445
 446 void*
 447 PerlEnvGetChildenv(struct IPerlEnv* piPerl)
 448 {
 449     return IPERL2HOST(piPerl)->CreateChildEnv();
 450 }
 451
 452 void
 453 PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
 454 {
 455     IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
 456 }
 457
 458 char*
 459 PerlEnvGetChilddir(struct IPerlEnv* piPerl)
 460 {
 461     return IPERL2HOST(piPerl)->GetChildDir();
 462 }
 463
 464 void
 465 PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
 466 {
 467     IPERL2HOST(piPerl)->FreeChildDir(childDir);
 468 }
 469
 470 unsigned long
 471 PerlEnvOsId(struct IPerlEnv* piPerl)
 472 {
 473     return win32_os_id();
 474 }
 475
 476 char*
 477 PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
 478 {
 479     return g_win32_get_privlib(pl);
 480 }
 481
 482 char*
 483 PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
 484 {
 485     return g_win32_get_sitelib(pl);
 486 }
 487
 488 char*
 489 PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
 490 {
 491     return g_win32_get_vendorlib(pl);
 492 }
 493
 494 void
 495 PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
 496 {
 497     win32_get_child_IO(ptr);
 498 }
 499
 500 struct IPerlEnv perlEnv =
 501 {
 502     PerlEnvGetenv,
 503     PerlEnvPutenv,
 504     PerlEnvGetenv_len,
 505     PerlEnvUname,
 506     PerlEnvClearenv,
 507     PerlEnvGetChildenv,
 508     PerlEnvFreeChildenv,
 509     PerlEnvGetChilddir,
 510     PerlEnvFreeChilddir,
 511     PerlEnvOsId,
 512     PerlEnvLibPath,
 513     PerlEnvSiteLibPath,
 514     PerlEnvVendorLibPath,
 515     PerlEnvGetChildIO,
 516 };
 517
 518 #undef IPERL2HOST
 519 #define IPERL2HOST(x) IPerlStdIO2Host(x)
 520
 521 /* PerlStdIO */
 522 FILE*
 523 PerlStdIOStdin(struct IPerlStdIO* piPerl)
 524 {
 525     return win32_stdin();
 526 }
 527
 528 FILE*
 529 PerlStdIOStdout(struct IPerlStdIO* piPerl)
 530 {
 531     return win32_stdout();
 532 }
 533
 534 FILE*
 535 PerlStdIOStderr(struct IPerlStdIO* piPerl)
 536 {
 537     return win32_stderr();
 538 }
 539
 540 FILE*
 541 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
 542 {
 543     return win32_fopen(path, mode);
 544 }
 545
 546 int
 547 PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf)
 548 {
 549     return win32_fclose((pf));
 550 }
 551
 552 int
 553 PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf)
 554 {
 555     return win32_feof(pf);
 556 }
 557
 558 int
 559 PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf)
 560 {
 561     return win32_ferror(pf);
 562 }
 563
 564 void
 565 PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf)
 566 {
 567     win32_clearerr(pf);
 568 }
 569
 570 int
 571 PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf)
 572 {
 573     return win32_getc(pf);
 574 }
 575
 576 char*
 577 PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf)
 578 {
 579 #ifdef FILE_base
 580     FILE *f = pf;
 581     return FILE_base(f);
 582 #else
 583     return Nullch;
 584 #endif
 585 }
 586
 587 int
 588 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf)
 589 {
 590 #ifdef FILE_bufsiz
 591     FILE *f = pf;
 592     return FILE_bufsiz(f);
 593 #else
 594     return (-1);
 595 #endif
 596 }
 597
 598 int
 599 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf)
 600 {
 601 #ifdef USE_STDIO_PTR
 602     FILE *f = pf;
 603     return FILE_cnt(f);
 604 #else
 605     return (-1);
 606 #endif
 607 }
 608
 609 char*
 610 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
 611 {
 612 #ifdef USE_STDIO_PTR
 613     FILE *f = pf;
 614     return FILE_ptr(f);
 615 #else
 616     return Nullch;
 617 #endif
 618 }
 619
 620 char*
 621 PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n)
 622 {
 623     return win32_fgets(s, n, pf);
 624 }
 625
 626 int
 627 PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c)
 628 {
 629     return win32_fputc(c, pf);
 630 }
 631
 632 int
 633 PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s)
 634 {
 635     return win32_fputs(s, pf);
 636 }
 637
 638 int
 639 PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf)
 640 {
 641     return win32_fflush(pf);
 642 }
 643
 644 int
 645 PerlStdIOUngetc(struct IPerlStdIO* piPerl,int c, FILE* pf)
 646 {
 647     return win32_ungetc(c, pf);
 648 }
 649
 650 int
 651 PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf)
 652 {
 653     return win32_fileno(pf);
 654 }
 655
 656 FILE*
 657 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
 658 {
 659     return win32_fdopen(fd, mode);
 660 }
 661
 662 FILE*
 663 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf)
 664 {
 665     return win32_freopen(path, mode, (FILE*)pf);
 666 }
 667
 668 SSize_t
 669 PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf)
 670 {
 671     return win32_fread(buffer, size, count, pf);
 672 }
 673
 674 SSize_t
 675 PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf)
 676 {
 677     return win32_fwrite(buffer, size, count, pf);
 678 }
 679
 680 void
 681 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer)
 682 {
 683     win32_setbuf(pf, buffer);
 684 }
 685
 686 int
 687 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size)
 688 {
 689     return win32_setvbuf(pf, buffer, type, size);
 690 }
 691
 692 void
 693 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n)
 694 {
 695 #ifdef STDIO_CNT_LVALUE
 696     FILE *f = pf;
 697     FILE_cnt(f) = n;
 698 #endif
 699 }
 700
 701 void
 702 PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr)
 703 {
 704 #ifdef STDIO_PTR_LVALUE
 705     FILE *f = pf;
 706     FILE_ptr(f) = ptr;
 707 #endif
 708 }
 709
 710 void
 711 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf)
 712 {
 713     win32_setvbuf(pf, NULL, _IOLBF, 0);
 714 }
 715
 716 int
 717 PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...)
 718 {
 719     va_list(arglist);
 720     va_start(arglist, format);
 721     return win32_vfprintf(pf, format, arglist);
 722 }
 723
 724 int
 725 PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist)
 726 {
 727     return win32_vfprintf(pf, format, arglist);
 728 }
 729
 730 long
 731 PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf)
 732 {
 733     return win32_ftell(pf);
 734 }
 735
 736 int
 737 PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, off_t offset, int origin)
 738 {
 739     return win32_fseek(pf, offset, origin);
 740 }
 741
 742 void
 743 PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf)
 744 {
 745     win32_rewind(pf);
 746 }
 747
 748 FILE*
 749 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
 750 {
 751     return win32_tmpfile();
 752 }
 753
 754 int
 755 PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p)
 756 {
 757     return win32_fgetpos(pf, p);
 758 }
 759
 760 int
 761 PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p)
 762 {
 763     return win32_fsetpos(pf, p);
 764 }
 765 void
 766 PerlStdIOInit(struct IPerlStdIO* piPerl)
 767 {
 768 }
 769
 770 void
 771 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
 772 {
 773     Perl_init_os_extras();
 774 }
 775
 776 int
 777 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags)
 778 {
 779     return win32_open_osfhandle(osfhandle, flags);
 780 }
 781
 782 int
 783 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
 784 {
 785     return win32_get_osfhandle(filenum);
 786 }
 787
 788 FILE*
 789 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
 790 {
 791     FILE* pfdup;
 792     fpos_t pos;
 793     char mode[3];
 794     int fileno = win32_dup(win32_fileno(pf));
 795
 796     /* open the file in the same mode */
 797 #ifdef __BORLANDC__
 798     if((pf)->flags & _F_READ) {
 799         mode[0] = 'r';
 800         mode[1] = 0;
 801     }
 802     else if((pf)->flags & _F_WRIT) {
 803         mode[0] = 'a';
 804         mode[1] = 0;
 805     }
 806     else if((pf)->flags & _F_RDWR) {
 807         mode[0] = 'r';
 808         mode[1] = '+';
 809         mode[2] = 0;
 810     }
 811 #else
 812     if((pf)->_flag & _IOREAD) {
 813         mode[0] = 'r';
 814         mode[1] = 0;
 815     }
 816     else if((pf)->_flag & _IOWRT) {
 817         mode[0] = 'a';
 818         mode[1] = 0;
 819     }
 820     else if((pf)->_flag & _IORW) {
 821         mode[0] = 'r';
 822         mode[1] = '+';
 823         mode[2] = 0;
 824     }
 825 #endif
 826
 827     /* it appears that the binmode is attached to the
 828      * file descriptor so binmode files will be handled
 829      * correctly
 830      */
 831     pfdup = win32_fdopen(fileno, mode);
 832
 833     /* move the file pointer to the same position */
 834     if (!fgetpos(pf, &pos)) {
 835         fsetpos(pfdup, &pos);
 836     }
 837     return pfdup;
 838 }
 839
 840 struct IPerlStdIO perlStdIO =
 841 {
 842     PerlStdIOStdin,
 843     PerlStdIOStdout,
 844     PerlStdIOStderr,
 845     PerlStdIOOpen,
 846     PerlStdIOClose,
 847     PerlStdIOEof,
 848     PerlStdIOError,
 849     PerlStdIOClearerr,
 850     PerlStdIOGetc,
 851     PerlStdIOGetBase,
 852     PerlStdIOGetBufsiz,
 853     PerlStdIOGetCnt,
 854     PerlStdIOGetPtr,
 855     PerlStdIOGets,
 856     PerlStdIOPutc,
 857     PerlStdIOPuts,
 858     PerlStdIOFlush,
 859     PerlStdIOUngetc,
 860     PerlStdIOFileno,
 861     PerlStdIOFdopen,
 862     PerlStdIOReopen,
 863     PerlStdIORead,
 864     PerlStdIOWrite,
 865     PerlStdIOSetBuf,
 866     PerlStdIOSetVBuf,
 867     PerlStdIOSetCnt,
 868     PerlStdIOSetPtr,
 869     PerlStdIOSetlinebuf,
 870     PerlStdIOPrintf,
 871     PerlStdIOVprintf,
 872     PerlStdIOTell,
 873     PerlStdIOSeek,
 874     PerlStdIORewind,
 875     PerlStdIOTmpfile,
 876     PerlStdIOGetpos,
 877     PerlStdIOSetpos,
 878     PerlStdIOInit,
 879     PerlStdIOInitOSExtras,
 880     PerlStdIOFdupopen,
 881 };
 882
 883
 884 #undef IPERL2HOST
 885 #define IPERL2HOST(x) IPerlLIO2Host(x)
 886
 887 /* IPerlLIO */
 888 int
 889 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
 890 {
 891     return win32_access(path, mode);
 892 }
 893
 894 int
 895 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
 896 {
 897     return win32_chmod(filename, pmode);
 898 }
 899
 900 int
 901 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
 902 {
 903     return chown(filename, owner, group);
 904 }
 905
 906 int
 907 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
 908 {
 909     return chsize(handle, size);
 910 }
 911
 912 int
 913 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
 914 {
 915     return win32_close(handle);
 916 }
 917
 918 int
 919 PerlLIODup(struct IPerlLIO* piPerl, int handle)
 920 {
 921     return win32_dup(handle);
 922 }
 923
 924 int
 925 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
 926 {
 927     return win32_dup2(handle1, handle2);
 928 }
 929
 930 int
 931 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
 932 {
 933     return win32_flock(fd, oper);
 934 }
 935
 936 int
 937 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
 938 {
 939     return win32_fstat(handle, buffer);
 940 }
 941
 942 int
 943 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
 944 {
 945     return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
 946 }
 947
 948 int
 949 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
 950 {
 951     return isatty(fd);
 952 }
 953
 954 int
 955 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
 956 {
 957     return win32_link(oldname, newname);
 958 }
 959
 960 long
 961 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
 962 {
 963     return win32_lseek(handle, offset, origin);
 964 }
 965
 966 int
 967 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
 968 {
 969     return win32_stat(path, buffer);
 970 }
 971
 972 char*
 973 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
 974 {
 975     return mktemp(Template);
 976 }
 977
 978 int
 979 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
 980 {
 981     return win32_open(filename, oflag);
 982 }
 983
 984 int
 985 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
 986 {
 987     return win32_open(filename, oflag, pmode);
 988 }
 989
 990 int
 991 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
 992 {
 993     return win32_read(handle, buffer, count);
 994 }
 995
 996 int
 997 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
 998 {
 999     return win32_rename(OldFileName, newname);
1000 }
1001
1002 int
1003 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1004 {
1005     return win32_setmode(handle, mode);
1006 }
1007
1008 int
1009 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
1010 {
1011     return win32_stat(path, buffer);
1012 }
1013
1014 char*
1015 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1016 {
1017     return tmpnam(string);
1018 }
1019
1020 int
1021 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1022 {
1023     return umask(pmode);
1024 }
1025
1026 int
1027 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1028 {
1029     return win32_unlink(filename);
1030 }
1031
1032 int
1033 PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
1034 {
1035     return win32_utime(filename, times);
1036 }
1037
1038 int
1039 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1040 {
1041     return win32_write(handle, buffer, count);
1042 }
1043
1044 struct IPerlLIO perlLIO =
1045 {
1046     PerlLIOAccess,
1047     PerlLIOChmod,
1048     PerlLIOChown,
1049     PerlLIOChsize,
1050     PerlLIOClose,
1051     PerlLIODup,
1052     PerlLIODup2,
1053     PerlLIOFlock,
1054     PerlLIOFileStat,
1055     PerlLIOIOCtl,
1056     PerlLIOIsatty,
1057     PerlLIOLink,
1058     PerlLIOLseek,
1059     PerlLIOLstat,
1060     PerlLIOMktemp,
1061     PerlLIOOpen,
1062     PerlLIOOpen3,
1063     PerlLIORead,
1064     PerlLIORename,
1065     PerlLIOSetmode,
1066     PerlLIONameStat,
1067     PerlLIOTmpnam,
1068     PerlLIOUmask,
1069     PerlLIOUnlink,
1070     PerlLIOUtime,
1071     PerlLIOWrite,
1072 };
1073
1074
1075 #undef IPERL2HOST
1076 #define IPERL2HOST(x) IPerlDir2Host(x)
1077
1078 /* IPerlDIR */
1079 int
1080 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1081 {
1082     return win32_mkdir(dirname, mode);
1083 }
1084
1085 int
1086 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1087 {
1088     return IPERL2HOST(piPerl)->Chdir(dirname);
1089 }
1090
1091 int
1092 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1093 {
1094     return win32_rmdir(dirname);
1095 }
1096
1097 int
1098 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1099 {
1100     return win32_closedir(dirp);
1101 }
1102
1103 DIR*
1104 PerlDirOpen(struct IPerlDir* piPerl, char *filename)
1105 {
1106     return win32_opendir(filename);
1107 }
1108
1109 struct direct *
1110 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1111 {
1112     return win32_readdir(dirp);
1113 }
1114
1115 void
1116 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1117 {
1118     win32_rewinddir(dirp);
1119 }
1120
1121 void
1122 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1123 {
1124     win32_seekdir(dirp, loc);
1125 }
1126
1127 long
1128 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1129 {
1130     return win32_telldir(dirp);
1131 }
1132
1133 char*
1134 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1135 {
1136     return IPERL2HOST(piPerl)->MapPathA(path);
1137 }
1138
1139 WCHAR*
1140 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1141 {
1142     return IPERL2HOST(piPerl)->MapPathW(path);
1143 }
1144
1145 struct IPerlDir perlDir =
1146 {
1147     PerlDirMakedir,
1148     PerlDirChdir,
1149     PerlDirRmdir,
1150     PerlDirClose,
1151     PerlDirOpen,
1152     PerlDirRead,
1153     PerlDirRewind,
1154     PerlDirSeek,
1155     PerlDirTell,
1156     PerlDirMapPathA,
1157     PerlDirMapPathW,
1158 };
1159
1160
1161 /* IPerlSock */
1162 u_long
1163 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1164 {
1165     return win32_htonl(hostlong);
1166 }
1167
1168 u_short
1169 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1170 {
1171     return win32_htons(hostshort);
1172 }
1173
1174 u_long
1175 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1176 {
1177     return win32_ntohl(netlong);
1178 }
1179
1180 u_short
1181 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1182 {
1183     return win32_ntohs(netshort);
1184 }
1185
1186 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1187 {
1188     return win32_accept(s, addr, addrlen);
1189 }
1190
1191 int
1192 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1193 {
1194     return win32_bind(s, name, namelen);
1195 }
1196
1197 int
1198 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1199 {
1200     return win32_connect(s, name, namelen);
1201 }
1202
1203 void
1204 PerlSockEndhostent(struct IPerlSock* piPerl)
1205 {
1206     win32_endhostent();
1207 }
1208
1209 void
1210 PerlSockEndnetent(struct IPerlSock* piPerl)
1211 {
1212     win32_endnetent();
1213 }
1214
1215 void
1216 PerlSockEndprotoent(struct IPerlSock* piPerl)
1217 {
1218     win32_endprotoent();
1219 }
1220
1221 void
1222 PerlSockEndservent(struct IPerlSock* piPerl)
1223 {
1224     win32_endservent();
1225 }
1226
1227 struct hostent*
1228 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1229 {
1230     return win32_gethostbyaddr(addr, len, type);
1231 }
1232
1233 struct hostent*
1234 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1235 {
1236     return win32_gethostbyname(name);
1237 }
1238
1239 struct hostent*
1240 PerlSockGethostent(struct IPerlSock* piPerl)
1241 {
1242     dTHX;
1243     Perl_croak(aTHX_ "gethostent not implemented!\n");
1244     return NULL;
1245 }
1246
1247 int
1248 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1249 {
1250     return win32_gethostname(name, namelen);
1251 }
1252
1253 struct netent *
1254 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1255 {
1256     return win32_getnetbyaddr(net, type);
1257 }
1258
1259 struct netent *
1260 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1261 {
1262     return win32_getnetbyname((char*)name);
1263 }
1264
1265 struct netent *
1266 PerlSockGetnetent(struct IPerlSock* piPerl)
1267 {
1268     return win32_getnetent();
1269 }
1270
1271 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1272 {
1273     return win32_getpeername(s, name, namelen);
1274 }
1275
1276 struct protoent*
1277 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1278 {
1279     return win32_getprotobyname(name);
1280 }
1281
1282 struct protoent*
1283 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1284 {
1285     return win32_getprotobynumber(number);
1286 }
1287
1288 struct protoent*
1289 PerlSockGetprotoent(struct IPerlSock* piPerl)
1290 {
1291     return win32_getprotoent();
1292 }
1293
1294 struct servent*
1295 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1296 {
1297     return win32_getservbyname(name, proto);
1298 }
1299
1300 struct servent*
1301 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1302 {
1303     return win32_getservbyport(port, proto);
1304 }
1305
1306 struct servent*
1307 PerlSockGetservent(struct IPerlSock* piPerl)
1308 {
1309     return win32_getservent();
1310 }
1311
1312 int
1313 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1314 {
1315     return win32_getsockname(s, name, namelen);
1316 }
1317
1318 int
1319 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1320 {
1321     return win32_getsockopt(s, level, optname, optval, optlen);
1322 }
1323
1324 unsigned long
1325 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1326 {
1327     return win32_inet_addr(cp);
1328 }
1329
1330 char*
1331 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1332 {
1333     return win32_inet_ntoa(in);
1334 }
1335
1336 int
1337 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1338 {
1339     return win32_listen(s, backlog);
1340 }
1341
1342 int
1343 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1344 {
1345     return win32_recv(s, buffer, len, flags);
1346 }
1347
1348 int
1349 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1350 {
1351     return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1352 }
1353
1354 int
1355 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1356 {
1357     return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1358 }
1359
1360 int
1361 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1362 {
1363     return win32_send(s, buffer, len, flags);
1364 }
1365
1366 int
1367 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1368 {
1369     return win32_sendto(s, buffer, len, flags, to, tolen);
1370 }
1371
1372 void
1373 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1374 {
1375     win32_sethostent(stayopen);
1376 }
1377
1378 void
1379 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1380 {
1381     win32_setnetent(stayopen);
1382 }
1383
1384 void
1385 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1386 {
1387     win32_setprotoent(stayopen);
1388 }
1389
1390 void
1391 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1392 {
1393     win32_setservent(stayopen);
1394 }
1395
1396 int
1397 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1398 {
1399     return win32_setsockopt(s, level, optname, optval, optlen);
1400 }
1401
1402 int
1403 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1404 {
1405     return win32_shutdown(s, how);
1406 }
1407
1408 SOCKET
1409 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1410 {
1411     return win32_socket(af, type, protocol);
1412 }
1413
1414 int
1415 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1416 {
1417     dTHX;
1418     Perl_croak(aTHX_ "socketpair not implemented!\n");
1419     return 0;
1420 }
1421
1422 int
1423 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1424 {
1425     return win32_closesocket(s);
1426 }
1427
1428 int
1429 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1430 {
1431     return win32_ioctlsocket(s, cmd, argp);
1432 }
1433
1434 struct IPerlSock perlSock =
1435 {
1436     PerlSockHtonl,
1437     PerlSockHtons,
1438     PerlSockNtohl,
1439     PerlSockNtohs,
1440     PerlSockAccept,
1441     PerlSockBind,
1442     PerlSockConnect,
1443     PerlSockEndhostent,
1444     PerlSockEndnetent,
1445     PerlSockEndprotoent,
1446     PerlSockEndservent,
1447     PerlSockGethostname,
1448     PerlSockGetpeername,
1449     PerlSockGethostbyaddr,
1450     PerlSockGethostbyname,
1451     PerlSockGethostent,
1452     PerlSockGetnetbyaddr,
1453     PerlSockGetnetbyname,
1454     PerlSockGetnetent,
1455     PerlSockGetprotobyname,
1456     PerlSockGetprotobynumber,
1457     PerlSockGetprotoent,
1458     PerlSockGetservbyname,
1459     PerlSockGetservbyport,
1460     PerlSockGetservent,
1461     PerlSockGetsockname,
1462     PerlSockGetsockopt,
1463     PerlSockInetAddr,
1464     PerlSockInetNtoa,
1465     PerlSockListen,
1466     PerlSockRecv,
1467     PerlSockRecvfrom,
1468     PerlSockSelect,
1469     PerlSockSend,
1470     PerlSockSendto,
1471     PerlSockSethostent,
1472     PerlSockSetnetent,
1473     PerlSockSetprotoent,
1474     PerlSockSetservent,
1475     PerlSockSetsockopt,
1476     PerlSockShutdown,
1477     PerlSockSocket,
1478     PerlSockSocketpair,
1479     PerlSockClosesocket,
1480 };
1481
1482
1483 /* IPerlProc */
1484
1485 #define EXECF_EXEC 1
1486 #define EXECF_SPAWN 2
1487
1488 void
1489 PerlProcAbort(struct IPerlProc* piPerl)
1490 {
1491     win32_abort();
1492 }
1493
1494 char *
1495 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1496 {
1497     return win32_crypt(clear, salt);
1498 }
1499
1500 void
1501 PerlProcExit(struct IPerlProc* piPerl, int status)
1502 {
1503     exit(status);
1504 }
1505
1506 void
1507 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1508 {
1509     _exit(status);
1510 }
1511
1512 int
1513 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1514 {
1515     return execl(cmdname, arg0, arg1, arg2, arg3);
1516 }
1517
1518 int
1519 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1520 {
1521     return win32_execvp(cmdname, argv);
1522 }
1523
1524 int
1525 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1526 {
1527     return win32_execvp(cmdname, argv);
1528 }
1529
1530 uid_t
1531 PerlProcGetuid(struct IPerlProc* piPerl)
1532 {
1533     return getuid();
1534 }
1535
1536 uid_t
1537 PerlProcGeteuid(struct IPerlProc* piPerl)
1538 {
1539     return geteuid();
1540 }
1541
1542 gid_t
1543 PerlProcGetgid(struct IPerlProc* piPerl)
1544 {
1545     return getgid();
1546 }
1547
1548 gid_t
1549 PerlProcGetegid(struct IPerlProc* piPerl)
1550 {
1551     return getegid();
1552 }
1553
1554 char *
1555 PerlProcGetlogin(struct IPerlProc* piPerl)
1556 {
1557     return g_getlogin();
1558 }
1559
1560 int
1561 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1562 {
1563     return win32_kill(pid, sig);
1564 }
1565
1566 int
1567 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1568 {
1569     dTHX;
1570     Perl_croak(aTHX_ "killpg not implemented!\n");
1571     return 0;
1572 }
1573
1574 int
1575 PerlProcPauseProc(struct IPerlProc* piPerl)
1576 {
1577     return win32_sleep((32767L << 16) + 32767);
1578 }
1579
1580 PerlIO*
1581 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1582 {
1583     dTHX;
1584     PERL_FLUSHALL_FOR_CHILD;
1585     return win32_popen(command, mode);
1586 }
1587
1588 PerlIO*
1589 PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
1590 {
1591     dTHX;
1592     PERL_FLUSHALL_FOR_CHILD;
1593     return win32_popenlist(mode, narg, args);
1594 }
1595
1596 int
1597 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1598 {
1599     return win32_pclose(stream);
1600 }
1601
1602 int
1603 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1604 {
1605     return win32_pipe(phandles, 512, O_BINARY);
1606 }
1607
1608 int
1609 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1610 {
1611     return setuid(u);
1612 }
1613
1614 int
1615 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1616 {
1617     return setgid(g);
1618 }
1619
1620 int
1621 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1622 {
1623     return win32_sleep(s);
1624 }
1625
1626 int
1627 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1628 {
1629     return win32_times(timebuf);
1630 }
1631
1632 int
1633 PerlProcWait(struct IPerlProc* piPerl, int *status)
1634 {
1635     return win32_wait(status);
1636 }
1637
1638 int
1639 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1640 {
1641     return win32_waitpid(pid, status, flags);
1642 }
1643
1644 Sighandler_t
1645 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1646 {
1647     return signal(sig, subcode);
1648 }
1649
1650 #ifdef USE_ITHREADS
1651 static THREAD_RET_TYPE
1652 win32_start_child(LPVOID arg)
1653 {
1654     PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1655     GV *tmpgv;
1656     int status;
1657 #ifdef PERL_SYNC_FORK
1658     static long sync_fork_id = 0;
1659     long id = ++sync_fork_id;
1660 #endif
1661
1662
1663     PERL_SET_THX(my_perl);
1664
1665     /* set $$ to pseudo id */
1666 #ifdef PERL_SYNC_FORK
1667     w32_pseudo_id = id;
1668 #else
1669     w32_pseudo_id = GetCurrentThreadId();
1670     if (IsWin95()) {
1671         int pid = (int)w32_pseudo_id;
1672         if (pid < 0)
1673             w32_pseudo_id = -pid;
1674     }
1675 #endif
1676     if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
1677         sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
1678     hv_clear(PL_pidstatus);
1679
1680     /* push a zero on the stack (we are the child) */
1681     {
1682         dSP;
1683         dTARGET;
1684         PUSHi(0);
1685         PUTBACK;
1686     }
1687
1688     /* continue from next op */
1689     PL_op = PL_op->op_next;
1690
1691     {
1692         dJMPENV;
1693         volatile int oldscope = PL_scopestack_ix;
1694
1695 restart:
1696         JMPENV_PUSH(status);
1697         switch (status) {
1698         case 0:
1699             CALLRUNOPS(aTHX);
1700             status = 0;
1701             break;
1702         case 2:
1703             while (PL_scopestack_ix > oldscope)
1704                 LEAVE;
1705             FREETMPS;
1706             PL_curstash = PL_defstash;
1707             if (PL_endav && !PL_minus_c)
1708                 call_list(oldscope, PL_endav);
1709             status = STATUS_NATIVE_EXPORT;
1710             break;
1711         case 3:
1712             if (PL_restartop) {
1713                 POPSTACK_TO(PL_mainstack);
1714                 PL_op = PL_restartop;
1715                 PL_restartop = Nullop;
1716                 goto restart;
1717             }
1718             PerlIO_printf(Perl_error_log, "panic: restartop\n");
1719             FREETMPS;
1720             status = 1;
1721             break;
1722         }
1723         JMPENV_POP;
1724
1725         /* XXX hack to avoid perl_destruct() freeing optree */
1726         PL_main_root = Nullop;
1727     }
1728
1729     /* close the std handles to avoid fd leaks */
1730     {
1731         do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
1732         do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE);
1733         do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE);
1734     }
1735
1736     /* destroy everything (waits for any pseudo-forked children) */
1737     perl_destruct(my_perl);
1738     perl_free(my_perl);
1739
1740 #ifdef PERL_SYNC_FORK
1741     return id;
1742 #else
1743     return (DWORD)status;
1744 #endif
1745 }
1746 #endif /* USE_ITHREADS */
1747
1748 int
1749 PerlProcFork(struct IPerlProc* piPerl)
1750 {
1751     dTHX;
1752 #ifdef USE_ITHREADS
1753     DWORD id;
1754     HANDLE handle;
1755     CPerlHost *h;
1756
1757     if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1758         errno = EAGAIN;
1759         return -1;
1760     }
1761     h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1762     PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 1,
1763                                                  h->m_pHostperlMem,
1764                                                  h->m_pHostperlMemShared,
1765                                                  h->m_pHostperlMemParse,
1766                                                  h->m_pHostperlEnv,
1767                                                  h->m_pHostperlStdIO,
1768                                                  h->m_pHostperlLIO,
1769                                                  h->m_pHostperlDir,
1770                                                  h->m_pHostperlSock,
1771                                                  h->m_pHostperlProc
1772                                                  );
1773     new_perl->Isys_intern.internal_host = h;
1774 #  ifdef PERL_SYNC_FORK
1775     id = win32_start_child((LPVOID)new_perl);
1776     PERL_SET_THX(aTHX);
1777 #  else
1778 #    ifdef USE_RTL_THREAD_API
1779     handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1780                                     (void*)new_perl, 0, (unsigned*)&id);
1781 #    else
1782     handle = CreateThread(NULL, 0, win32_start_child,
1783                           (LPVOID)new_perl, 0, &id);
1784 #    endif
1785     PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
1786     if (!handle) {
1787         errno = EAGAIN;
1788         return -1;
1789     }
1790     if (IsWin95()) {
1791         int pid = (int)id;
1792         if (pid < 0)
1793             id = -pid;
1794     }
1795     w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1796     w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1797     ++w32_num_pseudo_children;
1798 #  endif
1799     return -(int)id;
1800 #else
1801     Perl_croak(aTHX_ "fork() not implemented!\n");
1802     return -1;
1803 #endif /* USE_ITHREADS */
1804 }
1805
1806 int
1807 PerlProcGetpid(struct IPerlProc* piPerl)
1808 {
1809     return win32_getpid();
1810 }
1811
1812 void*
1813 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1814 {
1815     return win32_dynaload(filename);
1816 }
1817
1818 void
1819 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1820 {
1821     win32_str_os_error(sv, dwErr);
1822 }
1823
1824 BOOL
1825 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1826 {
1827     do_spawn2(cmd, EXECF_EXEC);
1828     return FALSE;
1829 }
1830
1831 int
1832 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1833 {
1834     return do_spawn2(cmds, EXECF_SPAWN);
1835 }
1836
1837 int
1838 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1839 {
1840     return win32_spawnvp(mode, cmdname, argv);
1841 }
1842
1843 int
1844 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1845 {
1846     return do_aspawn(vreally, vmark, vsp);
1847 }
1848
1849 int
1850 PerlProcLastHost(struct IPerlProc* piPerl)
1851 {
1852  dTHX;
1853  CPerlHost *h = (CPerlHost*)w32_internal_host;
1854  return h->LastHost();
1855 }
1856
1857 struct IPerlProc perlProc =
1858 {
1859     PerlProcAbort,
1860     PerlProcCrypt,
1861     PerlProcExit,
1862     PerlProc_Exit,
1863     PerlProcExecl,
1864     PerlProcExecv,
1865     PerlProcExecvp,
1866     PerlProcGetuid,
1867     PerlProcGeteuid,
1868     PerlProcGetgid,
1869     PerlProcGetegid,
1870     PerlProcGetlogin,
1871     PerlProcKill,
1872     PerlProcKillpg,
1873     PerlProcPauseProc,
1874     PerlProcPopen,
1875     PerlProcPclose,
1876     PerlProcPipe,
1877     PerlProcSetuid,
1878     PerlProcSetgid,
1879     PerlProcSleep,
1880     PerlProcTimes,
1881     PerlProcWait,
1882     PerlProcWaitpid,
1883     PerlProcSignal,
1884     PerlProcFork,
1885     PerlProcGetpid,
1886     PerlProcDynaLoader,
1887     PerlProcGetOSError,
1888     PerlProcDoCmd,
1889     PerlProcSpawn,
1890     PerlProcSpawnvp,
1891     PerlProcASpawn,
1892     PerlProcLastHost,
1893     PerlProcPopenList
1894 };
1895
1896
1897 /*
1898  * CPerlHost
1899  */
1900
1901 CPerlHost::CPerlHost(void)
1902 {
1903     /* Construct a host from scratch */
1904     InterlockedIncrement(&num_hosts);
1905     m_pvDir = new VDir();
1906     m_pVMem = new VMem();
1907     m_pVMemShared = new VMem();
1908     m_pVMemParse =  new VMem();
1909
1910     m_pvDir->Init(NULL, m_pVMem);
1911
1912     m_dwEnvCount = 0;
1913     m_lppEnvList = NULL;
1914
1915     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1916     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1917     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1918     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1919     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1920     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1921     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1922     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1923     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1924
1925     m_pHostperlMem          = &m_hostperlMem;
1926     m_pHostperlMemShared    = &m_hostperlMemShared;
1927     m_pHostperlMemParse     = &m_hostperlMemParse;
1928     m_pHostperlEnv          = &m_hostperlEnv;
1929     m_pHostperlStdIO        = &m_hostperlStdIO;
1930     m_pHostperlLIO          = &m_hostperlLIO;
1931     m_pHostperlDir          = &m_hostperlDir;
1932     m_pHostperlSock         = &m_hostperlSock;
1933     m_pHostperlProc         = &m_hostperlProc;
1934 }
1935
1936 #define SETUPEXCHANGE(xptr, iptr, table) \
1937     STMT_START {                                \
1938         if (xptr) {                             \
1939             iptr = *xptr;                       \
1940             *xptr = &table;                     \
1941         }                                       \
1942         else {                                  \
1943             iptr = &table;                      \
1944         }                                       \
1945     } STMT_END
1946
1947 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1948                  struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1949                  struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1950                  struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1951                  struct IPerlProc** ppProc)
1952 {
1953     InterlockedIncrement(&num_hosts);
1954     m_pvDir = new VDir(0);
1955     m_pVMem = new VMem();
1956     m_pVMemShared = new VMem();
1957     m_pVMemParse =  new VMem();
1958
1959     m_pvDir->Init(NULL, m_pVMem);
1960
1961     m_dwEnvCount = 0;
1962     m_lppEnvList = NULL;
1963
1964     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1965     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1966     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1967     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1968     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1969     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1970     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1971     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1972     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1973
1974     SETUPEXCHANGE(ppMem,        m_pHostperlMem,         m_hostperlMem);
1975     SETUPEXCHANGE(ppMemShared,  m_pHostperlMemShared,   m_hostperlMemShared);
1976     SETUPEXCHANGE(ppMemParse,   m_pHostperlMemParse,    m_hostperlMemParse);
1977     SETUPEXCHANGE(ppEnv,        m_pHostperlEnv,         m_hostperlEnv);
1978     SETUPEXCHANGE(ppStdIO,      m_pHostperlStdIO,       m_hostperlStdIO);
1979     SETUPEXCHANGE(ppLIO,        m_pHostperlLIO,         m_hostperlLIO);
1980     SETUPEXCHANGE(ppDir,        m_pHostperlDir,         m_hostperlDir);
1981     SETUPEXCHANGE(ppSock,       m_pHostperlSock,        m_hostperlSock);
1982     SETUPEXCHANGE(ppProc,       m_pHostperlProc,        m_hostperlProc);
1983 }
1984 #undef SETUPEXCHANGE
1985
1986 CPerlHost::CPerlHost(CPerlHost& host)
1987 {
1988     /* Construct a host from another host */
1989     InterlockedIncrement(&num_hosts);
1990     m_pVMem = new VMem();
1991     m_pVMemShared = host.GetMemShared();
1992     m_pVMemParse =  host.GetMemParse();
1993
1994     /* duplicate directory info */
1995     m_pvDir = new VDir(0);
1996     m_pvDir->Init(host.GetDir(), m_pVMem);
1997
1998     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1999     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2000     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2001     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2002     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2003     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2004     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2005     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2006     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2007     m_pHostperlMem          = &m_hostperlMem;
2008     m_pHostperlMemShared    = &m_hostperlMemShared;
2009     m_pHostperlMemParse     = &m_hostperlMemParse;
2010     m_pHostperlEnv          = &m_hostperlEnv;
2011     m_pHostperlStdIO        = &m_hostperlStdIO;
2012     m_pHostperlLIO          = &m_hostperlLIO;
2013     m_pHostperlDir          = &m_hostperlDir;
2014     m_pHostperlSock         = &m_hostperlSock;
2015     m_pHostperlProc         = &m_hostperlProc;
2016
2017     m_dwEnvCount = 0;
2018     m_lppEnvList = NULL;
2019
2020     /* duplicate environment info */
2021     LPSTR lpPtr;
2022     DWORD dwIndex = 0;
2023     while(lpPtr = host.GetIndex(dwIndex))
2024         Add(lpPtr);
2025 }
2026
2027 CPerlHost::~CPerlHost(void)
2028 {
2029 //  Reset();
2030     InterlockedDecrement(&num_hosts);
2031     delete m_pvDir;
2032     m_pVMemParse->Release();
2033     m_pVMemShared->Release();
2034     m_pVMem->Release();
2035 }
2036
2037 LPSTR
2038 CPerlHost::Find(LPCSTR lpStr)
2039 {
2040     LPSTR lpPtr;
2041     LPSTR* lppPtr = Lookup(lpStr);
2042     if(lppPtr != NULL) {
2043         for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2044             ;
2045
2046         if(*lpPtr == '=')
2047             ++lpPtr;
2048
2049         return lpPtr;
2050     }
2051     return NULL;
2052 }
2053
2054 int
2055 lookup(const void *arg1, const void *arg2)
2056 {   // Compare strings
2057     char*ptr1, *ptr2;
2058     char c1,c2;
2059
2060     ptr1 = *(char**)arg1;
2061     ptr2 = *(char**)arg2;
2062     for(;;) {
2063         c1 = *ptr1++;
2064         c2 = *ptr2++;
2065         if(c1 == '\0' || c1 == '=') {
2066             if(c2 == '\0' || c2 == '=')
2067                 break;
2068
2069             return -1; // string 1 < string 2
2070         }
2071         else if(c2 == '\0' || c2 == '=')
2072             return 1; // string 1 > string 2
2073         else if(c1 != c2) {
2074             c1 = toupper(c1);
2075             c2 = toupper(c2);
2076             if(c1 != c2) {
2077                 if(c1 < c2)
2078                     return -1; // string 1 < string 2
2079
2080                 return 1; // string 1 > string 2
2081             }
2082         }
2083     }
2084     return 0;
2085 }
2086
2087 LPSTR*
2088 CPerlHost::Lookup(LPCSTR lpStr)
2089 {
2090     return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2091 }
2092
2093 int
2094 compare(const void *arg1, const void *arg2)
2095 {   // Compare strings
2096     char*ptr1, *ptr2;
2097     char c1,c2;
2098
2099     ptr1 = *(char**)arg1;
2100     ptr2 = *(char**)arg2;
2101     for(;;) {
2102         c1 = *ptr1++;
2103         c2 = *ptr2++;
2104         if(c1 == '\0' || c1 == '=') {
2105             if(c1 == c2)
2106                 break;
2107
2108             return -1; // string 1 < string 2
2109         }
2110         else if(c2 == '\0' || c2 == '=')
2111             return 1; // string 1 > string 2
2112         else if(c1 != c2) {
2113             c1 = toupper(c1);
2114             c2 = toupper(c2);
2115             if(c1 != c2) {
2116                 if(c1 < c2)
2117                     return -1; // string 1 < string 2
2118
2119                 return 1; // string 1 > string 2
2120             }
2121         }
2122     }
2123     return 0;
2124 }
2125
2126 void
2127 CPerlHost::Add(LPCSTR lpStr)
2128 {
2129     dTHX;
2130     char szBuffer[1024];
2131     LPSTR *lpPtr;
2132     int index, length = strlen(lpStr)+1;
2133
2134     for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2135         szBuffer[index] = lpStr[index];
2136
2137     szBuffer[index] = '\0';
2138
2139     // replacing ?
2140     lpPtr = Lookup(szBuffer);
2141     if(lpPtr != NULL) {
2142         Renew(*lpPtr, length, char);
2143         strcpy(*lpPtr, lpStr);
2144     }
2145     else {
2146         ++m_dwEnvCount;
2147         Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2148         New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2149         if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2150             strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2151             qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2152         }
2153         else
2154             --m_dwEnvCount;
2155     }
2156 }
2157
2158 DWORD
2159 CPerlHost::CalculateEnvironmentSpace(void)
2160 {
2161     DWORD index;
2162     DWORD dwSize = 0;
2163     for(index = 0; index < m_dwEnvCount; ++index)
2164         dwSize += strlen(m_lppEnvList[index]) + 1;
2165
2166     return dwSize;
2167 }
2168
2169 void
2170 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2171 {
2172     dTHX;
2173     Safefree(lpStr);
2174 }
2175
2176 char*
2177 CPerlHost::GetChildDir(void)
2178 {
2179     dTHX;
2180     int length;
2181     char* ptr;
2182     New(0, ptr, MAX_PATH+1, char);
2183     if(ptr) {
2184         m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2185         length = strlen(ptr);
2186         if (length > 3) {
2187             if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2188                 ptr[length-1] = 0;
2189         }
2190     }
2191     return ptr;
2192 }
2193
2194 void
2195 CPerlHost::FreeChildDir(char* pStr)
2196 {
2197     dTHX;
2198     Safefree(pStr);
2199 }
2200
2201 LPSTR
2202 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2203 {
2204     dTHX;
2205     LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2206     DWORD dwSize, dwEnvIndex;
2207     int nLength, compVal;
2208
2209     // get the process environment strings
2210     lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2211
2212     // step over current directory stuff
2213     while(*lpTmp == '=')
2214         lpTmp += strlen(lpTmp) + 1;
2215
2216     // save the start of the environment strings
2217     lpEnvPtr = lpTmp;
2218     for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2219         // calculate the size of the environment strings
2220         dwSize += strlen(lpTmp) + 1;
2221     }
2222
2223     // add the size of current directories
2224     dwSize += vDir.CalculateEnvironmentSpace();
2225
2226     // add the additional space used by changes made to the environment
2227     dwSize += CalculateEnvironmentSpace();
2228
2229     New(1, lpStr, dwSize, char);
2230     lpPtr = lpStr;
2231     if(lpStr != NULL) {
2232         // build the local environment
2233         lpStr = vDir.BuildEnvironmentSpace(lpStr);
2234
2235         dwEnvIndex = 0;
2236         lpLocalEnv = GetIndex(dwEnvIndex);
2237         while(*lpEnvPtr != '\0') {
2238             if(!lpLocalEnv) {
2239                 // all environment overrides have been added
2240                 // so copy string into place
2241                 strcpy(lpStr, lpEnvPtr);
2242                 nLength = strlen(lpEnvPtr) + 1;
2243                 lpStr += nLength;
2244                 lpEnvPtr += nLength;
2245             }
2246             else {
2247                 // determine which string to copy next
2248                 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2249                 if(compVal < 0) {
2250                     strcpy(lpStr, lpEnvPtr);
2251                     nLength = strlen(lpEnvPtr) + 1;
2252                     lpStr += nLength;
2253                     lpEnvPtr += nLength;
2254                 }
2255                 else {
2256                     char *ptr = strchr(lpLocalEnv, '=');
2257                     if(ptr && ptr[1]) {
2258                         strcpy(lpStr, lpLocalEnv);
2259                         lpStr += strlen(lpLocalEnv) + 1;
2260                     }
2261                     lpLocalEnv = GetIndex(dwEnvIndex);
2262                     if(compVal == 0) {
2263                         // this string was replaced
2264                         lpEnvPtr += strlen(lpEnvPtr) + 1;
2265                     }
2266                 }
2267             }
2268         }
2269
2270         while(lpLocalEnv) {
2271             // still have environment overrides to add
2272             // so copy the strings into place
2273             strcpy(lpStr, lpLocalEnv);
2274             nLength = strlen(lpLocalEnv) + 1;
2275             lpStr += nLength;
2276             lpEnvPtr += nLength;
2277             lpLocalEnv = GetIndex(dwEnvIndex);
2278         }
2279
2280         // add final NULL
2281         *lpStr = '\0';
2282     }
2283
2284     // release the process environment strings
2285     FreeEnvironmentStrings(lpAllocPtr);
2286
2287     return lpPtr;
2288 }
2289
2290 void
2291 CPerlHost::Reset(void)
2292 {
2293     dTHX;
2294     if(m_lppEnvList != NULL) {
2295         for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2296             Safefree(m_lppEnvList[index]);
2297             m_lppEnvList[index] = NULL;
2298         }
2299     }
2300     m_dwEnvCount = 0;
2301 }
2302
2303 void
2304 CPerlHost::Clearenv(void)
2305 {
2306     dTHX;
2307     char ch;
2308     LPSTR lpPtr, lpStr, lpEnvPtr;
2309     if (m_lppEnvList != NULL) {
2310         /* set every entry to an empty string */
2311         for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2312             char* ptr = strchr(m_lppEnvList[index], '=');
2313             if(ptr) {
2314                 *++ptr = 0;
2315             }
2316         }
2317     }
2318
2319     /* get the process environment strings */
2320     lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2321
2322     /* step over current directory stuff */
2323     while(*lpStr == '=')
2324         lpStr += strlen(lpStr) + 1;
2325
2326     while(*lpStr) {
2327         lpPtr = strchr(lpStr, '=');
2328         if(lpPtr) {
2329             ch = *++lpPtr;
2330             *lpPtr = 0;
2331             Add(lpStr);
2332             if (!w32_pseudo_id)
2333                 (void)win32_putenv(lpStr);
2334             *lpPtr = ch;
2335         }
2336         lpStr += strlen(lpStr) + 1;
2337     }
2338
2339     FreeEnvironmentStrings(lpEnvPtr);
2340 }
2341
2342
2343 char*
2344 CPerlHost::Getenv(const char *varname)
2345 {
2346     dTHX;
2347     if (w32_pseudo_id) {
2348         char *pEnv = Find(varname);
2349         if (pEnv && *pEnv)
2350             return pEnv;
2351     }
2352     return win32_getenv(varname);
2353 }
2354
2355 int
2356 CPerlHost::Putenv(const char *envstring)
2357 {
2358     dTHX;
2359     Add(envstring);
2360     if (!w32_pseudo_id)
2361         return win32_putenv(envstring);
2362
2363     return 0;
2364 }
2365
2366 int
2367 CPerlHost::Chdir(const char *dirname)
2368 {
2369     dTHX;
2370     int ret;
2371     if (USING_WIDE()) {
2372         WCHAR wBuffer[MAX_PATH];
2373         A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2374         ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2375     }
2376     else
2377         ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2378     if(ret < 0) {
2379         errno = ENOENT;
2380     }
2381     return ret;
2382 }
2383
2384 #endif /* ___PerlHost_H___ */