os2/OS2/Process/Process.xs

   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