Commit | Line | Data |
760ac839 |
1 | #include "EXTERN.h" |
2 | #include "perl.h" |
3 | #include "XSUB.h" |
4 | |
5 | #include <process.h> |
7f61b687 |
6 | #define INCL_DOS |
7 | #define INCL_DOSERRORS |
8 | #include <os2.h> |
760ac839 |
9 | |
760ac839 |
10 | static unsigned long |
41cd3736 |
11 | constant(char *name, int arg) |
760ac839 |
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 |
7f61b687 |
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 |
760ac839 |
196 | } |
197 | |
198 | errno = EINVAL; |
199 | return 0; |
200 | |
201 | not_there: |
202 | errno = ENOENT; |
203 | return 0; |
204 | } |
205 | |
7f61b687 |
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 |
760ac839 |
338 | |
339 | MODULE = OS2::Process PACKAGE = OS2::Process |
340 | |
341 | |
342 | unsigned long |
343 | constant(name,arg) |
344 | char * name |
345 | int arg |
346 | |
7f61b687 |
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 |