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 THREAD_RET_TYPE
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(*(CPerlHost*)w32_internal_host);
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     new_perl->Isys_intern.internal_host = h;
1739 #  ifdef PERL_SYNC_FORK
1740     id = win32_start_child((LPVOID)new_perl);
1741     PERL_SET_INTERP(aTHXo);
1742 #  else
1743 #    ifdef USE_RTL_THREAD_API
1744     handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1745                                     (void*)new_perl, 0, (unsigned*)&id);
1746 #    else
1747     handle = CreateThread(NULL, 0, win32_start_child,
1748                           (LPVOID)new_perl, 0, &id);
1749 #    endif
1750     PERL_SET_INTERP(aTHXo);     /* XXX perl_clone*() set TLS */
1751     if (!handle)
1752         Perl_croak(aTHX_ "panic: pseudo fork() failed");
1753     w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1754     w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1755     ++w32_num_pseudo_children;
1756 #  endif
1757     return -(int)id;
1758 #else
1759     Perl_croak(aTHX_ "fork() not implemented!\n");
1760     return -1;
1761 #endif /* USE_ITHREADS */
1762 }
1763
1764 int
1765 PerlProcGetpid(struct IPerlProc* piPerl)
1766 {
1767     return win32_getpid();
1768 }
1769
1770 void*
1771 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1772 {
1773     return win32_dynaload(filename);
1774 }
1775
1776 void
1777 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1778 {
1779     win32_str_os_error(sv, dwErr);
1780 }
1781
1782 BOOL
1783 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1784 {
1785     do_spawn2(cmd, EXECF_EXEC);
1786     return FALSE;
1787 }
1788
1789 int
1790 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1791 {
1792     return do_spawn2(cmds, EXECF_SPAWN);
1793 }
1794
1795 int
1796 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1797 {
1798     return win32_spawnvp(mode, cmdname, argv);
1799 }
1800
1801 int
1802 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1803 {
1804     return do_aspawn(vreally, vmark, vsp);
1805 }
1806
1807 struct IPerlProc perlProc =
1808 {
1809     PerlProcAbort,
1810     PerlProcCrypt,
1811     PerlProcExit,
1812     PerlProc_Exit,
1813     PerlProcExecl,
1814     PerlProcExecv,
1815     PerlProcExecvp,
1816     PerlProcGetuid,
1817     PerlProcGeteuid,
1818     PerlProcGetgid,
1819     PerlProcGetegid,
1820     PerlProcGetlogin,
1821     PerlProcKill,
1822     PerlProcKillpg,
1823     PerlProcPauseProc,
1824     PerlProcPopen,
1825     PerlProcPclose,
1826     PerlProcPipe,
1827     PerlProcSetuid,
1828     PerlProcSetgid,
1829     PerlProcSleep,
1830     PerlProcTimes,
1831     PerlProcWait,
1832     PerlProcWaitpid,
1833     PerlProcSignal,
1834     PerlProcFork,
1835     PerlProcGetpid,
1836     PerlProcDynaLoader,
1837     PerlProcGetOSError,
1838     PerlProcDoCmd,
1839     PerlProcSpawn,
1840     PerlProcSpawnvp,
1841     PerlProcASpawn,
1842 };
1843
1844
1845 /*
1846  * CPerlHost
1847  */
1848
1849 CPerlHost::CPerlHost(void)
1850 {
1851     m_pvDir = new VDir();
1852     m_pVMem = new VMem();
1853     m_pVMemShared = new VMem();
1854     m_pVMemParse =  new VMem();
1855
1856     m_pvDir->Init(NULL, m_pVMem);
1857
1858     m_dwEnvCount = 0;
1859     m_lppEnvList = NULL;
1860
1861     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1862     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1863     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1864     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1865     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1866     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1867     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1868     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1869     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1870
1871     m_pHostperlMem          = &m_hostperlMem;
1872     m_pHostperlMemShared    = &m_hostperlMemShared;
1873     m_pHostperlMemParse     = &m_hostperlMemParse;
1874     m_pHostperlEnv          = &m_hostperlEnv;
1875     m_pHostperlStdIO        = &m_hostperlStdIO;
1876     m_pHostperlLIO          = &m_hostperlLIO;
1877     m_pHostperlDir          = &m_hostperlDir;
1878     m_pHostperlSock         = &m_hostperlSock;
1879     m_pHostperlProc         = &m_hostperlProc;
1880 }
1881
1882 #define SETUPEXCHANGE(xptr, iptr, table) \
1883     STMT_START {                                \
1884         if (xptr) {                             \
1885             iptr = *xptr;                       \
1886             *xptr = &table;                     \
1887         }                                       \
1888         else {                                  \
1889             iptr = &table;                      \
1890         }                                       \
1891     } STMT_END
1892
1893 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1894                  struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1895                  struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1896                  struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1897                  struct IPerlProc** ppProc)
1898 {
1899     m_pvDir = new VDir(0);
1900     m_pVMem = new VMem();
1901     m_pVMemShared = new VMem();
1902     m_pVMemParse =  new VMem();
1903
1904     m_pvDir->Init(NULL, m_pVMem);
1905
1906     m_dwEnvCount = 0;
1907     m_lppEnvList = NULL;
1908
1909     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1910     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1911     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1912     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1913     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1914     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1915     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1916     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1917     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1918
1919     SETUPEXCHANGE(ppMem,        m_pHostperlMem,         m_hostperlMem);
1920     SETUPEXCHANGE(ppMemShared,  m_pHostperlMemShared,   m_hostperlMemShared);
1921     SETUPEXCHANGE(ppMemParse,   m_pHostperlMemParse,    m_hostperlMemParse);
1922     SETUPEXCHANGE(ppEnv,        m_pHostperlEnv,         m_hostperlEnv);
1923     SETUPEXCHANGE(ppStdIO,      m_pHostperlStdIO,       m_hostperlStdIO);
1924     SETUPEXCHANGE(ppLIO,        m_pHostperlLIO,         m_hostperlLIO);
1925     SETUPEXCHANGE(ppDir,        m_pHostperlDir,         m_hostperlDir);
1926     SETUPEXCHANGE(ppSock,       m_pHostperlSock,        m_hostperlSock);
1927     SETUPEXCHANGE(ppProc,       m_pHostperlProc,        m_hostperlProc);
1928 }
1929 #undef SETUPEXCHANGE
1930
1931 CPerlHost::CPerlHost(CPerlHost& host)
1932 {
1933     m_pVMem = new VMem();
1934     m_pVMemShared = host.GetMemShared();
1935     m_pVMemParse =  host.GetMemParse();
1936
1937     /* duplicate directory info */
1938     m_pvDir = new VDir(0);
1939     m_pvDir->Init(host.GetDir(), m_pVMem);
1940
1941     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1942     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1943     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1944     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1945     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1946     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1947     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1948     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1949     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1950     m_pHostperlMem          = &m_hostperlMem;
1951     m_pHostperlMemShared    = &m_hostperlMemShared;
1952     m_pHostperlMemParse     = &m_hostperlMemParse;
1953     m_pHostperlEnv          = &m_hostperlEnv;
1954     m_pHostperlStdIO        = &m_hostperlStdIO;
1955     m_pHostperlLIO          = &m_hostperlLIO;
1956     m_pHostperlDir          = &m_hostperlDir;
1957     m_pHostperlSock         = &m_hostperlSock;
1958     m_pHostperlProc         = &m_hostperlProc;
1959
1960     m_dwEnvCount = 0;
1961     m_lppEnvList = NULL;
1962
1963     /* duplicate environment info */
1964     LPSTR lpPtr;
1965     DWORD dwIndex = 0;
1966     while(lpPtr = host.GetIndex(dwIndex))
1967         Add(lpPtr);
1968 }
1969
1970 CPerlHost::~CPerlHost(void)
1971 {
1972 //  Reset();
1973     delete m_pvDir;
1974     m_pVMemParse->Release();
1975     m_pVMemShared->Release();
1976     m_pVMem->Release();
1977 }
1978
1979 LPSTR
1980 CPerlHost::Find(LPCSTR lpStr)
1981 {
1982     LPSTR lpPtr;
1983     LPSTR* lppPtr = Lookup(lpStr);
1984     if(lppPtr != NULL) {
1985         for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
1986             ;
1987
1988         if(*lpPtr == '=')
1989             ++lpPtr;
1990
1991         return lpPtr;
1992     }
1993     return NULL;
1994 }
1995
1996 int
1997 lookup(const void *arg1, const void *arg2)
1998 {   // Compare strings
1999     char*ptr1, *ptr2;
2000     char c1,c2;
2001
2002     ptr1 = *(char**)arg1;
2003     ptr2 = *(char**)arg2;
2004     for(;;) {
2005         c1 = *ptr1++;
2006         c2 = *ptr2++;
2007         if(c1 == '\0' || c1 == '=') {
2008             if(c2 == '\0' || c2 == '=')
2009                 break;
2010
2011             return -1; // string 1 < string 2
2012         }
2013         else if(c2 == '\0' || c2 == '=')
2014             return 1; // string 1 > string 2
2015         else if(c1 != c2) {
2016             c1 = toupper(c1);
2017             c2 = toupper(c2);
2018             if(c1 != c2) {
2019                 if(c1 < c2)
2020                     return -1; // string 1 < string 2
2021
2022                 return 1; // string 1 > string 2
2023             }
2024         }
2025     }
2026     return 0;
2027 }
2028
2029 LPSTR*
2030 CPerlHost::Lookup(LPCSTR lpStr)
2031 {
2032     return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2033 }
2034
2035 int
2036 compare(const void *arg1, const void *arg2)
2037 {   // Compare strings
2038     char*ptr1, *ptr2;
2039     char c1,c2;
2040
2041     ptr1 = *(char**)arg1;
2042     ptr2 = *(char**)arg2;
2043     for(;;) {
2044         c1 = *ptr1++;
2045         c2 = *ptr2++;
2046         if(c1 == '\0' || c1 == '=') {
2047             if(c1 == c2)
2048                 break;
2049
2050             return -1; // string 1 < string 2
2051         }
2052         else if(c2 == '\0' || c2 == '=')
2053             return 1; // string 1 > string 2
2054         else if(c1 != c2) {
2055             c1 = toupper(c1);
2056             c2 = toupper(c2);
2057             if(c1 != c2) {
2058                 if(c1 < c2)
2059                     return -1; // string 1 < string 2
2060
2061                 return 1; // string 1 > string 2
2062             }
2063         }
2064     }
2065     return 0;
2066 }
2067
2068 void
2069 CPerlHost::Add(LPCSTR lpStr)
2070 {
2071     dTHXo;
2072     char szBuffer[1024];
2073     LPSTR *lpPtr;
2074     int index, length = strlen(lpStr)+1;
2075
2076     for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2077         szBuffer[index] = lpStr[index];
2078
2079     szBuffer[index] = '\0';
2080
2081     // replacing ?
2082     lpPtr = Lookup(szBuffer);
2083     if(lpPtr != NULL) {
2084         Renew(*lpPtr, length, char);
2085         strcpy(*lpPtr, lpStr);
2086     }
2087     else {
2088         ++m_dwEnvCount;
2089         Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2090         New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2091         if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2092             strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2093             qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2094         }
2095         else
2096             --m_dwEnvCount;
2097     }
2098 }
2099
2100 DWORD
2101 CPerlHost::CalculateEnvironmentSpace(void)
2102 {
2103     DWORD index;
2104     DWORD dwSize = 0;
2105     for(index = 0; index < m_dwEnvCount; ++index)
2106         dwSize += strlen(m_lppEnvList[index]) + 1;
2107
2108     return dwSize;
2109 }
2110
2111 void
2112 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2113 {
2114     dTHXo;
2115     Safefree(lpStr);
2116 }
2117
2118 char*
2119 CPerlHost::GetChildDir(void)
2120 {
2121     dTHXo;
2122     int length;
2123     char* ptr;
2124     New(0, ptr, MAX_PATH+1, char);
2125     if(ptr) {
2126         m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2127         length = strlen(ptr)-1;
2128         if(length > 0) {
2129             if((ptr[length] == '\\') || (ptr[length] == '/'))
2130                 ptr[length] = 0;
2131         }
2132     }
2133     return ptr;
2134 }
2135
2136 void
2137 CPerlHost::FreeChildDir(char* pStr)
2138 {
2139     dTHXo;
2140     Safefree(pStr);
2141 }
2142
2143 LPSTR
2144 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2145 {
2146     dTHXo;
2147     LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2148     DWORD dwSize, dwEnvIndex;
2149     int nLength, compVal;
2150
2151     // get the process environment strings
2152     lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2153
2154     // step over current directory stuff
2155     while(*lpTmp == '=')
2156         lpTmp += strlen(lpTmp) + 1;
2157
2158     // save the start of the environment strings
2159     lpEnvPtr = lpTmp;
2160     for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2161         // calculate the size of the environment strings
2162         dwSize += strlen(lpTmp) + 1;
2163     }
2164
2165     // add the size of current directories
2166     dwSize += vDir.CalculateEnvironmentSpace();
2167
2168     // add the additional space used by changes made to the environment
2169     dwSize += CalculateEnvironmentSpace();
2170
2171     New(1, lpStr, dwSize, char);
2172     lpPtr = lpStr;
2173     if(lpStr != NULL) {
2174         // build the local environment
2175         lpStr = vDir.BuildEnvironmentSpace(lpStr);
2176
2177         dwEnvIndex = 0;
2178         lpLocalEnv = GetIndex(dwEnvIndex);
2179         while(*lpEnvPtr != '\0') {
2180             if(lpLocalEnv == NULL) {
2181                 // all environment overrides have been added
2182                 // so copy string into place
2183                 strcpy(lpStr, lpEnvPtr);
2184                 nLength = strlen(lpEnvPtr) + 1;
2185                 lpStr += nLength;
2186                 lpEnvPtr += nLength;
2187             }
2188             else {
2189                 // determine which string to copy next
2190                 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2191                 if(compVal < 0) {
2192                     strcpy(lpStr, lpEnvPtr);
2193                     nLength = strlen(lpEnvPtr) + 1;
2194                     lpStr += nLength;
2195                     lpEnvPtr += nLength;
2196                 }
2197                 else {
2198                     char *ptr = strchr(lpLocalEnv, '=');
2199                     if(ptr && ptr[1]) {
2200                         strcpy(lpStr, lpLocalEnv);
2201                         lpStr += strlen(lpLocalEnv) + 1;
2202                     }
2203                     lpLocalEnv = GetIndex(dwEnvIndex);
2204                     if(compVal == 0) {
2205                         // this string was replaced
2206                         lpEnvPtr += strlen(lpEnvPtr) + 1;
2207                     }
2208                 }
2209             }
2210         }
2211
2212         // add final NULL
2213         *lpStr = '\0';
2214     }
2215
2216     // release the process environment strings
2217     FreeEnvironmentStrings(lpAllocPtr);
2218
2219     return lpPtr;
2220 }
2221
2222 void
2223 CPerlHost::Reset(void)
2224 {
2225     dTHXo;
2226     if(m_lppEnvList != NULL) {
2227         for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2228             Safefree(m_lppEnvList[index]);
2229             m_lppEnvList[index] = NULL;
2230         }
2231     }
2232     m_dwEnvCount = 0;
2233 }
2234
2235 void
2236 CPerlHost::Clearenv(void)
2237 {
2238     char ch;
2239     LPSTR lpPtr, lpStr, lpEnvPtr;
2240     if(m_lppEnvList != NULL) {
2241         /* set every entry to an empty string */
2242         for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2243             char* ptr = strchr(m_lppEnvList[index], '=');
2244             if(ptr) {
2245                 *++ptr = 0;
2246             }
2247         }
2248     }
2249
2250     /* get the process environment strings */
2251     lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2252
2253     /* step over current directory stuff */
2254     while(*lpStr == '=')
2255         lpStr += strlen(lpStr) + 1;
2256
2257     while(*lpStr) {
2258         lpPtr = strchr(lpStr, '=');
2259         if(lpPtr) {
2260             ch = *++lpPtr;
2261             *lpPtr = 0;
2262             Add(lpStr);
2263             *lpPtr = ch;
2264         }
2265         lpStr += strlen(lpStr) + 1;
2266     }
2267
2268     FreeEnvironmentStrings(lpEnvPtr);
2269 }
2270
2271
2272 char*
2273 CPerlHost::Getenv(const char *varname)
2274 {
2275     char* pEnv = Find(varname);
2276     if(pEnv == NULL) {
2277         pEnv = win32_getenv(varname);
2278     }
2279     else {
2280         if(!*pEnv)
2281             pEnv = 0;
2282     }
2283
2284     return pEnv;
2285 }
2286
2287 int
2288 CPerlHost::Putenv(const char *envstring)
2289 {
2290     Add(envstring);
2291     return 0;
2292 }
2293
2294 int
2295 CPerlHost::Chdir(const char *dirname)
2296 {
2297     dTHXo;
2298     int ret;
2299     if (USING_WIDE()) {
2300         WCHAR wBuffer[MAX_PATH];
2301         A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2302         ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2303     }
2304     else
2305         ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2306     if(ret < 0) {
2307         errno = ENOENT;
2308     }
2309     return ret;
2310 }
2311
2312 #endif /* ___PerlHost_H___ */