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