File Coverage

blib/lib/Term/Output/List.pm
Criterion Covered Total %
statement 18 59 30.5
branch 0 14 0.0
condition 0 2 0.0
subroutine 6 10 60.0
pod 4 4 100.0
total 28 89 31.4


line stmt bran cond sub pod time code
1             package Term::Output::List;
2 1     1   684 use strict;
  1         2  
  1         32  
3 1     1   6 use warnings;
  1         3  
  1         35  
4 1     1   584 use Moo 2;
  1         11877  
  1         6  
5 1     1   2183 use Term::Cap;
  1         3109  
  1         38  
6 1     1   10 use feature 'signatures';
  1         2  
  1         105  
7 1     1   7 no warnings 'experimental::signatures';
  1         2  
  1         723  
8              
9             our $VERSION = '0.02';
10              
11             # We should have Win32 console support (maybe just Win32::Console::ANSI ?)
12             # -> Win32::Console->Mode & ENABLE_VIRTUAL_TERMINAL_PROCESSING != 0 -> VT sequences
13             # -> otherwise scroll_up via Win32::Console->Cursor()
14             # The API doesn't look great - do we want multiple instances at all? We can't
15             # handle them anyway, in a sensible way
16              
17             =head1 NAME
18              
19             Term::Output::List - output an updateable list of ongoing jobs
20              
21             =head1 SYNOPSIS
22              
23             my $printer = Term::Output::List->new();
24             my @ongoing_tasks = ('file1: frobnicating', 'file2: bamboozling', 'file3: frobnicating');
25             $printer->output_list(@ongoing_tasks);
26              
27             $printer->output_permanent("Frobnicated gizmos"); # appears above the list
28              
29             =cut
30              
31             has '_last_lines' => (
32             is => 'rw',
33             );
34              
35             =head1 MEMBERS
36              
37             =head2 C<< fh >>
38              
39             Filehandle used for output. Default is C<< STDOUT >>.
40              
41             =cut
42              
43             has 'fh' => (
44             is => 'lazy',
45             default => sub { \*STDOUT },
46             );
47              
48             has 'terminfo' => (
49             is => 'lazy',
50             default => sub { Term::Cap->Tgetent({ OSPEED => 112000 })},
51             );
52              
53             has 'term_scroll_up' => (
54             is => 'lazy',
55             default => sub { $_[0]->terminfo->Tputs('UP') },
56             );
57              
58             has 'term_clear_eol' => (
59             is => 'lazy',
60             default => sub { $_[0]->terminfo->Tputs('ce') },
61             );
62              
63             has 'interactive' => (
64             is => 'lazy',
65             default => sub { -t $_[0]->fh },
66             );
67              
68             =head2 C<< width >>
69              
70             Width of the terminal. This is initialized at first use. You may (or may not)
71             want to set up a C<< $SIG{WINCH} >> handler to set the terminal width when
72             the terminal size changes.
73              
74             =cut
75              
76             has 'width' => (
77             is => 'lazy',
78             default => sub { `tput cols` },
79             );
80              
81             =head1 METHODS
82              
83             =head2 C<< Term::Output::List->new() >>
84              
85             =cut
86              
87             =head2 C<< ->scroll_up >>
88              
89             Helper method to place the cursor at the top of the updateable list.
90              
91             =cut
92              
93 0     0 1   sub scroll_up( $self, $count=$self->_last_lines ) {
  0            
  0            
  0            
94 0 0         if( !$count) {
95             } else {
96             # Overwrite the number of lines we printed last time
97 0           print { $self->fh } "\r" . sprintf $self->term_scroll_up(), ${count};
  0            
98             #sleep 1;
99             };
100             }
101              
102             =head2 C<<->output_permanent>>
103              
104             $o->output_permanent("Frobnicated 3 items for job 2");
105             $o->output_list("Frobnicating 9 items for job 1",
106             "Frobnicating 2 items for job 3",
107             );
108              
109             Outputs items that should go on the permanent record. It is expected to
110             output the (remaining) list of ongoing jobs after that.
111              
112             =cut
113              
114 0     0 1   sub output_permanent( $self, @items ) {
  0            
  0            
  0            
115 0   0       my $total = $self->_last_lines // 0;
116 0 0         if( $self->interactive ) {
117 0           $self->scroll_up();
118 0           my $w = $self->width;
119 0           my $clear_eol = $self->term_clear_eol;
120 0 0         if( @items ) {
121 0           print { $self->fh }
122             join("$clear_eol\n",
123 0 0         map { length($_) > $w - 1 ? (substr($_,0,$w-3).'..'): $_
  0            
124             } @items)."$clear_eol\n";
125             };
126             } else {
127 0           print { $self->fh } join("\n", @items) . "\n";
  0            
128             }
129             #sleep 1;
130              
131 0 0         if( $self->interactive ) {
132 0           my $blank = $total - @items;
133 0           my $clear_eol = $self->term_clear_eol;
134 0 0         if( $blank > 0 ) {
135 0           print { $self->fh } "$clear_eol\n"x ($blank);
  0            
136 0           $self->scroll_up( $blank );
137             }
138 0           $self->fresh_output();
139             }
140             }
141              
142             =head2 C<<->output_list @items>>
143              
144             $o->output_list("Frobnicating 9 items for job 1",
145             "Frobnicating 2 items for job 3",
146             );
147              
148             Outputs items that can be updated later, as long as no intervening output
149             (like from C, C or C) has happened. If you want to output
150             lines that should not be overwritten later, see C<output_permanent>>
151              
152             =cut
153              
154 0     0 1   sub output_list( $self, @items ) {
  0            
  0            
  0            
155 0 0         if( $self->interactive ) {
156 0           $self->output_permanent(@items);
157             #sleep 1;
158 0           $self->_last_lines( 0+@items);
159             }
160             }
161              
162             =head2 C<<->fresh_output >>
163              
164             $o->fresh_output();
165              
166             Helper subroutine to make all items from the last output list remain as is.
167              
168             For compatibility between output to a terminal and output without a terminal,
169             you should use C<< ->output_permanent >> for things that should be permanent
170             instead.
171              
172             =cut
173              
174 0     0 1   sub fresh_output( $self ) {
  0            
  0            
175 0           $self->_last_lines( 0 );
176             }
177              
178             1;