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