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