home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / os2 / OS2 / Process / Process.xs < prev   
Text File  |  1999-07-20  |  8KB  |  377 lines
  1. #include "EXTERN.h"
  2. #include "perl.h"
  3. #include "XSUB.h"
  4.  
  5. #include <process.h>
  6. #define INCL_DOS
  7. #define INCL_DOSERRORS
  8. #include <os2.h>
  9.  
  10. static unsigned long
  11. constant(char *name, int arg)
  12. {
  13.     errno = 0;
  14.     if (name[0] == 'P' && name[1] == '_') {
  15.     if (strEQ(name, "P_BACKGROUND"))
  16. #ifdef P_BACKGROUND
  17.         return P_BACKGROUND;
  18. #else
  19.         goto not_there;
  20. #endif
  21.     if (strEQ(name, "P_DEBUG"))
  22. #ifdef P_DEBUG
  23.         return P_DEBUG;
  24. #else
  25.         goto not_there;
  26. #endif
  27.     if (strEQ(name, "P_DEFAULT"))
  28. #ifdef P_DEFAULT
  29.         return P_DEFAULT;
  30. #else
  31.         goto not_there;
  32. #endif
  33.     if (strEQ(name, "P_DETACH"))
  34. #ifdef P_DETACH
  35.         return P_DETACH;
  36. #else
  37.         goto not_there;
  38. #endif
  39.     if (strEQ(name, "P_FOREGROUND"))
  40. #ifdef P_FOREGROUND
  41.         return P_FOREGROUND;
  42. #else
  43.         goto not_there;
  44. #endif
  45.     if (strEQ(name, "P_FULLSCREEN"))
  46. #ifdef P_FULLSCREEN
  47.         return P_FULLSCREEN;
  48. #else
  49.         goto not_there;
  50. #endif
  51.     if (strEQ(name, "P_MAXIMIZE"))
  52. #ifdef P_MAXIMIZE
  53.         return P_MAXIMIZE;
  54. #else
  55.         goto not_there;
  56. #endif
  57.     if (strEQ(name, "P_MINIMIZE"))
  58. #ifdef P_MINIMIZE
  59.         return P_MINIMIZE;
  60. #else
  61.         goto not_there;
  62. #endif
  63.     if (strEQ(name, "P_NOCLOSE"))
  64. #ifdef P_NOCLOSE
  65.         return P_NOCLOSE;
  66. #else
  67.         goto not_there;
  68. #endif
  69.     if (strEQ(name, "P_NOSESSION"))
  70. #ifdef P_NOSESSION
  71.         return P_NOSESSION;
  72. #else
  73.         goto not_there;
  74. #endif
  75.     if (strEQ(name, "P_NOWAIT"))
  76. #ifdef P_NOWAIT
  77.         return P_NOWAIT;
  78. #else
  79.         goto not_there;
  80. #endif
  81.     if (strEQ(name, "P_OVERLAY"))
  82. #ifdef P_OVERLAY
  83.         return P_OVERLAY;
  84. #else
  85.         goto not_there;
  86. #endif
  87.     if (strEQ(name, "P_PM"))
  88. #ifdef P_PM
  89.         return P_PM;
  90. #else
  91.         goto not_there;
  92. #endif
  93.     if (strEQ(name, "P_QUOTE"))
  94. #ifdef P_QUOTE
  95.         return P_QUOTE;
  96. #else
  97.         goto not_there;
  98. #endif
  99.     if (strEQ(name, "P_SESSION"))
  100. #ifdef P_SESSION
  101.         return P_SESSION;
  102. #else
  103.         goto not_there;
  104. #endif
  105.     if (strEQ(name, "P_TILDE"))
  106. #ifdef P_TILDE
  107.         return P_TILDE;
  108. #else
  109.         goto not_there;
  110. #endif
  111.     if (strEQ(name, "P_UNRELATED"))
  112. #ifdef P_UNRELATED
  113.         return P_UNRELATED;
  114. #else
  115.         goto not_there;
  116. #endif
  117.     if (strEQ(name, "P_WAIT"))
  118. #ifdef P_WAIT
  119.         return P_WAIT;
  120. #else
  121.         goto not_there;
  122. #endif
  123.     if (strEQ(name, "P_WINDOWED"))
  124. #ifdef P_WINDOWED
  125.         return P_WINDOWED;
  126. #else
  127.         goto not_there;
  128. #endif
  129.     } else if (name[0] == 'T' && name[1] == '_') {
  130.     if (strEQ(name, "FAPPTYP_NOTSPEC"))
  131. #ifdef FAPPTYP_NOTSPEC
  132.         return FAPPTYP_NOTSPEC;
  133. #else
  134.         goto not_there;
  135. #endif
  136.     if (strEQ(name, "T_NOTWINDOWCOMPAT"))
  137. #ifdef FAPPTYP_NOTWINDOWCOMPAT
  138.         return FAPPTYP_NOTWINDOWCOMPAT;
  139. #else
  140.         goto not_there;
  141. #endif
  142.     if (strEQ(name, "T_WINDOWCOMPAT"))
  143. #ifdef FAPPTYP_WINDOWCOMPAT
  144.         return FAPPTYP_WINDOWCOMPAT;
  145. #else
  146.         goto not_there;
  147. #endif
  148.     if (strEQ(name, "T_WINDOWAPI"))
  149. #ifdef FAPPTYP_WINDOWAPI
  150.         return FAPPTYP_WINDOWAPI;
  151. #else
  152.         goto not_there;
  153. #endif
  154.     if (strEQ(name, "T_BOUND"))
  155. #ifdef FAPPTYP_BOUND
  156.         return FAPPTYP_BOUND;
  157. #else
  158.         goto not_there;
  159. #endif
  160.     if (strEQ(name, "T_DLL"))
  161. #ifdef FAPPTYP_DLL
  162.         return FAPPTYP_DLL;
  163. #else
  164.         goto not_there;
  165. #endif
  166.     if (strEQ(name, "T_DOS"))
  167. #ifdef FAPPTYP_DOS
  168.         return FAPPTYP_DOS;
  169. #else
  170.         goto not_there;
  171. #endif
  172.     if (strEQ(name, "T_PHYSDRV"))
  173. #ifdef FAPPTYP_PHYSDRV
  174.         return FAPPTYP_PHYSDRV;
  175. #else
  176.         goto not_there;
  177. #endif
  178.     if (strEQ(name, "T_VIRTDRV"))
  179. #ifdef FAPPTYP_VIRTDRV
  180.         return FAPPTYP_VIRTDRV;
  181. #else
  182.         goto not_there;
  183. #endif
  184.     if (strEQ(name, "T_PROTDLL"))
  185. #ifdef FAPPTYP_PROTDLL
  186.         return FAPPTYP_PROTDLL;
  187. #else
  188.         goto not_there;
  189. #endif
  190.     if (strEQ(name, "T_32BIT"))
  191. #ifdef FAPPTYP_32BIT
  192.         return FAPPTYP_32BIT;
  193. #else
  194.         goto not_there;
  195. #endif
  196.     }
  197.  
  198.     errno = EINVAL;
  199.     return 0;
  200.  
  201. not_there:
  202.     errno = ENOENT;
  203.     return 0;
  204. }
  205.  
  206. const char* const ptypes[] = { "FS", "DOS", "VIO", "PM", "DETACH" };
  207.  
  208. static char *
  209. my_type()
  210. {
  211.     int rc;
  212.     TIB *tib;
  213.     PIB *pib;
  214.     
  215.     if (!(_emx_env & 0x200)) return (char*)ptypes[1]; /* not OS/2. */
  216.     if (CheckOSError(DosGetInfoBlocks(&tib, &pib))) 
  217.     return NULL; 
  218.     
  219.     return (pib->pib_ultype <= 4 ? (char*)ptypes[pib->pib_ultype] : "UNKNOWN");
  220. }
  221.  
  222. static ULONG
  223. file_type(char *path)
  224. {
  225.     int rc;
  226.     ULONG apptype;
  227.     
  228.     if (!(_emx_env & 0x200)) 
  229.     croak("file_type not implemented on DOS"); /* not OS/2. */
  230.     if (CheckOSError(DosQueryAppType(path, &apptype))) {
  231.     if (rc == ERROR_INVALID_EXE_SIGNATURE) 
  232.         croak("Invalid EXE signature"); 
  233.     else if (rc == ERROR_EXE_MARKED_INVALID) {
  234.         croak("EXE marked invalid"); 
  235.     }
  236.     croak("DosQueryAppType err %ld", rc); 
  237.     }
  238.     
  239.     return apptype;
  240. }
  241.  
  242. static void
  243. fill_swcntrl(SWCNTRL *swcntrlp)
  244. {
  245.      int rc;
  246.      PTIB ptib;
  247.      PPIB ppib;
  248.      HSWITCH hSwitch;    
  249.      HWND hwndMe;
  250.  
  251.      if (!(_emx_env & 0x200)) 
  252.          croak("switch_entry not implemented on DOS"); /* not OS/2. */
  253.      if (CheckOSError(DosGetInfoBlocks(&ptib, &ppib)))
  254.          croak("DosGetInfoBlocks err %ld", rc);
  255.      if (CheckWinError(hSwitch = 
  256.                WinQuerySwitchHandle(NULLHANDLE, 
  257.                         (PID)ppib->pib_ulpid)))
  258.          croak("WinQuerySwitchHandle err %ld", Perl_rc);
  259.      if (CheckOSError(WinQuerySwitchEntry(hSwitch, swcntrlp)))
  260.          croak("WinQuerySwitchEntry err %ld", rc);
  261. }
  262.  
  263. /* static ULONG (* APIENTRY16 pDosSmSetTitle)(ULONG, PSZ); */
  264. ULONG _THUNK_FUNCTION(DosSmSetTitle)(ULONG, PSZ);
  265.  
  266. #if 0            /*  Does not work.  */
  267. static ULONG (*pDosSmSetTitle)(ULONG, PSZ);
  268.  
  269. static void
  270. set_title(char *s)
  271. {
  272.     SWCNTRL swcntrl;
  273.     static HMODULE hdosc = 0;
  274.     BYTE buf[20];
  275.     long rc;
  276.  
  277.     fill_swcntrl(&swcntrl);
  278.     if (!pDosSmSetTitle || !hdosc) {
  279.     if (CheckOSError(DosLoadModule(buf, sizeof buf, "sesmgr", &hdosc)))
  280.         croak("Cannot load SESMGR: no `%s'", buf);
  281.     if (CheckOSError(DosQueryProcAddr(hdosc, 0, "DOSSMSETTITLE",
  282.                       (PFN*)&pDosSmSetTitle)))
  283.         croak("Cannot load SESMGR.DOSSMSETTITLE, err=%ld", rc);
  284.     }
  285. /*     (pDosSmSetTitle)(swcntrl.idSession,s); */
  286.     rc = ((USHORT)
  287.           (_THUNK_PROLOG (2+4);
  288.            _THUNK_SHORT (swcntrl.idSession);
  289.            _THUNK_FLAT (s);
  290.            _THUNK_CALLI (*pDosSmSetTitle)));
  291.     if (CheckOSError(rc))
  292.     warn("*DOSSMSETTITLE: err=%ld, ses=%ld, addr=%x, *paddr=%x", 
  293.          rc, swcntrl.idSession, &_THUNK_FUNCTION(DosSmSetTitle),
  294.          pDosSmSetTitle);
  295. }
  296.  
  297. #else /* !0 */
  298.  
  299. static bool
  300. set_title(char *s)
  301. {
  302.     SWCNTRL swcntrl;
  303.     static HMODULE hdosc = 0;
  304.     BYTE buf[20];
  305.     long rc;
  306.  
  307.     fill_swcntrl(&swcntrl);
  308.     rc = ((USHORT)
  309.           (_THUNK_PROLOG (2+4);
  310.            _THUNK_SHORT (swcntrl.idSession);
  311.            _THUNK_FLAT (s);
  312.            _THUNK_CALL (DosSmSetTitle)));
  313. #if 0
  314.     if (CheckOSError(rc))
  315.     warn("DOSSMSETTITLE: err=%ld, ses=%ld, addr=%x", 
  316.          rc, swcntrl.idSession, _THUNK_FUNCTION(DosSmSetTitle));
  317. #endif
  318.     return !CheckOSError(rc);
  319. }
  320. #endif /* !0 */
  321.  
  322. #if 0            /*  Does not work.  */
  323. USHORT _THUNK_FUNCTION(Win16SetTitle) ();
  324.  
  325. static void
  326. set_title2(char *s)
  327. {
  328.     long rc;
  329.  
  330.     rc = ((USHORT)
  331.           (_THUNK_PROLOG (4);
  332.            _THUNK_FLAT (s);
  333.            _THUNK_CALL (Win16SetTitle)));
  334.     if (CheckWinError(rc))
  335.     warn("Win16SetTitle: err=%ld", rc);
  336. }
  337. #endif
  338.  
  339. MODULE = OS2::Process        PACKAGE = OS2::Process
  340.  
  341.  
  342. unsigned long
  343. constant(name,arg)
  344.     char *        name
  345.     int        arg
  346.  
  347. char *
  348. my_type()
  349.  
  350. U32
  351. file_type(path)
  352.     char *path
  353.  
  354. U32
  355. process_entry()
  356.     PPCODE:
  357.      {
  358.      SWCNTRL swcntrl;
  359.  
  360.      fill_swcntrl(&swcntrl);
  361.      EXTEND(sp,9);
  362.      PUSHs(sv_2mortal(newSVpv(swcntrl.szSwtitle, 0)));
  363.      PUSHs(sv_2mortal(newSVnv(swcntrl.hwnd)));
  364.      PUSHs(sv_2mortal(newSVnv(swcntrl.hwndIcon)));
  365.      PUSHs(sv_2mortal(newSViv(swcntrl.hprog)));
  366.      PUSHs(sv_2mortal(newSViv(swcntrl.idProcess)));
  367.      PUSHs(sv_2mortal(newSViv(swcntrl.idSession)));
  368.      PUSHs(sv_2mortal(newSViv(swcntrl.uchVisibility != SWL_INVISIBLE)));
  369.      PUSHs(sv_2mortal(newSViv(swcntrl.uchVisibility == SWL_GRAYED)));
  370.      PUSHs(sv_2mortal(newSViv(swcntrl.fbJump == SWL_JUMPABLE)));
  371.      PUSHs(sv_2mortal(newSViv(swcntrl.bProgType)));
  372.      }
  373.  
  374. bool
  375. set_title(s)
  376.     char *s
  377.