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 #ifdef __BORLANDC__
 786     if(((FILE*)pf)->flags & _F_READ) {
 787         mode[0] = 'r';
 788         mode[1] = 0;
 789     }
 790     else if(((FILE*)pf)->flags & _F_WRIT) {
 791         mode[0] = 'a';
 792         mode[1] = 0;
 793     }
 794     else if(((FILE*)pf)->flags & _F_RDWR) {
 795         mode[0] = 'r';
 796         mode[1] = '+';
 797         mode[2] = 0;
 798     }
 799 #else
 800     if(((FILE*)pf)->_flag & _IOREAD) {
 801         mode[0] = 'r';
 802         mode[1] = 0;
 803     }
 804     else if(((FILE*)pf)->_flag & _IOWRT) {
 805         mode[0] = 'a';
 806         mode[1] = 0;
 807     }
 808     else if(((FILE*)pf)->_flag & _IORW) {
 809         mode[0] = 'r';
 810         mode[1] = '+';
 811         mode[2] = 0;
 812     }
 813 #endif
 814
 815     /* it appears that the binmode is attached to the
 816      * file descriptor so binmode files will be handled
 817      * correctly
 818      */
 819     pfdup = (PerlIO*)win32_fdopen(fileno, mode);
 820
 821     /* move the file pointer to the same position */
 822     if (!fgetpos((FILE*)pf, &pos)) {
 823         fsetpos((FILE*)pfdup, &pos);
 824     }
 825     return pfdup;
 826 }
 827
 828 struct IPerlStdIO perlStdIO =
 829 {
 830     PerlStdIOStdin,
 831     PerlStdIOStdout,
 832     PerlStdIOStderr,
 833     PerlStdIOOpen,
 834     PerlStdIOClose,
 835     PerlStdIOEof,
 836     PerlStdIOError,
 837     PerlStdIOClearerr,
 838     PerlStdIOGetc,
 839     PerlStdIOGetBase,
 840     PerlStdIOGetBufsiz,
 841     PerlStdIOGetCnt,
 842     PerlStdIOGetPtr,
 843     PerlStdIOGets,
 844     PerlStdIOPutc,
 845     PerlStdIOPuts,
 846     PerlStdIOFlush,
 847     PerlStdIOUngetc,
 848     PerlStdIOFileno,
 849     PerlStdIOFdopen,
 850     PerlStdIOReopen,
 851     PerlStdIORead,
 852     PerlStdIOWrite,
 853     PerlStdIOSetBuf,
 854     PerlStdIOSetVBuf,
 855     PerlStdIOSetCnt,
 856     PerlStdIOSetPtrCnt,
 857     PerlStdIOSetlinebuf,
 858     PerlStdIOPrintf,
 859     PerlStdIOVprintf,
 860     PerlStdIOTell,
 861     PerlStdIOSeek,
 862     PerlStdIORewind,
 863     PerlStdIOTmpfile,
 864     PerlStdIOGetpos,
 865     PerlStdIOSetpos,
 866     PerlStdIOInit,
 867     PerlStdIOInitOSExtras,
 868     PerlStdIOFdupopen,
 869 };
 870
 871
 872 #undef IPERL2HOST
 873 #define IPERL2HOST(x) IPerlLIO2Host(x)
 874
 875 /* IPerlLIO */
 876 int
 877 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
 878 {
 879     return win32_access(path, mode);
 880 }
 881
 882 int
 883 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
 884 {
 885     return win32_chmod(filename, pmode);
 886 }
 887
 888 int
 889 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
 890 {
 891     return chown(filename, owner, group);
 892 }
 893
 894 int
 895 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
 896 {
 897     return chsize(handle, size);
 898 }
 899
 900 int
 901 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
 902 {
 903     return win32_close(handle);
 904 }
 905
 906 int
 907 PerlLIODup(struct IPerlLIO* piPerl, int handle)
 908 {
 909     return win32_dup(handle);
 910 }
 911
 912 int
 913 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
 914 {
 915     return win32_dup2(handle1, handle2);
 916 }
 917
 918 int
 919 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
 920 {
 921     return win32_flock(fd, oper);
 922 }
 923
 924 int
 925 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
 926 {
 927     return fstat(handle, buffer);
 928 }
 929
 930 int
 931 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
 932 {
 933     return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
 934 }
 935
 936 int
 937 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
 938 {
 939     return isatty(fd);
 940 }
 941
 942 int
 943 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
 944 {
 945     return win32_link(oldname, newname);
 946 }
 947
 948 long
 949 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
 950 {
 951     return win32_lseek(handle, offset, origin);
 952 }
 953
 954 int
 955 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
 956 {
 957     return win32_stat(path, buffer);
 958 }
 959
 960 char*
 961 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
 962 {
 963     return mktemp(Template);
 964 }
 965
 966 int
 967 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
 968 {
 969     return win32_open(filename, oflag);
 970 }
 971
 972 int
 973 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
 974 {
 975     return win32_open(filename, oflag, pmode);
 976 }
 977
 978 int
 979 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
 980 {
 981     return win32_read(handle, buffer, count);
 982 }
 983
 984 int
 985 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
 986 {
 987     return win32_rename(OldFileName, newname);
 988 }
 989
 990 int
 991 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
 992 {
 993     return win32_setmode(handle, mode);
 994 }
 995
 996 int
 997 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
 998 {
 999     return win32_stat(path, buffer);
1000 }
1001
1002 char*
1003 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1004 {
1005     return tmpnam(string);
1006 }
1007
1008 int
1009 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1010 {
1011     return umask(pmode);
1012 }
1013
1014 int
1015 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1016 {
1017     return win32_unlink(filename);
1018 }
1019
1020 int
1021 PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
1022 {
1023     return win32_utime(filename, times);
1024 }
1025
1026 int
1027 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1028 {
1029     return win32_write(handle, buffer, count);
1030 }
1031
1032 struct IPerlLIO perlLIO =
1033 {
1034     PerlLIOAccess,
1035     PerlLIOChmod,
1036     PerlLIOChown,
1037     PerlLIOChsize,
1038     PerlLIOClose,
1039     PerlLIODup,
1040     PerlLIODup2,
1041     PerlLIOFlock,
1042     PerlLIOFileStat,
1043     PerlLIOIOCtl,
1044     PerlLIOIsatty,
1045     PerlLIOLink,
1046     PerlLIOLseek,
1047     PerlLIOLstat,
1048     PerlLIOMktemp,
1049     PerlLIOOpen,
1050     PerlLIOOpen3,
1051     PerlLIORead,
1052     PerlLIORename,
1053     PerlLIOSetmode,
1054     PerlLIONameStat,
1055     PerlLIOTmpnam,
1056     PerlLIOUmask,
1057     PerlLIOUnlink,
1058     PerlLIOUtime,
1059     PerlLIOWrite,
1060 };
1061
1062
1063 #undef IPERL2HOST
1064 #define IPERL2HOST(x) IPerlDir2Host(x)
1065
1066 /* IPerlDIR */
1067 int
1068 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1069 {
1070     return win32_mkdir(dirname, mode);
1071 }
1072
1073 int
1074 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1075 {
1076     return IPERL2HOST(piPerl)->Chdir(dirname);
1077 }
1078
1079 int
1080 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1081 {
1082     return win32_rmdir(dirname);
1083 }
1084
1085 int
1086 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1087 {
1088     return win32_closedir(dirp);
1089 }
1090
1091 DIR*
1092 PerlDirOpen(struct IPerlDir* piPerl, char *filename)
1093 {
1094     return win32_opendir(filename);
1095 }
1096
1097 struct direct *
1098 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1099 {
1100     return win32_readdir(dirp);
1101 }
1102
1103 void
1104 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1105 {
1106     win32_rewinddir(dirp);
1107 }
1108
1109 void
1110 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1111 {
1112     win32_seekdir(dirp, loc);
1113 }
1114
1115 long
1116 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1117 {
1118     return win32_telldir(dirp);
1119 }
1120
1121 char*
1122 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1123 {
1124     return IPERL2HOST(piPerl)->MapPathA(path);
1125 }
1126
1127 WCHAR*
1128 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1129 {
1130     return IPERL2HOST(piPerl)->MapPathW(path);
1131 }
1132
1133 struct IPerlDir perlDir =
1134 {
1135     PerlDirMakedir,
1136     PerlDirChdir,
1137     PerlDirRmdir,
1138     PerlDirClose,
1139     PerlDirOpen,
1140     PerlDirRead,
1141     PerlDirRewind,
1142     PerlDirSeek,
1143     PerlDirTell,
1144     PerlDirMapPathA,
1145     PerlDirMapPathW,
1146 };
1147
1148
1149 /* IPerlSock */
1150 u_long
1151 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1152 {
1153     return win32_htonl(hostlong);
1154 }
1155
1156 u_short
1157 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1158 {
1159     return win32_htons(hostshort);
1160 }
1161
1162 u_long
1163 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1164 {
1165     return win32_ntohl(netlong);
1166 }
1167
1168 u_short
1169 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1170 {
1171     return win32_ntohs(netshort);
1172 }
1173
1174 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1175 {
1176     return win32_accept(s, addr, addrlen);
1177 }
1178
1179 int
1180 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1181 {
1182     return win32_bind(s, name, namelen);
1183 }
1184
1185 int
1186 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1187 {
1188     return win32_connect(s, name, namelen);
1189 }
1190
1191 void
1192 PerlSockEndhostent(struct IPerlSock* piPerl)
1193 {
1194     win32_endhostent();
1195 }
1196
1197 void
1198 PerlSockEndnetent(struct IPerlSock* piPerl)
1199 {
1200     win32_endnetent();
1201 }
1202
1203 void
1204 PerlSockEndprotoent(struct IPerlSock* piPerl)
1205 {
1206     win32_endprotoent();
1207 }
1208
1209 void
1210 PerlSockEndservent(struct IPerlSock* piPerl)
1211 {
1212     win32_endservent();
1213 }
1214
1215 struct hostent*
1216 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1217 {
1218     return win32_gethostbyaddr(addr, len, type);
1219 }
1220
1221 struct hostent*
1222 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1223 {
1224     return win32_gethostbyname(name);
1225 }
1226
1227 struct hostent*
1228 PerlSockGethostent(struct IPerlSock* piPerl)
1229 {
1230     dTHXo;
1231     Perl_croak(aTHX_ "gethostent not implemented!\n");
1232     return NULL;
1233 }
1234
1235 int
1236 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1237 {
1238     return win32_gethostname(name, namelen);
1239 }
1240
1241 struct netent *
1242 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1243 {
1244     return win32_getnetbyaddr(net, type);
1245 }
1246
1247 struct netent *
1248 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1249 {
1250     return win32_getnetbyname((char*)name);
1251 }
1252
1253 struct netent *
1254 PerlSockGetnetent(struct IPerlSock* piPerl)
1255 {
1256     return win32_getnetent();
1257 }
1258
1259 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1260 {
1261     return win32_getpeername(s, name, namelen);
1262 }
1263
1264 struct protoent*
1265 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1266 {
1267     return win32_getprotobyname(name);
1268 }
1269
1270 struct protoent*
1271 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1272 {
1273     return win32_getprotobynumber(number);
1274 }
1275
1276 struct protoent*
1277 PerlSockGetprotoent(struct IPerlSock* piPerl)
1278 {
1279     return win32_getprotoent();
1280 }
1281
1282 struct servent*
1283 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1284 {
1285     return win32_getservbyname(name, proto);
1286 }
1287
1288 struct servent*
1289 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1290 {
1291     return win32_getservbyport(port, proto);
1292 }
1293
1294 struct servent*
1295 PerlSockGetservent(struct IPerlSock* piPerl)
1296 {
1297     return win32_getservent();
1298 }
1299
1300 int
1301 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1302 {
1303     return win32_getsockname(s, name, namelen);
1304 }
1305
1306 int
1307 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1308 {
1309     return win32_getsockopt(s, level, optname, optval, optlen);
1310 }
1311
1312 unsigned long
1313 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1314 {
1315     return win32_inet_addr(cp);
1316 }
1317
1318 char*
1319 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1320 {
1321     return win32_inet_ntoa(in);
1322 }
1323
1324 int
1325 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1326 {
1327     return win32_listen(s, backlog);
1328 }
1329
1330 int
1331 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1332 {
1333     return win32_recv(s, buffer, len, flags);
1334 }
1335
1336 int
1337 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1338 {
1339     return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1340 }
1341
1342 int
1343 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1344 {
1345     return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1346 }
1347
1348 int
1349 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1350 {
1351     return win32_send(s, buffer, len, flags);
1352 }
1353
1354 int
1355 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1356 {
1357     return win32_sendto(s, buffer, len, flags, to, tolen);
1358 }
1359
1360 void
1361 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1362 {
1363     win32_sethostent(stayopen);
1364 }
1365
1366 void
1367 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1368 {
1369     win32_setnetent(stayopen);
1370 }
1371
1372 void
1373 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1374 {
1375     win32_setprotoent(stayopen);
1376 }
1377
1378 void
1379 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1380 {
1381     win32_setservent(stayopen);
1382 }
1383
1384 int
1385 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1386 {
1387     return win32_setsockopt(s, level, optname, optval, optlen);
1388 }
1389
1390 int
1391 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1392 {
1393     return win32_shutdown(s, how);
1394 }
1395
1396 SOCKET
1397 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1398 {
1399     return win32_socket(af, type, protocol);
1400 }
1401
1402 int
1403 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1404 {
1405     dTHXo;
1406     Perl_croak(aTHX_ "socketpair not implemented!\n");
1407     return 0;
1408 }
1409
1410 int
1411 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1412 {
1413     return win32_closesocket(s);
1414 }
1415
1416 int
1417 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1418 {
1419     return win32_ioctlsocket(s, cmd, argp);
1420 }
1421
1422 struct IPerlSock perlSock =
1423 {
1424     PerlSockHtonl,
1425     PerlSockHtons,
1426     PerlSockNtohl,
1427     PerlSockNtohs,
1428     PerlSockAccept,
1429     PerlSockBind,
1430     PerlSockConnect,
1431     PerlSockEndhostent,
1432     PerlSockEndnetent,
1433     PerlSockEndprotoent,
1434     PerlSockEndservent,
1435     PerlSockGethostname,
1436     PerlSockGetpeername,
1437     PerlSockGethostbyaddr,
1438     PerlSockGethostbyname,
1439     PerlSockGethostent,
1440     PerlSockGetnetbyaddr,
1441     PerlSockGetnetbyname,
1442     PerlSockGetnetent,
1443     PerlSockGetprotobyname,
1444     PerlSockGetprotobynumber,
1445     PerlSockGetprotoent,
1446     PerlSockGetservbyname,
1447     PerlSockGetservbyport,
1448     PerlSockGetservent,
1449     PerlSockGetsockname,
1450     PerlSockGetsockopt,
1451     PerlSockInetAddr,
1452     PerlSockInetNtoa,
1453     PerlSockListen,
1454     PerlSockRecv,
1455     PerlSockRecvfrom,
1456     PerlSockSelect,
1457     PerlSockSend,
1458     PerlSockSendto,
1459     PerlSockSethostent,
1460     PerlSockSetnetent,
1461     PerlSockSetprotoent,
1462     PerlSockSetservent,
1463     PerlSockSetsockopt,
1464     PerlSockShutdown,
1465     PerlSockSocket,
1466     PerlSockSocketpair,
1467     PerlSockClosesocket,
1468 };
1469
1470
1471 /* IPerlProc */
1472
1473 #define EXECF_EXEC 1
1474 #define EXECF_SPAWN 2
1475
1476 void
1477 PerlProcAbort(struct IPerlProc* piPerl)
1478 {
1479     win32_abort();
1480 }
1481
1482 char *
1483 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1484 {
1485     return win32_crypt(clear, salt);
1486 }
1487
1488 void
1489 PerlProcExit(struct IPerlProc* piPerl, int status)
1490 {
1491     exit(status);
1492 }
1493
1494 void
1495 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1496 {
1497     _exit(status);
1498 }
1499
1500 int
1501 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1502 {
1503     return execl(cmdname, arg0, arg1, arg2, arg3);
1504 }
1505
1506 int
1507 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1508 {
1509     return win32_execvp(cmdname, argv);
1510 }
1511
1512 int
1513 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1514 {
1515     return win32_execvp(cmdname, argv);
1516 }
1517
1518 uid_t
1519 PerlProcGetuid(struct IPerlProc* piPerl)
1520 {
1521     return getuid();
1522 }
1523
1524 uid_t
1525 PerlProcGeteuid(struct IPerlProc* piPerl)
1526 {
1527     return geteuid();
1528 }
1529
1530 gid_t
1531 PerlProcGetgid(struct IPerlProc* piPerl)
1532 {
1533     return getgid();
1534 }
1535
1536 gid_t
1537 PerlProcGetegid(struct IPerlProc* piPerl)
1538 {
1539     return getegid();
1540 }
1541
1542 char *
1543 PerlProcGetlogin(struct IPerlProc* piPerl)
1544 {
1545     return g_getlogin();
1546 }
1547
1548 int
1549 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1550 {
1551     return win32_kill(pid, sig);
1552 }
1553
1554 int
1555 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1556 {
1557     dTHXo;
1558     Perl_croak(aTHX_ "killpg not implemented!\n");
1559     return 0;
1560 }
1561
1562 int
1563 PerlProcPauseProc(struct IPerlProc* piPerl)
1564 {
1565     return win32_sleep((32767L << 16) + 32767);
1566 }
1567
1568 PerlIO*
1569 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1570 {
1571     dTHXo;
1572     PERL_FLUSHALL_FOR_CHILD;
1573     return (PerlIO*)win32_popen(command, mode);
1574 }
1575
1576 int
1577 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1578 {
1579     return win32_pclose((FILE*)stream);
1580 }
1581
1582 int
1583 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1584 {
1585     return win32_pipe(phandles, 512, O_BINARY);
1586 }
1587
1588 int
1589 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1590 {
1591     return setuid(u);
1592 }
1593
1594 int
1595 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1596 {
1597     return setgid(g);
1598 }
1599
1600 int
1601 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1602 {
1603     return win32_sleep(s);
1604 }
1605
1606 int
1607 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1608 {
1609     return win32_times(timebuf);
1610 }
1611
1612 int
1613 PerlProcWait(struct IPerlProc* piPerl, int *status)
1614 {
1615     return win32_wait(status);
1616 }
1617
1618 int
1619 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1620 {
1621     return win32_waitpid(pid, status, flags);
1622 }
1623
1624 Sighandler_t
1625 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1626 {
1627     return 0;
1628 }
1629
1630 #ifdef USE_ITHREADS
1631 static DWORD WINAPI
1632 win32_start_child(LPVOID arg)
1633 {
1634     PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1635     GV *tmpgv;
1636     int status;
1637 #ifdef PERL_OBJECT
1638     CPerlObj *pPerl = (CPerlObj*)my_perl;
1639 #endif
1640 #ifdef PERL_SYNC_FORK
1641     static long sync_fork_id = 0;
1642     long id = ++sync_fork_id;
1643 #endif
1644
1645
1646     PERL_SET_INTERP(my_perl);
1647
1648     /* set $$ to pseudo id */
1649 #ifdef PERL_SYNC_FORK
1650     w32_pseudo_id = id;
1651 #else
1652     w32_pseudo_id = GetCurrentThreadId();
1653 #endif
1654     if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
1655         sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
1656     hv_clear(PL_pidstatus);
1657
1658     /* push a zero on the stack (we are the child) */
1659     {
1660         djSP;
1661         dTARGET;
1662         PUSHi(0);
1663         PUTBACK;
1664     }
1665
1666     /* continue from next op */
1667     PL_op = PL_op->op_next;
1668
1669     {
1670         dJMPENV;
1671         volatile int oldscope = PL_scopestack_ix;
1672
1673 restart:
1674         JMPENV_PUSH(status);
1675         switch (status) {
1676         case 0:
1677             CALLRUNOPS(aTHX);
1678             status = 0;
1679             break;
1680         case 2:
1681             while (PL_scopestack_ix > oldscope)
1682                 LEAVE;
1683             FREETMPS;
1684             PL_curstash = PL_defstash;
1685             if (PL_endav && !PL_minus_c)
1686                 call_list(oldscope, PL_endav);
1687             status = STATUS_NATIVE_EXPORT;
1688             break;
1689         case 3:
1690             if (PL_restartop) {
1691                 POPSTACK_TO(PL_mainstack);
1692                 PL_op = PL_restartop;
1693                 PL_restartop = Nullop;
1694                 goto restart;
1695             }
1696             PerlIO_printf(Perl_error_log, "panic: restartop\n");
1697             FREETMPS;
1698             status = 1;
1699             break;
1700         }
1701         JMPENV_POP;
1702
1703         /* XXX hack to avoid perl_destruct() freeing optree */
1704         PL_main_root = Nullop;
1705     }
1706
1707     /* destroy everything (waits for any pseudo-forked children) */
1708     perl_destruct(my_perl);
1709     perl_free(my_perl);
1710
1711 #ifdef PERL_SYNC_FORK
1712     return id;
1713 #else
1714     return (DWORD)status;
1715 #endif
1716 }
1717 #endif /* USE_ITHREADS */
1718
1719 int
1720 PerlProcFork(struct IPerlProc* piPerl)
1721 {
1722     dTHXo;
1723 #ifdef USE_ITHREADS
1724     DWORD id;
1725     HANDLE handle;
1726     CPerlHost *h = new CPerlHost();
1727     PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHXo, 1,
1728                                                  h->m_pHostperlMem,
1729                                                  h->m_pHostperlMemShared,
1730                                                  h->m_pHostperlMemParse,
1731                                                  h->m_pHostperlEnv,
1732                                                  h->m_pHostperlStdIO,
1733                                                  h->m_pHostperlLIO,
1734                                                  h->m_pHostperlDir,
1735                                                  h->m_pHostperlSock,
1736                                                  h->m_pHostperlProc
1737                                                  );
1738 #  ifdef PERL_SYNC_FORK
1739     id = win32_start_child((LPVOID)new_perl);
1740     PERL_SET_INTERP(aTHXo);
1741 #  else
1742     handle = CreateThread(NULL, 0, win32_start_child,
1743                           (LPVOID)new_perl, 0, &id);
1744     PERL_SET_INTERP(aTHXo);
1745     if (!handle)
1746         Perl_croak(aTHX_ "panic: pseudo fork() failed");
1747     w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1748     w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1749     ++w32_num_pseudo_children;
1750 #  endif
1751     return -(int)id;
1752 #else
1753     Perl_croak(aTHX_ "fork() not implemented!\n");
1754     return -1;
1755 #endif /* USE_ITHREADS */
1756 }
1757
1758 int
1759 PerlProcGetpid(struct IPerlProc* piPerl)
1760 {
1761     return win32_getpid();
1762 }
1763
1764 void*
1765 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1766 {
1767     return win32_dynaload(filename);
1768 }
1769
1770 void
1771 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1772 {
1773     win32_str_os_error(sv, dwErr);
1774 }
1775
1776 BOOL
1777 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1778 {
1779     do_spawn2(cmd, EXECF_EXEC);
1780     return FALSE;
1781 }
1782
1783 int
1784 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1785 {
1786     return do_spawn2(cmds, EXECF_SPAWN);
1787 }
1788
1789 int
1790 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1791 {
1792     return win32_spawnvp(mode, cmdname, argv);
1793 }
1794
1795 int
1796 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1797 {
1798     return do_aspawn(vreally, vmark, vsp);
1799 }
1800
1801 struct IPerlProc perlProc =
1802 {
1803     PerlProcAbort,
1804     PerlProcCrypt,
1805     PerlProcExit,
1806     PerlProc_Exit,
1807     PerlProcExecl,
1808     PerlProcExecv,
1809     PerlProcExecvp,
1810     PerlProcGetuid,
1811     PerlProcGeteuid,
1812     PerlProcGetgid,
1813     PerlProcGetegid,
1814     PerlProcGetlogin,
1815     PerlProcKill,
1816     PerlProcKillpg,
1817     PerlProcPauseProc,
1818     PerlProcPopen,
1819     PerlProcPclose,
1820     PerlProcPipe,
1821     PerlProcSetuid,
1822     PerlProcSetgid,
1823     PerlProcSleep,
1824     PerlProcTimes,
1825     PerlProcWait,
1826     PerlProcWaitpid,
1827     PerlProcSignal,
1828     PerlProcFork,
1829     PerlProcGetpid,
1830     PerlProcDynaLoader,
1831     PerlProcGetOSError,
1832     PerlProcDoCmd,
1833     PerlProcSpawn,
1834     PerlProcSpawnvp,
1835     PerlProcASpawn,
1836 };
1837
1838
1839 /*
1840  * CPerlHost
1841  */
1842
1843 CPerlHost::CPerlHost(void)
1844 {
1845     m_pvDir = new VDir();
1846     m_pVMem = new VMem();
1847     m_pVMemShared = new VMem();
1848     m_pVMemParse =  new VMem();
1849
1850     m_pvDir->Init(NULL, m_pVMem);
1851
1852     m_dwEnvCount = 0;
1853     m_lppEnvList = NULL;
1854
1855     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1856     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1857     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1858     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1859     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1860     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1861     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1862     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1863     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1864
1865     m_pHostperlMem          = &m_hostperlMem;
1866     m_pHostperlMemShared    = &m_hostperlMemShared;
1867     m_pHostperlMemParse     = &m_hostperlMemParse;
1868     m_pHostperlEnv          = &m_hostperlEnv;
1869     m_pHostperlStdIO        = &m_hostperlStdIO;
1870     m_pHostperlLIO          = &m_hostperlLIO;
1871     m_pHostperlDir          = &m_hostperlDir;
1872     m_pHostperlSock         = &m_hostperlSock;
1873     m_pHostperlProc         = &m_hostperlProc;
1874 }
1875
1876 #define SETUPEXCHANGE(xptr, iptr, table) \
1877     STMT_START {                                \
1878         if (xptr) {                             \
1879             iptr = *xptr;                       \
1880             *xptr = &table;                     \
1881         }                                       \
1882         else {                                  \
1883             iptr = &table;                      \
1884         }                                       \
1885     } STMT_END
1886
1887 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1888                  struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1889                  struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1890                  struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1891                  struct IPerlProc** ppProc)
1892 {
1893     m_pvDir = new VDir();
1894     m_pVMem = new VMem();
1895     m_pVMemShared = new VMem();
1896     m_pVMemParse =  new VMem();
1897
1898     m_pvDir->Init(NULL, m_pVMem);
1899
1900     m_dwEnvCount = 0;
1901     m_lppEnvList = NULL;
1902
1903     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1904     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1905     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1906     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1907     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1908     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1909     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1910     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1911     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1912
1913     SETUPEXCHANGE(ppMem,        m_pHostperlMem,         m_hostperlMem);
1914     SETUPEXCHANGE(ppMemShared,  m_pHostperlMemShared,   m_hostperlMemShared);
1915     SETUPEXCHANGE(ppMemParse,   m_pHostperlMemParse,    m_hostperlMemParse);
1916     SETUPEXCHANGE(ppEnv,        m_pHostperlEnv,         m_hostperlEnv);
1917     SETUPEXCHANGE(ppStdIO,      m_pHostperlStdIO,       m_hostperlStdIO);
1918     SETUPEXCHANGE(ppLIO,        m_pHostperlLIO,         m_hostperlLIO);
1919     SETUPEXCHANGE(ppDir,        m_pHostperlDir,         m_hostperlDir);
1920     SETUPEXCHANGE(ppSock,       m_pHostperlSock,        m_hostperlSock);
1921     SETUPEXCHANGE(ppProc,       m_pHostperlProc,        m_hostperlProc);
1922 }
1923 #undef SETUPEXCHANGE
1924
1925 CPerlHost::CPerlHost(CPerlHost& host)
1926 {
1927     m_pVMem = new VMem();
1928     m_pVMemShared = host.GetMemShared();
1929     m_pVMemParse =  host.GetMemParse();
1930
1931     /* duplicate directory info */
1932     m_pvDir = new VDir();
1933     m_pvDir->Init(host.GetDir(), m_pVMem);
1934
1935     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1936     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1937     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1938     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1939     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1940     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1941     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1942     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1943     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1944     m_pHostperlMem          = &host.m_hostperlMem;
1945     m_pHostperlMemShared    = &host.m_hostperlMemShared;
1946     m_pHostperlMemParse     = &host.m_hostperlMemParse;
1947     m_pHostperlEnv          = &host.m_hostperlEnv;
1948     m_pHostperlStdIO        = &host.m_hostperlStdIO;
1949     m_pHostperlLIO          = &host.m_hostperlLIO;
1950     m_pHostperlDir          = &host.m_hostperlDir;
1951     m_pHostperlSock         = &host.m_hostperlSock;
1952     m_pHostperlProc         = &host.m_hostperlProc;
1953
1954     m_dwEnvCount = 0;
1955     m_lppEnvList = NULL;
1956
1957     /* duplicate environment info */
1958     LPSTR lpPtr;
1959     DWORD dwIndex = 0;
1960     while(lpPtr = host.GetIndex(dwIndex))
1961         Add(lpPtr);
1962 }
1963
1964 CPerlHost::~CPerlHost(void)
1965 {
1966 //  Reset();
1967     delete m_pvDir;
1968     m_pVMemParse->Release();
1969     m_pVMemShared->Release();
1970     m_pVMem->Release();
1971 }
1972
1973 LPSTR
1974 CPerlHost::Find(LPCSTR lpStr)
1975 {
1976     LPSTR lpPtr;
1977     LPSTR* lppPtr = Lookup(lpStr);
1978     if(lppPtr != NULL) {
1979         for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
1980             ;
1981
1982         if(*lpPtr == '=')
1983             ++lpPtr;
1984
1985         return lpPtr;
1986     }
1987     return NULL;
1988 }
1989
1990 int
1991 lookup(const void *arg1, const void *arg2)
1992 {   // Compare strings
1993     char*ptr1, *ptr2;
1994     char c1,c2;
1995
1996     ptr1 = *(char**)arg1;
1997     ptr2 = *(char**)arg2;
1998     for(;;) {
1999         c1 = *ptr1++;
2000         c2 = *ptr2++;
2001         if(c1 == '\0' || c1 == '=') {
2002             if(c2 == '\0' || c2 == '=')
2003                 break;
2004
2005             return -1; // string 1 < string 2
2006         }
2007         else if(c2 == '\0' || c2 == '=')
2008             return 1; // string 1 > string 2
2009         else if(c1 != c2) {
2010             c1 = toupper(c1);
2011             c2 = toupper(c2);
2012             if(c1 != c2) {
2013                 if(c1 < c2)
2014                     return -1; // string 1 < string 2
2015
2016                 return 1; // string 1 > string 2
2017             }
2018         }
2019     }
2020     return 0;
2021 }
2022
2023 LPSTR*
2024 CPerlHost::Lookup(LPCSTR lpStr)
2025 {
2026     return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2027 }
2028
2029 int
2030 compare(const void *arg1, const void *arg2)
2031 {   // Compare strings
2032     char*ptr1, *ptr2;
2033     char c1,c2;
2034
2035     ptr1 = *(char**)arg1;
2036     ptr2 = *(char**)arg2;
2037     for(;;) {
2038         c1 = *ptr1++;
2039         c2 = *ptr2++;
2040         if(c1 == '\0' || c1 == '=') {
2041             if(c1 == c2)
2042                 break;
2043
2044             return -1; // string 1 < string 2
2045         }
2046         else if(c2 == '\0' || c2 == '=')
2047             return 1; // string 1 > string 2
2048         else if(c1 != c2) {
2049             c1 = toupper(c1);
2050             c2 = toupper(c2);
2051             if(c1 != c2) {
2052                 if(c1 < c2)
2053                     return -1; // string 1 < string 2
2054
2055                 return 1; // string 1 > string 2
2056             }
2057         }
2058     }
2059     return 0;
2060 }
2061
2062 void
2063 CPerlHost::Add(LPCSTR lpStr)
2064 {
2065     dTHXo;
2066     char szBuffer[1024];
2067     LPSTR *lpPtr;
2068     int index, length = strlen(lpStr)+1;
2069
2070     for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2071         szBuffer[index] = lpStr[index];
2072
2073     szBuffer[index] = '\0';
2074
2075     // replacing ?
2076     lpPtr = Lookup(szBuffer);
2077     if(lpPtr != NULL) {
2078         Renew(*lpPtr, length, char);
2079         strcpy(*lpPtr, lpStr);
2080     }
2081     else {
2082         ++m_dwEnvCount;
2083         Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2084         New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2085         if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2086             strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2087             qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2088         }
2089         else
2090             --m_dwEnvCount;
2091     }
2092 }
2093
2094 DWORD
2095 CPerlHost::CalculateEnvironmentSpace(void)
2096 {
2097     DWORD index;
2098     DWORD dwSize = 0;
2099     for(index = 0; index < m_dwEnvCount; ++index)
2100         dwSize += strlen(m_lppEnvList[index]) + 1;
2101
2102     return dwSize;
2103 }
2104
2105 void
2106 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2107 {
2108     dTHXo;
2109     Safefree(lpStr);
2110 }
2111
2112 char*
2113 CPerlHost::GetChildDir(void)
2114 {
2115     dTHXo;
2116     int length;
2117     char* ptr;
2118     New(0, ptr, MAX_PATH+1, char);
2119     if(ptr) {
2120         m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2121         length = strlen(ptr)-1;
2122         if(length > 0) {
2123             if((ptr[length] == '\\') || (ptr[length] == '/'))
2124                 ptr[length] = 0;
2125         }
2126     }
2127     return ptr;
2128 }
2129
2130 void
2131 CPerlHost::FreeChildDir(char* pStr)
2132 {
2133     dTHXo;
2134     Safefree(pStr);
2135 }
2136
2137 LPSTR
2138 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2139 {
2140     dTHXo;
2141     LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2142     DWORD dwSize, dwEnvIndex;
2143     int nLength, compVal;
2144
2145     // get the process environment strings
2146     lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2147
2148     // step over current directory stuff
2149     while(*lpTmp == '=')
2150         lpTmp += strlen(lpTmp) + 1;
2151
2152     // save the start of the environment strings
2153     lpEnvPtr = lpTmp;
2154     for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2155         // calculate the size of the environment strings
2156         dwSize += strlen(lpTmp) + 1;
2157     }
2158
2159     // add the size of current directories
2160     dwSize += vDir.CalculateEnvironmentSpace();
2161
2162     // add the additional space used by changes made to the environment
2163     dwSize += CalculateEnvironmentSpace();
2164
2165     New(1, lpStr, dwSize, char);
2166     lpPtr = lpStr;
2167     if(lpStr != NULL) {
2168         // build the local environment
2169         lpStr = vDir.BuildEnvironmentSpace(lpStr);
2170
2171         dwEnvIndex = 0;
2172         lpLocalEnv = GetIndex(dwEnvIndex);
2173         while(*lpEnvPtr != '\0') {
2174             if(lpLocalEnv == NULL) {
2175                 // all environment overrides have been added
2176                 // so copy string into place
2177                 strcpy(lpStr, lpEnvPtr);
2178                 nLength = strlen(lpEnvPtr) + 1;
2179                 lpStr += nLength;
2180                 lpEnvPtr += nLength;
2181             }
2182             else {
2183                 // determine which string to copy next
2184                 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2185                 if(compVal < 0) {
2186                     strcpy(lpStr, lpEnvPtr);
2187                     nLength = strlen(lpEnvPtr) + 1;
2188                     lpStr += nLength;
2189                     lpEnvPtr += nLength;
2190                 }
2191                 else {
2192                     char *ptr = strchr(lpLocalEnv, '=');
2193                     if(ptr && ptr[1]) {
2194                         strcpy(lpStr, lpLocalEnv);
2195                         lpStr += strlen(lpLocalEnv) + 1;
2196                     }
2197                     lpLocalEnv = GetIndex(dwEnvIndex);
2198                     if(compVal == 0) {
2199                         // this string was replaced
2200                         lpEnvPtr += strlen(lpEnvPtr) + 1;
2201                     }
2202                 }
2203             }
2204         }
2205
2206         // add final NULL
2207         *lpStr = '\0';
2208     }
2209
2210     // release the process environment strings
2211     FreeEnvironmentStrings(lpAllocPtr);
2212
2213     return lpPtr;
2214 }
2215
2216 void
2217 CPerlHost::Reset(void)
2218 {
2219     dTHXo;
2220     if(m_lppEnvList != NULL) {
2221         for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2222             Safefree(m_lppEnvList[index]);
2223             m_lppEnvList[index] = NULL;
2224         }
2225     }
2226     m_dwEnvCount = 0;
2227 }
2228
2229 void
2230 CPerlHost::Clearenv(void)
2231 {
2232     char ch;
2233     LPSTR lpPtr, lpStr, lpEnvPtr;
2234     if(m_lppEnvList != NULL) {
2235         /* set every entry to an empty string */
2236         for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2237             char* ptr = strchr(m_lppEnvList[index], '=');
2238             if(ptr) {
2239                 *++ptr = 0;
2240             }
2241         }
2242     }
2243
2244     /* get the process environment strings */
2245     lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2246
2247     /* step over current directory stuff */
2248     while(*lpStr == '=')
2249         lpStr += strlen(lpStr) + 1;
2250
2251     while(*lpStr) {
2252         lpPtr = strchr(lpStr, '=');
2253         if(lpPtr) {
2254             ch = *++lpPtr;
2255             *lpPtr = 0;
2256             Add(lpStr);
2257             *lpPtr = ch;
2258         }
2259         lpStr += strlen(lpStr) + 1;
2260     }
2261
2262     FreeEnvironmentStrings(lpEnvPtr);
2263 }
2264
2265
2266 char*
2267 CPerlHost::Getenv(const char *varname)
2268 {
2269     char* pEnv = Find(varname);
2270     if(pEnv == NULL) {
2271         pEnv = win32_getenv(varname);
2272     }
2273     else {
2274         if(!*pEnv)
2275             pEnv = 0;
2276     }
2277
2278     return pEnv;
2279 }
2280
2281 int
2282 CPerlHost::Putenv(const char *envstring)
2283 {
2284     Add(envstring);
2285     return 0;
2286 }
2287
2288 int
2289 CPerlHost::Chdir(const char *dirname)
2290 {
2291     dTHXo;
2292     int ret;
2293     if (USING_WIDE()) {
2294         WCHAR wBuffer[MAX_PATH];
2295         A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2296         ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2297     }
2298     else
2299         ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2300     if(ret < 0) {
2301         errno = ENOENT;
2302     }
2303     return ret;
2304 }
2305
2306 #endif /* ___PerlHost_H___ */