win32/perlhost.h

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