diff options
author | Ilya Zakharevich <ilya@math.berkeley.edu> | 2001-06-28 12:03:14 -0400 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2001-06-28 19:10:54 +0000 |
commit | 35bc1fdc44cabda9b94bf3b2cbffe0be67fef25d (patch) | |
tree | ce362683cbc25c281c69b49928a386e14df2dd92 /os2 | |
parent | 531b886104fed3302a6d671985aba5e2f6420dd5 (diff) | |
download | perl-35bc1fdc44cabda9b94bf3b2cbffe0be67fef25d.tar.gz |
OS/2 improvements
Message-ID: <20010628160314.A17906@math.ohio-state.edu>
p4raw-id: //depot/perl@11010
Diffstat (limited to 'os2')
-rw-r--r-- | os2/OS2/PrfDB/PrfDB.xs | 48 | ||||
-rw-r--r-- | os2/OS2/Process/Process.pm | 660 | ||||
-rw-r--r-- | os2/OS2/Process/Process.xs | 794 | ||||
-rw-r--r-- | os2/OS2/REXX/REXX.xs | 58 | ||||
-rw-r--r-- | os2/dl_os2.c | 10 | ||||
-rw-r--r-- | os2/dlfcn.h | 4 | ||||
-rw-r--r-- | os2/os2.c | 269 | ||||
-rw-r--r-- | os2/os2_base.t | 49 | ||||
-rw-r--r-- | os2/os2ish.h | 85 |
9 files changed, 1748 insertions, 229 deletions
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); @@ -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); |