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