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