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