Update os2's OS2::Process

	Message-Id: <199807112221.SAA03221@monk.mps.ohio-state.edu>

p4raw-id: //depot/perl@1441

3 files changed, 419 insertions, 3 deletions

diff --git a/os2/OS2/Process/Makefile.PL b/os2/OS2/Process/Makefile.PL
index b7a295f857..d324063164 100644
--- a/os2/OS2/Process/Makefile.PL
+++ b/os2/OS2/Process/Makefile.PL
@@ -3,9 +3,12 @@ use ExtUtils::MakeMaker;
 # 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',
+		   },
 );
diff --git a/os2/OS2/Process/Process.pm b/os2/OS2/Process/Process.pm
index 9216bb1e05..88de2bfad5 100644
--- a/os2/OS2/Process/Process.pm
+++ b/os2/OS2/Process/Process.pm
@@ -1,8 +1,10 @@
 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
@@ -28,6 +30,22 @@ require AutoLoader;
 	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()
@@ -56,6 +74,8 @@ bootstrap OS2::Process;
 
 # Preloaded methods go here.
 
+sub get_title () { (process_entry())[0] }
+
 # Autoload methods go after __END__, and are processed by the autosplit program.
 
 1;
@@ -101,9 +121,170 @@ and optionally add PM and session option bits:
 	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
 
diff --git a/os2/OS2/Process/Process.xs b/os2/OS2/Process/Process.xs
index bdb2ece7a0..c16d15d0d0 100644
--- a/os2/OS2/Process/Process.xs
+++ b/os2/OS2/Process/Process.xs
@@ -3,6 +3,9 @@
 #include "XSUB.h"
 
 #include <process.h>
+#define INCL_DOS
+#define INCL_DOSERRORS
+#include <os2.h>
 
 static int
 not_here(s)
@@ -133,6 +136,73 @@ int arg;
 #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;
@@ -143,6 +213,138 @@ not_there:
     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
 
@@ -152,3 +354,33 @@ constant(name,arg)
 	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