File Coverage

blib/lib/UI/Dialog/Backend/XOSD.pm
Criterion Covered Total %
statement 50 190 26.3
branch 6 96 6.2
condition 14 75 18.6
subroutine 9 18 50.0
pod 8 8 100.0
total 87 387 22.4


line stmt bran cond sub pod time code
1             package UI::Dialog::Backend::XOSD;
2             ###############################################################################
3             # Copyright (C) 2004-2016 Kevin C. Krinke
4             #
5             # This library is free software; you can redistribute it and/or
6             # modify it under the terms of the GNU Lesser General Public
7             # License as published by the Free Software Foundation; either
8             # version 2.1 of the License, or (at your option) any later version.
9             #
10             # This library 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
13             # Lesser General Public License for more details.
14             #
15             # You should have received a copy of the GNU Lesser General Public
16             # License along with this library; if not, write to the Free Software
17             # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18             ###############################################################################
19 1     1   12519 use 5.006;
  1         3  
20 1     1   3 use strict;
  1         2  
  1         14  
21 1     1   3 use warnings;
  1         1  
  1         16  
22 1     1   3 use Carp;
  1         1  
  1         57  
23 1     1   359 use UI::Dialog::Backend;
  1         2  
  1         29  
24 1     1   362 use FileHandle;
  1         1575  
  1         4  
25              
26             #: Ideas:
27             # - implement debugging code...
28             # - what about tail("/file")?
29             # - and my $fh = tail_pipe() ?
30             # (or pipe_start(), pipe_print() and pipe_close())
31             # - now here's a kicker, what about a "valid fonts" list and a
32             # suitable mechanism to use (and cache) `xlsfonts` to determine
33             # the font to use. Once the decision is made the decision should
34             # simply be enforced rather than revalidated again and again.
35              
36             BEGIN {
37 1     1   232 use vars qw( $VERSION @ISA );
  1         1  
  1         43  
38 1     1   7 @ISA = qw( UI::Dialog::Backend );
39 1         1528 $VERSION = '1.21';
40             }
41              
42             sub new {
43 1     1 1 351 my $proto = shift();
44 1   33     5 my $class = ref($proto) || $proto;
45 1 50       5 my $cfg = ((ref($_[0]) eq "HASH") ? $_[0] : (@_) ? { @_ } : {});
    50          
46 1         2 my $self = {};
47 1         1 bless($self, $class);
48 1         7 $self->{'_opts'} = {};
49              
50             #: Dynamic path discovery...
51 1         2 my $CFG_PATH = $cfg->{'PATH'};
52 1 50       4 if ($CFG_PATH) {
    50          
53 0 0       0 if (ref($CFG_PATH) eq "ARRAY") { $self->{'PATHS'} = $CFG_PATH; }
  0 0       0  
    0          
54 0         0 elsif ($CFG_PATH =~ m!:!) { $self->{'PATHS'} = [ split(/:/,$CFG_PATH) ]; }
55 0         0 elsif (-d $CFG_PATH) { $self->{'PATHS'} = [ $CFG_PATH ]; }
56 1         6 } elsif ($ENV{'PATH'}) { $self->{'PATHS'} = [ split(/:/,$ENV{'PATH'}) ]; }
57 0         0 else { $self->{'PATHS'} = ''; }
58              
59 1         7 $self->{'_opts'}->{'bin'} = $self->_find_bin('osd_cat');
60 1         3 $self->{'_opts'}->{'tail'} = $self->_find_bin('tail');
61 1         5 $self->{'_opts'}->{'kill'} = $self->_find_bin('kill');
62 1   50     8 $self->{'_opts'}->{'pos'} = $cfg->{'pos'} || undef();
63 1   50     4 $self->{'_opts'}->{'offset'} = $cfg->{'offset'} || 0;
64 1   50     13 $self->{'_opts'}->{'align'} = $cfg->{'align'} || undef();
65 1   50     4 $self->{'_opts'}->{'indent'} = $cfg->{'indent'} || 0;
66 1   50     5 $self->{'_opts'}->{'font'} = $cfg->{'font'} || undef();
67 1   50     5 $self->{'_opts'}->{'colour'} = $cfg->{'colour'} || $cfg->{'color'} || undef();
68 1   50     4 $self->{'_opts'}->{'delay'} = $cfg->{'delay'} || 0;
69 1   50     5 $self->{'_opts'}->{'lines'} = $cfg->{'lines'} || 0;
70 1   50     8 $self->{'_opts'}->{'shadow'} = $cfg->{'shadow'} || 0;
71 1   50     4 $self->{'_opts'}->{'age'} = $cfg->{'age'} || 0;
72 1 50       3 $self->{'_opts'}->{'wait'} = ($cfg->{'wait'}) ? 1 : 0;
73 1   50     3 $self->{'_opts'}->{'length'} = $cfg->{'wait'} || 40;
74 1   50     8 $self->{'_opts'}->{'bar'} = $cfg->{'bar'} || "-";
75 1   50     4 $self->{'_opts'}->{'mark'} = $cfg->{'mark'} || "|";
76 1 50       7 unless (-x $self->{'_opts'}->{'bin'}) {
77 1         159 croak("the osd_cat binary could not be found at: ".$self->{'_opts'}->{'bin'});
78             }
79              
80             $self->{'_opts'}->{'trust-input'} =
81             ( exists $cfg->{'trust-input'}
82 0 0 0       && $cfg->{'trust-input'}==1
83             ) ? 1 : 0;
84              
85 0           return($self);
86             }
87              
88             #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
89             #: Internal Methods
90             #:
91              
92             my $SIG_CODE = {};
93             sub _del_display {
94 0     0     my $CODE = $SIG_CODE->{$$};
95 0 0         unless (not ref($CODE)) {
96 0           delete($CODE->{'_DISPLAY'});
97 0           $SIG_CODE->{$$} = "";
98             }
99             }
100             sub _gen_opt_str {
101 0     0     my $self = shift();
102 0           my $args = shift();
103 0           my $string = "";
104 0 0         if ($args->{'pos'}) {
105 0 0         my $pos = ($args->{'pos'} =~ /^top|middle|bottom$/i) ? lc($args->{'pos'}) : 'top';
106 0           $string .= " --pos='".$pos."'";
107             }
108 0 0         if ($args->{'offset'}) {
109 0 0         my $offset = ($args->{'offset'} =~ /^\d+$/) ? $args->{'offset'} : 0;
110 0           $string .= " --offset='".$offset."'";
111             }
112 0 0         if ($args->{'align'}) {
113 0 0         my $align = ($args->{'align'} =~ /^left|center|right$/i) ? lc($args->{'align'}) : 'left';
114 0           $string .= " --align='".$align."'";
115             }
116 0 0         if ($args->{'indent'}) {
117 0 0         my $indent = ($args->{'indent'} =~ /^\d+$/) ? $args->{'indent'} : 0;
118 0           $string .= " --indent='".$indent."'";
119             }
120 0 0         if ($args->{'font'}) {
121 0   0       my $font = $args->{'font'} || "-*-fixed-*-*-*-*-*-*-*-*-*-*-*-*";
122 0           $string .= " --font='".$font."'";
123             }
124 0 0         if ($args->{'colour'}) {
125 0   0       my $colour = $args->{'colour'} || "green";
126 0           $string .= " --color='".$colour."'";
127             }
128 0 0         if ($args->{'delay'}) {
129 0 0         my $delay = ($args->{'delay'} =~ /^\d+$/) ? $args->{'delay'} : 5;
130 0           $string .= " --delay='".$delay."'";
131             }
132 0 0         if ($args->{'lines'}) {
133 0 0         my $lines = ($args->{'lines'} =~ /^\d+$/) ? $args->{'lines'} : 5;
134 0           $string .= " --lines='".$lines."'";
135             }
136 0 0         if ($args->{'shadow'}) {
137 0 0         my $shadow = ($args->{'shadow'} =~ /^\d+$/) ? $args->{'shadow'} : 0;
138 0           $string .= " --shadow='".$shadow."'";
139             }
140 0 0         if ($args->{'age'}) {
141 0 0         my $age = ($args->{'age'} =~ /^\d+$/) ? $args->{'age'} : 0;
142 0           $string .= " --age='".$age."'";
143             }
144 0 0         if ($args->{'wait'}) {
145 0           $string .= " --wait";
146             }
147 0           $self->_debug("xosd: ".$string,3);
148 0   0       return($string||" ");
149             }
150              
151             #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
152             #: Public Methods
153             #:
154              
155             sub line {
156 0     0 1   my $self = shift();
157 0           my $args = $self->_merge_attrs(@_);
158 0           my $opts = $self->_gen_opt_str($args);
159 0 0         if (open(XOSD,"| ".$self->{'_opts'}->{'bin'}.$opts." -")) {
160 0   0       print XOSD ($args->{'text'}||'')."\n";
161 0           close(XOSD);
162             } else {
163 0           croak("failed to open osd_cat output pipe!");
164             }
165             }
166              
167             sub file {
168 0     0 1   my $self = shift();
169 0           my $args = $self->_merge_attrs(@_);
170 0           my $opts = $self->_gen_opt_str($args);
171 0 0         if (-r $args->{'file'}) {
172 0 0         if (open(FILE,"<".$args->{'file'})) {
173 0           local $/;
174 0           my $text = ;
175 0           close(FILE);
176 0           $text =~ s!\t! !g;
177 0 0         if (open(XOSD,"| ".$self->{'_opts'}->{'bin'}.$opts." -")) {
178 0   0       print XOSD ($text||'')."\n";
179 0           close(XOSD);
180             } else {
181 0           croak("failed to open osd_cat output pipe!");
182             }
183             }
184             }
185             }
186              
187             sub gauge {
188 0     0 1   my $self = shift();
189 0           my $args = $self->_merge_attrs(@_);
190 0           my $opts = $self->_gen_opt_str($args);
191 0   0       my $length = $args->{'length'} || 40;
192 0   0       my $bar = ($args->{'bar'} || "-") x $length;
193 0   0       my $percent = $args->{'percent'} || '0';
194 0 0 0       $percent = (($percent <= 100 && $percent >= 0) ? $percent : 0 );
195 0           my $perc = int((($length / 100) * $percent));
196 0   0       substr($bar,($perc||0),1,($args->{'mark'}||"|"));
      0        
197 0 0         my $text = $args->{'text'} ? $args->{'text'}."\n" : '';
198 0           $text .= $percent."% ".$bar."\n";
199 0 0         if (open(XOSD,"| ".$self->{'_opts'}->{'bin'}.$opts." -")) {
200 0           print XOSD $text;
201 0           close(XOSD);
202             } else {
203 0           croak("failed to open osd_cat output pipe!");
204             }
205             }
206              
207             sub display_start {
208 0     0 1   my $self = shift();
209 0           my $args = $self->_merge_attrs(@_);
210 0           my $opts = $self->_gen_opt_str($args);
211 0   0       $self->{'_DISPLAY'} ||= {};
212 0           $self->{'_DISPLAY'}->{'ARGS'} = $args;
213 0 0         return(0) if defined $self->{'_DISPLAY'}->{'FH'};
214 0           my $command = $self->{'_opts'}->{'bin'}.$opts." -";
215 0           $self->{'_DISPLAY'}->{'FH'} = new FileHandle;
216 0           $self->{'_DISPLAY'}->{'FH'}->open("| $command");
217 0           my $rv = $? >> 8;
218 0           $self->{'_DISPLAY'}->{'FH'}->autoflush(1);
219 0           my $this_rv;
220 0 0 0       if ($rv && $rv >= 1) { $this_rv = 0; }
  0            
221 0           else { $this_rv = 1; }
222 0           return($this_rv);
223             }
224             sub display_text {
225 0     0 1   my $self = shift();
226 0           my $mesg;
227 0 0         if (@_ > 1) { $mesg = join("\n",@_); }
  0 0          
228 0           elsif (ref($_[0]) eq "ARRAY") { $mesg = join("\n",@{$_[0]}); }
  0            
229 0   0       else { $mesg = $_[0] || return(0); }
230 0 0         return(0) unless $self->{'_DISPLAY'}->{'FH'};
231 0           my $fh = $self->{'_DISPLAY'}->{'FH'};
232 0           $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;
  0            
233 0           print $fh $mesg."\n";
234 0 0         return(((defined $self->{'_DISPLAY'}->{'FH'}) ? 1 : 0));
235             }
236             sub display_gauge {
237 0     0 1   my $self = $_[0];
238 0 0         return(0) unless $self->{'_DISPLAY'}->{'FH'};
239 0           my $args = $self->_merge_attrs();
240 0   0       my $length = $args->{'length'} || 40;
241 0   0       my $bar = ($args->{'bar'} || "-") x $length;
242 0   0       my $percent = $_[1] || 0;
243 0 0 0       $percent = (($percent <= 100 && $percent >= 0) ? $percent : 0 );
244 0           my $perc = int((($length / 100) * $percent));
245 0   0       substr($bar,($perc||0),1,($args->{'mark'}||"|"));
      0        
246 0 0         my $text = $_[2] ? $_[2]."\n" : '';
247 0           $text .= $percent."% ".$bar."\n";
248 0           my $fh = $self->{'_DISPLAY'}->{'FH'};
249 0           $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;
  0            
250 0           print $fh $text;
251 0 0         return(((defined $self->{'_DISPLAY'}->{'FH'}) ? 1 : 0));
252             }
253             sub display_stop {
254 0     0 1   my $self = shift();
255 0 0         return(0) unless $self->{'_DISPLAY'}->{'FH'};
256 0           my $args = $self->{'_DISPLAY'}->{'ARGS'};
257 0           my $fh = $self->{'_DISPLAY'}->{'FH'};
258 0           $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;
  0            
259 0           $self->{'_DISPLAY'}->{'FH'}->close();
260 0           delete($self->{'_DISPLAY'}->{'FH'});
261 0           delete($self->{'_DISPLAY'}->{'ARGS'});
262 0           delete($self->{'_DISPLAY'}->{'PERCENT'});
263 0           delete($self->{'_DISPLAY'});
264 0           return(1);
265             }
266              
267             # #$d->tail( file => "/tmp/xosdtail.log", delay => '3' );
268             # sub tail {
269             # my $self = shift();
270             # my $args = $self->_merge_attrs(@_);
271             # my $opts = $self->_gen_opt_str($args);
272             # if (-r $args->{'file'}) {
273             # my $tail_cmnd = $self->{'_opts'}->{'tail'}.' -f '.$args->{'file'};
274             # system($tail_cmnd." | ".$self->{'_opts'}->{'bin'}.$opts." -");
275             # } else {
276             # $self->line( @_, text => "couldn't open file: ".($args->{'file'}||'NULL') );
277             # }
278             # }
279              
280             # sub tailbg {
281             # my $self = shift();
282             # my $args = $self->_merge_attrs(@_);
283             # my $opts = $self->_gen_opt_str($args);
284             # if (-r $args->{'file'}) {
285             # my $tail_cmnd = $self->{'_opts'}->{'tail'}.' -f '.$args->{'file'};
286             # my $xosd_cmnd = $self->{'_opts'}->{'bin'}.$opts." -";
287             # # system($tail_cmnd." | ".$self->{'_opts'}->{'bin'}.$opts." - &");
288             # # $self->{'forkpid'} = $self->command_forked($tail_cmnd." | ".$self->{'_opts'}->{'bin'}.$opts." -");
289             # # $self->{'forkpid'} = $self->command_forked($self->{'_opts'}->{'tail'},' -f '.$args->{'file'}. " | ".$self->{'_opts'}->{'bin'}.$opts." -");
290             # $self->{'forkpid'} = $self->tailbg_forked($tail_cmnd,$xosd_cmnd);
291             # print "pid: ".$self->{'forkpid'}."\n";
292             # return(1) if $self->{'forkpid'};
293             # return(0);
294             # } else {
295             # $self->line( @_, text => "couldn't open file: ".($args->{'file'}||'NULL') );
296             # }
297             # }
298              
299              
300             # sub command_forked {
301             # my $self = shift();
302             # if (my $pid = fork()) { return($pid); }
303             # else { exec(@_); }
304             # }
305              
306             # sub tailbg_forked {
307             # my $self = shift();
308             # my $tail = shift();
309             # my $osdc = shift();
310             # if (my $pid = fork()) { return($pid); }
311             # else {
312             # # here we open the tail and read
313             # # while reading, print to an open osd_cat
314             # my $TSIGP = $SIG{'PIPE'};
315             # $SIG{'PIPE'} = "IGNORE";
316             # if (open(TAIL,$tail." |")) {
317             # unless (open(OSDC,"| ".$osdc)) {
318             # close(TAIL);
319             # return();
320             # }
321             # my $TP = $|;
322             # $| = 1;
323             # while (my $line = ) {
324             # print OSDC $line;
325             # }
326             # $| = $TP;
327             # close(OSDC);
328             # close(TAIL);
329             # }
330             # $SIG{'PIPE'} = $TSIGP;
331             # }
332             # }
333              
334             # sub tailbg_end {
335             # my $self = shift();
336             # my $args = $self->_merge_attrs(@_);
337             # if ($self->{'forkpid'}) {
338             # print "pid: ".$self->{'forkpid'}."\n";
339             # if (kill(15,$self->{'forkpid'})) {
340             # print "killed: ".$self->{'forkpid'}."\n";
341             # } else {
342             # print "maimed: ".$self->{'forkpid'}."\n";
343             # }
344             # }
345             # }
346              
347             1;