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