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