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