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