2 # vim:ts=4:sw=4:expandtab
7 use Time::HiRes qw(sleep);
10 our @EXPORT = qw(start_xdummy);
12 # reads in a whole file
14 open(my $fh, '<', shift) or return '';
19 =head2 start_xdummy($parallel)
21 Starts C<$parallel> (or number of cores * 2 if undef) Xdummy processes (see
22 the file ./Xdummy) and returns two arrayrefs: a list of X11 display numbers to
23 the Xdummy processes and a list of PIDs of the processes.
27 my $x_socketpath = '/tmp/.X11-unix/X';
35 # Yeah, I know it’s non-standard, but Perl’s POSIX module doesn’t have
36 # _SC_NPROCESSORS_CONF.
37 my $cpuinfo = slurp('/proc/cpuinfo');
38 my $num_cores = scalar grep { /model name/ } split("\n", $cpuinfo);
39 # If /proc/cpuinfo does not exist, we fall back to 2 cores.
42 $parallel ||= $num_cores * 2;
44 # First get the last used display number, then increment it by one.
45 # Effectively falls back to 1 if no X server is running.
46 my ($displaynum) = map { /(\d+)$/ } reverse sort glob($x_socketpath . '*');
49 say "Starting $parallel Xdummy instances, starting at :$displaynum...";
52 for my $idx (0 .. ($parallel-1)) {
54 die "Could not fork: $!" unless defined($pid);
56 # Child, close stdout/stderr, then start Xdummy.
59 # make sure this display isn’t in use yet
60 $displaynum++ while -e ($x_socketpath . $displaynum);
62 # We use -config /dev/null to prevent Xdummy from using the system
63 # Xorg configuration. The tests should be independant from the
64 # actual system X configuration.
65 exec './Xdummy', ":$displaynum", '-config', '/dev/null';
68 push(@childpids, $pid);
69 push(@displays, ":$displaynum");
70 push(@sockets_waiting, $x_socketpath . $displaynum);
74 # Wait until the X11 sockets actually appear. Pretty ugly solution, but as
75 # long as we can’t socket-activate X11…
77 @sockets_waiting = grep { ! -S $_ } @sockets_waiting;
78 last unless @sockets_waiting;
82 return \@displays, \@childpids;