File Coverage

blib/lib/Metabrik/Xorg/Xrandr.pm
Criterion Covered Total %
statement 9 233 3.8
branch 0 158 0.0
condition 0 15 0.0
subroutine 3 28 10.7
pod 1 25 4.0
total 13 459 2.8


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # xorg::xrandr Brik
5             #
6             package Metabrik::Xorg::Xrandr;
7 1     1   632 use strict;
  1         2  
  1         30  
8 1     1   4 use warnings;
  1         2  
  1         29  
9              
10 1     1   5 use base qw(Metabrik::Shell::Command Metabrik::System::Package);
  1         1  
  1         3016  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             output => [ qw(output) ],
20             resolution => [ qw(resolution) ],
21             },
22             commands => {
23             install => [ ], # Inherited
24             list_outputs => [ ],
25             list_connected_outputs => [ ],
26             list_disconnected_outputs => [ ],
27             list_output_resolutions => [ qw(output) ],
28             list_first_output_resolutions => [ qw(output) ],
29             list_secondary_output_resolutions => [ qw(output) ],
30             get_first_output => [ ],
31             get_secondary_output => [ ],
32             get_common_resolution => [ ],
33             get_first_output_resolution => [ ],
34             get_first_output_max_resolution => [ ],
35             get_secondary_output_resolution => [ ],
36             get_secondary_output_max_resolution => [ ],
37             get_output_max_resolution => [ ], # Alias to get_first_output_max_resolution
38             get_output_resolution => [ ], # Alias to get_first_output_resolution
39             set_first_output_resolution => [ qw(resolution) ],
40             set_first_output_max_resolution => [ ],
41             set_secondary_output_resolution => [ qw(resolution) ],
42             set_secondary_output_max_resolution => [ ],
43             set_output_max_resolution => [ ], # Alias to set_first_output_max_resolution
44             set_output_resolution => [ qw(resolution) ], # Alias to set_first_output_resolution
45             clone_first_to => [ qw(secondary_output) ],
46             dual_first_right_of => [ qw(secondary_output) ],
47             clone => [ qw(resolution|OPTIONAL) ],
48             },
49             require_binaries => {
50             xrandr => [ ],
51             },
52             need_packages => {
53             ubuntu => [ qw(x11-xserver-utils) ],
54             debian => [ qw(x11-xserver-utils) ],
55             kali => [ qw(x11-xserver-utils) ],
56             },
57             };
58             }
59              
60             sub list_outputs {
61 0     0 0   my $self = shift;
62              
63 0 0         my $lines = $self->capture('xrandr') or return;
64              
65 0           my @list = ();
66 0           for my $line (@$lines) {
67 0 0         if ($line =~ m{^(\S+)\s+(connected|disconnected)}) {
68 0           push @list, $1;
69             }
70             }
71              
72 0           return \@list;
73             }
74              
75             sub list_connected_outputs {
76 0     0 0   my $self = shift;
77              
78 0 0         my $lines = $self->capture('xrandr') or return;
79              
80 0           my @list = ();
81 0           for my $line (@$lines) {
82 0 0         if ($line =~ m{^(\S+)\s+connected}) {
83 0           push @list, $1;
84             }
85             }
86              
87 0           return \@list;
88             }
89              
90             sub list_disconnected_outputs {
91 0     0 0   my $self = shift;
92              
93 0 0         my $lines = $self->capture('xrandr') or return;
94              
95 0           my @list = ();
96 0           for my $line (@$lines) {
97 0 0         if ($line =~ m{^(\S+)\s+disconnected}) {
98 0           push @list, $1;
99             }
100             }
101              
102 0           return \@list;
103             }
104              
105             #
106             # Return a HASHref of output names with their list of available resolutions
107             #
108             sub list_output_resolutions {
109 0     0 0   my $self = shift;
110 0           my ($output) = @_;
111              
112 0   0       $output ||= $self->output;
113 0 0         my $lines = $self->capture('xrandr') or return;
114              
115 0           my $current_output = '';
116 0           my %list = ();
117 0           for my $line (@$lines) {
118 0 0         if ($line =~ m{^(\S+)\s+(connected|disconnected)}) {
119 0           $current_output = $1;
120 0           next;
121             }
122              
123 0 0         if (defined($output)) {
124 0 0 0       if (length($current_output) && $current_output eq $output) {
125 0 0         if ($line =~ m{^\s+(\d+x\d+)\s+}) {
126 0           push @{$list{$current_output}}, $1;
  0            
127             }
128             }
129             }
130             else {
131 0 0         if (length($current_output)) {
132 0 0         if ($line =~ m{^\s+(\d+x\d+)\s+}) {
133 0           push @{$list{$current_output}}, $1;
  0            
134             }
135             }
136             }
137             }
138              
139             # If output was specified, we return only this one.
140 0 0         if (defined($output)) {
141 0           return $list{$output};
142             }
143              
144 0           return \%list;
145             }
146              
147             #
148             # Return the list of available resolutions for first connected output
149             #
150             sub list_first_output_resolutions {
151 0     0 0   my $self = shift;
152              
153 0 0         my $output = $self->get_first_output or return;
154 0           return $self->list_output_resolutions($output);
155             }
156              
157             #
158             # Return the list of available resolutions for secondary connected output
159             #
160             sub list_secondary_output_resolutions {
161 0     0 0   my $self = shift;
162              
163 0 0         my $output = $self->get_secondary_output or return;
164 0           return $self->list_output_resolutions($output);
165             }
166              
167             #
168             # Return first connected output
169             #
170             sub get_first_output {
171 0     0 0   my $self = shift;
172              
173 0 0         my $lines = $self->capture('xrandr') or return;
174              
175 0           my $first_output = '';
176 0           for my $line (@$lines) {
177 0 0         if ($line =~ m{^(\S+)\s+connected}) {
178 0           $first_output = $1;
179 0           last;
180             }
181             }
182              
183 0           return $first_output;
184             }
185              
186             #
187             # Return second connected output
188             #
189             sub get_secondary_output {
190 0     0 0   my $self = shift;
191              
192 0 0         my $lines = $self->capture('xrandr') or return;
193              
194 0           my $first = 1;
195 0           my $secondary_output = '';
196 0           for my $line (@$lines) {
197 0 0         if ($line =~ m{^(\S+)\s+connected}) {
198 0 0         if ($first) {
199 0           $first--;
200 0           next;
201             }
202 0           $secondary_output = $1;
203 0           last;
204             }
205             }
206              
207 0           return $secondary_output;
208             }
209              
210             #
211             # Return first connected output resolution
212             #
213             sub get_first_output_resolution {
214 0     0 0   my $self = shift;
215              
216 0 0         my $lines = $self->capture('xrandr') or return;
217              
218 0           my $current_output = '';
219 0           my $current_resolution = 0;
220 0           for my $line (@$lines) {
221 0 0         if ($line =~ m{^(\S+)\s+connected}) {
222 0           $current_output = $1;
223 0           next;
224             }
225              
226 0 0         if (length($current_output)) {
227 0 0         if ($line =~ m{^\s+(\d+x\d+)\s+\S+\*}) {
228 0           $current_resolution = $1;
229             }
230             }
231             }
232              
233 0           return $current_resolution;
234             }
235              
236             sub get_first_output_max_resolution {
237 0     0 0   my $self = shift;
238              
239 0 0         my $list = $self->list_first_output_resolutions or return;
240              
241 0 0         if (@$list > 0) {
242 0           return $list->[0];
243             }
244              
245 0           return $self->log->error("get_first_output_max_resolution: resolution not possible?");
246             }
247              
248             sub get_secondary_output_resolution {
249 0     0 0   my $self = shift;
250              
251 0 0         my $second = $self->get_secondary_output or return;
252              
253 0 0         my $lines = $self->capture('xrandr') or return;
254              
255 0           my $current_output = '';
256 0           my $current_resolution = 0;
257 0           for my $line (@$lines) {
258 0 0         if ($line =~ m{^(\S+)\s+connected}) {
259 0 0         if ($1 eq $second) {
260 0           $current_output = $1;
261 0           next;
262             }
263             else {
264 0           next;
265             }
266             }
267              
268 0 0         if (length($current_output)) {
269 0 0         if ($line =~ m{^\s+(\d+x\d+)\s+\S+\*}) {
270 0           $current_resolution = $1;
271             }
272             }
273             }
274              
275 0           return $current_resolution;
276             }
277              
278             sub get_secondary_output_max_resolution {
279 0     0 0   my $self = shift;
280              
281 0 0         my $list = $self->list_secondary_output_resolutions or return;
282              
283 0 0         if (@$list > 0) {
284 0           return $list->[0];
285             }
286              
287 0           return $self->log->error("get_secondary_output_max_resolution: resolution not possible?");
288             }
289              
290             #
291             # Alias to get_first_output_max_resolution
292             #
293             sub get_output_max_resolution {
294 0     0 0   my $self = shift;
295              
296 0           return $self->get_first_output_max_resolution;
297             }
298              
299             #
300             # Alias to get_first_output_resolution
301             #
302             sub get_output_resolution {
303 0     0 0   my $self = shift;
304              
305 0           return $self->get_first_output_resolution;
306             }
307              
308             #
309             # Set first connected output resolution
310             #
311             sub set_first_output_resolution {
312 0     0 0   my $self = shift;
313 0           my ($resolution) = @_;
314              
315 0 0         $self->brik_help_run_undef_arg('set_first_output_resolution', $resolution) or return;
316              
317 0 0         my $lines = $self->capture('xrandr') or return;
318 0 0         my $output = $self->get_first_output or return;
319 0 0         my $possible = $self->list_output_resolutions($output) or return;
320              
321 0           my $ok = 0;
322 0           for my $this (@$possible) {
323 0 0         if ($this eq $resolution) {
324 0           $ok++;
325 0           last;
326             }
327             }
328              
329 0 0         if (! $ok) {
330 0           return $self->log->error("set_first_output_resolution: resolution [$resolution] ".
331             "not available for output [$output]");
332             }
333              
334 0           return $self->capture("xrandr --output $output --mode $resolution");
335             }
336              
337             #
338             # Alias to set_first_output_resolution
339             #
340             sub set_output_resolution {
341 0     0 0   my $self = shift;
342              
343 0           return $self->set_first_output_resolution(@_);
344             }
345              
346              
347             sub set_first_output_max_resolution {
348 0     0 0   my $self = shift;
349              
350 0 0         my $max = $self->get_first_output_max_resolution or return;
351              
352 0           return $self->set_first_output_resolution($max);
353             }
354              
355             #
356             # Set secondary connected output resolution
357             #
358             sub set_secondary_output_resolution {
359 0     0 0   my $self = shift;
360 0           my ($resolution) = @_;
361              
362 0 0         $self->brik_help_run_undef_arg('set_secondary_output_resolution', $resolution) or return;
363              
364 0 0         my $lines = $self->capture('xrandr') or return;
365 0 0         my $output = $self->get_secondary_output or return;
366 0 0         my $possible = $self->list_output_resolutions($output) or return;
367              
368 0           my $ok = 0;
369 0           for my $this (@$possible) {
370 0 0         if ($this eq $resolution) {
371 0           $ok++;
372 0           last;
373             }
374             }
375              
376 0 0         if (! $ok) {
377 0           return $self->log->error("set_secondary_output_resolution: resolution [$resolution] ".
378             "not available for output [$output]");
379             }
380              
381 0           return $self->capture("xrandr --output $output --mode $resolution");
382             }
383              
384             sub set_secondary_output_max_resolution {
385 0     0 0   my $self = shift;
386              
387 0 0         my $max = $self->get_secondary_output_max_resolution or return;
388              
389 0           return $self->set_secondary_output_resolution($max);
390             }
391              
392             #
393             # Alias to set_first_output_max_resolution
394             #
395             sub set_output_max_resolution {
396 0     0 0   my $self = shift;
397              
398 0           return $self->set_first_output_max_resolution;
399             }
400              
401             sub clone_first_to {
402 0     0 0   my $self = shift;
403 0           my ($second) = @_;
404              
405 0 0         $self->brik_help_run_undef_arg('clone_first_to', $second) or return;
406              
407 0 0         my $connected = $self->list_connected_outputs or return;
408 0           my $found = 0;
409 0           for my $this (@$connected) {
410 0 0         if ($this eq $second) {
411 0           $found++;
412 0           last;
413             }
414             }
415              
416 0 0         if (! $found) {
417 0           return $self->log->error("clone_first_to: output [$second] not connected");
418             }
419              
420 0 0         my $current_output = $self->get_first_output or return;
421 0 0         my $current_resolution = $self->get_first_output_resolution or return;
422              
423 0           my $cmd = "xrandr --output \"$second\" --mode $current_resolution ".
424             "--same-as \"$current_output\"";
425              
426 0           $self->log->verbose("clone_first_to: [$cmd]");
427              
428 0           return $self->capture($cmd);
429             }
430              
431             sub dual_first_right_of {
432 0     0 0   my $self = shift;
433 0           my ($second) = @_;
434              
435 0 0         $self->brik_help_run_undef_arg('dual_first_right_of', $second) or return;
436              
437 0 0         my $connected = $self->list_connected_outputs or return;
438 0           my $found = 0;
439 0           for my $this (@$connected) {
440 0 0         if ($this eq $second) {
441 0           $found++;
442 0           last;
443             }
444             }
445              
446 0 0         if (! $found) {
447 0           return $self->log->error("dual_first_right_of: output [$second] not connected");
448             }
449              
450 0 0         my $current_output = $self->get_first_output or return;
451 0 0         my $current_resolution = $self->get_first_output_resolution or return;
452              
453 0           my $cmd = "xrandr --output \"$second\" --auto --left-of \"$current_output\"";
454              
455 0           $self->log->verbose("dual_first_right_of: [$cmd]");
456              
457 0           return $self->capture($cmd);
458             }
459              
460             sub get_common_resolution {
461 0     0 0   my $self = shift;
462 0           my ($first, $second) = @_;
463              
464 0 0         my $outputs = $self->list_output_resolutions or return;
465 0 0 0       if ((! defined($first) && ! defined($second)) && (@$outputs < 2 || @$outputs > 2)) {
      0        
      0        
466 0           return $self->log->error("get_common_resolution: less than or more than 2 screens");
467             }
468              
469 0           $first = $outputs->{$first};
470 0           $second = $outputs->{$second};
471              
472 0           my $resolution;
473 0           for my $this_first (@$first) {
474 0           for my $this_second (@$second) {
475 0 0         if ($this_first eq $this_second) {
476 0           $self->log->info("get_common_resolution: found common ".
477             "resolution [$this_first]");
478 0           $resolution = $this_first;
479 0           last;
480             }
481             }
482 0 0         last if defined($resolution);
483             }
484              
485 0           return $resolution;
486             }
487              
488             sub clone {
489 0     0 0   my $self = shift;
490 0           my ($resolution) = @_;
491              
492             # We try to find the best resolution for first and second outputs.
493 0 0         if (! defined($resolution)) {
494 0 0         my $first = $self->get_first_output or return;
495 0 0         my $second = $self->get_secondary_output or return;
496 0 0         $resolution = $self->get_common_resolution($first, $second) or return;
497             }
498              
499             # If not found, user must give that information.
500 0 0         $self->brik_help_run_undef_arg('clone', $resolution) or return;
501              
502 0 0         my $list1 = $self->list_first_output_resolutions or return;
503 0           my $ok = 0;
504 0           for (@$list1) {
505 0 0         if ($_ eq $resolution) {
506 0           $ok = 1;
507 0           last;
508             }
509             }
510 0 0         if (! $ok) {
511 0           return $self->log->error("clone: first output does not support ".
512             "resolution [$resolution]");
513             }
514              
515 0 0         $self->set_first_output_resolution($resolution) or return;
516              
517 0 0         my $second = $self->get_secondary_output or return;
518 0 0         my $list2 = $self->list_secondary_output_resolutions or return;
519 0           $ok = 0;
520 0           for (@$list2) {
521 0 0         if ($_ eq $resolution) {
522 0           $ok = 1;
523 0           last;
524             }
525             }
526 0 0         if (! $ok) {
527 0           return $self->log->error("clone: secondary output does not support ".
528             "resolution [$resolution]");
529             }
530              
531 0 0         $self->set_secondary_output_resolution($resolution) or return;
532              
533 0           return $self->clone_first_to($second);
534             }
535              
536             1;
537              
538             __END__