2011-11-07 18:04:45 -05:00
|
|
|
|
package StartXDummy;
|
|
|
|
|
# vim:ts=4:sw=4:expandtab
|
|
|
|
|
|
|
|
|
|
use strict;
|
|
|
|
|
use warnings;
|
|
|
|
|
use Exporter 'import';
|
|
|
|
|
use Time::HiRes qw(sleep);
|
|
|
|
|
use v5.10;
|
|
|
|
|
|
|
|
|
|
our @EXPORT = qw(start_xdummy);
|
|
|
|
|
|
|
|
|
|
# reads in a whole file
|
|
|
|
|
sub slurp {
|
|
|
|
|
open(my $fh, '<', shift) or return '';
|
|
|
|
|
local $/;
|
|
|
|
|
<$fh>;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
=head2 start_xdummy($parallel)
|
|
|
|
|
|
|
|
|
|
Starts C<$parallel> (or number of cores * 2 if undef) Xdummy processes (see
|
|
|
|
|
the file ./Xdummy) and returns two arrayrefs: a list of X11 display numbers to
|
|
|
|
|
the Xdummy processes and a list of PIDs of the processes.
|
|
|
|
|
|
|
|
|
|
=cut
|
2011-11-24 08:06:55 -05:00
|
|
|
|
|
|
|
|
|
my $x_socketpath = '/tmp/.X11-unix/X';
|
|
|
|
|
|
2011-11-07 18:04:45 -05:00
|
|
|
|
sub start_xdummy {
|
|
|
|
|
my ($parallel) = @_;
|
|
|
|
|
|
|
|
|
|
my @displays = ();
|
|
|
|
|
my @childpids = ();
|
|
|
|
|
|
|
|
|
|
# Yeah, I know it’s non-standard, but Perl’s POSIX module doesn’t have
|
|
|
|
|
# _SC_NPROCESSORS_CONF.
|
|
|
|
|
my $cpuinfo = slurp('/proc/cpuinfo');
|
|
|
|
|
my $num_cores = scalar grep { /model name/ } split("\n", $cpuinfo);
|
|
|
|
|
# If /proc/cpuinfo does not exist, we fall back to 2 cores.
|
|
|
|
|
$num_cores ||= 2;
|
|
|
|
|
|
|
|
|
|
$parallel ||= $num_cores * 2;
|
|
|
|
|
|
|
|
|
|
# First get the last used display number, then increment it by one.
|
|
|
|
|
# Effectively falls back to 1 if no X server is running.
|
2011-11-24 08:06:55 -05:00
|
|
|
|
my ($displaynum) = map { /(\d+)$/ } reverse sort glob($x_socketpath . '*');
|
2011-11-07 18:04:45 -05:00
|
|
|
|
$displaynum++;
|
|
|
|
|
|
|
|
|
|
say "Starting $parallel Xdummy instances, starting at :$displaynum...";
|
|
|
|
|
|
2011-11-24 08:06:55 -05:00
|
|
|
|
my @sockets_waiting;
|
2011-11-07 18:04:45 -05:00
|
|
|
|
for my $idx (0 .. ($parallel-1)) {
|
|
|
|
|
my $pid = fork();
|
|
|
|
|
die "Could not fork: $!" unless defined($pid);
|
|
|
|
|
if ($pid == 0) {
|
|
|
|
|
# Child, close stdout/stderr, then start Xdummy.
|
2011-11-07 18:39:45 -05:00
|
|
|
|
close STDOUT;
|
|
|
|
|
close STDERR;
|
2011-11-24 08:06:55 -05:00
|
|
|
|
# make sure this display isn’t in use yet
|
|
|
|
|
$displaynum++ while -e ($x_socketpath . $displaynum);
|
|
|
|
|
|
2011-11-07 18:07:08 -05:00
|
|
|
|
# We use -config /dev/null to prevent Xdummy from using the system
|
|
|
|
|
# Xorg configuration. The tests should be independant from the
|
|
|
|
|
# actual system X configuration.
|
2011-11-07 18:04:45 -05:00
|
|
|
|
exec './Xdummy', ":$displaynum", '-config', '/dev/null';
|
|
|
|
|
exit 1;
|
|
|
|
|
}
|
2011-11-29 07:48:04 -05:00
|
|
|
|
push(@complete_run::CLEANUP, sub { kill(15, $pid) });
|
2011-11-07 18:04:45 -05:00
|
|
|
|
push(@displays, ":$displaynum");
|
2011-11-24 08:06:55 -05:00
|
|
|
|
push(@sockets_waiting, $x_socketpath . $displaynum);
|
2011-11-07 18:04:45 -05:00
|
|
|
|
$displaynum++;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# Wait until the X11 sockets actually appear. Pretty ugly solution, but as
|
|
|
|
|
# long as we can’t socket-activate X11…
|
2011-11-24 08:06:55 -05:00
|
|
|
|
while (1) {
|
|
|
|
|
@sockets_waiting = grep { ! -S $_ } @sockets_waiting;
|
|
|
|
|
last unless @sockets_waiting;
|
2011-11-07 18:04:45 -05:00
|
|
|
|
sleep 0.1;
|
2011-11-24 08:06:55 -05:00
|
|
|
|
}
|
2011-11-07 18:04:45 -05:00
|
|
|
|
|
2011-11-27 12:21:41 -05:00
|
|
|
|
return @displays;
|
2011-11-07 18:04:45 -05:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
1
|