summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--MANIFEST1
-rw-r--r--hints/os2.sh1
-rw-r--r--makedef.pl2
-rw-r--r--os2/OS2/PrfDB/PrfDB.xs48
-rw-r--r--os2/OS2/Process/Process.pm660
-rw-r--r--os2/OS2/Process/Process.xs794
-rw-r--r--os2/OS2/REXX/REXX.xs58
-rw-r--r--os2/dl_os2.c10
-rw-r--r--os2/dlfcn.h4
-rw-r--r--os2/os2.c269
-rw-r--r--os2/os2_base.t49
-rw-r--r--os2/os2ish.h85
12 files changed, 1752 insertions, 229 deletions
diff --git a/MANIFEST b/MANIFEST
index b9119d010e..0a9f2c3b28 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1544,6 +1544,7 @@ os2/dl_os2.c Addon for dl_open
os2/Makefile.SHs Shared library generation for OS/2
os2/os2.c Additional code for OS/2
os2/os2.sym Additional symbols to export
+os2/os2_base.t Additional tests for builtin methods
os2/OS2/ExtAttr/Changes EA access module
os2/OS2/ExtAttr/ExtAttr.pm EA access module
os2/OS2/ExtAttr/ExtAttr.xs EA access module
diff --git a/hints/os2.sh b/hints/os2.sh
index 9be6f006ec..126f6114dd 100644
--- a/hints/os2.sh
+++ b/hints/os2.sh
@@ -437,6 +437,7 @@ cp -rfu * ../../ext/OS2/
# Install tests:
+cp -uf ../*.t ../../t/lib
for xxx in * ; do
if $test -d $xxx/t; then
cp -uf $xxx/t/*.t ../../t/lib
diff --git a/makedef.pl b/makedef.pl
index 4fe193bb90..9c8a65e572 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -342,6 +342,8 @@ elsif ($PLATFORM eq 'os2') {
init_PMWIN_entries
PMWIN_entries
Perl_hab_GET
+ loadByOrdinal
+ pExtFCN
)]);
}
elsif ($PLATFORM eq 'MacOS') {
diff --git a/os2/OS2/PrfDB/PrfDB.xs b/os2/OS2/PrfDB/PrfDB.xs
index e747fcf377..bc4661a5d6 100644
--- a/os2/OS2/PrfDB/PrfDB.xs
+++ b/os2/OS2/PrfDB/PrfDB.xs
@@ -11,8 +11,30 @@ extern "C" {
}
#endif
-#define Prf_Open(pszFileName) SaveWinError(PrfOpenProfile(Perl_hab, (pszFileName)))
-#define Prf_Close(hini) (!CheckWinError(PrfCloseProfile(hini)))
+#define Prf_Open(pszFileName) SaveWinError(pPrfOpenProfile(Perl_hab, (pszFileName)))
+#define Prf_Close(hini) (!CheckWinError(pPrfCloseProfile(hini)))
+
+BOOL (*pPrfCloseProfile) (HINI hini);
+HINI (*pPrfOpenProfile) (HAB hab, PCSZ pszFileName);
+BOOL (*pPrfQueryProfile) (HAB hab, PPRFPROFILE pPrfProfile);
+BOOL (*pPrfQueryProfileData) (HINI hini, PCSZ pszApp, PCSZ pszKey, PVOID pBuffer,
+ PULONG pulBufferLength);
+/*
+LONG (*pPrfQueryProfileInt) (HINI hini, PCSZ pszApp, PCSZ pszKey, LONG sDefault);
+ */
+BOOL (*pPrfQueryProfileSize) (HINI hini, PCSZ pszApp, PCSZ pszKey,
+ PULONG pulReqLen);
+/*
+ULONG (*pPrfQueryProfileString) (HINI hini, PCSZ pszApp, PCSZ pszKey,
+ PCSZ pszDefault, PVOID pBuffer, ULONG ulBufferLength);
+ */
+BOOL (*pPrfReset) (HAB hab, __const__ PRFPROFILE *pPrfProfile);
+BOOL (*pPrfWriteProfileData) (HINI hini, PCSZ pszApp, PCSZ pszKey,
+ CPVOID pData, ULONG ulDataLength);
+/*
+BOOL (*pPrfWriteProfileString) (HINI hini, PCSZ pszApp, PCSZ pszKey,
+ PCSZ pszData);
+ */
SV *
Prf_Get(pTHX_ HINI hini, PSZ app, PSZ key) {
@@ -20,10 +42,10 @@ Prf_Get(pTHX_ HINI hini, PSZ app, PSZ key) {
BOOL rc;
SV *sv;
- if (CheckWinError(PrfQueryProfileSize(hini, app, key, &len))) return &PL_sv_undef;
+ if (CheckWinError(pPrfQueryProfileSize(hini, app, key, &len))) return &PL_sv_undef;
sv = newSVpv("", 0);
SvGROW(sv, len + 1);
- if (CheckWinError(PrfQueryProfileData(hini, app, key, SvPVX(sv), &len))
+ if (CheckWinError(pPrfQueryProfileData(hini, app, key, SvPVX(sv), &len))
|| (len == 0 && (app == NULL || key == NULL))) { /* Somewhy needed. */
SvREFCNT_dec(sv);
return &PL_sv_undef;
@@ -37,12 +59,12 @@ I32
Prf_GetLength(HINI hini, PSZ app, PSZ key) {
U32 len;
- if (CheckWinError(PrfQueryProfileSize(hini, app, key, &len))) return -1;
+ if (CheckWinError(pPrfQueryProfileSize(hini, app, key, &len))) return -1;
return len;
}
#define Prf_Set(hini, app, key, s, l) \
- (!(CheckWinError(PrfWriteProfileData(hini, app, key, s, l))))
+ (!(CheckWinError(pPrfWriteProfileData(hini, app, key, s, l))))
#define Prf_System(key) \
( (key) ? ( (key) == 1 ? HINI_USERPROFILE \
@@ -59,7 +81,7 @@ Prf_Profiles(pTHX)
char system[257];
PRFPROFILE info = { 257, user, 257, system};
- if (CheckWinError(PrfQueryProfile(Perl_hab, &info))) return &PL_sv_undef;
+ if (CheckWinError(pPrfQueryProfile(Perl_hab, &info))) return &PL_sv_undef;
if (info.cchUserName > 257 || info.cchSysName > 257)
die("Panic: Profile names too long");
av_push(av, newSVpv(user, info.cchUserName - 1));
@@ -78,12 +100,12 @@ Prf_SetUser(pTHX_ SV *sv)
if (!SvPOK(sv)) die("User profile name not defined");
if (SvCUR(sv) > 256) die("User profile name too long");
- if (CheckWinError(PrfQueryProfile(Perl_hab, &info))) return 0;
+ if (CheckWinError(pPrfQueryProfile(Perl_hab, &info))) return 0;
if (info.cchSysName > 257)
die("Panic: System profile name too long");
info.cchUserName = SvCUR(sv) + 1;
info.pszUserName = SvPVX(sv);
- return !CheckWinError(PrfReset(Perl_hab, &info));
+ return !CheckWinError(pPrfReset(Perl_hab, &info));
}
MODULE = OS2::PrfDB PACKAGE = OS2::Prf PREFIX = Prf_
@@ -141,3 +163,11 @@ OUTPUT:
BOOT:
Acquire_hab();
+ AssignFuncPByORD(pPrfQueryProfileSize, ORD_PRF32QUERYPROFILESIZE);
+ AssignFuncPByORD(pPrfOpenProfile, ORD_PRF32OPENPROFILE);
+ AssignFuncPByORD(pPrfCloseProfile, ORD_PRF32CLOSEPROFILE);
+ AssignFuncPByORD(pPrfQueryProfile, ORD_PRF32QUERYPROFILE);
+ AssignFuncPByORD(pPrfReset, ORD_PRF32RESET);
+ AssignFuncPByORD(pPrfQueryProfileData, ORD_PRF32QUERYPROFILEDATA);
+ AssignFuncPByORD(pPrfWriteProfileData, ORD_PRF32WRITEPROFILEDATA);
+
diff --git a/os2/OS2/Process/Process.pm b/os2/OS2/Process/Process.pm
index b862885b40..6ce93c049a 100644
--- a/os2/OS2/Process/Process.pm
+++ b/os2/OS2/Process/Process.pm
@@ -1,12 +1,20 @@
+package OS2::localMorphPM;
+
+sub new { my ($c,$f) = @_; OS2::MorphPM($f); bless [shift], $c }
+sub DESTROY { OS2::UnMorphPM(shift->[0]) }
+
package OS2::Process;
-$VERSION = 0.2;
+BEGIN {
+ require Exporter;
+ require DynaLoader;
+ #require AutoLoader;
-require Exporter;
-require DynaLoader;
-#require AutoLoader;
+ @ISA = qw(Exporter DynaLoader);
+ $VERSION = "1.0";
+ bootstrap OS2::Process;
+}
-@ISA = qw(Exporter DynaLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@@ -43,10 +51,51 @@ require DynaLoader;
T_VIRTDRV
T_PROTDLL
T_32BIT
+ ppid
+ ppidOf
+ sidOf
+ scrsize
+ scrsize_set
process_entry
- set_title
- get_title
+ process_entries
+ process_hentry
+ process_hentries
+ change_entry
+ change_entryh
+ Title_set
+ Title
+ WindowText
+ WindowText_set
+ WindowPos
+ WindowPos_set
+ WindowProcess
+ SwitchToProgram
+ ActiveWindow
+ ClassName
+ FocusWindow
+ FocusWindow_set
+ ShowWindow
+ PostMsg
+ BeginEnumWindows
+ EndEnumWindows
+ GetNextWindow
+ IsWindow
+ ChildWindows
+ out_codepage
+ out_codepage_set
+ in_codepage
+ in_codepage_set
+ cursor
+ cursor_set
+ screen
+ screen_set
+ process_codepages
+ QueryWindow
+ WindowFromId
+ WindowFromPoint
+ EnumDlgItem
);
+
sub AUTOLOAD {
# This AUTOLOAD is used to 'autoload' constants from the constant()
# XS function. If a constant is not found then control is passed
@@ -70,11 +119,111 @@ sub AUTOLOAD {
goto &$AUTOLOAD;
}
-bootstrap OS2::Process;
-
# Preloaded methods go here.
-sub get_title () { (process_entry())[0] }
+sub Title () { (process_entry())[0] }
+
+# *Title_set = \&sesmgr_title_set;
+
+sub swTitle_set_sw {
+ my ($title, @sw) = @_;
+ $sw[0] = $title;
+ change_entry(@sw);
+}
+
+sub swTitle_set {
+ my (@sw) = process_entry();
+ swTitle_set_sw(shift, @sw);
+}
+
+sub winTitle_set_sw {
+ my ($title, @sw) = @_;
+ my $h = OS2::localMorphPM->new(0);
+ WindowText_set $sw[1], $title;
+}
+
+sub winTitle_set {
+ my (@sw) = process_entry();
+ winTitle_set_sw(shift, @sw);
+}
+
+sub bothTitle_set {
+ my (@sw) = process_entry();
+ my $t = shift;
+ winTitle_set_sw($t, @sw);
+ swTitle_set_sw($t, @sw);
+}
+
+sub Title_set {
+ my $t = shift;
+ return 1 if sesmgr_title_set($t);
+ return 0 unless $^E == 372;
+ my (@sw) = process_entry();
+ winTitle_set_sw($t, @sw);
+ swTitle_set_sw($t, @sw);
+}
+
+sub process_entry { swentry_expand(process_swentry(@_)) }
+
+our @hentry_fields = qw( title owner_hwnd icon_hwnd
+ owner_phandle owner_pid owner_sid
+ visible nonswitchable jumpable ptype sw_entry );
+
+sub swentry_hexpand ($) {
+ my %h;
+ @h{@hentry_fields} = swentry_expand(shift);
+ \%h;
+}
+
+sub process_hentry { swentry_hexpand(process_swentry(@_)) }
+
+my $swentry_size = swentry_size();
+
+sub sw_entries () {
+ my $s = swentries_list();
+ my ($c, $s1) = unpack 'La*', $s;
+ die "Unconsistent size in swentries_list()" unless 4+$c*$swentry_size == length $s;
+ my (@l, $e);
+ push @l, $e while $e = substr $s1, 0, $swentry_size, '';
+ @l;
+}
+
+sub process_entries () {
+ map [swentry_expand($_)], sw_entries;
+}
+
+sub process_hentries () {
+ map swentry_hexpand($_), sw_entries;
+}
+
+sub change_entry {
+ change_swentry(create_swentry(@_));
+}
+
+sub create_swentryh ($) {
+ my $h = shift;
+ create_swentry(@$h{@hentry_fields});
+}
+
+sub change_entryh ($) {
+ change_swentry(create_swentryh(shift));
+}
+
+# Massage entries into the same order as WindowPos_set:
+sub WindowPos ($) {
+ my ($fl, $w, $h, $x, $y, $behind, $hwnd, @rest)
+ = unpack 'L l4 L4', WindowSWP(shift);
+ ($x, $y, $fl, $w, $h, $behind, @rest);
+}
+
+sub ChildWindows ($) {
+ my @kids;
+ my $h = BeginEnumWindows shift;
+ my $w;
+ push @kids, $w while $w = GetNextWindow $h;
+ EndEnumWindows $h;
+ @kids;
+}
# Autoload methods go after __END__, and are processed by the autosplit program.
@@ -83,15 +232,17 @@ __END__
=head1 NAME
-OS2::Process - exports constants for system() call on OS2.
+OS2::Process - exports constants for system() call, and process control on OS2.
=head1 SYNOPSIS
use OS2::Process;
- $pid = system(P_PM+P_BACKGROUND, "epm.exe");
+ $pid = system(P_PM | P_BACKGROUND, "epm.exe");
=head1 DESCRIPTION
+=head2 Optional argument to system()
+
the builtin function system() under OS/2 allows an optional first
argument which denotes the mode of the process. Note that this argument is
recognized only if it is strictly numerical.
@@ -123,14 +274,21 @@ and optionally add PM and session option bits:
=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.
+On OS/2 processes have the usual I<parent/child> semantic;
+additionally, there is a hierarchy of sessions with their own
+I<parent/child> tree. A session is either a FS session, or a windowed
+pseudo-session created by PM. A session is a "unit of user
+interaction", a change to in/out settings in one of them does not
+affect other sessions.
=over
-=item C<file_type(file)>
+=item my_type()
+
+returns the type of the current process (one of
+"FS", "DOS", "VIO", "PM", "DETACH" and "UNKNOWN"), or C<undef> on error.
+
+=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
@@ -139,15 +297,15 @@ dies on error. The bits 0-2 of the result contain one of the values
=item C<T_NOTSPEC> (0)
-Application type is not specified in the executable header.
+Application type is not specified in the executable header.
=item C<T_NOTWINDOWCOMPAT> (1)
-Application type is not-window-compatible.
+Application type is not-window-compatible.
=item C<T_WINDOWCOMPAT> (2)
-Application type is window-compatible.
+Application type is window-compatible.
=item C<T_WINDOWAPI> (3)
@@ -177,11 +335,11 @@ and 4 will be set to 0.
=item C<T_PHYSDRV> (0x40)
-Set to 1 if the executable file is a physical device driver.
+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.
+Set to 1 if the executable file is a virtual device driver.
=item C<T_PROTDLL> (0x100)
@@ -190,7 +348,7 @@ library module.
=item C<T_32BIT> (0x4000)
-Set to 1 for 32-bit executable files.
+Set to 1 for 32-bit executable files.
=back
@@ -200,37 +358,127 @@ 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 C<@list = process_codepages()>
+
+the first element is the currently active codepage, up to 2 additional
+entries specify the system's "prepared codepages": the codepages the
+user can switch to. The active codepage of a process is one of the
+prepared codepages of the system (if present).
+
+=item C<process_codepage_set($cp)>
+
+sets the currently active codepage. [Affects printer output, in/out
+codepages of sessions started by this process, and the default
+codepage for drawing in PM; is inherited by kids. Does not affect the
+out- and in-codepages of the session.]
+
+=item ppid()
+
+returns the PID of the parent process.
+
+=item C<ppidOf($pid = $$)>
+
+returns the PID of the parent process of $pid. -1 on error.
+
+=item C<sidOf($pid = $$)>
+
+returns the session id of the process id $pid. -1 on error.
+
+=back
+
+=head2 Control of VIO sessions
+
+VIO applications are applications running in a text-mode session.
+
+=over
+
+=item out_codepage()
+
+gets code page used for screen output (glyphs). -1 means that a user font
+was loaded.
+
+=item C<out_codepage_set($cp)>
+
+sets code page used for screen output (glyphs). -1 switches to a preloaded
+user font. -2 switches off the preloaded user font.
+
+=item in_codepage()
+
+gets code page used for keyboard input. 0 means that a hardware codepage
+is used.
+
+=item C<in_codepage_set($cp)>
+
+sets code page used for keyboard input.
+
+=item C<($w, $h) = scrsize()>
+
+width and height of the given console window in character cells.
+
+=item C<scrsize_set([$w, ] $h)>
+
+set height (and optionally width) of the given console window in
+character cells. Use 0 size to keep the old size.
+
+=item C<($s, $e, $w, $a) = cursor()>
+
+gets start/end lines of the blinking cursor in the charcell, its width
+(1 on text modes) and attribute (-1 for hidden, in text modes other
+values mean visible, in graphic modes color).
+
+=item C<cursor_set($s, $e, [$w [, $a]])>
+
+sets start/end lines of the blinking cursor in the charcell. Negative
+values mean percents of the character cell height.
+
+=item screen()
+
+gets a buffer with characters and attributes of the screen.
+
+=item C<screen_set($buffer)>
+
+restores the screen given the result of screen().
+
+=back
+
+=head2 Control of the process list
+
+With the exception of Title_set(), all these calls require that PM is
+running, they would not work under alternative Session Managers.
+
+=over
+
=item process_entry()
returns a list of the following data:
=over
-=item
+=item
Title of the process (in the C<Ctrl-Esc> list);
-=item
+=item
window handle of switch entry of the process (in the C<Ctrl-Esc> list);
-=item
+=item
window handle of the icon of the process;
-=item
+=item
process handle of the owner of the entry in C<Ctrl-Esc> list;
-=item
+=item
process id of the owner of the entry in C<Ctrl-Esc> list;
-=item
+=item
session id of the owner of the entry in C<Ctrl-Esc> list;
-=item
+=item
whether visible in C<Ctrl-Esc> list;
@@ -239,20 +487,20 @@ whether visible in C<Ctrl-Esc> list;
whether item cannot be switched to (note that it is not actually
grayed in the C<Ctrl-Esc> list));
-=item
+=item
whether participates in jump sequence;
-=item
+=item
-program type. Possible values are:
+program type. Possible values are:
- PROG_DEFAULT 0
- PROG_FULLSCREEN 1
- PROG_WINDOWABLEVIO 2
- PROG_PM 3
- PROG_VDM 4
- PROG_WINDOWEDVDM 7
+ 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
@@ -263,31 +511,351 @@ 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.
+=item
+
+switch-entry handle.
=back
-=item C<set_title(newtitle)>
+Optional arguments: the pid and the window-handle of the application running
+in the OS/2 session to query.
+
+=item process_hentry()
+
+similar to process_entry(), but returns a hash reference, the keys being
+
+ title owner_hwnd icon_hwnd owner_phandle owner_pid owner_sid
+ visible nonswitchable jumpable ptype sw_entry
+
+(a copy of the list of keys is in @hentry_fields).
+
+=item process_entries()
-- does not work with some windows (if the title is set from the start).
+similar to process_entry(), but returns a list of array reference for all
+the elements in the switch list (one controlling C<Ctrl-Esc> window).
+
+=item process_hentries()
+
+similar to process_hentry(), but returns a list of hash reference for all
+the elements in the switch list (one controlling C<Ctrl-Esc> window).
+
+=item change_entry()
+
+changes a process entry, arguments are the same as process_entry() returns.
+
+=item change_entryh()
+
+Similar to change_entry(), but takes a hash reference as an argument.
+
+=item Title()
+
+returns a title of the current session. (There is no way to get this
+info in non-standard Session Managers, this implementation is a
+shortcut via process_entry().)
+
+=item C<Title_set(newtitle)>
+
+tries two different interfaces. The Session Manager one 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 ;-).
+for a funny - and wrong - explanation ;-). In such cases a
+direct-manipulation of low-level entries is used. Keep in mind that
+some versions of OS/2 leak memory with such a manipulation.
+
+=item C<SwitchToProgram($sw_entry)>
+
+switch to session given by a switch list handle.
+
+Use of this function causes another window (and its related windows)
+of a PM session to appear on the front of the screen, or a switch to
+another session in the case of a non-PM program. In either case,
+the keyboard (and mouse for the non-PM case) input is directed to
+the new program.
+
+=back
+
+=head2 Control of the PM windows
+
+Some of these API's require sending a message to the specified window.
+In such a case the process needs to be a PM process, or to be morphed
+to a PM process via OS2::MorphPM().
+
+For a temporary morphing to PM use L<OS2::localMorphPM class>.
+
+Keep in mind that PM windows are engaged in 2 "orthogonal" window
+trees, as well as in the z-order list.
+
+One tree is given by the I<parent/child> relationship. This
+relationship affects drawing (child is drawn relative to its parent
+(lower-left corner), and the drawing is clipped by the parent's
+boundary; parent may request that I<it's> drawing is clipped to be
+confined to the outsize of the childs and/or siblings' windows);
+hiding; minimizing/restoring; and destroying windows.
+
+Another tree (not necessarily connected?) is given by I<ownership>
+relationship. Ownership relationship assumes cooperation of the
+engaged windows via passing messages on "important events"; e.g.,
+scrollbars send information messages when the "bar" is moved, menus
+send messages when an item is selected; frames
+move/hide/unhide/minimize/restore/change-z-order-of owned frames when
+the owner is moved/etc., and destroy the owned frames (even when these
+frames are not descendants) when the owner is destroyed; etc. [An
+important restriction on ownership is that owner should be created by
+the same thread as the owned thread, so they engage in the same
+message queue.]
+
+Windows may be in many different state: Focused, Activated (=Windows
+in the I<parent/child> tree between the root and the window with
+focus; usually indicate such "active state" by titlebar highlights),
+Enabled/Disabled (this influences *an ability* to receive user input
+(be focused?), and may change appearance, as for enabled/disabled
+buttons), Visible/Hidden, Minimized/Maximized/Restored, Modal, etc.
+
+=over
+
+=item C<WindowText($hwnd)>
+
+gets "a text content" of a window.
+
+=item C<WindowText_set($hwnd, $text)>
+
+sets "a text content" of a window.
+
+=item C<WindowPos($hwnd)>
+
+gets window position info as 8 integers (of C<SWP>), in the order suitable
+for WindowPos_set(): $x, $y, $fl, $w, $h, $behind, @rest.
+
+=item C<WindowPos_set($hwnd, $x, $y, $flags = SWP_MOVE, $wid = 0, $h = 0, $behind = HWND_TOP)>
+
+Set state of the window: position, size, zorder, show/hide, activation,
+minimize/maximize/restore etc. Which of these operations to perform
+is governed by $flags.
+
+=item C<WindowProcess($hwnd)>
+
+gets I<PID> and I<TID> of the process associated to the window.
+
+=item ActiveWindow([$parentHwnd])
+
+gets the active subwindow's handle for $parentHwnd or desktop.
+Returns FALSE if none.
+
+=item C<ClassName($hwnd)>
+
+returns the class name of the window.
+
+If this window is of any of the preregistered WC_* classes the class
+name returned is in the form "#nnnnn", where "nnnnn" is a group
+of up to five digits that corresponds to the value of the WC_* class name
+constant.
+
+=item FocusWindow()
+
+returns the handle of the focus window. Optional argument for specifying the desktop
+to use.
+
+=item C<FocusWindow_set($hwnd)>
+
+set the focus window by handle. Optional argument for specifying the desktop
+to use. E.g, the first entry in program_entries() is the C<Ctrl-Esc> list.
+To show it
+
+ WinShowWindow( wlhwnd, TRUE );
+ WinSetFocus( HWND_DESKTOP, wlhwnd );
+ WinSwitchToProgram(wlhswitch);
+
+
+=item C<ShowWindow($hwnd [, $show])>
+
+Set visible/hidden flag of the window. Default: $show is TRUE.
+
+=item C<PostMsg($hwnd, $msg, $mp1, $mp2)>
+
+post message to a window. The meaning of $mp1, $mp2 is specific for each
+message id $msg, they default to 0. E.g., in C it is done similar to
+
+ /* Emulate `Restore' */
+ WinPostMsg(SwitchBlock.tswe[i].swctl.hwnd, WM_SYSCOMMAND,
+ MPFROMSHORT(SC_RESTORE), 0);
+
+ /* Emulate `Show-Contextmenu' (Double-Click-2) */
+ hwndParent = WinQueryFocus(HWND_DESKTOP);
+ hwndActive = WinQueryActiveWindow(hwndParent);
+ WinPostMsg(hwndActive, WM_CONTEXTMENU, MPFROM2SHORT(0,0), MPFROMLONG(0));
+
+ /* Emulate `Close' */
+ WinPostMsg(pSWB->aswentry[i].swctl.hwnd, WM_CLOSE, 0, 0);
+
+ /* Same but softer: */
+ WinPostMsg(hwndactive, WM_SAVEAPPLICATION, 0L, 0L);
+ WinPostMsg(hwndactive, WM_CLOSE, 0L, 0L));
+ WinPostMsg(hwndactive, WM_QUIT, 0L, 0L));
+
+=item C<$eh = BeginEnumWindows($hwnd)>
+
+starts enumerating immediate child windows of $hwnd in z-order. The
+enumeration reflects the state at the moment of BeginEnumWindows() calls;
+use IsWindow() to be sure.
+
+=item C<$kid_hwnd = GetNextWindow($eh)>
+
+gets the next kid in the list. Gets 0 on error or when the list ends.
-=item get_title()
+=item C<EndEnumWindows($eh)>
-is a shortcut implemented via process_entry().
+End enumeration and release the list.
+
+=item C<@list = ChildWindows($hwnd)>
+
+returns the list of child windows at the moment of the call. Same remark
+as for enumeration interface applies. Example of usage:
+
+ sub l {
+ my ($o,$h) = @_;
+ printf ' ' x $o . "%#x\n", $h;
+ l($o+2,$_) for ChildWindows $h;
+ }
+ l 0, $HWND_DESKTOP
+
+=item C<IsWindow($hwnd)>
+
+true if the window handle is still valid.
+
+=item C<QueryWindow($hwnd, $type)>
+
+gets the handle of a related window. $type should be one of C<QW_*> constants.
+
+=item C<IsChild($hwnd, $parent)>
+
+return TRUE if $hwnd is a descendant of $parent.
+
+=item C<WindowFromId($hwnd, $id)>
+
+return a window handle of a child of $hwnd with the given $id.
+
+ hwndSysMenu = WinWindowFromID(hwndDlg, FID_SYSMENU);
+ WinSendMsg(hwndSysMenu, MM_SETITEMATTR,
+ MPFROM2SHORT(SC_CLOSE, TRUE),
+ MPFROM2SHORT(MIA_DISABLED, MIA_DISABLED));
+
+=item C<WindowFromPoint($x, $y [, $hwndParent [, $descedantsToo]])>
+
+gets a handle of a child of $hwndParent at C<($x,$y)>. If $descedantsToo
+(defaulting to 0) then children of children may be returned too. May return
+$hwndParent (defaults to desktop) if no suitable children are found,
+or 0 if the point is outside the parent.
+
+$x and $y are relative to $hwndParent.
+
+=item C<EnumDlgItem($dlgHwnd, $type [, $relativeHwnd])>
+
+gets a dialog item window handle for an item of type $type of $dlgHwnd
+relative to $relativeHwnd, which is descendant of $dlgHwnd.
+$relativeHwnd may be specified if $type is EDI_FIRSTTABITEM or
+EDI_LASTTABITEM.
+
+The return is always an immediate child of hwndDlg, even if hwnd is
+not an immediate child window. $type may be
+
+=over
+
+=item EDI_FIRSTGROUPITEM
+
+First item in the same group.
+
+=item EDI_FIRSTTABITEM
+
+First item in dialog with style WS_TABSTOP. hwnd is ignored.
+
+=item EDI_LASTGROUPITEM
+
+Last item in the same group.
+
+=item EDI_LASTTABITEM
+
+Last item in dialog with style WS_TABSTOP. hwnd is ignored.
+
+=item EDI_NEXTGROUPITEM
+
+Next item in the same group. Wraps around to beginning of group when
+the end of the group is reached.
+
+=item EDI_NEXTTABITEM
+
+Next item with style WS_TABSTOP. Wraps around to beginning of dialog
+item list when end is reached.
+
+=item EDI_PREVGROUPITEM
+
+Previous item in the same group. Wraps around to end of group when the
+start of the group is reached. For information on the WS_GROUP style,
+see Window Styles.
+
+=item EDI_PREVTABITEM
+
+Previous item with style WS_TABSTOP. Wraps around to end of dialog
+item list when beginning is reached.
=back
+=back
+
+=head1 OS2::localMorphPM class
+
+This class morphs the process to PM for the duration of the given context.
+
+ {
+ my $h = OS2::localMorphPM->new(0);
+ # Do something
+ }
+
+The argument has the same meaning as one to OS2::MorphPM(). Calls can
+nest with internal ones being NOPs.
+
+=head1 TODO
+
+Constants (currently one needs to get them looking in a header file):
+
+ HWND_*
+ WM_* /* Separate module? */
+ SC_*
+ SWP_*
+ WC_*
+ PROG_*
+ QW_*
+ EDI_*
+ WS_*
+
+Show/Hide, Enable/Disable (WinShowWindow(), WinIsWindowVisible(),
+WinEnableWindow(), WinIsWindowEnabled()).
+
+Maximize/minimize/restore via WindowPos_set(), check via checking
+WS_MAXIMIZED/WS_MINIMIZED flags (how to get them?).
+
+=head1 $^E
+
+the majority of the APIs of this module set $^E on failure (no matter
+whether they die() on failure or not). By the semantic of PM API
+which returns something other than a boolean, it is impossible to
+distinguish failure from a "normal" 0-return. In such cases C<$^E ==
+0> indicates an absence of error.
+
+=head1 BUGS
+
+whether a given API dies or returns FALSE/empty-list on error may be
+confusing. This may change in the future.
+
=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
-C<spawn*>() system calls.
+C<spawn*>() system calls, L<OS2::Proc> and L<OS2::WinObject> modules.
=cut
diff --git a/os2/OS2/Process/Process.xs b/os2/OS2/Process/Process.xs
index 16b494d77c..159ef49a55 100644
--- a/os2/OS2/Process/Process.xs
+++ b/os2/OS2/Process/Process.xs
@@ -1,12 +1,18 @@
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
#include <process.h>
#define INCL_DOS
#define INCL_DOSERRORS
+#define INCL_DOSNLS
+#define INCL_WINSWITCHLIST
+#define INCL_WINWINDOWMGR
+#define INCL_WININPUT
+#define INCL_VIO
+#define INCL_KBD
#include <os2.h>
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
static unsigned long
constant(char *name, int arg)
{
@@ -239,27 +245,247 @@ file_type(char *path)
return apptype;
}
+DeclFuncByORD(HSWITCH, myWinQuerySwitchHandle, ORD_WinQuerySwitchHandle,
+ (HWND hwnd, PID pid), (hwnd, pid))
+DeclFuncByORD(ULONG, myWinQuerySwitchEntry, ORD_WinQuerySwitchEntry,
+ (HSWITCH hsw, PSWCNTRL pswctl), (hsw, pswctl))
+DeclFuncByORD(ULONG, myWinSetWindowText, ORD_WinSetWindowText,
+ (HWND hwnd, char* text), (hwnd, text))
+DeclFuncByORD(BOOL, myWinQueryWindowProcess, ORD_WinQueryWindowProcess,
+ (HWND hwnd, PPID ppid, PTID ptid), (hwnd, ppid, ptid))
+
+DeclFuncByORD(ULONG, XmyWinSwitchToProgram, ORD_WinSwitchToProgram,
+ (HSWITCH hsw), (hsw))
+#define myWinSwitchToProgram(hsw) (!CheckOSError(XmyWinSwitchToProgram(hsw)))
+
+DeclFuncByORD(HWND, myWinQueryActiveWindow, ORD_WinQueryActiveWindow,
+ (HWND hwnd), (hwnd))
+
+
+ULONG (*pWinQuerySwitchList) (HAB hab, PSWBLOCK pswblk, ULONG usDataLength);
+ULONG (*pWinChangeSwitchEntry) (HSWITCH hsw, __const__ SWCNTRL *pswctl);
+
+HWND (*pWinQueryWindow) (HWND hwnd, LONG cmd);
+BOOL (*pWinQueryWindowPos) (HWND hwnd, PSWP pswp);
+LONG (*pWinQueryWindowText) (HWND hwnd, LONG cchBufferMax, PCH pchBuffer);
+LONG (*pWinQueryWindowTextLength) (HWND hwnd);
+LONG (*pWinQueryClassName) (HWND hwnd, LONG cchMax, PCH pch);
+HWND (*pWinQueryFocus) (HWND hwndDesktop);
+BOOL (*pWinSetFocus) (HWND hwndDesktop, HWND hwndFocus);
+BOOL (*pWinShowWindow) (HWND hwnd, BOOL fShow);
+BOOL (*pWinPostMsg) (HWND hwnd, ULONG msg, MPARAM mp1, MPARAM mp2);
+BOOL (*pWinSetWindowPos) (HWND hwnd, HWND hwndInsertBehind, LONG x, LONG y,
+ LONG cx, LONG cy, ULONG fl);
+HENUM (*pWinBeginEnumWindows) (HWND hwnd);
+BOOL (*pWinEndEnumWindows) (HENUM henum);
+HWND (*pWinGetNextWindow) (HENUM henum);
+BOOL (*pWinIsWindow) (HAB hab, HWND hwnd);
+HWND (*pWinQueryWindow) (HWND hwnd, LONG cmd);
+
+DeclWinFuncByORD(HWND, IsChild, ORD_WinIsChild,
+ (HWND hwnd, HWND hwndParent), (hwnd, hwndParent))
+DeclWinFuncByORD(HWND, WindowFromId, ORD_WinWindowFromId,
+ (HWND hwnd, ULONG id), (hwnd, id))
+
+HWND (*pWinWindowFromPoint)(HWND hwnd, __const__ POINTL *pptl, BOOL fChildren);
+
+DeclWinFuncByORD(HWND, EnumDlgItem, ORD_WinEnumDlgItem,
+ (HWND hwndDlg, HWND hwnd, ULONG code), (hwndDlg, hwnd, code));
+
+int
+WindowText_set(HWND hwnd, char* text)
+{
+ return !CheckWinError(myWinSetWindowText(hwnd, text));
+}
+
+LONG
+QueryWindowTextLength(HWND hwnd)
+{
+ LONG ret;
+
+ if (!pWinQueryWindowTextLength)
+ AssignFuncPByORD(pWinQueryWindowTextLength, ORD_WinQueryWindowTextLength);
+ ret = pWinQueryWindowTextLength(hwnd);
+ CheckWinError(ret); /* May put false positive */
+ return ret;
+}
+
+SV *
+QueryWindowText(HWND hwnd)
+{
+ LONG l = QueryWindowTextLength(hwnd);
+ SV *sv = newSVpvn("", 0);
+ STRLEN n_a;
+
+ if (l == 0)
+ return sv;
+ SvGROW(sv, l + 1);
+ if (!pWinQueryWindowText)
+ AssignFuncPByORD(pWinQueryWindowText, ORD_WinQueryWindowText);
+ CheckWinError(l = pWinQueryWindowText(hwnd, l + 1, SvPV_force(sv, n_a)));
+ SvCUR_set(sv, l);
+ return sv;
+}
+
+SWP
+QueryWindowSWP_(HWND hwnd)
+{
+ SWP swp;
+
+ if (!pWinQueryWindowPos)
+ AssignFuncPByORD(pWinQueryWindowPos, ORD_WinQueryWindowPos);
+ if (CheckWinError(pWinQueryWindowPos(hwnd, &swp)))
+ croak("WinQueryWindowPos() error");
+ return swp;
+}
+
+SV *
+QueryWindowSWP(HWND hwnd)
+{
+ SWP swp = QueryWindowSWP_(hwnd);
+
+ return newSVpvn((char*)&swp, sizeof(swp));
+}
+
+SV *
+QueryClassName(HWND hwnd)
+{
+ SV *sv = newSVpvn("",0);
+ STRLEN l = 46, len = 0, n_a;
+
+ if (!pWinQueryClassName)
+ AssignFuncPByORD(pWinQueryClassName, ORD_WinQueryClassName);
+ while (l + 1 >= len) {
+ if (len)
+ len = 2*len + 10; /* Grow quick */
+ else
+ len = l + 2;
+ SvGROW(sv, len);
+ l = pWinQueryClassName(hwnd, len, SvPV_force(sv, n_a));
+ CheckWinError(l);
+ SvCUR_set(sv, l);
+ }
+ return sv;
+}
+
+HWND
+QueryFocusWindow(HWND hwndDesktop)
+{
+ HWND ret;
+
+ if (!pWinQueryFocus)
+ AssignFuncPByORD(pWinQueryFocus, ORD_WinQueryFocus);
+ ret = pWinQueryFocus(hwndDesktop);
+ CheckWinError(ret);
+ return ret;
+}
+
+BOOL
+FocusWindow_set(HWND hwndFocus, HWND hwndDesktop)
+{
+ if (!pWinSetFocus)
+ AssignFuncPByORD(pWinSetFocus, ORD_WinSetFocus);
+ return !CheckWinError(pWinSetFocus(hwndDesktop, hwndFocus));
+}
+
+BOOL
+ShowWindow(HWND hwnd, BOOL fShow)
+{
+ if (!pWinShowWindow)
+ AssignFuncPByORD(pWinShowWindow, ORD_WinShowWindow);
+ return !CheckWinError(pWinShowWindow(hwnd, fShow));
+}
+
+BOOL
+PostMsg(HWND hwnd, ULONG msg, ULONG mp1, ULONG mp2)
+{
+ if (!pWinPostMsg)
+ AssignFuncPByORD(pWinPostMsg, ORD_WinPostMsg);
+ return !CheckWinError(pWinPostMsg(hwnd, msg, (MPARAM)mp1, (MPARAM)mp2));
+}
+
+BOOL
+WindowPos_set(HWND hwnd, LONG x, LONG y, ULONG fl, LONG cx, LONG cy,
+ HWND hwndInsertBehind)
+{
+ if (!pWinSetWindowPos)
+ AssignFuncPByORD(pWinSetWindowPos, ORD_WinSetWindowPos);
+ return !CheckWinError(pWinSetWindowPos(hwnd, hwndInsertBehind, x, y, cx, cy, fl));
+}
+
+HENUM
+BeginEnumWindows(HWND hwnd)
+{
+ if (!pWinBeginEnumWindows)
+ AssignFuncPByORD(pWinBeginEnumWindows, ORD_WinBeginEnumWindows);
+ return SaveWinError(pWinBeginEnumWindows(hwnd));
+}
+
+BOOL
+EndEnumWindows(HENUM henum)
+{
+ if (!pWinEndEnumWindows)
+ AssignFuncPByORD(pWinEndEnumWindows, ORD_WinEndEnumWindows);
+ return !CheckWinError(pWinEndEnumWindows(henum));
+}
+
+HWND
+GetNextWindow(HENUM henum)
+{
+ if (!pWinGetNextWindow)
+ AssignFuncPByORD(pWinGetNextWindow, ORD_WinGetNextWindow);
+ return SaveWinError(pWinGetNextWindow(henum));
+}
+
+BOOL
+IsWindow(HWND hwnd, HAB hab)
+{
+ if (!pWinIsWindow)
+ AssignFuncPByORD(pWinIsWindow, ORD_WinIsWindow);
+ return !CheckWinError(pWinIsWindow(hab, hwnd));
+}
+
+HWND
+QueryWindow(HWND hwnd, LONG cmd)
+{
+ if (!pWinQueryWindow)
+ AssignFuncPByORD(pWinQueryWindow, ORD_WinQueryWindow);
+ return !CheckWinError(pWinQueryWindow(hwnd, cmd));
+}
+
+HWND
+WindowFromPoint(long x, long y, HWND hwnd, BOOL fChildren)
+{
+ POINTL ppl;
+
+ ppl.x = x; ppl.y = y;
+ if (!pWinWindowFromPoint)
+ AssignFuncPByORD(pWinWindowFromPoint, ORD_WinWindowFromPoint);
+ return SaveWinError(pWinWindowFromPoint(hwnd, &ppl, fChildren));
+}
+
static void
-fill_swcntrl(SWCNTRL *swcntrlp)
+fill_swentry(SWENTRY *swentryp, HWND hwnd, PID pid)
{
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)))
+ myWinQuerySwitchHandle(hwnd, pid)))
croak("WinQuerySwitchHandle err %ld", Perl_rc);
- if (CheckOSError(WinQuerySwitchEntry(hSwitch, swcntrlp)))
+ swentryp->hswitch = hSwitch;
+ if (CheckOSError(myWinQuerySwitchEntry(hSwitch, &swentryp->swctl)))
croak("WinQuerySwitchEntry err %ld", rc);
}
+static void
+fill_swentry_default(SWENTRY *swentryp)
+{
+ fill_swentry(swentryp, NULLHANDLE, getpid());
+}
+
/* static ULONG (* APIENTRY16 pDosSmSetTitle)(ULONG, PSZ); */
ULONG _THUNK_FUNCTION(DosSmSetTitle)(ULONG, PSZ);
@@ -267,14 +493,14 @@ ULONG _THUNK_FUNCTION(DosSmSetTitle)(ULONG, PSZ);
static ULONG (*pDosSmSetTitle)(ULONG, PSZ);
static void
-set_title(char *s)
+sesmgr_title_set(char *s)
{
- SWCNTRL swcntrl;
+ SWENTRY swentry;
static HMODULE hdosc = 0;
BYTE buf[20];
long rc;
- fill_swcntrl(&swcntrl);
+ fill_swentry_default(&swentry);
if (!pDosSmSetTitle || !hdosc) {
if (CheckOSError(DosLoadModule(buf, sizeof buf, "sesmgr", &hdosc)))
croak("Cannot load SESMGR: no `%s'", buf);
@@ -297,17 +523,15 @@ set_title(char *s)
#else /* !0 */
static bool
-set_title(char *s)
+sesmgr_title_set(char *s)
{
- SWCNTRL swcntrl;
- static HMODULE hdosc = 0;
- BYTE buf[20];
+ SWENTRY swentry;
long rc;
- fill_swcntrl(&swcntrl);
+ fill_swentry_default(&swentry);
rc = ((USHORT)
(_THUNK_PROLOG (2+4);
- _THUNK_SHORT (swcntrl.idSession);
+ _THUNK_SHORT (swentry.swctl.idSession);
_THUNK_FLAT (s);
_THUNK_CALL (DosSmSetTitle)));
#if 0
@@ -336,6 +560,345 @@ set_title2(char *s)
}
#endif
+SV *
+process_swentry(unsigned long pid, unsigned long hwnd)
+{
+ SWENTRY swentry;
+
+ if (!(_emx_env & 0x200))
+ croak("process_swentry not implemented on DOS"); /* not OS/2. */
+ fill_swentry(&swentry, hwnd, pid);
+ return newSVpvn((char*)&swentry, sizeof(swentry));
+}
+
+SV *
+swentries_list()
+{
+ int num, n = 0;
+ STRLEN n_a;
+ PSWBLOCK pswblk;
+ SV *sv = newSVpvn("",0);
+
+ if (!(_emx_env & 0x200))
+ croak("swentries_list not implemented on DOS"); /* not OS/2. */
+ if (!pWinQuerySwitchList)
+ AssignFuncPByORD(pWinQuerySwitchList, ORD_WinQuerySwitchList);
+ num = pWinQuerySwitchList(0, NULL, 0); /* HAB is not required */
+ if (!num)
+ croak("(Unknown) error during WinQuerySwitchList()");
+ /* Allow one extra entry to allow overflow detection (may happen
+ if the list has been changed). */
+ while (num > n) {
+ if (n == 0)
+ n = num + 1;
+ else
+ n = 2*num + 10; /* Enlarge quickly */
+ SvGROW(sv, sizeof(ULONG) + sizeof(SWENTRY) * n + 1);
+ pswblk = (PSWBLOCK) SvPV_force(sv, n_a);
+ num = pWinQuerySwitchList(0, pswblk, SvLEN(sv));
+ }
+ SvCUR_set(sv, sizeof(ULONG) + sizeof(SWENTRY) * num);
+ *SvEND(sv) = 0;
+ return sv;
+}
+
+SWENTRY
+swentry( char *title, HWND sw_hwnd, HWND icon_hwnd, HPROGRAM owner_phandle,
+ PID owner_pid, ULONG owner_sid, ULONG visible, ULONG nonswitchable,
+ ULONG jumpable, ULONG ptype, HSWITCH sw_entry)
+{
+ SWENTRY e;
+
+ strncpy(e.swctl.szSwtitle, title, MAXNAMEL);
+ e.swctl.szSwtitle[60] = 0;
+ e.swctl.hwnd = sw_hwnd;
+ e.swctl.hwndIcon = icon_hwnd;
+ e.swctl.hprog = owner_phandle;
+ e.swctl.idProcess = owner_pid;
+ e.swctl.idSession = owner_sid;
+ e.swctl.uchVisibility = ((visible ? SWL_VISIBLE : SWL_INVISIBLE)
+ | (nonswitchable ? SWL_GRAYED : 0));
+ e.swctl.fbJump = (jumpable ? SWL_JUMPABLE : 0);
+ e.swctl.bProgType = ptype;
+ e.hswitch = sw_entry;
+ return e;
+}
+
+SV *
+create_swentry( char *title, HWND owner_hwnd, HWND icon_hwnd, HPROGRAM owner_phandle,
+ PID owner_pid, ULONG owner_sid, ULONG visible, ULONG nonswitchable,
+ ULONG jumpable, ULONG ptype, HSWITCH sw_entry)
+{
+ SWENTRY e = swentry(title, owner_hwnd, icon_hwnd, owner_phandle, owner_pid,
+ owner_sid, visible, nonswitchable, jumpable, ptype,
+ sw_entry);
+
+ return newSVpvn((char*)&e, sizeof(e));
+}
+
+int
+change_swentrysw(SWENTRY *sw)
+{
+ ULONG rc; /* For CheckOSError */
+
+ if (!(_emx_env & 0x200))
+ croak("change_entry() not implemented on DOS"); /* not OS/2. */
+ if (!pWinChangeSwitchEntry)
+ AssignFuncPByORD(pWinChangeSwitchEntry, ORD_WinChangeSwitchEntry);
+ return !CheckOSError(pWinChangeSwitchEntry(sw->hswitch, &sw->swctl));
+}
+
+int
+change_swentry(SV *sv)
+{
+ STRLEN l;
+ PSWENTRY pswentry = (PSWENTRY)SvPV(sv, l);
+
+ if (l != sizeof(SWENTRY))
+ croak("Wrong structure size %ld!=%ld in change_swentry()", (long)l, (long)sizeof(SWENTRY));
+ return change_swentrysw(pswentry);
+}
+
+
+#define swentry_size() (sizeof(SWENTRY))
+
+void
+getscrsize(int *wp, int *hp)
+{
+ int i[2];
+
+ _scrsize(i);
+ *wp = i[0];
+ *hp = i[1];
+}
+
+/* Force vio to not cross 64K-boundary: */
+#define VIO_FROM_VIOB \
+ vio = viob; \
+ if (!_THUNK_PTR_STRUCT_OK(vio)) \
+ vio++
+
+bool
+scrsize_set(int w, int h)
+{
+ VIOMODEINFO viob[2], *vio;
+ ULONG rc;
+
+ VIO_FROM_VIOB;
+
+ if (h == -9999)
+ h = w, w = 0;
+ vio->cb = sizeof(*vio);
+ if (CheckOSError(VioGetMode( vio, 0 )))
+ return 0;
+
+ if( w > 0 )
+ vio->col = (USHORT)w;
+
+ if( h > 0 )
+ vio->row = (USHORT)h;
+
+ vio->cb = 8;
+ if (CheckOSError(VioSetMode( vio, 0 )))
+ return 0;
+ return 1;
+}
+
+void
+cursor(int *sp, int *ep, int *wp, int *ap)
+{
+ VIOCURSORINFO viob[2], *vio;
+ ULONG rc;
+
+ VIO_FROM_VIOB;
+
+ if (CheckOSError(VioGetCurType( vio, 0 )))
+ croak("VioGetCurType() error");
+
+ *sp = vio->yStart;
+ *ep = vio->cEnd;
+ *wp = vio->cx;
+ *ep = vio->attr;
+}
+
+bool
+cursor__(int is_a)
+{
+ int s,e,w,a;
+
+ cursor(&s, &e, &w, &a);
+ if (is_a)
+ return a;
+ else
+ return w;
+}
+
+bool
+cursor_set(int s, int e, int w, int a)
+{
+ VIOCURSORINFO viob[2], *vio;
+ ULONG rc;
+
+ VIO_FROM_VIOB;
+
+ vio->yStart = s;
+ vio->cEnd = e;
+ vio->cx = w;
+ vio->attr = a;
+ return !CheckOSError(VioSetCurType( vio, 0 ));
+}
+
+static int
+bufsize(void)
+{
+#if 1
+ VIOMODEINFO viob[2], *vio;
+ ULONG rc;
+
+ VIO_FROM_VIOB;
+
+ vio->cb = sizeof(*vio);
+ if (CheckOSError(VioGetMode( vio, 0 )))
+ croak("Can't get size of buffer for screen");
+#if 0 /* buf=323552247, full=1118455, partial=0 */
+ croak("Lengths: buf=%d, full=%d, partial=%d",vio->buf_length,vio->full_length,vio->partial_length);
+ return newSVpvn((char*)vio->buf_addr, vio->full_length);
+#endif
+ return vio->col * vio->row * 2; /* How to get bytes/cell? 2 or 4? */
+#else /* 0 */
+ int i[2];
+
+ _scrsize(i);
+ return i[0]*i[1]*2;
+#endif /* 0 */
+}
+
+SV *
+screen(void)
+{
+ ULONG rc;
+ USHORT bufl = bufsize();
+ char b[(1<<16) * 3]; /* This/3 is enough for 16-bit calls, we need
+ 2x overhead due to 2 vs 4 issue, and extra
+ 64K due to alignment logic */
+ char *buf = b;
+
+ if (((ULONG)buf) & 0xFFFF)
+ buf += 0x10000 - (((ULONG)buf) & 0xFFFF);
+ if ((sizeof(b) - (buf - b)) < 2*bufl)
+ croak("panic: VIO buffer allocation");
+ if (CheckOSError(VioReadCellStr( buf, &bufl, 0, 0, 0 )))
+ return &PL_sv_undef;
+ return newSVpvn(buf,bufl);
+}
+
+bool
+screen_set(SV *sv)
+{
+ ULONG rc;
+ STRLEN l = SvCUR(sv), bufl = bufsize();
+ char b[(1<<16) * 2]; /* This/2 is enough for 16-bit calls, we need
+ extra 64K due to alignment logic */
+ char *buf = b;
+
+ if (((ULONG)buf) & 0xFFFF)
+ buf += 0x10000 - (((ULONG)buf) & 0xFFFF);
+ if (!SvPOK(sv) || ((l != bufl) && (l != 2*bufl)))
+ croak("Wrong size %d of saved screen data", SvCUR(sv));
+ if ((sizeof(b) - (buf - b)) < l)
+ croak("panic: VIO buffer allocation");
+ Copy(SvPV(sv,l), buf, bufl, char);
+ if (CheckOSError(VioWrtCellStr( buf, bufl, 0, 0, 0 )))
+ return 0;
+ return 1;
+}
+
+int
+process_codepages()
+{
+ ULONG cps[4], cp, rc;
+
+ if (CheckOSError(DosQueryCp( sizeof(cps), cps, &cp )))
+ croak("DosQueryCp() error");
+ return cp;
+}
+
+int
+out_codepage()
+{
+ USHORT cp, rc;
+
+ if (CheckOSError(VioGetCp( 0, &cp, 0 )))
+ croak("VioGetCp() error");
+ return cp;
+}
+
+bool
+out_codepage_set(int cp)
+{
+ USHORT rc;
+
+ return !(CheckOSError(VioSetCp( 0, cp, 0 )));
+}
+
+int
+in_codepage()
+{
+ USHORT cp, rc;
+
+ if (CheckOSError(KbdGetCp( 0, &cp, 0 )))
+ croak("KbdGetCp() error");
+ return cp;
+}
+
+bool
+in_codepage_set(int cp)
+{
+ USHORT rc;
+
+ return !(CheckOSError(KbdSetCp( 0, cp, 0 )));
+}
+
+bool
+process_codepage_set(int cp)
+{
+ USHORT rc;
+
+ return !(CheckOSError(DosSetProcessCp( cp )));
+}
+
+int
+ppidOf(int pid)
+{
+ PQTOPLEVEL psi;
+ int ppid;
+
+ if (!pid)
+ return -1;
+ psi = get_sysinfo(pid, QSS_PROCESS);
+ if (!psi)
+ return -1;
+ ppid = psi->procdata->ppid;
+ Safefree(psi);
+ return ppid;
+}
+
+int
+sidOf(int pid)
+{
+ PQTOPLEVEL psi;
+ int sid;
+
+ if (!pid)
+ return -1;
+ psi = get_sysinfo(pid, QSS_PROCESS);
+ if (!psi)
+ return -1;
+ sid = psi->procdata->sessid;
+ Safefree(psi);
+ return sid;
+}
+
MODULE = OS2::Process PACKAGE = OS2::Process
@@ -351,26 +914,179 @@ U32
file_type(path)
char *path
-U32
-process_entry()
+SV *
+swentry_expand( SV *sv )
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)));
+ STRLEN l;
+ PSWENTRY pswentry = (PSWENTRY)SvPV(sv, l);
+
+ if (l != sizeof(SWENTRY))
+ croak("Wrong structure size %ld!=%ld in swentry_expand()", (long)l, (long)sizeof(SWENTRY));
+ EXTEND(sp,11);
+ PUSHs(sv_2mortal(newSVpv(pswentry->swctl.szSwtitle, 0)));
+ PUSHs(sv_2mortal(newSVnv(pswentry->swctl.hwnd)));
+ PUSHs(sv_2mortal(newSVnv(pswentry->swctl.hwndIcon)));
+ PUSHs(sv_2mortal(newSViv(pswentry->swctl.hprog)));
+ PUSHs(sv_2mortal(newSViv(pswentry->swctl.idProcess)));
+ PUSHs(sv_2mortal(newSViv(pswentry->swctl.idSession)));
+ PUSHs(sv_2mortal(newSViv(pswentry->swctl.uchVisibility & SWL_VISIBLE)));
+ PUSHs(sv_2mortal(newSViv(pswentry->swctl.uchVisibility & SWL_GRAYED)));
+ PUSHs(sv_2mortal(newSViv(pswentry->swctl.fbJump == SWL_JUMPABLE)));
+ PUSHs(sv_2mortal(newSViv(pswentry->swctl.bProgType)));
+ PUSHs(sv_2mortal(newSViv(pswentry->hswitch)));
}
+SV *
+create_swentry( char *title, unsigned long sw_hwnd, unsigned long icon_hwnd, unsigned long owner_phandle, unsigned long owner_pid, unsigned long owner_sid, unsigned long visible, unsigned long switchable, unsigned long jumpable, unsigned long ptype, unsigned long sw_entry)
+
+int
+change_swentry( SV *sv )
+
bool
-set_title(s)
+sesmgr_title_set(s)
char *s
+
+SV *
+process_swentry(unsigned long pid = getpid(), unsigned long hwnd = NULLHANDLE);
+
+int
+swentry_size()
+
+SV *
+swentries_list()
+
+int
+WindowText_set(unsigned long hwndFrame, char *title)
+
+bool
+FocusWindow_set(unsigned long hwndFocus, unsigned long hwndDesktop = HWND_DESKTOP)
+
+bool
+ShowWindow(unsigned long hwnd, bool fShow = TRUE)
+
+bool
+PostMsg(unsigned long hwnd, unsigned long msg, unsigned long mp1 = 0, unsigned long mp2 = 0)
+
+bool
+WindowPos_set(unsigned long hwnd, long x, long y, unsigned long fl = SWP_MOVE, long cx = 0, long cy = 0, unsigned long hwndInsertBehind = HWND_TOP)
+
+unsigned long
+BeginEnumWindows(unsigned long hwnd)
+
+bool
+EndEnumWindows(unsigned long henum)
+
+unsigned long
+GetNextWindow(unsigned long henum)
+
+bool
+IsWindow(unsigned long hwnd, unsigned long hab = Acquire_hab())
+
+unsigned long
+QueryWindow(unsigned long hwnd, long cmd)
+
+unsigned long
+IsChild(unsigned long hwnd, unsigned long hwndParent)
+
+unsigned long
+WindowFromId(unsigned long hwndParent, unsigned long id)
+
+unsigned long
+WindowFromPoint(long x, long y, unsigned long hwnd, bool fChildren = 0)
+
+unsigned long
+EnumDlgItem(unsigned long hwndDlg, unsigned long code, unsigned long hwnd = NULLHANDLE)
+ C_ARGS: hwndDlg, hwnd, code
+
+int
+out_codepage()
+
+bool
+out_codepage_set(int cp)
+
+int
+in_codepage()
+
+bool
+in_codepage_set(int cp)
+
+SV *
+screen()
+
+bool
+screen_set(SV *sv)
+
+SV *
+process_codepages()
+ PPCODE:
+ {
+ ULONG cps[4], c, i = 0, rc;
+
+ if (CheckOSError(DosQueryCp( sizeof(cps), cps, &c )))
+ c = 0;
+ c /= sizeof(ULONG);
+ if (c >= 3)
+ EXTEND(sp, c);
+ while (i < c)
+ PUSHs(sv_2mortal(newSViv(cps[i++])));
+ }
+
+bool
+process_codepage_set(int cp)
+
+MODULE = OS2::Process PACKAGE = OS2::Process PREFIX = Query
+
+unsigned long
+QueryFocusWindow(unsigned long hwndDesktop = HWND_DESKTOP)
+
+long
+QueryWindowTextLength(unsigned long hwnd)
+
+SV *
+QueryWindowText(unsigned long hwnd)
+
+SV *
+QueryWindowSWP(unsigned long hwnd)
+
+SV *
+QueryClassName(unsigned long hwnd)
+
+MODULE = OS2::Process PACKAGE = OS2::Process PREFIX = myWin
+
+NO_OUTPUT BOOL
+myWinQueryWindowProcess(unsigned long hwnd, OUTLIST unsigned long pid, OUTLIST unsigned long tid)
+ POSTCALL:
+ if (CheckWinError(RETVAL))
+ croak("QueryWindowProcess() error");
+
+void
+cursor(OUTLIST int stp, OUTLIST int ep, OUTLIST int wp, OUTLIST int ap)
+
+bool
+cursor_set(int s, int e, int w = cursor__(0), int a = cursor__(1))
+
+int
+myWinSwitchToProgram(unsigned long hsw)
+ PREINIT:
+ ULONG rc;
+
+unsigned long
+myWinQueryActiveWindow(unsigned long hwnd = HWND_DESKTOP)
+
+MODULE = OS2::Process PACKAGE = OS2::Process PREFIX = get
+
+int
+getppid()
+
+int
+ppidOf(int pid = getpid())
+
+int
+sidOf(int pid = getpid())
+
+void
+getscrsize(OUTLIST int wp, OUTLIST int hp)
+
+bool
+scrsize_set(int w_or_h, int h = -9999)
diff --git a/os2/OS2/REXX/REXX.xs b/os2/OS2/REXX/REXX.xs
index f88d0afbc6..85944c75d2 100644
--- a/os2/OS2/REXX/REXX.xs
+++ b/os2/OS2/REXX/REXX.xs
@@ -25,9 +25,11 @@ static SHVBLOCK * vars;
static int nvars;
static char * trace;
+/*
static RXSTRING rxcommand = { 9, "RXCOMMAND" };
static RXSTRING rxsubroutine = { 12, "RXSUBROUTINE" };
static RXSTRING rxfunction = { 11, "RXFUNCTION" };
+*/
static ULONG PERLCALL(PCSZ name, ULONG argc, PRXSTRING argv, PCSZ queue, PRXSTRING ret);
@@ -43,16 +45,17 @@ static ULONG PERLCALL(PCSZ name, ULONG argc, PRXSTRING argv, PCSZ queue, PRXSTRI
static long incompartment;
+static LONG APIENTRY (*pRexxStart) (LONG, PRXSTRING, PSZ, PRXSTRING,
+ PSZ, LONG, PRXSYSEXIT, PSHORT, PRXSTRING);
+static APIRET APIENTRY (*pRexxRegisterFunctionExe) (PSZ,
+ RexxFunctionHandler *);
+static APIRET APIENTRY (*pRexxDeregisterFunction) (PSZ);
+
+static ULONG (*pRexxVariablePool) (PSHVBLOCK pRequest);
+
static SV*
exec_in_REXX(pTHX_ char *cmd, char * handlerName, RexxFunctionHandler *handler)
{
- HMODULE hRexx, hRexxAPI;
- BYTE buf[200];
- LONG APIENTRY (*pRexxStart) (LONG, PRXSTRING, PSZ, PRXSTRING,
- PSZ, LONG, PRXSYSEXIT, PSHORT, PRXSTRING);
- APIRET APIENTRY (*pRexxRegisterFunctionExe) (PSZ,
- RexxFunctionHandler *);
- APIRET APIENTRY (*pRexxDeregisterFunction) (PSZ);
RXSTRING args[1];
RXSTRING inst[2];
RXSTRING result;
@@ -64,16 +67,6 @@ exec_in_REXX(pTHX_ char *cmd, char * handlerName, RexxFunctionHandler *handler)
Perl_die(aTHX_ "Attempt to reenter into REXX compartment");
incompartment = 1;
- if (DosLoadModule(buf, sizeof buf, "REXX", &hRexx)
- || DosLoadModule(buf, sizeof buf, "REXXAPI", &hRexxAPI)
- || DosQueryProcAddr(hRexx, 0, "RexxStart", (PFN *)&pRexxStart)
- || DosQueryProcAddr(hRexxAPI, 0, "RexxRegisterFunctionExe",
- (PFN *)&pRexxRegisterFunctionExe)
- || DosQueryProcAddr(hRexxAPI, 0, "RexxDeregisterFunction",
- (PFN *)&pRexxDeregisterFunction)) {
- Perl_die(aTHX_ "REXX not available\n");
- }
-
if (handlerName)
pRexxRegisterFunctionExe(handlerName, handler);
@@ -86,8 +79,10 @@ exec_in_REXX(pTHX_ char *cmd, char * handlerName, RexxFunctionHandler *handler)
incompartment = 0;
pRexxDeregisterFunction("StartPerl");
+#if 0 /* Do we want to restore these? */
DosFreeModule(hRexxAPI);
DosFreeModule(hRexx);
+#endif
if (!RXNULLSTRING(result)) {
res = newSVpv(RXSTRPTR(result), RXSTRLEN(result));
DosFreeMem(RXSTRPTR(result));
@@ -128,7 +123,6 @@ PERLCALL(PCSZ name, ULONG argc, PRXSTRING argv, PCSZ queue, PRXSTRING ret)
int i, rc;
unsigned long len;
char *str;
- char **arr;
SV *res;
dSP;
@@ -207,6 +201,12 @@ needvars(int n)
static void
initialize(void)
{
+ *(PFN *)&pRexxStart = loadByOrdinal(ORD_RexxStart, 1);
+ *(PFN *)&pRexxRegisterFunctionExe
+ = loadByOrdinal(ORD_RexxRegisterFunctionExe, 1);
+ *(PFN *)&pRexxDeregisterFunction
+ = loadByOrdinal(ORD_RexxDeregisterFunction, 1);
+ *(PFN *)&pRexxVariablePool = loadByOrdinal(ORD_RexxVariablePool, 1);
needstrs(8);
needvars(8);
trace = getenv("PERL_REXX_DEBUG");
@@ -262,15 +262,15 @@ _set(name,value,...)
MAKERXSTRING(var->shvvalue, value, valuelen);
if (trace)
fprintf(stderr, " %.*s='%.*s'",
- var->shvname.strlength, var->shvname.strptr,
- var->shvvalue.strlength, var->shvvalue.strptr);
+ (int)var->shvname.strlength, var->shvname.strptr,
+ (int)var->shvvalue.strlength, var->shvvalue.strptr);
}
if (trace)
fprintf(stderr, "\n");
vars[n-1].shvnext = NULL;
- rc = RexxVariablePool(vars);
+ rc = pRexxVariablePool(vars);
if (trace)
- fprintf(stderr, " rc=%X\n", rc);
+ fprintf(stderr, " rc=%#lX\n", rc);
RETVAL = (rc & ~RXSHV_NEWV) ? FALSE : TRUE;
}
OUTPUT:
@@ -303,7 +303,7 @@ _fetch(name, ...)
if (trace)
fprintf(stderr, "\n");
vars[items-1].shvnext = NULL;
- rc = RexxVariablePool(vars);
+ rc = pRexxVariablePool(vars);
if (!(rc & ~RXSHV_NEWV)) {
for (i = 0; i < items; ++i) {
int namelen;
@@ -315,7 +315,7 @@ _fetch(name, ...)
namelen = var->shvvaluelen; /* is */
if (trace)
fprintf(stderr, " %.*s='%.*s'\n",
- var->shvname.strlength, var->shvname.strptr,
+ (int)var->shvname.strlength, var->shvname.strptr,
namelen, var->shvvalue.strptr);
if (var->shvret & RXSHV_NEWV || !var->shvvalue.strptr)
PUSHs(&PL_sv_undef);
@@ -325,7 +325,7 @@ _fetch(name, ...)
}
} else {
if (trace)
- fprintf(stderr, " rc=%X\n", rc);
+ fprintf(stderr, " rc=%#lX\n", rc);
}
}
@@ -351,7 +351,7 @@ _next(stem)
DosFreeMem(sv.shvvalue.strptr);
MAKERXSTRING(sv.shvvalue, NULL, 0);
}
- rc = RexxVariablePool(&sv);
+ rc = pRexxVariablePool(&sv);
} while (!rc && memcmp(stem, sv.shvname.strptr, len) != 0);
if (!rc) {
EXTEND(SP, 2);
@@ -377,7 +377,7 @@ _next(stem)
die("Error %i when in _next", rc);
} else {
if (trace)
- fprintf(stderr, " rc=%X\n", rc);
+ fprintf(stderr, " rc=%#lX\n", rc);
}
}
@@ -400,7 +400,7 @@ _drop(name,...)
MAKERXSTRING(var->shvvalue, NULL, 0);
}
vars[items-1].shvnext = NULL;
- RETVAL = (RexxVariablePool(vars) & ~RXSHV_NEWV) ? FALSE : TRUE;
+ RETVAL = (pRexxVariablePool(vars) & ~RXSHV_NEWV) ? FALSE : TRUE;
}
OUTPUT:
RETVAL
@@ -409,7 +409,7 @@ int
_register(name)
char * name
CODE:
- RETVAL = RexxRegisterFunctionExe(name, PERLCALL);
+ RETVAL = pRexxRegisterFunctionExe(name, PERLCALL);
OUTPUT:
RETVAL
diff --git a/os2/dl_os2.c b/os2/dl_os2.c
index aaeeb580f4..5c8b6e6871 100644
--- a/os2/dl_os2.c
+++ b/os2/dl_os2.c
@@ -11,18 +11,21 @@ static char fail[300];
char *os2error(int rc);
void *
-dlopen(char *path, int mode)
+dlopen(const char *path, int mode)
{
HMODULE handle;
char tmp[260], *beg, *dot;
ULONG rc;
fail[0] = 0;
- if ((rc = DosLoadModule(fail, sizeof fail, path, &handle)) == 0)
+ if ((rc = DosLoadModule(fail, sizeof fail, (char*)path, &handle)) == 0)
return (void *)handle;
retcode = rc;
+ if (strlen(path) >= sizeof(tmp))
+ return NULL;
+
/* Not found. Check for non-FAT name and try truncated name. */
/* Don't know if this helps though... */
for (beg = dot = path + strlen(path);
@@ -32,6 +35,7 @@ dlopen(char *path, int mode)
dot = beg;
if (dot - beg > 8) {
int n = beg+8-path;
+
memmove(tmp, path, n);
memmove(tmp+n, dot, strlen(dot)+1);
if (DosLoadModule(fail, sizeof fail, tmp, &handle) == 0)
@@ -42,7 +46,7 @@ dlopen(char *path, int mode)
}
void *
-dlsym(void *handle, char *symbol)
+dlsym(void *handle, const char *symbol)
{
ULONG rc, type;
PFN addr;
diff --git a/os2/dlfcn.h b/os2/dlfcn.h
index c2feee6000..80e5aac52e 100644
--- a/os2/dlfcn.h
+++ b/os2/dlfcn.h
@@ -1,4 +1,4 @@
-void *dlopen(char *path, int mode);
-void *dlsym(void *handle, char *symbol);
+void *dlopen(const char *path, int mode);
+void *dlsym(void *handle, const char *symbol);
char *dlerror(void);
int dlclose(void *handle);
diff --git a/os2/os2.c b/os2/os2.c
index 67fe3b750d..03c06edd73 100644
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -186,83 +186,199 @@ os2_cond_wait(perl_cond *c, perl_mutex *m)
/*****************************************************************************/
/* 2.1 would not resolve symbols on demand, and has no ExtLIBPATH. */
-static PFN ExtFCN[2]; /* Labeled by ord below. */
-static USHORT loadOrd[2] = { 874, 873 }; /* Query=874, Set=873. */
-#define ORD_QUERY_ELP 0
-#define ORD_SET_ELP 1
+#define C_ARR_LEN(sym) (sizeof(sym)/sizeof(*sym))
+
+struct dll_handle {
+ const char *modname;
+ HMODULE handle;
+};
+static struct dll_handle doscalls_handle = {"doscalls", 0};
+static struct dll_handle tcp_handle = {"tcp32dll", 0};
+static struct dll_handle pmwin_handle = {"pmwin", 0};
+static struct dll_handle rexx_handle = {"rexx", 0};
+static struct dll_handle rexxapi_handle = {"rexxapi", 0};
+static struct dll_handle sesmgr_handle = {"sesmgr", 0};
+static struct dll_handle pmshapi_handle = {"pmshapi", 0};
+
+/* This should match enum entries_ordinals defined in os2ish.h. */
+static const struct {
+ struct dll_handle *dll;
+ const char *entryname;
+ int entrypoint;
+} loadOrdinals[ORD_NENTRIES] = {
+ {&doscalls_handle, NULL, 874}, /* DosQueryExtLibpath */
+ {&doscalls_handle, NULL, 873}, /* DosSetExtLibpath */
+ {&doscalls_handle, NULL, 460}, /* DosVerifyPidTid */
+ {&tcp_handle, "SETHOSTENT", 0},
+ {&tcp_handle, "SETNETENT" , 0},
+ {&tcp_handle, "SETPROTOENT", 0},
+ {&tcp_handle, "SETSERVENT", 0},
+ {&tcp_handle, "GETHOSTENT", 0},
+ {&tcp_handle, "GETNETENT" , 0},
+ {&tcp_handle, "GETPROTOENT", 0},
+ {&tcp_handle, "GETSERVENT", 0},
+ {&tcp_handle, "ENDHOSTENT", 0},
+ {&tcp_handle, "ENDNETENT", 0},
+ {&tcp_handle, "ENDPROTOENT", 0},
+ {&tcp_handle, "ENDSERVENT", 0},
+ {&pmwin_handle, NULL, 763}, /* WinInitialize */
+ {&pmwin_handle, NULL, 716}, /* WinCreateMsgQueue */
+ {&pmwin_handle, NULL, 726}, /* WinDestroyMsgQueue */
+ {&pmwin_handle, NULL, 918}, /* WinPeekMsg */
+ {&pmwin_handle, NULL, 915}, /* WinGetMsg */
+ {&pmwin_handle, NULL, 912}, /* WinDispatchMsg */
+ {&pmwin_handle, NULL, 753}, /* WinGetLastError */
+ {&pmwin_handle, NULL, 705}, /* WinCancelShutdown */
+ /* These are needed in extensions.
+ How to protect PMSHAPI: it comes through EMX functions? */
+ {&rexx_handle, "RexxStart", 0},
+ {&rexx_handle, "RexxVariablePool", 0},
+ {&rexxapi_handle, "RexxRegisterFunctionExe", 0},
+ {&rexxapi_handle, "RexxDeregisterFunction", 0},
+ {&sesmgr_handle, "DOSSMSETTITLE", 0}, /* Would not work runtime-loaded */
+ {&pmshapi_handle, "PRF32QUERYPROFILESIZE", 0},
+ {&pmshapi_handle, "PRF32OPENPROFILE", 0},
+ {&pmshapi_handle, "PRF32CLOSEPROFILE", 0},
+ {&pmshapi_handle, "PRF32QUERYPROFILE", 0},
+ {&pmshapi_handle, "PRF32RESET", 0},
+ {&pmshapi_handle, "PRF32QUERYPROFILEDATA", 0},
+ {&pmshapi_handle, "PRF32WRITEPROFILEDATA", 0},
+
+ /* At least some of these do not work by name, since they need
+ WIN32 instead of WIN... */
+#if 0
+ These were generated with
+ nm I:\emx\lib\os2.a | fgrep -f API-list | grep = > API-list-entries
+ perl -wnle "next unless /^0+\s+E\s+_(\w+)=(\w+).(\d+)/; print qq( ORD_$1,)" API-list-entries > API-list-ORD_
+ perl -wnle "next unless /^0+\s+E\s+_(\w+)=(\w+).(\d+)/; print qq( {${2}_handle, NULL, $3},\t\t/* $1 */)" WinSwitch-API-list-entries >API-list-entry
+#endif
+ {&pmshapi_handle, NULL, 123}, /* WinChangeSwitchEntry */
+ {&pmshapi_handle, NULL, 124}, /* WinQuerySwitchEntry */
+ {&pmshapi_handle, NULL, 125}, /* WinQuerySwitchHandle */
+ {&pmshapi_handle, NULL, 126}, /* WinQuerySwitchList */
+ {&pmshapi_handle, NULL, 131}, /* WinSwitchToProgram */
+ {&pmwin_handle, NULL, 702}, /* WinBeginEnumWindows */
+ {&pmwin_handle, NULL, 737}, /* WinEndEnumWindows */
+ {&pmwin_handle, NULL, 740}, /* WinEnumDlgItem */
+ {&pmwin_handle, NULL, 756}, /* WinGetNextWindow */
+ {&pmwin_handle, NULL, 768}, /* WinIsChild */
+ {&pmwin_handle, NULL, 799}, /* WinQueryActiveWindow */
+ {&pmwin_handle, NULL, 805}, /* WinQueryClassName */
+ {&pmwin_handle, NULL, 817}, /* WinQueryFocus */
+ {&pmwin_handle, NULL, 834}, /* WinQueryWindow */
+ {&pmwin_handle, NULL, 837}, /* WinQueryWindowPos */
+ {&pmwin_handle, NULL, 838}, /* WinQueryWindowProcess */
+ {&pmwin_handle, NULL, 841}, /* WinQueryWindowText */
+ {&pmwin_handle, NULL, 842}, /* WinQueryWindowTextLength */
+ {&pmwin_handle, NULL, 860}, /* WinSetFocus */
+ {&pmwin_handle, NULL, 875}, /* WinSetWindowPos */
+ {&pmwin_handle, NULL, 877}, /* WinSetWindowText */
+ {&pmwin_handle, NULL, 883}, /* WinShowWindow */
+ {&pmwin_handle, NULL, 872}, /* WinIsWindow */
+ {&pmwin_handle, NULL, 899}, /* WinWindowFromId */
+ {&pmwin_handle, NULL, 900}, /* WinWindowFromPoint */
+ {&pmwin_handle, NULL, 919}, /* WinPostMsg */
+};
+
+static PFN ExtFCN[C_ARR_LEN(loadOrdinals)]; /* Labeled by ord ORD_*. */
+const Perl_PFN * const pExtFCN = ExtFCN;
struct PMWIN_entries_t PMWIN_entries;
HMODULE
-loadModule(char *modname)
+loadModule(const char *modname, int fail)
{
HMODULE h = (HMODULE)dlopen(modname, 0);
- if (!h)
+
+ if (!h && fail)
Perl_croak_nocontext("Error loading module '%s': %s",
modname, dlerror());
return h;
}
-void
-loadByOrd(char *modname, ULONG ord)
+PFN
+loadByOrdinal(enum entries_ordinals ord, int fail)
{
if (ExtFCN[ord] == NULL) {
- static HMODULE hdosc = 0;
PFN fcn = (PFN)-1;
APIRET rc;
- if (!hdosc)
- hdosc = loadModule(modname);
- if (CheckOSError(DosQueryProcAddr(hdosc, loadOrd[ord], NULL, &fcn)))
+ if (!loadOrdinals[ord].dll->handle)
+ loadOrdinals[ord].dll->handle
+ = loadModule(loadOrdinals[ord].dll->modname, fail);
+ if (!loadOrdinals[ord].dll->handle)
+ return 0; /* Possible with FAIL==0 only */
+ if (CheckOSError(DosQueryProcAddr(loadOrdinals[ord].dll->handle,
+ loadOrdinals[ord].entrypoint,
+ loadOrdinals[ord].entryname,&fcn))) {
+ char buf[20], *s = (char*)loadOrdinals[ord].entryname;
+
+ if (!fail)
+ return 0;
+ if (!s)
+ sprintf(s = buf, "%d", loadOrdinals[ord].entrypoint);
Perl_croak_nocontext(
- "This version of OS/2 does not support %s.%i",
- modname, loadOrd[ord]);
+ "This version of OS/2 does not support %s.%s",
+ loadOrdinals[ord].dll->modname, s);
+ }
ExtFCN[ord] = fcn;
}
- if ((long)ExtFCN[ord] == -1)
+ if ((long)ExtFCN[ord] == -1)
Perl_croak_nocontext("panic queryaddr");
+ return ExtFCN[ord];
}
void
init_PMWIN_entries(void)
{
- static HMODULE hpmwin = 0;
- static const int ords[] = {
- 763, /* Initialize */
- 716, /* CreateMsgQueue */
- 726, /* DestroyMsgQueue */
- 918, /* PeekMsg */
- 915, /* GetMsg */
- 912, /* DispatchMsg */
- 753, /* GetLastError */
- 705, /* CancelShutdown */
- };
- int i = 0;
- unsigned long rc;
-
- if (hpmwin)
- return;
-
- hpmwin = loadModule("pmwin");
- while (i < sizeof(ords)/sizeof(int)) {
- if (CheckOSError(DosQueryProcAddr(hpmwin, ords[i], NULL,
- ((PFN*)&PMWIN_entries)+i)))
- Perl_croak_nocontext("This version of OS/2 does not support pmwin.%d", ords[i]);
- i++;
- }
+ int i;
+
+ for (i = ORD_WinInitialize; i <= ORD_WinCancelShutdown; i++)
+ ((PFN*)&PMWIN_entries)[i - ORD_WinInitialize] = loadByOrdinal(i, 1);
}
+/*****************************************************/
+/* socket forwarders without linking with tcpip DLLs */
+
+DeclFuncByORD(struct hostent *, gethostent, ORD_GETHOSTENT, (void), ())
+DeclFuncByORD(struct netent *, getnetent, ORD_GETNETENT, (void), ())
+DeclFuncByORD(struct protoent *, getprotoent, ORD_GETPROTOENT, (void), ())
+DeclFuncByORD(struct servent *, getservent, ORD_GETSERVENT, (void), ())
+
+DeclVoidFuncByORD(sethostent, ORD_SETHOSTENT, (int x), (x))
+DeclVoidFuncByORD(setnetent, ORD_SETNETENT, (int x), (x))
+DeclVoidFuncByORD(setprotoent, ORD_SETPROTOENT, (int x), (x))
+DeclVoidFuncByORD(setservent, ORD_SETSERVENT, (int x), (x))
+
+DeclVoidFuncByORD(endhostent, ORD_ENDHOSTENT, (void), ())
+DeclVoidFuncByORD(endnetent, ORD_ENDNETENT, (void), ())
+DeclVoidFuncByORD(endprotoent, ORD_ENDPROTOENT, (void), ())
+DeclVoidFuncByORD(endservent, ORD_ENDSERVENT, (void), ())
/* priorities */
static signed char priors[] = {0, 1, 3, 2}; /* Last two interchanged,
self inverse. */
#define QSS_INI_BUFFER 1024
+ULONG (*pDosVerifyPidTid) (PID pid, TID tid);
+static int pidtid_lookup;
+
PQTOPLEVEL
get_sysinfo(ULONG pid, ULONG flags)
{
char *pbuffer;
ULONG rc, buf_len = QSS_INI_BUFFER;
+ PQTOPLEVEL psi;
+ if (!pidtid_lookup) {
+ pidtid_lookup = 1;
+ *(PFN*)&pDosVerifyPidTid = loadByOrdinal(ORD_DosVerifyPidTid, 0);
+ }
+ if (pDosVerifyPidTid) { /* Warp3 or later */
+ /* Up to some fixpak QuerySysState() kills the system if a non-existent
+ pid is used. */
+ if (!pDosVerifyPidTid(pid, 1))
+ return 0;
+ }
New(1322, pbuffer, buf_len, char);
/* QSS_PROCESS | QSS_MODULE | QSS_SEMAPHORES | QSS_SHARED */
rc = QuerySysState(flags, pid, pbuffer, buf_len);
@@ -275,7 +391,12 @@ get_sysinfo(ULONG pid, ULONG flags)
Safefree(pbuffer);
return 0;
}
- return (PQTOPLEVEL)pbuffer;
+ psi = (PQTOPLEVEL)pbuffer;
+ if (psi && pid && pid != psi->procdata->pid) {
+ Safefree(psi);
+ Perl_croak_nocontext("panic: wrong pid in sysinfo");
+ }
+ return psi;
}
#define PRIO_ERR 0x1111
@@ -286,14 +407,11 @@ sys_prio(pid)
ULONG prio;
PQTOPLEVEL psi;
+ if (!pid)
+ return PRIO_ERR;
psi = get_sysinfo(pid, QSS_PROCESS);
- if (!psi) {
+ if (!psi)
return PRIO_ERR;
- }
- if (pid != psi->procdata->pid) {
- Safefree(psi);
- Perl_croak_nocontext("panic: wrong pid in sysinfo");
- }
prio = psi->procdata->threads->priority;
Safefree(psi);
return prio;
@@ -331,12 +449,6 @@ setpriority(int which, int pid, int val)
abs(pid)))
? -1 : 0;
}
-/* else return CheckOSError(DosSetPriority((pid < 0) */
-/* ? PRTYS_PROCESSTREE : PRTYS_PROCESS, */
-/* priors[(32 - val) >> 5] + 1, */
-/* (32 - val) % 32 - (prio & 0xFF), */
-/* abs(pid))) */
-/* ? -1 : 0; */
}
int
@@ -1122,51 +1234,6 @@ char * ctermid(char *s) { return 0; }
void * ttyname(x) { return 0; }
#endif
-/******************************************************************/
-/* my socket forwarders - EMX lib only provides static forwarders */
-
-static HMODULE htcp = 0;
-
-static void *
-tcp0(char *name)
-{
- PFN fcn;
-
- if (!(_emx_env & 0x200)) Perl_croak_nocontext("%s requires OS/2", name); /* Die if not OS/2. */
- if (!htcp)
- htcp = loadModule("tcp32dll");
- if (htcp && DosQueryProcAddr(htcp, 0, name, &fcn) == 0)
- return (void *) ((void * (*)(void)) fcn) ();
- return 0;
-}
-
-static void
-tcp1(char *name, int arg)
-{
- static BYTE buf[20];
- PFN fcn;
-
- if (!(_emx_env & 0x200)) Perl_croak_nocontext("%s requires OS/2", name); /* Die if not OS/2. */
- if (!htcp)
- DosLoadModule(buf, sizeof buf, "tcp32dll", &htcp);
- if (htcp && DosQueryProcAddr(htcp, 0, name, &fcn) == 0)
- ((void (*)(int)) fcn) (arg);
-}
-
-struct hostent * gethostent() { return tcp0("GETHOSTENT"); }
-struct netent * getnetent() { return tcp0("GETNETENT"); }
-struct protoent * getprotoent() { return tcp0("GETPROTOENT"); }
-struct servent * getservent() { return tcp0("GETSERVENT"); }
-
-void sethostent(x) { tcp1("SETHOSTENT", x); }
-void setnetent(x) { tcp1("SETNETENT", x); }
-void setprotoent(x) { tcp1("SETPROTOENT", x); }
-void setservent(x) { tcp1("SETSERVENT", x); }
-void endhostent() { tcp0("ENDHOSTENT"); }
-void endnetent() { tcp0("ENDNETENT"); }
-void endprotoent() { tcp0("ENDPROTOENT"); }
-void endservent() { tcp0("ENDSERVENT"); }
-
/*****************************************************************************/
/* not implemented in C Set++ */
@@ -2012,22 +2079,22 @@ APIRET
ExtLIBPATH(ULONG ord, PSZ path, IV type)
{
ULONG what;
+ PFN f = loadByOrdinal(ord, 1); /* Guarantied to load or die! */
- loadByOrd("doscalls",ord); /* Guarantied to load or die! */
if (type > 0)
what = END_LIBPATH;
else if (type == 0)
what = BEGIN_LIBPATH;
else
what = LIBPATHSTRICT;
- return (*(PELP)ExtFCN[ord])(path, what);
+ return (*(PELP)f)(path, what);
}
#define extLibpath(to,type) \
- (CheckOSError(ExtLIBPATH(ORD_QUERY_ELP, (to), (type))) ? NULL : (to) )
+ (CheckOSError(ExtLIBPATH(ORD_DosQueryExtLibpath, (to), (type))) ? NULL : (to) )
#define extLibpath_set(p,type) \
- (!CheckOSError(ExtLIBPATH(ORD_SET_ELP, (p), (type))))
+ (!CheckOSError(ExtLIBPATH(ORD_DosSetExtLibpath, (p), (type))))
XS(XS_Cwd_extLibpath)
{
diff --git a/os2/os2_base.t b/os2/os2_base.t
new file mode 100644
index 0000000000..ceaeb3f9eb
--- /dev/null
+++ b/os2/os2_base.t
@@ -0,0 +1,49 @@
+print "1.." . lasttest() . "\n";
+
+$cwd = Cwd::sys_cwd();
+print "ok 1\n";
+print "not " unless -d $cwd;
+print "ok 2\n";
+
+$lpb = Cwd::extLibpath;
+print "ok 3\n";
+$lpb .= ';' unless $lpb and $lpb =~ /;$/;
+
+$lpe = Cwd::extLibpath(1);
+print "ok 4\n";
+$lpe .= ';' unless $lpe and $lpe =~ /;$/;
+
+Cwd::extLibpath_set("$lpb$cwd") or print "not ";
+print "ok 5\n";
+
+$lpb = Cwd::extLibpath;
+print "ok 6\n";
+$lpb =~ s#\\#/#g;
+($s_cwd = $cwd) =~ s#\\#/#g;
+
+print "not " unless $lpb =~ /\Q$s_cwd/;
+print "ok 7\n";
+
+Cwd::extLibpath_set("$lpe$cwd", 1) or print "not ";
+print "ok 8\n";
+
+$lpe = Cwd::extLibpath(1);
+print "ok 9\n";
+$lpe =~ s#\\#/#g;
+
+print "not " unless $lpe =~ /\Q$s_cwd/;
+print "ok 10\n";
+
+unshift @INC, 'lib';
+require OS2::Process;
+@l = OS2::Process::process_entry();
+print "not " unless @l == 11;
+print "ok 11\n";
+
+# 1: FS 2: Window-VIO
+print "not " unless $l[9] == 1 or $l[9] == 2;
+print "ok 12\n";
+
+print "# $_\n" for @l;
+
+sub lasttest {12}
diff --git a/os2/os2ish.h b/os2/os2ish.h
index e6cbe108fa..7f3393ba62 100644
--- a/os2/os2ish.h
+++ b/os2/os2ish.h
@@ -469,9 +469,94 @@ void init_PMWIN_entries(void);
#define STATIC_FILE_LENGTH 127
+ /* This should match loadOrdinals[] array in os2.c */
+enum entries_ordinals {
+ ORD_DosQueryExtLibpath,
+ ORD_DosSetExtLibpath,
+ ORD_DosVerifyPidTid,
+ ORD_SETHOSTENT,
+ ORD_SETNETENT,
+ ORD_SETPROTOENT,
+ ORD_SETSERVENT,
+ ORD_GETHOSTENT,
+ ORD_GETNETENT,
+ ORD_GETPROTOENT,
+ ORD_GETSERVENT,
+ ORD_ENDHOSTENT,
+ ORD_ENDNETENT,
+ ORD_ENDPROTOENT,
+ ORD_ENDSERVENT,
+ ORD_WinInitialize,
+ ORD_WinCreateMsgQueue,
+ ORD_WinDestroyMsgQueue,
+ ORD_WinPeekMsg,
+ ORD_WinGetMsg,
+ ORD_WinDispatchMsg,
+ ORD_WinGetLastError,
+ ORD_WinCancelShutdown,
+ ORD_RexxStart,
+ ORD_RexxVariablePool,
+ ORD_RexxRegisterFunctionExe,
+ ORD_RexxDeregisterFunction,
+ ORD_DOSSMSETTITLE,
+ ORD_PRF32QUERYPROFILESIZE,
+ ORD_PRF32OPENPROFILE,
+ ORD_PRF32CLOSEPROFILE,
+ ORD_PRF32QUERYPROFILE,
+ ORD_PRF32RESET,
+ ORD_PRF32QUERYPROFILEDATA,
+ ORD_PRF32WRITEPROFILEDATA,
+
+ ORD_WinChangeSwitchEntry,
+ ORD_WinQuerySwitchEntry,
+ ORD_WinQuerySwitchHandle,
+ ORD_WinQuerySwitchList,
+ ORD_WinSwitchToProgram,
+ ORD_WinBeginEnumWindows,
+ ORD_WinEndEnumWindows,
+ ORD_WinEnumDlgItem,
+ ORD_WinGetNextWindow,
+ ORD_WinIsChild,
+ ORD_WinQueryActiveWindow,
+ ORD_WinQueryClassName,
+ ORD_WinQueryFocus,
+ ORD_WinQueryWindow,
+ ORD_WinQueryWindowPos,
+ ORD_WinQueryWindowProcess,
+ ORD_WinQueryWindowText,
+ ORD_WinQueryWindowTextLength,
+ ORD_WinSetFocus,
+ ORD_WinSetWindowPos,
+ ORD_WinSetWindowText,
+ ORD_WinShowWindow,
+ ORD_WinIsWindow,
+ ORD_WinWindowFromId,
+ ORD_WinWindowFromPoint,
+ ORD_WinPostMsg,
+ ORD_NENTRIES
+};
+
+/* RET: return type, AT: argument signature in (), ARGS: should be in () */
+#define CallORD(ret,o,at,args) (((ret (*)at) loadByOrdinal(o, 1))args)
+#define DeclFuncByORD(ret,name,o,at,args) \
+ ret name at { return CallORD(ret,o,at,args); }
+#define DeclVoidFuncByORD(name,o,at,args) \
+ void name at { CallORD(void,o,at,args); }
+
+/* These functions return false on error, and save the error info in $^E */
+#define DeclOSFuncByORD(ret,name,o,at,args) \
+ ret name at { unsigned long rc; return !CheckOSError(CallORD(ret,o,at,args)); }
+#define DeclWinFuncByORD(ret,name,o,at,args) \
+ ret name at { return SaveWinError(CallORD(ret,o,at,args)); }
+
+#define AssignFuncPByORD(p,o) (*(Perl_PFN*)&(p) = (loadByOrdinal(o, 1)))
+
#define PERLLIB_MANGLE(s, n) perllib_mangle((s), (n))
char *perllib_mangle(char *, unsigned int);
+typedef int (*Perl_PFN)();
+Perl_PFN loadByOrdinal(enum entries_ordinals ord, int fail);
+extern const Perl_PFN * const pExtFCN;
char *os2error(int rc);
int os2_stat(const char *name, struct stat *st);
int setpriority(int which, int pid, int val);
View Lorry Controller Status