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 | |
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 |
7f61b687 |
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 |
760ac839 |
206 | } |
207 | |
208 | errno = EINVAL; |
209 | return 0; |
210 | |
211 | not_there: |
212 | errno = ENOENT; |
213 | return 0; |
214 | } |
215 | |
7f61b687 |
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 |
760ac839 |
348 | |
349 | MODULE = OS2::Process PACKAGE = OS2::Process |
350 | |
351 | |
352 | unsigned long |
353 | constant(name,arg) |
354 | char * name |
355 | int arg |
356 | |
7f61b687 |
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 |