1# Copyright 2011, 2012, 2013, 2014, 2017 Kevin Ryde 2 3# This file is part of X11-Protocol-Other. 4# 5# X11-Protocol-Other is free software; you can redistribute it and/or 6# modify it under the terms of the GNU General Public License as published 7# by the Free Software Foundation; either version 3, or (at your option) any 8# later version. 9# 10# X11-Protocol-Other is distributed in the hope that it will be useful, 11# but WITHOUT ANY WARRANTY; without even the implied warranty of 12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 13# Public License for more details. 14# 15# You should have received a copy of the GNU General Public License along 16# with X11-Protocol-Other. If not, see <http://www.gnu.org/licenses/>. 17 18BEGIN { require 5 } 19package X11::Protocol::Ext::XTEST; 20use strict; 21use X11::Protocol; 22 23use vars '$VERSION', '@CARP_NOT'; 24$VERSION = 31; 25@CARP_NOT = ('X11::Protocol'); 26 27# uncomment this to run the ### lines 28#use Smart::Comments; 29 30 31# /usr/share/doc/x11proto-xext-dev/xtest.txt.gz 32# 33# /usr/include/X11/extensions/xtestproto.h 34# /usr/include/X11/extensions/xtestconst.h 35# 36# /usr/include/X11/extensions/xtestext1proto.h 37# /usr/include/X11/extensions/xtestext1const.h 38# /usr/include/X11/extensions/xtestext1.h 39# 40# /usr/include/X11/extensions/XTest.h 41# /usr/share/doc/libxext-dev/xtest1.txt.gz 42# lib/Xext/XTestExt1.c 43# Xlib 44# 45# Server side xtest.c 46# 47# /usr/share/doc/x11proto-core-dev/x11protocol.txt.gz 48# /usr/share/doc/x11proto-input-dev/XIproto.txt.gz 49# /usr/share/doc/x11proto-input-dev/XI2proto.txt.gz 50# /usr/include/X11/extensions/XIproto.h 51# /usr/include/X11/extensions/xtestconst.h 52 53 54# these not documented yet ... 55use constant CLIENT_MAJOR_VERSION => 2; 56use constant CLIENT_MINOR_VERSION => 2; 57 58my $reqs = 59 [ 60 ['XTestGetVersion', # 0 61 sub { 62 my ($X, $major, $minor) = @_; 63 return pack 'CxS', $major, $minor; 64 }, 65 sub { 66 my ($X, $data) = @_; 67 return unpack 'xCxxxxS', $data; 68 69 # Any interest in holding onto the version? 70 # my ($server_major, $server_minor) = unpack 'xCxxxxS', $data; 71 # ### $server_major 72 # ### $server_minor 73 # my $self; 74 # if ($self = $self->{'ext'}{'XTEST'}->[3]) { 75 # $self->{'major'} = $server_major; 76 # $self->{'minor'} = $server_minor; 77 # } 78 # return ($server_major, $server_minor); 79 }], 80 81 ['XTestCompareCursor', # 1 82 sub { 83 my ($X, $window, $cursor) = @_; 84 return pack ('LL', 85 $window, 86 $cursor eq 'CurrentCursor' ? 1 : _num_none($cursor)); 87 }, 88 sub { 89 my ($X, $data) = @_; 90 return unpack 'xC', $data; 91 }], 92 93 ['XTestFakeInput', # 2 94 sub { 95 my $X = shift; 96 if (ref $_[0] eq 'ARRAY') { 97 # one or more packets by arrayrefs 98 return join('',map {_fake_input_pack($X,@$_)} @_); 99 } else { 100 # one packet by event fields 101 return _fake_input_pack($X,@_); 102 } 103 } ], 104 105 ['XTestGrabControl', # 3 106 sub { 107 my ($X, $impervious) = @_; 108 return pack 'Cxxx', $impervious; 109 }], 110 ]; 111 112sub _fake_input_pack { 113 my $X = shift; 114 my %h = @_; 115 116 if ($h{'name'} =~ /^(MotionNotify|(Key|Button)(Press|Release))$/) { 117 118 # avoid some undef warnings from pack_event() in X11::Protocol 0.56 119 local $^W = 0; 120 121 return $X->pack_event (detail => 0, # defaults 122 root_x => 0, 123 root_y => 0, 124 root => 0, # default current screen 125 time => 0, # default no delay 126 127 # unused by XTestFakeInput, zero for the pack 128 event => 0, # window 129 child => 0, # window 130 event_x => 0, 131 event_y => 0, 132 state => 0, 133 same_screen => 0, 134 135 @_); 136 } else { 137 return $X->pack_event (@_); 138 } 139} 140 141sub _num_time { 142 my ($time) = @_; 143 if (defined $time && $time eq 'CurrentTime') { 144 return 0; 145 } else { 146 return $time; 147 } 148} 149sub _num_none { 150 my ($xid) = @_; 151 if (defined $xid && $xid eq "None") { 152 return 0; 153 } else { 154 return $xid; 155 } 156} 157 158sub new { 159 my ($class, $X, $request_num, $event_num, $error_num) = @_; 160 ### XTest new() 161 162 # Requests 163 _ext_requests_install ($X, $request_num, $reqs); 164 165 # Any need to negotiate the version before using? 166 # my ($major, $minor) = $X->req('XTestQueryVersion', 167 # CLIENT_MAJOR_VERSION, 168 # CLIENT_MINOR_VERSION); 169 # if ($major != 1) { 170 # carp "Unrecognised XTest major version, got $major want 1"; 171 # return 0; 172 # } 173 return bless { 174 # major => $major, 175 # minor => $minor, 176 }, $class; 177} 178 179sub _ext_requests_install { 180 my ($X, $request_num, $reqs) = @_; 181 182 $X->{'ext_request'}->{$request_num} = $reqs; 183 my $href = $X->{'ext_request_num'}; 184 my $i; 185 foreach $i (0 .. $#$reqs) { 186 $href->{$reqs->[$i]->[0]} = [$request_num, $i]; 187 } 188} 189 1901; 191__END__ 192 193=for stopwords XTEST CurrentCursor hashref KeyPress KeyRelease keycode ButtonPress ButtonRelase MotionNotify CurrentTime umm XInputExtension XID Ryde recognised arrayrefs timestamp lookup ie GrabServer Imperviousness Xlib 194 195=head1 NAME 196 197X11::Protocol::Ext::XTEST - synthetic user input and more 198 199=head1 SYNOPSIS 200 201 use X11::Protocol; 202 my $X = X11::Protocol->new; 203 $X->init_extension('XTEST') 204 or print "XTEST extension not available"; 205 206 $X->XTestFakeInput (name => 'ButtonPress', 207 detail => 3); # physical button 3 208 $X->XTestFakeInput (name => 'ButtonRelease', 209 detail => 3); 210 211=head1 DESCRIPTION 212 213The XTEST extension provides 214 215=over 216 217=item * 218 219Synthetic keyboard and mouse pointer actions. 220 221=item * 222 223Displayed cursor comparisons. 224 225=item * 226 227Test programs continuing during C<GrabServer> by other clients. 228 229=back 230 231These things help exercise library or server features which would otherwise 232require user interaction. 233 234=head1 REQUESTS 235 236The following requests are made available with an C<init_extension()>, as 237per L<X11::Protocol/EXTENSIONS>. 238 239 my $is_available = $X->init_extension('XTEST'); 240 241=over 242 243=item C<($server_major, $server_minor) = $X-E<gt>XTestGetVersion ($client_major, $client_minor)> 244 245Negotiate a protocol version with the server. C<$client_major> and 246C<$client_minor> is what the client would like. The returned 247C<$server_major> and C<$server_minor> is what the server will do. 248 249The current code supports up to 2.1. The intention would be to 250automatically negotiate in C<init_extension()> if/when necessary. 251 252=back 253 254=head2 Cursor Comparisons 255 256=over 257 258=item C<$is_same = $X-E<gt>XTestCompareCursor ($window, $cursor)> 259 260Return true if the cursor attribute of C<$window> is equal to C<$cursor>. 261C<$cursor> can be 262 263=over 264 265=item * 266 267XID (an integer) of a cursor. 268 269=item * 270 271"None" (or 0). 272 273=item * 274 275"CurrentCursor" (or 1) for the currently displayed cursor. 276 277=back 278 279This can be used to check that the cursor attribute of some C<$window> is a 280desired setting, for example 281 282 $desired_cursor = $X->new_rsrc; 283 $X->CreateGlyphCursor ($desired_cursor, ...); 284 285 $X->XTestCompareCursor ($window, $desired_cursor) 286 or die "Oops, $window doesn't have desired cursor"; 287 288Or alternatively, construct a window with a particular cursor and use 289"CurrentCursor" to check that what's currently displayed is as desired, for 290example to see if a C<GrabPointer()> is displaying what's intended, 291 292 my $test_window = $X->new_rsrc; 293 $X->CreateWindow ($test_window, ..., 294 cursor => $desired_cursor); 295 296 $X->XTestCompareCursor ($test_window, "CurrentCursor"); 297 or die "Oops, currently displayed cursor is not as desired"; 298 299=back 300 301=head2 Simulated Input 302 303=over 304 305=item C<$X-E<gt>XTestFakeInput (name=E<gt>...)> 306 307=item C<$X-E<gt>XTestFakeInput ([ name=E<gt>... ])> 308 309=item C<$X-E<gt>XTestFakeInput ([ name=E<gt>], [name=E<gt>], ...)> 310 311Simulate user input for button presses, key presses, and pointer movement. 312 313An input action is specified as an event packet using fields similar to 314C<$X-E<gt>pack_event()>. 315 316C<XTestFakeInput()> is always a single user action, so for example a button 317press and button release are two separate C<XTestFakeInput()> requests. For 318the core events a single event packet is enough to describe an input but 319some extensions such as C<XInputExtension> may require more. 320 321=over 322 323=item Button Press and Release 324 325The argument fields are 326 327 name "ButtonPress" or "ButtonRelease" 328 detail physical button number (1 upwards) 329 time milliseconds delay before event, default 0 330 331For example to fake a physical button 3 press 332 333 $X->XTestFakeInput (name => 'ButtonPress', 334 detail => 3); 335 336C<detail> is the physical button number, before the core protocol 337C<SetPointerMapping()> translation is applied. To simulate a logical button 338it's necessary to check C<GetPointerMapping()> to see which physical button, 339if any, corresponds. 340 341Be careful when faking a C<ButtonPress> as it might be important to fake a 342matching C<ButtonRelease> too. On the X.org server circa 1.9.x after a 343synthetic press the physical mouse doesn't work to generate a release and 344the button is left hung (presumably in its normal implicit pointer grab). 345 346=item Key Press and Release 347 348The argument fields are 349 350 name "KeyPress" or "KeyRelease" 351 detail keycode (integer) 352 time milliseconds delay before event, default 0 353 354=item Mouse Pointer Movement 355 356Mouse pointer motion can be induced with the following. The effect is 357similar to a C<WarpPointer()>. 358 359 name "MotionNotify" 360 root XID of root window, default "None" for current 361 root_x \ pointer position to move to 362 root_y / 363 detail flag 0=absolute, 1=relative, default 0 364 time milliseconds delay before event, default 0 365 366C<root> is the root window (integer XID) to move on. The default "None" (or 3670) means the screen the pointer is currently on. 368 369 $X->XTestFakeInput (name => 'MotionNotify', 370 root_x => 123, 371 root_y => 456); 372 373C<detail> can be 1 to move relative to the current mouse position. 374 375 $X->XTestFakeInput (name => 'MotionNotify', 376 root_x => 10, 377 root_y => -20, 378 detail => 1); # relative motion 379 380=item Other Events 381 382Extension events can be faked after an C<init_extension()> so they're 383recognised by C<$X-E<gt>pack_event()>. It's up to the server or extension 384which events can actually be simulated. 385 386If an extension input requires more than one event packet to describe then 387pass multiple arrayrefs. For example C<DeviceMotion> (from 388C<XInputExtension>) may need further C<DeviceValuator> packets, 389 390 $X->XTestFakeInput ([ name => 'DeviceMotion', ... ], 391 [ name => 'DeviceValuator', ... ], 392 [ name => 'DeviceValuator', ... ]); 393 394=back 395 396For all events C<time> is how long in milliseconds the server should wait 397before playing the event. The default is 0 for no delay. No further 398requests are processed from the current client during the delay, so a 399sequence of C<XTestFakeInput()> with delays will execute sequentially with 400one delay after another. 401 402Generally the event fields from a C<$X-E<gt>{'event_handler'}> function 403cannot be passed directly to C<XTestFakeInput()> to replay it. In 404particular, 405 406=over 407 408=item * 409 410C<time> from an event is a timestamp, so would have to be zeroed or adjusted 411to a relative time for a delay in C<XTestFakeInput()>. 412 413=item * 414 415For C<MotionNotify>, C<detail> from an event is the hint mechanism, so would 416have to be zeroed for the absolute/relative flag in C<XTestFakeInput()>. 417 418=item * 419 420For C<ButtonPress> and C<ButtonRelease>, C<detail> from an event is a 421logical button number after C<SetPointerMapping()> transformation, whereas 422C<XFakeInput()> takes a physical number. A reverse lookup through the 423C<GetPointerMapping()> table would be needed. 424 425=back 426 427=back 428 429=head2 GrabServer Imperviousness 430 431=over 432 433=item C<$X-E<gt>XTestGrabControl ($impervious)> 434 435Control the current client's behaviour during a C<GrabServer()> by another 436client. 437 438If C<$impervious> is 1 then the current client can continue to make 439requests, ie. it's impervious to server grabs by other clients. 440 441If C<$impervious> is 0 then the current client behaves as normal. Its 442requests wait during any C<GrabServer()> by another client. 443 444=back 445 446=head1 SEE ALSO 447 448L<X11::Protocol>, 449L<X11::Protocol::Ext::XInputExtension> 450 451L<xdotool(1)>, L<X11::GUITest>, Xlib L<XTestQueryExtension(3)> 452 453F</usr/share/doc/x11proto-xext-dev/xtest.txt.gz>, 454F</usr/share/X11/doc/hardcopy/Xext/xtest.PS.gz> 455 456=head1 HOME PAGE 457 458L<http://user42.tuxfamily.org/x11-protocol-other/index.html> 459 460=head1 LICENSE 461 462Copyright 2011, 2012, 2013, 2014, 2017 Kevin Ryde 463 464X11-Protocol-Other is free software; you can redistribute it and/or modify 465it under the terms of the GNU General Public License as published by the 466Free Software Foundation; either version 3, or (at your option) any later 467version. 468 469X11-Protocol-Other is distributed in the hope that it will be useful, but 470WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 471or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 472more details. 473 474You should have received a copy of the GNU General Public License along with 475X11-Protocol-Other. If not, see <http://www.gnu.org/licenses/>. 476 477=cut 478