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