File Coverage

blib/lib/Log/Progress/RenderTTY.pm
Criterion Covered Total %
statement 84 105 80.0
branch 18 38 47.3
condition 15 29 51.7
subroutine 15 18 83.3
pod 2 2 100.0
total 134 192 69.7


line stmt bran cond sub pod time code
1             package Log::Progress::RenderTTY;
2             $Log::Progress::RenderTTY::VERSION = '0.13';
3 1     1   1250 use Moo 2;
  1         17  
  1         7  
4 1     1   329 use Carp;
  1         3  
  1         82  
5 1     1   8 use Try::Tiny;
  1         2  
  1         61  
6 1     1   6 use IO::Handle;
  1         2  
  1         54  
7 1     1   6 use Log::Progress::Parser;
  1         2  
  1         39  
8 1     1   1760 use Term::Cap;
  1         3199  
  1         34  
9 1     1   6 use Scalar::Util;
  1         2  
  1         1358  
10              
11             # ABSTRACT: Render progress state on a terminal
12              
13              
14             has listen_resize => ( is => 'ro' );
15             has tty_metrics => ( is => 'lazy', clearer => 1 );
16             has termcap => ( is => 'lazy' );
17             has parser => ( is => 'rw' );
18             has out => ( is => 'rw' );
19             has _prev_output => ( is => 'rw' );
20             has _winch_handler => ( is => 'rw' );
21              
22             sub _build_tty_metrics {
23 1     1   14 my $self= shift;
24 1 50       7337 my $stty= `stty -a` or warn "unable to run 'stty -a' to fetch terminal size\n";
25 1         17 my ($speed)= ($stty =~ /speed[ =]+(\d+)/);
26 1         16 my ($cols)= ($stty =~ /columns[ =]+(\d+)/);
27 1         16 my ($rows)= ($stty =~ /rows[ =]+(\d+)/);
28 1 50 33     30 $self->_init_window_change_watch() if $self->listen_resize and $cols;
29 1   50     86 return { speed => $speed || 9600, cols => $cols || 80, rows => $rows || 25 };
      50        
      50        
30             }
31              
32             sub _build_termcap {
33 1     1   12 my $self= shift;
34 1   50     35 my $speed= $self->tty_metrics->{speed} || 9600;
35 1         63 return Tgetent Term::Cap { TERM => '', OSPEED => $speed };
36             }
37              
38             sub _init_window_change_watch {
39 0     0   0 my $self= shift;
40 0 0       0 return if defined $self->_winch_handler;
41             try {
42 0     0   0 my $existing= $SIG{WINCH};
43 0         0 Scalar::Util::weaken($self);
44             my $handler= sub {
45 0 0       0 $self->clear_tty_metrics if defined $self;
46 0 0       0 goto $existing if defined $existing;
47 0         0 };
48 0         0 $self->_winch_handler([ $handler, $existing ]);
49 0         0 $SIG{WINCH}= $handler;
50             }
51             catch {
52 0     0   0 warn "Can't install SIGWINCH handler\n";
53 0         0 };
54             }
55              
56              
57             sub format {
58 4     4 1 10 my ($self, $state, $dims)= @_;
59            
60             # Build the new string of progress ascii art, but without terminal escapes
61 4         11 my $str= '';
62 4         14 $dims->{message_margin}= $dims->{cols} * .5;
63 4 100       11 if ($state->{step}) {
64 3         13 $dims->{title_width}= 10;
65 3         5 for (values %{ $state->{step} }) {
  3         9  
66             $dims->{title_width}= length($_->{title})
67 11 50 50     31 if length($_->{title} || '') > $dims->{title_width};
68             }
69 3         4 for (sort { $a->{idx} <=> $b->{idx} } values %{ $state->{step} }) {
  14         29  
  3         19  
70 11         32 $str .= $self->_format_step_progress_line($_, $dims);
71             }
72 3         7 $str .= "\n";
73             }
74 4         18 $str .= $self->_format_main_progress_line($state, $dims);
75 4         13 return $str;
76             }
77              
78              
79             sub render {
80 1     1 1 10 my $self= shift;
81 1         2 my ($cols, $rows)= @{ $self->tty_metrics }{'cols','rows'};
  1         17  
82 1         44 my $output= $self->format($self->parser->parse, {
83             cols => $cols,
84             rows => $rows
85             });
86            
87             # Now the fun part. Diff vs. previous output to figure out which lines (if any)
88             # have changed, then move the cursor to those lines and repaint.
89             # To make things extra interesting, the old output might have scrolled off the
90             # screen, and if the new output also scrolls off the screen then we want to
91             # let it happen naturally so that the scroll-back buffer is consistent.
92 1 50       23 my @prev= defined $self->_prev_output? (split /\n/, $self->_prev_output, -1) : ();
93 1         12 my @next= split /\n/, $output, -1;
94             # we leave last line blank, so all calculations are rows-1
95 1 50       7 my $first_vis_line= @prev > ($rows-1)? @prev - ($rows-1) : 0;
96 1 50       12 my $starting_row= @prev > ($rows-1)? 0 : ($rows-1) - @prev;
97 1         72 my $up= $self->termcap->Tputs('up');
98 1         31230 my $down= $self->termcap->Tputs('do');
99 1         73 my $clear_eol= $self->termcap->Tputs('ce');
100 1         51 my $str= '';
101 1         4 my $cursor_row= $rows-1;
102             my $cursor_seek= sub {
103 1     1   12 my $dest_row= shift;
104 1 50       11 if ($cursor_row > $dest_row) {
    50          
105 0         0 $str .= $up x ($cursor_row - $dest_row);
106             } elsif ($dest_row > $cursor_row) {
107 0         0 $str .= $down x ($dest_row - $cursor_row);
108             }
109 1         10 $cursor_row= $dest_row;
110 1         30 };
111 1         3 my $i;
112 1         15 for ($i= $first_vis_line; $i < @prev; $i++) {
113 0 0       0 if ($prev[$i] ne $next[$i]) {
114             # Seek to row
115 0         0 $cursor_seek->($i - $first_vis_line + $starting_row);
116             # clear line and replace
117 0         0 $str .= $clear_eol . $next[$i] . "\n";
118 0         0 $cursor_row++;
119             }
120             }
121 1         8 $cursor_seek->($rows-1);
122             # Now, print any new rows in @next, letting them scroll the screen as needed
123 1         11 while ($i < @next) {
124 8         30 $str .= $next[$i++] . "\n";
125             }
126 1         13 $self->_prev_output($output);
127            
128 1   50     61 ($self->out || \*STDOUT)->print($str);
129             }
130              
131             sub _format_main_progress_line {
132 4     4   8 my ($self, $state, $dims)= @_;
133            
134 4         10 my $message= $state->{message};
135 4 100       13 $message= '' unless defined $message;
136             $message= sprintf("(%d/%d) %s", $state->{current}, $state->{total}, $message)
137 4 100 66     28 if defined $state->{total} and defined $state->{current};
138            
139 4         7 my $max_chars= $dims->{cols} - 8;
140             return sprintf "[%-*s] %3d%%\n %.*s",
141             $max_chars, '=' x int( ($state->{progress}||0) * $max_chars + .000001 ),
142             int( ($state->{progress}||0) * 100 + .0000001 ),
143 4   50     30 $dims->{cols}, $message;
      50        
144             }
145              
146             sub _format_step_progress_line {
147 11     11   31 my ($self, $state, $dims)= @_;
148            
149 11         19 my $message= $state->{message};
150 11 50       23 $message= '' unless defined $message;
151             $message= sprintf("(%d/%d) %s", $state->{current}, $state->{total}, $message)
152 11 100 66     42 if defined $state->{total} and defined $state->{current};
153            
154 11         21 my $max_chars= $dims->{cols} - $dims->{message_margin} - $dims->{title_width} - 11;
155             return sprintf " %-*.*s [%-*s] %3d%% %.*s\n",
156             $dims->{title_width}, $dims->{title_width}, $_->{title},
157             $max_chars, '=' x int( ($state->{progress}||0) * $max_chars + .000001 ),
158             int( ($state->{progress}||0) * 100 + .000001 ),
159 11   50     100 $dims->{message_margin}, $message;
      50        
160             }
161              
162             sub DESTROY {
163 1     1   3887 my $self= shift;
164 1 50       378 if ($self->_winch_handler) {
165 0 0         if ($SIG{WINCH} eq $self->_winch_handler->[0]) {
166 0           $SIG{WINCH}= $self->_winch_handler->[1];
167             } else {
168 0           warn "Can't uninstall SIGWINCH handler\n";
169             }
170 0           $self->_winch_handler(undef);
171             }
172             }
173              
174             1;
175              
176             __END__