# the contents of the Makefile that is written.
WriteMakefile(
'NAME' => 'OS2::Process',
- 'VERSION' => '0.1',
+ VERSION_FROM=> 'Process.pm',
MAN3PODS => ' ', # Pods will be built by installman.
'LIBS' => [''], # e.g., '-lm'
'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
'INC' => '', # e.g., '-I/usr/include/other'
+ IMPORTS => { _16_DosSmSetTitle => 'sesmgr.DOSSMSETTITLE',
+ # _16_Win16SetTitle => 'pmshapi.93',
+ },
);
package OS2::Process;
+$VERSION = 0.2;
+
require Exporter;
require DynaLoader;
-require AutoLoader;
+#require AutoLoader;
@ISA = qw(Exporter DynaLoader);
# Items to export into callers namespace by default. Note: do not export
P_UNRELATED
P_WAIT
P_WINDOWED
+ my_type
+ file_type
+ T_NOTSPEC
+ T_NOTWINDOWCOMPAT
+ T_WINDOWCOMPAT
+ T_WINDOWAPI
+ T_BOUND
+ T_DLL
+ T_DOS
+ T_PHYSDRV
+ T_VIRTDRV
+ T_PROTDLL
+ T_32BIT
+ process_entry
+ set_title
+ get_title
);
sub AUTOLOAD {
# This AUTOLOAD is used to 'autoload' constants from the constant()
# Preloaded methods go here.
+sub get_title () { (process_entry())[0] }
+
# Autoload methods go after __END__, and are processed by the autosplit program.
1;
P_TILDE = MKS argument passing convention
P_UNRELATED = do not kill child when father terminates
+=head2 Access to process properties
+
+Additionaly, subroutines my_type(), process_entry() and
+C<file_type(file)>, get_title() and C<set_title(newtitle)> are implemented.
+my_type() returns the type of the current process (one of
+"FS", "DOS", "VIO", "PM", "DETACH" and "UNKNOWN"), or C<undef> on error.
+
+=over
+
+=item C<file_type(file)>
+
+returns the type of the executable file C<file>, or
+dies on error. The bits 0-2 of the result contain one of the values
+
+=over
+
+=item C<T_NOTSPEC> (0)
+
+Application type is not specified in the executable header.
+
+=item C<T_NOTWINDOWCOMPAT> (1)
+
+Application type is not-window-compatible.
+
+=item C<T_WINDOWCOMPAT> (2)
+
+Application type is window-compatible.
+
+=item C<T_WINDOWAPI> (3)
+
+Application type is window-API.
+
+=back
+
+The remaining bits should be masked with the following values to
+determine the type of the executable:
+
+=over
+
+=item C<T_BOUND> (8)
+
+Set to 1 if the executable file has been "bound" (by the BIND command)
+as a Family API application. Bits 0, 1, and 2 still apply.
+
+=item C<T_DLL> (0x10)
+
+Set to 1 if the executable file is a dynamic link library (DLL)
+module. Bits 0, 1, 2, 3, and 5 will be set to 0.
+
+=item C<T_DOS> (0x20)
+
+Set to 1 if the executable file is in PC/DOS format. Bits 0, 1, 2, 3,
+and 4 will be set to 0.
+
+=item C<T_PHYSDRV> (0x40)
+
+Set to 1 if the executable file is a physical device driver.
+
+=item C<T_VIRTDRV> (0x80)
+
+Set to 1 if the executable file is a virtual device driver.
+
+=item C<T_PROTDLL> (0x100)
+
+Set to 1 if the executable file is a protected-memory dynamic link
+library module.
+
+=item C<T_32BIT> (0x4000)
+
+Set to 1 for 32-bit executable files.
+
+=back
+
+file_type() may croak with one of the strings C<"Invalid EXE
+signature"> or C<"EXE marked invalid"> to indicate typical error
+conditions. If given non-absolute path, will look on C<PATH>, will
+add extention F<.exe> if no extension is present (add extension F<.>
+to suppress).
+
+=item process_entry()
+
+returns a list of the following data:
+
+=over
+
+=item
+
+Title of the process (in the C<Ctrl-Esc> list);
+
+=item
+
+window handle of switch entry of the process (in the C<Ctrl-Esc> list);
+
+=item
+
+window handle of the icon of the process;
+
+=item
+
+process handle of the owner of the entry in C<Ctrl-Esc> list;
+
+=item
+
+process id of the owner of the entry in C<Ctrl-Esc> list;
+
+=item
+
+session id of the owner of the entry in C<Ctrl-Esc> list;
+
+=item
+
+whether visible in C<Ctrl-Esc> list;
+
+=item
+
+whether item cannot be switched to (note that it is not actually
+grayed in the C<Ctrl-Esc> list));
+
+=item
+
+whether participates in jump sequence;
+
+=item
+
+program type. Possible values are:
+
+ PROG_DEFAULT 0
+ PROG_FULLSCREEN 1
+ PROG_WINDOWABLEVIO 2
+ PROG_PM 3
+ PROG_VDM 4
+ PROG_WINDOWEDVDM 7
+
+Although there are several other program types for WIN-OS/2 programs,
+these do not show up in this field. Instead, the PROG_VDM or
+PROG_WINDOWEDVDM program types are used. For instance, for
+PROG_31_STDSEAMLESSVDM, PROG_WINDOWEDVDM is used. This is because all
+the WIN-OS/2 programs run in DOS sessions. For example, if a program
+is a windowed WIN-OS/2 program, it runs in a PROG_WINDOWEDVDM
+session. Likewise, if it's a full-screen WIN-OS/2 program, it runs in
+a PROG_VDM session.
+
+
+=back
+
+=item C<set_title(newtitle)>
+
+- does not work with some windows (if the title is set from the start).
+This is a limitation of OS/2, in such a case $^E is set to 372 (type
+
+ help 372
+
+for a funny - and wrong - explanation ;-).
+
+=item get_title()
+
+is a shortcut implemented via process_entry().
+
+=back
+
=head1 AUTHOR
-Andreas Kaiser <ak@ananke.s.bawue.de>.
+Andreas Kaiser <ak@ananke.s.bawue.de>,
+Ilya Zakharevich <ilya@math.ohio-state.edu>.
=head1 SEE ALSO
#include "XSUB.h"
#include <process.h>
+#define INCL_DOS
+#define INCL_DOSERRORS
+#include <os2.h>
static int
not_here(s)
#else
goto not_there;
#endif
+ } else if (name[0] == 'T' && name[1] == '_') {
+ if (strEQ(name, "FAPPTYP_NOTSPEC"))
+#ifdef FAPPTYP_NOTSPEC
+ return FAPPTYP_NOTSPEC;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_NOTWINDOWCOMPAT"))
+#ifdef FAPPTYP_NOTWINDOWCOMPAT
+ return FAPPTYP_NOTWINDOWCOMPAT;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_WINDOWCOMPAT"))
+#ifdef FAPPTYP_WINDOWCOMPAT
+ return FAPPTYP_WINDOWCOMPAT;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_WINDOWAPI"))
+#ifdef FAPPTYP_WINDOWAPI
+ return FAPPTYP_WINDOWAPI;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_BOUND"))
+#ifdef FAPPTYP_BOUND
+ return FAPPTYP_BOUND;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_DLL"))
+#ifdef FAPPTYP_DLL
+ return FAPPTYP_DLL;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_DOS"))
+#ifdef FAPPTYP_DOS
+ return FAPPTYP_DOS;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_PHYSDRV"))
+#ifdef FAPPTYP_PHYSDRV
+ return FAPPTYP_PHYSDRV;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_VIRTDRV"))
+#ifdef FAPPTYP_VIRTDRV
+ return FAPPTYP_VIRTDRV;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_PROTDLL"))
+#ifdef FAPPTYP_PROTDLL
+ return FAPPTYP_PROTDLL;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "T_32BIT"))
+#ifdef FAPPTYP_32BIT
+ return FAPPTYP_32BIT;
+#else
+ goto not_there;
+#endif
}
errno = EINVAL;
return 0;
}
+const char* const ptypes[] = { "FS", "DOS", "VIO", "PM", "DETACH" };
+
+static char *
+my_type()
+{
+ int rc;
+ TIB *tib;
+ PIB *pib;
+
+ if (!(_emx_env & 0x200)) return (char*)ptypes[1]; /* not OS/2. */
+ if (CheckOSError(DosGetInfoBlocks(&tib, &pib)))
+ return NULL;
+
+ return (pib->pib_ultype <= 4 ? (char*)ptypes[pib->pib_ultype] : "UNKNOWN");
+}
+
+static ULONG
+file_type(char *path)
+{
+ int rc;
+ ULONG apptype;
+
+ if (!(_emx_env & 0x200))
+ croak("file_type not implemented on DOS"); /* not OS/2. */
+ if (CheckOSError(DosQueryAppType(path, &apptype))) {
+ if (rc == ERROR_INVALID_EXE_SIGNATURE)
+ croak("Invalid EXE signature");
+ else if (rc == ERROR_EXE_MARKED_INVALID) {
+ croak("EXE marked invalid");
+ }
+ croak("DosQueryAppType err %ld", rc);
+ }
+
+ return apptype;
+}
+
+static void
+fill_swcntrl(SWCNTRL *swcntrlp)
+{
+ int rc;
+ PTIB ptib;
+ PPIB ppib;
+ HSWITCH hSwitch;
+ HWND hwndMe;
+
+ if (!(_emx_env & 0x200))
+ croak("switch_entry not implemented on DOS"); /* not OS/2. */
+ if (CheckOSError(DosGetInfoBlocks(&ptib, &ppib)))
+ croak("DosGetInfoBlocks err %ld", rc);
+ if (CheckWinError(hSwitch =
+ WinQuerySwitchHandle(NULLHANDLE,
+ (PID)ppib->pib_ulpid)))
+ croak("WinQuerySwitchHandle err %ld", Perl_rc);
+ if (CheckOSError(WinQuerySwitchEntry(hSwitch, swcntrlp)))
+ croak("WinQuerySwitchEntry err %ld", rc);
+}
+
+/* static ULONG (* APIENTRY16 pDosSmSetTitle)(ULONG, PSZ); */
+ULONG _THUNK_FUNCTION(DosSmSetTitle)(ULONG, PSZ);
+
+#if 0 /* Does not work. */
+static ULONG (*pDosSmSetTitle)(ULONG, PSZ);
+
+static void
+set_title(char *s)
+{
+ SWCNTRL swcntrl;
+ static HMODULE hdosc = 0;
+ BYTE buf[20];
+ long rc;
+
+ fill_swcntrl(&swcntrl);
+ if (!pDosSmSetTitle || !hdosc) {
+ if (CheckOSError(DosLoadModule(buf, sizeof buf, "sesmgr", &hdosc)))
+ croak("Cannot load SESMGR: no `%s'", buf);
+ if (CheckOSError(DosQueryProcAddr(hdosc, 0, "DOSSMSETTITLE",
+ (PFN*)&pDosSmSetTitle)))
+ croak("Cannot load SESMGR.DOSSMSETTITLE, err=%ld", rc);
+ }
+/* (pDosSmSetTitle)(swcntrl.idSession,s); */
+ rc = ((USHORT)
+ (_THUNK_PROLOG (2+4);
+ _THUNK_SHORT (swcntrl.idSession);
+ _THUNK_FLAT (s);
+ _THUNK_CALLI (*pDosSmSetTitle)));
+ if (CheckOSError(rc))
+ warn("*DOSSMSETTITLE: err=%ld, ses=%ld, addr=%x, *paddr=%x",
+ rc, swcntrl.idSession, &_THUNK_FUNCTION(DosSmSetTitle),
+ pDosSmSetTitle);
+}
+
+#else /* !0 */
+
+static bool
+set_title(char *s)
+{
+ SWCNTRL swcntrl;
+ static HMODULE hdosc = 0;
+ BYTE buf[20];
+ long rc;
+
+ fill_swcntrl(&swcntrl);
+ rc = ((USHORT)
+ (_THUNK_PROLOG (2+4);
+ _THUNK_SHORT (swcntrl.idSession);
+ _THUNK_FLAT (s);
+ _THUNK_CALL (DosSmSetTitle)));
+#if 0
+ if (CheckOSError(rc))
+ warn("DOSSMSETTITLE: err=%ld, ses=%ld, addr=%x",
+ rc, swcntrl.idSession, _THUNK_FUNCTION(DosSmSetTitle));
+#endif
+ return !CheckOSError(rc);
+}
+#endif /* !0 */
+
+#if 0 /* Does not work. */
+USHORT _THUNK_FUNCTION(Win16SetTitle) ();
+
+static void
+set_title2(char *s)
+{
+ long rc;
+
+ rc = ((USHORT)
+ (_THUNK_PROLOG (4);
+ _THUNK_FLAT (s);
+ _THUNK_CALL (Win16SetTitle)));
+ if (CheckWinError(rc))
+ warn("Win16SetTitle: err=%ld", rc);
+}
+#endif
MODULE = OS2::Process PACKAGE = OS2::Process
char * name
int arg
+char *
+my_type()
+
+U32
+file_type(path)
+ char *path
+
+U32
+process_entry()
+ PPCODE:
+ {
+ SWCNTRL swcntrl;
+
+ fill_swcntrl(&swcntrl);
+ EXTEND(sp,9);
+ PUSHs(sv_2mortal(newSVpv(swcntrl.szSwtitle, 0)));
+ PUSHs(sv_2mortal(newSVnv(swcntrl.hwnd)));
+ PUSHs(sv_2mortal(newSVnv(swcntrl.hwndIcon)));
+ PUSHs(sv_2mortal(newSViv(swcntrl.hprog)));
+ PUSHs(sv_2mortal(newSViv(swcntrl.idProcess)));
+ PUSHs(sv_2mortal(newSViv(swcntrl.idSession)));
+ PUSHs(sv_2mortal(newSViv(swcntrl.uchVisibility != SWL_INVISIBLE)));
+ PUSHs(sv_2mortal(newSViv(swcntrl.uchVisibility == SWL_GRAYED)));
+ PUSHs(sv_2mortal(newSViv(swcntrl.fbJump == SWL_JUMPABLE)));
+ PUSHs(sv_2mortal(newSViv(swcntrl.bProgType)));
+ }
+
+bool
+set_title(s)
+ char *s
STRLEN maxlen;
char *max = SvPV((SV*)av, maxlen);
if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
- sv_setsv(*cx->blk_loop.itervar, cur);
+ /* we need a fresh SV every time so that loop body sees a
+ * completely new SV for closures/references to work as they
+ * used to */
+ SvREFCNT_dec(*cx->blk_loop.itervar);
+ *cx->blk_loop.itervar = newSVsv(cur);
if (strEQ(SvPVX(cur), max))
sv_setiv(cur, 0); /* terminate next time */
else
/* integer increment */
if (cx->blk_loop.iterix > cx->blk_loop.itermax)
RETPUSHNO;
- sv_setiv(*cx->blk_loop.itervar, cx->blk_loop.iterix++);
+
+ /* we need a fresh SV every time so that loop body sees a
+ * completely new SV for closures/references to work as they
+ * used to */
+ SvREFCNT_dec(*cx->blk_loop.itervar);
+ *cx->blk_loop.itervar = newSViv(cx->blk_loop.iterix++);
RETPUSHYES;
}
projects / p5sagit/p5-mst-13.2.git / commitdiff