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