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 PerlIO*
1598 PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
1599 {
1600     dTHXo;
1601     PERL_FLUSHALL_FOR_CHILD;
1602     return win32_popenlist(mode, narg, args);
1603 }
1604
1605 int
1606 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1607 {
1608     return win32_pclose(stream);
1609 }
1610
1611 int
1612 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1613 {
1614     return win32_pipe(phandles, 512, O_BINARY);
1615 }
1616
1617 int
1618 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1619 {
1620     return setuid(u);
1621 }
1622
1623 int
1624 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1625 {
1626     return setgid(g);
1627 }
1628
1629 int
1630 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1631 {
1632     return win32_sleep(s);
1633 }
1634
1635 int
1636 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1637 {
1638     return win32_times(timebuf);
1639 }
1640
1641 int
1642 PerlProcWait(struct IPerlProc* piPerl, int *status)
1643 {
1644     return win32_wait(status);
1645 }
1646
1647 int
1648 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1649 {
1650     return win32_waitpid(pid, status, flags);
1651 }
1652
1653 Sighandler_t
1654 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1655 {
1656     return signal(sig, subcode);
1657 }
1658
1659 #ifdef USE_ITHREADS
1660 static THREAD_RET_TYPE
1661 win32_start_child(LPVOID arg)
1662 {
1663     PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1664     GV *tmpgv;
1665     int status;
1666 #ifdef PERL_OBJECT
1667     CPerlObj *pPerl = (CPerlObj*)my_perl;
1668 #endif
1669 #ifdef PERL_SYNC_FORK
1670     static long sync_fork_id = 0;
1671     long id = ++sync_fork_id;
1672 #endif
1673
1674
1675     PERL_SET_THX(my_perl);
1676
1677     /* set $$ to pseudo id */
1678 #ifdef PERL_SYNC_FORK
1679     w32_pseudo_id = id;
1680 #else
1681     w32_pseudo_id = GetCurrentThreadId();
1682     if (IsWin95()) {
1683         int pid = (int)w32_pseudo_id;
1684         if (pid < 0)
1685             w32_pseudo_id = -pid;
1686     }
1687 #endif
1688     if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
1689         sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
1690     hv_clear(PL_pidstatus);
1691
1692     /* push a zero on the stack (we are the child) */
1693     {
1694         dSP;
1695         dTARGET;
1696         PUSHi(0);
1697         PUTBACK;
1698     }
1699
1700     /* continue from next op */
1701     PL_op = PL_op->op_next;
1702
1703     {
1704         dJMPENV;
1705         volatile int oldscope = PL_scopestack_ix;
1706
1707 restart:
1708         JMPENV_PUSH(status);
1709         switch (status) {
1710         case 0:
1711             CALLRUNOPS(aTHX);
1712             status = 0;
1713             break;
1714         case 2:
1715             while (PL_scopestack_ix > oldscope)
1716                 LEAVE;
1717             FREETMPS;
1718             PL_curstash = PL_defstash;
1719             if (PL_endav && !PL_minus_c)
1720                 call_list(oldscope, PL_endav);
1721             status = STATUS_NATIVE_EXPORT;
1722             break;
1723         case 3:
1724             if (PL_restartop) {
1725                 POPSTACK_TO(PL_mainstack);
1726                 PL_op = PL_restartop;
1727                 PL_restartop = Nullop;
1728                 goto restart;
1729             }
1730             PerlIO_printf(Perl_error_log, "panic: restartop\n");
1731             FREETMPS;
1732             status = 1;
1733             break;
1734         }
1735         JMPENV_POP;
1736
1737         /* XXX hack to avoid perl_destruct() freeing optree */
1738         PL_main_root = Nullop;
1739     }
1740
1741     /* close the std handles to avoid fd leaks */
1742     {
1743         do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
1744         do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE);
1745         do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE);
1746     }
1747
1748     /* destroy everything (waits for any pseudo-forked children) */
1749     perl_destruct(my_perl);
1750     perl_free(my_perl);
1751
1752 #ifdef PERL_SYNC_FORK
1753     return id;
1754 #else
1755     return (DWORD)status;
1756 #endif
1757 }
1758 #endif /* USE_ITHREADS */
1759
1760 int
1761 PerlProcFork(struct IPerlProc* piPerl)
1762 {
1763     dTHXo;
1764 #ifdef USE_ITHREADS
1765     DWORD id;
1766     HANDLE handle;
1767     CPerlHost *h;
1768
1769     if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1770         errno = EAGAIN;
1771         return -1;
1772     }
1773     h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1774     PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHXo, 1,
1775                                                  h->m_pHostperlMem,
1776                                                  h->m_pHostperlMemShared,
1777                                                  h->m_pHostperlMemParse,
1778                                                  h->m_pHostperlEnv,
1779                                                  h->m_pHostperlStdIO,
1780                                                  h->m_pHostperlLIO,
1781                                                  h->m_pHostperlDir,
1782                                                  h->m_pHostperlSock,
1783                                                  h->m_pHostperlProc
1784                                                  );
1785     new_perl->Isys_intern.internal_host = h;
1786 #  ifdef PERL_SYNC_FORK
1787     id = win32_start_child((LPVOID)new_perl);
1788     PERL_SET_THX(aTHXo);
1789 #  else
1790 #    ifdef USE_RTL_THREAD_API
1791     handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1792                                     (void*)new_perl, 0, (unsigned*)&id);
1793 #    else
1794     handle = CreateThread(NULL, 0, win32_start_child,
1795                           (LPVOID)new_perl, 0, &id);
1796 #    endif
1797     PERL_SET_THX(aTHXo);        /* XXX perl_clone*() set TLS */
1798     if (!handle) {
1799         errno = EAGAIN;
1800         return -1;
1801     }
1802     if (IsWin95()) {
1803         int pid = (int)id;
1804         if (pid < 0)
1805             id = -pid;
1806     }
1807     w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1808     w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1809     ++w32_num_pseudo_children;
1810 #  endif
1811     return -(int)id;
1812 #else
1813     Perl_croak(aTHX_ "fork() not implemented!\n");
1814     return -1;
1815 #endif /* USE_ITHREADS */
1816 }
1817
1818 int
1819 PerlProcGetpid(struct IPerlProc* piPerl)
1820 {
1821     return win32_getpid();
1822 }
1823
1824 void*
1825 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1826 {
1827     return win32_dynaload(filename);
1828 }
1829
1830 void
1831 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1832 {
1833     win32_str_os_error(sv, dwErr);
1834 }
1835
1836 BOOL
1837 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1838 {
1839     do_spawn2(cmd, EXECF_EXEC);
1840     return FALSE;
1841 }
1842
1843 int
1844 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1845 {
1846     return do_spawn2(cmds, EXECF_SPAWN);
1847 }
1848
1849 int
1850 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1851 {
1852     return win32_spawnvp(mode, cmdname, argv);
1853 }
1854
1855 int
1856 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1857 {
1858     return do_aspawn(vreally, vmark, vsp);
1859 }
1860
1861 int
1862 PerlProcLastHost(struct IPerlProc* piPerl)
1863 {
1864  dTHXo;
1865  CPerlHost *h = (CPerlHost*)w32_internal_host;
1866  return h->LastHost();
1867 }
1868
1869 struct IPerlProc perlProc =
1870 {
1871     PerlProcAbort,
1872     PerlProcCrypt,
1873     PerlProcExit,
1874     PerlProc_Exit,
1875     PerlProcExecl,
1876     PerlProcExecv,
1877     PerlProcExecvp,
1878     PerlProcGetuid,
1879     PerlProcGeteuid,
1880     PerlProcGetgid,
1881     PerlProcGetegid,
1882     PerlProcGetlogin,
1883     PerlProcKill,
1884     PerlProcKillpg,
1885     PerlProcPauseProc,
1886     PerlProcPopen,
1887     PerlProcPclose,
1888     PerlProcPipe,
1889     PerlProcSetuid,
1890     PerlProcSetgid,
1891     PerlProcSleep,
1892     PerlProcTimes,
1893     PerlProcWait,
1894     PerlProcWaitpid,
1895     PerlProcSignal,
1896     PerlProcFork,
1897     PerlProcGetpid,
1898     PerlProcDynaLoader,
1899     PerlProcGetOSError,
1900     PerlProcDoCmd,
1901     PerlProcSpawn,
1902     PerlProcSpawnvp,
1903     PerlProcASpawn,
1904     PerlProcLastHost,
1905     PerlProcPopenList
1906 };
1907
1908
1909 /*
1910  * CPerlHost
1911  */
1912
1913 CPerlHost::CPerlHost(void)
1914 {
1915     /* Construct a host from scratch */
1916     InterlockedIncrement(&num_hosts);
1917     m_pvDir = new VDir();
1918     m_pVMem = new VMem();
1919     m_pVMemShared = new VMem();
1920     m_pVMemParse =  new VMem();
1921
1922     m_pvDir->Init(NULL, m_pVMem);
1923
1924     m_dwEnvCount = 0;
1925     m_lppEnvList = NULL;
1926
1927     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1928     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1929     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1930     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1931     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1932     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1933     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1934     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1935     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1936
1937     m_pHostperlMem          = &m_hostperlMem;
1938     m_pHostperlMemShared    = &m_hostperlMemShared;
1939     m_pHostperlMemParse     = &m_hostperlMemParse;
1940     m_pHostperlEnv          = &m_hostperlEnv;
1941     m_pHostperlStdIO        = &m_hostperlStdIO;
1942     m_pHostperlLIO          = &m_hostperlLIO;
1943     m_pHostperlDir          = &m_hostperlDir;
1944     m_pHostperlSock         = &m_hostperlSock;
1945     m_pHostperlProc         = &m_hostperlProc;
1946 }
1947
1948 #define SETUPEXCHANGE(xptr, iptr, table) \
1949     STMT_START {                                \
1950         if (xptr) {                             \
1951             iptr = *xptr;                       \
1952             *xptr = &table;                     \
1953         }                                       \
1954         else {                                  \
1955             iptr = &table;                      \
1956         }                                       \
1957     } STMT_END
1958
1959 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1960                  struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1961                  struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1962                  struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1963                  struct IPerlProc** ppProc)
1964 {
1965     InterlockedIncrement(&num_hosts);
1966     m_pvDir = new VDir(0);
1967     m_pVMem = new VMem();
1968     m_pVMemShared = new VMem();
1969     m_pVMemParse =  new VMem();
1970
1971     m_pvDir->Init(NULL, m_pVMem);
1972
1973     m_dwEnvCount = 0;
1974     m_lppEnvList = NULL;
1975
1976     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1977     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1978     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1979     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1980     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1981     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1982     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1983     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1984     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1985
1986     SETUPEXCHANGE(ppMem,        m_pHostperlMem,         m_hostperlMem);
1987     SETUPEXCHANGE(ppMemShared,  m_pHostperlMemShared,   m_hostperlMemShared);
1988     SETUPEXCHANGE(ppMemParse,   m_pHostperlMemParse,    m_hostperlMemParse);
1989     SETUPEXCHANGE(ppEnv,        m_pHostperlEnv,         m_hostperlEnv);
1990     SETUPEXCHANGE(ppStdIO,      m_pHostperlStdIO,       m_hostperlStdIO);
1991     SETUPEXCHANGE(ppLIO,        m_pHostperlLIO,         m_hostperlLIO);
1992     SETUPEXCHANGE(ppDir,        m_pHostperlDir,         m_hostperlDir);
1993     SETUPEXCHANGE(ppSock,       m_pHostperlSock,        m_hostperlSock);
1994     SETUPEXCHANGE(ppProc,       m_pHostperlProc,        m_hostperlProc);
1995 }
1996 #undef SETUPEXCHANGE
1997
1998 CPerlHost::CPerlHost(CPerlHost& host)
1999 {
2000     /* Construct a host from another host */
2001     InterlockedIncrement(&num_hosts);
2002     m_pVMem = new VMem();
2003     m_pVMemShared = host.GetMemShared();
2004     m_pVMemParse =  host.GetMemParse();
2005
2006     /* duplicate directory info */
2007     m_pvDir = new VDir(0);
2008     m_pvDir->Init(host.GetDir(), m_pVMem);
2009
2010     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2011     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2012     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2013     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2014     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2015     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2016     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2017     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2018     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2019     m_pHostperlMem          = &m_hostperlMem;
2020     m_pHostperlMemShared    = &m_hostperlMemShared;
2021     m_pHostperlMemParse     = &m_hostperlMemParse;
2022     m_pHostperlEnv          = &m_hostperlEnv;
2023     m_pHostperlStdIO        = &m_hostperlStdIO;
2024     m_pHostperlLIO          = &m_hostperlLIO;
2025     m_pHostperlDir          = &m_hostperlDir;
2026     m_pHostperlSock         = &m_hostperlSock;
2027     m_pHostperlProc         = &m_hostperlProc;
2028
2029     m_dwEnvCount = 0;
2030     m_lppEnvList = NULL;
2031
2032     /* duplicate environment info */
2033     LPSTR lpPtr;
2034     DWORD dwIndex = 0;
2035     while(lpPtr = host.GetIndex(dwIndex))
2036         Add(lpPtr);
2037 }
2038
2039 CPerlHost::~CPerlHost(void)
2040 {
2041 //  Reset();
2042     InterlockedDecrement(&num_hosts);
2043     delete m_pvDir;
2044     m_pVMemParse->Release();
2045     m_pVMemShared->Release();
2046     m_pVMem->Release();
2047 }
2048
2049 LPSTR
2050 CPerlHost::Find(LPCSTR lpStr)
2051 {
2052     LPSTR lpPtr;
2053     LPSTR* lppPtr = Lookup(lpStr);
2054     if(lppPtr != NULL) {
2055         for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2056             ;
2057
2058         if(*lpPtr == '=')
2059             ++lpPtr;
2060
2061         return lpPtr;
2062     }
2063     return NULL;
2064 }
2065
2066 int
2067 lookup(const void *arg1, const void *arg2)
2068 {   // Compare strings
2069     char*ptr1, *ptr2;
2070     char c1,c2;
2071
2072     ptr1 = *(char**)arg1;
2073     ptr2 = *(char**)arg2;
2074     for(;;) {
2075         c1 = *ptr1++;
2076         c2 = *ptr2++;
2077         if(c1 == '\0' || c1 == '=') {
2078             if(c2 == '\0' || c2 == '=')
2079                 break;
2080
2081             return -1; // string 1 < string 2
2082         }
2083         else if(c2 == '\0' || c2 == '=')
2084             return 1; // string 1 > string 2
2085         else if(c1 != c2) {
2086             c1 = toupper(c1);
2087             c2 = toupper(c2);
2088             if(c1 != c2) {
2089                 if(c1 < c2)
2090                     return -1; // string 1 < string 2
2091
2092                 return 1; // string 1 > string 2
2093             }
2094         }
2095     }
2096     return 0;
2097 }
2098
2099 LPSTR*
2100 CPerlHost::Lookup(LPCSTR lpStr)
2101 {
2102     return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2103 }
2104
2105 int
2106 compare(const void *arg1, const void *arg2)
2107 {   // Compare strings
2108     char*ptr1, *ptr2;
2109     char c1,c2;
2110
2111     ptr1 = *(char**)arg1;
2112     ptr2 = *(char**)arg2;
2113     for(;;) {
2114         c1 = *ptr1++;
2115         c2 = *ptr2++;
2116         if(c1 == '\0' || c1 == '=') {
2117             if(c1 == c2)
2118                 break;
2119
2120             return -1; // string 1 < string 2
2121         }
2122         else if(c2 == '\0' || c2 == '=')
2123             return 1; // string 1 > string 2
2124         else if(c1 != c2) {
2125             c1 = toupper(c1);
2126             c2 = toupper(c2);
2127             if(c1 != c2) {
2128                 if(c1 < c2)
2129                     return -1; // string 1 < string 2
2130
2131                 return 1; // string 1 > string 2
2132             }
2133         }
2134     }
2135     return 0;
2136 }
2137
2138 void
2139 CPerlHost::Add(LPCSTR lpStr)
2140 {
2141     dTHXo;
2142     char szBuffer[1024];
2143     LPSTR *lpPtr;
2144     int index, length = strlen(lpStr)+1;
2145
2146     for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2147         szBuffer[index] = lpStr[index];
2148
2149     szBuffer[index] = '\0';
2150
2151     // replacing ?
2152     lpPtr = Lookup(szBuffer);
2153     if(lpPtr != NULL) {
2154         Renew(*lpPtr, length, char);
2155         strcpy(*lpPtr, lpStr);
2156     }
2157     else {
2158         ++m_dwEnvCount;
2159         Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2160         New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2161         if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2162             strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2163             qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2164         }
2165         else
2166             --m_dwEnvCount;
2167     }
2168 }
2169
2170 DWORD
2171 CPerlHost::CalculateEnvironmentSpace(void)
2172 {
2173     DWORD index;
2174     DWORD dwSize = 0;
2175     for(index = 0; index < m_dwEnvCount; ++index)
2176         dwSize += strlen(m_lppEnvList[index]) + 1;
2177
2178     return dwSize;
2179 }
2180
2181 void
2182 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2183 {
2184     dTHXo;
2185     Safefree(lpStr);
2186 }
2187
2188 char*
2189 CPerlHost::GetChildDir(void)
2190 {
2191     dTHXo;
2192     int length;
2193     char* ptr;
2194     New(0, ptr, MAX_PATH+1, char);
2195     if(ptr) {
2196         m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2197         length = strlen(ptr);
2198         if (length > 3) {
2199             if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2200                 ptr[length-1] = 0;
2201         }
2202     }
2203     return ptr;
2204 }
2205
2206 void
2207 CPerlHost::FreeChildDir(char* pStr)
2208 {
2209     dTHXo;
2210     Safefree(pStr);
2211 }
2212
2213 LPSTR
2214 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2215 {
2216     dTHXo;
2217     LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2218     DWORD dwSize, dwEnvIndex;
2219     int nLength, compVal;
2220
2221     // get the process environment strings
2222     lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2223
2224     // step over current directory stuff
2225     while(*lpTmp == '=')
2226         lpTmp += strlen(lpTmp) + 1;
2227
2228     // save the start of the environment strings
2229     lpEnvPtr = lpTmp;
2230     for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2231         // calculate the size of the environment strings
2232         dwSize += strlen(lpTmp) + 1;
2233     }
2234
2235     // add the size of current directories
2236     dwSize += vDir.CalculateEnvironmentSpace();
2237
2238     // add the additional space used by changes made to the environment
2239     dwSize += CalculateEnvironmentSpace();
2240
2241     New(1, lpStr, dwSize, char);
2242     lpPtr = lpStr;
2243     if(lpStr != NULL) {
2244         // build the local environment
2245         lpStr = vDir.BuildEnvironmentSpace(lpStr);
2246
2247         dwEnvIndex = 0;
2248         lpLocalEnv = GetIndex(dwEnvIndex);
2249         while(*lpEnvPtr != '\0') {
2250             if(!lpLocalEnv) {
2251                 // all environment overrides have been added
2252                 // so copy string into place
2253                 strcpy(lpStr, lpEnvPtr);
2254                 nLength = strlen(lpEnvPtr) + 1;
2255                 lpStr += nLength;
2256                 lpEnvPtr += nLength;
2257             }
2258             else {
2259                 // determine which string to copy next
2260                 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2261                 if(compVal < 0) {
2262                     strcpy(lpStr, lpEnvPtr);
2263                     nLength = strlen(lpEnvPtr) + 1;
2264                     lpStr += nLength;
2265                     lpEnvPtr += nLength;
2266                 }
2267                 else {
2268                     char *ptr = strchr(lpLocalEnv, '=');
2269                     if(ptr && ptr[1]) {
2270                         strcpy(lpStr, lpLocalEnv);
2271                         lpStr += strlen(lpLocalEnv) + 1;
2272                     }
2273                     lpLocalEnv = GetIndex(dwEnvIndex);
2274                     if(compVal == 0) {
2275                         // this string was replaced
2276                         lpEnvPtr += strlen(lpEnvPtr) + 1;
2277                     }
2278                 }
2279             }
2280         }
2281
2282         while(lpLocalEnv) {
2283             // still have environment overrides to add
2284             // so copy the strings into place
2285             strcpy(lpStr, lpLocalEnv);
2286             nLength = strlen(lpLocalEnv) + 1;
2287             lpStr += nLength;
2288             lpEnvPtr += nLength;
2289             lpLocalEnv = GetIndex(dwEnvIndex);
2290         }
2291
2292         // add final NULL
2293         *lpStr = '\0';
2294     }
2295
2296     // release the process environment strings
2297     FreeEnvironmentStrings(lpAllocPtr);
2298
2299     return lpPtr;
2300 }
2301
2302 void
2303 CPerlHost::Reset(void)
2304 {
2305     dTHXo;
2306     if(m_lppEnvList != NULL) {
2307         for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2308             Safefree(m_lppEnvList[index]);
2309             m_lppEnvList[index] = NULL;
2310         }
2311     }
2312     m_dwEnvCount = 0;
2313 }
2314
2315 void
2316 CPerlHost::Clearenv(void)
2317 {
2318     char ch;
2319     LPSTR lpPtr, lpStr, lpEnvPtr;
2320     if(m_lppEnvList != NULL) {
2321         /* set every entry to an empty string */
2322         for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2323             char* ptr = strchr(m_lppEnvList[index], '=');
2324             if(ptr) {
2325                 *++ptr = 0;
2326             }
2327         }
2328     }
2329
2330     /* get the process environment strings */
2331     lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2332
2333     /* step over current directory stuff */
2334     while(*lpStr == '=')
2335         lpStr += strlen(lpStr) + 1;
2336
2337     while(*lpStr) {
2338         lpPtr = strchr(lpStr, '=');
2339         if(lpPtr) {
2340             ch = *++lpPtr;
2341             *lpPtr = 0;
2342             Add(lpStr);
2343             *lpPtr = ch;
2344         }
2345         lpStr += strlen(lpStr) + 1;
2346     }
2347
2348     FreeEnvironmentStrings(lpEnvPtr);
2349 }
2350
2351
2352 char*
2353 CPerlHost::Getenv(const char *varname)
2354 {
2355     char* pEnv = Find(varname);
2356     if(pEnv == NULL) {
2357         pEnv = win32_getenv(varname);
2358     }
2359     else {
2360         if(!*pEnv)
2361             pEnv = 0;
2362     }
2363
2364     return pEnv;
2365 }
2366
2367 int
2368 CPerlHost::Putenv(const char *envstring)
2369 {
2370     Add(envstring);
2371     return 0;
2372 }
2373
2374 int
2375 CPerlHost::Chdir(const char *dirname)
2376 {
2377     dTHXo;
2378     int ret;
2379     if (USING_WIDE()) {
2380         WCHAR wBuffer[MAX_PATH];
2381         A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2382         ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2383     }
2384     else
2385         ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2386     if(ret < 0) {
2387         errno = ENOENT;
2388     }
2389     return ret;
2390 }
2391
2392 #endif /* ___PerlHost_H___ */