File Coverage

blib/lib/X11/Wallpaper.pm
Criterion Covered Total %
statement 50 51 98.0
branch 16 18 88.8
condition 9 14 64.2
subroutine 11 11 100.0
pod 2 2 100.0
total 88 96 91.6


line stmt bran cond sub pod time code
1             package X11::Wallpaper;
2             # ABSTRACT: set X11 wallpaper using best available helper program
3              
4 1     1   28335 use strict;
  1         2  
  1         37  
5 1     1   5 use warnings;
  1         2  
  1         23  
6 1     1   6 use Carp;
  1         6  
  1         92  
7 1     1   910 use File::Which qw(which);
  1         975  
  1         59  
8 1     1   941 use IPC::System::Simple qw(systemx);
  1         16679  
  1         79  
9              
10             BEGIN {
11 1     1   9 use Exporter;
  1         2  
  1         50  
12 1     1   13 our @ISA = qw(Exporter);
13 1         627 our @EXPORT_OK = qw(set_wallpaper set_wallpaper_command);
14             }
15              
16             # Ordered by preference
17             my @SETTERS = (
18             {
19             name => 'feh',
20             full => ['--bg-scale'],
21             tile => ['--bg-tile'],
22             center => ['--bg-center'],
23             aspect => ['--bg-fill'],
24             },
25             {
26             name => 'Esetroot',
27             full => ['-scale'],
28             tile => [],
29             center => ['-c'],
30             aspect => ['-fit'],
31             require_ldd => 'libImlib',
32             },
33             {
34             name => 'hsetroot',
35             full => ['-fill'],
36             tile => ['-tile'],
37             center => ['-center'],
38             aspect => ['-full'],
39             },
40             {
41             name => 'habak',
42             full => ['-full'],
43             tile => [],
44             center => ['-mC'],
45             aspect => ['-mS'],
46             },
47             {
48             name => 'imlibsetroot',
49             full => [qw(-s f)],
50             tile => [qw(-t -p c)],
51             center => [qw(-p c)],
52             aspect => [qw(-s a)],
53             },
54             {
55             name => 'chbg',
56             full => [qw(-once -mode maximize)],
57             tile => [qw(-once -mode tile)],
58             center => [qw(-once -mode center)],
59             aspect => [qw(-once -mode smart -max_grow 1000 -max_size 100)],
60             },
61             {
62             name => 'xsri',
63             full => [qw(--center-x --center-y --scale-width=100 --scale-height=100)],
64             tile => [qw(--tile)],
65             center => [qw(--center-x --center-y --color=black)],
66             aspect => [qw(--center-x --center-y --scale-width=100 --scale-height=100 --keep-aspect --color=black)],
67             },
68             {
69             name => 'wmsetbg',
70             full => ['-s', '-S'],
71             tile => ['-t'],
72             center => [qw(-b black -e)],
73             aspect => [qw(-b black -a -S)],
74             },
75             {
76             name => 'xsetbg',
77             full => { fallback => 'aspect' },
78             tile => [qw(-border black)],
79             center => [qw(-center -border black)],
80             aspect => [qw(-fullscreen -border black)],
81             },
82             {
83             name => 'xli', # aka xloadimage
84             full => { fallback => 'aspect' },
85             tile => [qw(-onroot -quiet -border black)],
86             center => [qw(-center -onroot -quiet -border black)],
87             aspect => [qw(-fullscreen -onroot -quiet -border black)],
88             },
89             {
90             name => 'icewmbg',
91             full => { fallback => 'tile' },
92             tile => ['-s'],
93             center => { fallback => 'tile' },
94             aspect => { fallback => 'tile' },
95             },
96             {
97             name => 'qiv',
98             full => ['--root_s'],
99             tile => ['--root_t'],
100             center => ['--root'],
101             aspect => ['--root', '-m'],
102             broken_transparency => 1,
103             },
104             {
105             name => 'xv',
106             full => [qw(-max -smooth -root -quit)],
107             tile => [qw(-root -quit)],
108             center => [qw(-rmode 5 -root -quit)],
109             aspect => [qw(-maxpect -smooth -root -quit)],
110             broken_transparency => 1,
111             },
112             );
113             my %SETTER = map { $_->{name} => $_ } @SETTERS;
114              
115             sub set_wallpaper {
116 4     4 1 4643 my ($image, %args) = @_;
117              
118 4 100 66     54 if (!defined $args{display} && (!defined $ENV{DISPLAY} || $ENV{DISPLAY} eq '')) {
      66        
119 1         20 croak "You are not connected to an X session, consider setting the DISPLAY"
120             . "environment variable or passing the 'display' option to set_wallpaper()";
121             }
122              
123 3         10 my @command = set_wallpaper_command($image, %args);
124 3         14 return systemx(@command);
125             }
126              
127             sub set_wallpaper_command {
128 14     14 1 3568 my ($image, %args) = @_;
129 14   100     71 my $mode = $args{mode} || 'full';
130 14   66     65 my $setter = $args{setter} || _find_setter($mode);
131 12         33 my $display = $args{display};
132              
133             # Build command
134 12 100       40 my @command = defined $display ? ('env', "DISPLAY=$display") : ();
135 12         26 push @command, ($setter, _find_setter_args($setter, $mode), $image);
136              
137 12         104 return @command;
138             }
139              
140             # Find the best available setter for the given 'mode'.
141             sub _find_setter {
142 13     13   26 my $mode = shift;
143 13         13 my $best;
144 13         15 my $fallback = 0;
145              
146 13         32 for my $setter (@SETTERS) {
147 70 100       509 next if !defined which($setter->{name});
148 13 100       123 next if !defined $setter->{$mode};
149              
150 12 100       57 if (ref $setter->{$mode} eq 'HASH') {
151 1         3 $fallback = 1;
152             }
153              
154 12         24 $best = $setter->{name};
155 12 100       31 last if !$fallback; # else wait for a better one
156             }
157              
158 13 100       56 if (!defined $best) {
159 2         54 croak "No setter program found for mode '$mode'!";
160             }
161              
162 11         48 return $best;
163             }
164              
165             sub _find_setter_args {
166 12     12   24 my ($setter, $mode) = @_;
167 12         25 my $args = $SETTER{$setter}{$mode};
168 12 50 33     39 if (ref $args eq 'HASH' && $args->{fallback}) {
169 0         0 $args = $SETTER{$setter}{ $args->{fallback} };
170             }
171 12 50       25 ref $args eq 'ARRAY' or die "Expecting arguments for $setter/$mode. Fallback chain?";
172              
173 12         40 return @$args;
174             }
175              
176             1;
177              
178              
179              
180             =pod
181              
182             =head1 NAME
183              
184             X11::Wallpaper - set X11 wallpaper using best available helper program
185              
186             =head1 VERSION
187              
188             version 1.1
189              
190             =head1 SYNOPSIS
191              
192             use X11::Wallpaper qw(set_wallpaper);
193             set_wallpaper( "./foo.jpg", {
194             mode => 'full', # default, or: aspect, center, tile
195             setter => 'feh', # override setter
196             display => ':0.0' # override X display
197             } );
198              
199             my @cmd = set_wallaper_command(...); # just give me the command
200              
201             =head1 DESCRIPTION
202              
203             This module provides an interface for setting the background on X11
204             systems, by recruiting a suitable helper script (feh, Esetroot, hsetroot,
205             chbg, xli etc.) and providing appropriate options.
206              
207             =head1 METHODS
208              
209             =head2 set_wallpaper($image_path, %args)
210              
211             Sets C<$image_path> as the desktop wallpaper. The following args are
212             supported:
213              
214             =over
215              
216             =item mode
217              
218             May be 'full' (fullscreen, stretched to fit - the default), 'tile',
219             'center' (do not stretch) or 'aspect' (fullscreen, preserving
220             aspect ratio). For the latter two options, the background for any
221             borders around the image is set to black.
222              
223             =item setter
224              
225             Manually specify the program to use, e.g. 'qiv', provided it is
226             in this module's dictionary of commands.
227              
228             =item display
229              
230             Override the X display to use, e.g. ':0.0'. Otherwise defaults to
231             the value of the DISPLAY environment variable.
232              
233             =back
234              
235             =head2 @cmd = set_wallpaper_command($image_path, %args)
236              
237             As with C, except returns the command (as a list of
238             arguments) instead of executing it.
239              
240             =head1 CREDITS
241              
242             Inspired by the C shell script by Julian Danjou, which in turn
243             is derived from C by Han Boetes.
244              
245             =head1 TODO
246              
247             Skip the middle man and code against the X11 libraries directly. But
248             that wouldn't be quite as portable...
249              
250             =head1 AUTHOR
251              
252             Richard Harris
253              
254             =head1 COPYRIGHT AND LICENSE
255              
256             This software is copyright (c) 2012 by Richard Harris.
257              
258             This is free software; you can redistribute it and/or modify it under
259             the same terms as the Perl 5 programming language system itself.
260              
261             =cut
262              
263              
264             __END__