File Coverage

blib/lib/App/sdview/Output/Formatted.pm
Criterion Covered Total %
statement 143 149 95.9
branch 30 38 78.9
condition 23 36 63.8
subroutine 14 14 100.0
pod 0 5 0.0
total 210 242 86.7


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2021-2023 -- leonerd@leonerd.org.uk
5              
6 2     2   24 use v5.26;
  2         6  
7 2     2   17 use warnings;
  2         2  
  2         48  
8 2     2   10 use utf8;
  2         13  
  2         14  
9              
10 2     2   76 use Object::Pad 0.800;
  2         26  
  2         75  
11              
12             package App::sdview::Output::Formatted 0.11;
13             class App::sdview::Output::Formatted :strict(params);
14              
15             # This isn't itself an output module; but a base class to build them on
16             # So no `format` constant.
17              
18 2     2   1098 use App::sdview::Style;
  2         36  
  2         142  
19              
20 2     2   17 use List::Util qw( max );
  2         4  
  2         195  
21 2     2   15 use String::Tagged 0.15; # ->from_sprintf
  2         50  
  2         8057  
22              
23             =head1 NAME
24              
25             C - base class for generating formatted output from L
26              
27             =head1 DESCRIPTION
28              
29             This module is the base class used by both L and
30             L. It shouldn't be used directly.
31              
32             =cut
33              
34             field $_TERMWIDTH;
35             field $_nextblank;
36              
37 8         15 method output ( @paragraphs )
  8         17  
  8         13  
38 8     8 0 25 {
39 8         30 $self->setup_output();
40              
41 8         9926 $_TERMWIDTH = $self->width;
42              
43 8         23 foreach my $para ( @paragraphs ) {
44 15 50       173 my $code = $self->can( "output_" . ( $para->type =~ s/-/_/gr ) )
45             or die "TODO: Unhandled paragraph type " . $para->type;
46              
47 15         53 $self->$code( $para );
48             }
49             }
50              
51             # Most paragraphs are handled in a uniform way
52             *output_head1 = \&_output_para;
53             *output_head2 = \&_output_para;
54             *output_head3 = \&_output_para;
55             *output_head4 = \&_output_para;
56              
57             *output_plain = \&_output_para;
58              
59             *output_verbatim = \&_output_para;
60              
61             *output_item = \&_output_para;
62              
63 21         35 method _output_para ( $para, %opts )
  21         36  
  21         45  
  21         26  
64 21     21   52 {
65 21   100     69 my $margin = $opts{margin} // 0;
66 21         32 my $leader = $opts{leader};
67 21         32 my $indent = $opts{indent};
68              
69 21         56 my %typestyle = App::sdview::Style->para_style( $para->type )->%*;
70              
71 21 100       77 $self->say() if $_nextblank;
72              
73 21         56 my $text = App::sdview::Style->convert_str( $para->text );
74              
75             $typestyle{$_} and $text->apply_tag( 0, -1, $_ => $typestyle{$_} )
76 21   66     1451 for qw( fg bg bold under italic monospace );
77              
78 21         367 $_nextblank = !!$typestyle{blank_after};
79              
80 21         106 my @lines = $text->split( qr/\n/ );
81 21 100 33     2153 @lines or @lines = ( String::Tagged->new ) if defined $leader;
82              
83             # If there's a background set, then space-pad every line to the same width
84             # so it looks neater on the terminal
85             # https://rt.cpan.org/Ticket/Display.html?id=140536
86 21 100       55 if( defined $typestyle{bg} ) {
87 1         3 my $width = max map { length $_ } @lines;
  3         15  
88 1         8 $_ .= " " x ( $width - length $_ ) for @lines;
89             }
90              
91 21   100     148 $indent //= $typestyle{indent};
92 21   100     46 $indent //= 0;
93              
94 21         39 foreach my $line ( @lines ) {
95 23 50 33     88 length $line or defined $leader or
96             ( $self->say() ), next;
97              
98 23         145 my $width = $_TERMWIDTH - $margin - $indent;
99              
100 23   66     51 while( length $line or defined $leader ) {
101 23         165 my $part;
102 23 50       50 if( length($line) > $width ) {
103 0 0       0 if( substr($line, 0, $width) =~ m/(\s+)\S*$/ ) {
104 0         0 my $partlen = $-[1];
105 0         0 my $chopat = $+[1];
106              
107 0         0 $part = $line->substr( 0, $partlen );
108 0         0 $line->set_substr( 0, $chopat, "" );
109             }
110             else {
111 0         0 die "ARGH: notsure how to trim this one\n";
112             }
113             }
114             else {
115 23         120 $part = $line;
116 23         44 $line = "";
117             }
118              
119 23         56 my $prefix = " "x$margin;;
120              
121 23 100       48 if( defined $leader ) {
122 11         27 my %leaderstyle = App::sdview::Style->para_style( "leader" )->%*;
123             $leaderstyle{$_} and $leader->apply_tag( 0, -1, $_ => $leaderstyle{$_} )
124 11   66     100 for qw( fg bg bold under italic monospace );
125              
126 11 100       415 if( length $leader <= $indent ) {
127             # If the leader will fit on the same line
128 8         48 $prefix .= $leader . " "x($indent - length $leader);
129             }
130             else {
131             # Spill the leader onto its own line
132 3         24 $self->say( $prefix, $leader );
133              
134 3 50       42 $prefix .= " "x$indent if length $part;
135             }
136              
137 11         2651 undef $leader;
138             }
139             else {
140 12         26 $prefix .= " "x$indent;
141             }
142              
143 23         78 $self->say( $prefix, $part );
144             }
145             }
146             }
147              
148 3     3 0 7 method output_list_bullet ( $para, %opts ) { $self->_output_list( bullet => $para, %opts ); }
  3         6  
  3         6  
  3         8  
  3         4  
  3         18  
149 1     1 0 4 method output_list_number ( $para, %opts ) { $self->_output_list( number => $para, %opts ); }
  1         2  
  1         2  
  1         3  
  1         2  
  1         5  
150 1     1 0 3 method output_list_text ( $para, %opts ) { $self->_output_list( text => $para, %opts ); }
  1         2  
  1         3  
  1         3  
  1         1  
  1         6  
151              
152 5         9 method _output_list( $listtype, $para, %opts )
  5         8  
  5         8  
  5         10  
  5         7  
153 5     5   12 {
154 5         16 my $n = $para->initial;
155              
156 5   100     24 my $margin = $opts{margin} // 0;
157 5   50     25 my $indent = App::sdview::Style->para_style( "list" )->{indent} // 0;
158              
159 5         18 foreach my $item ( $para->items ) {
160 13         160 my $leader;
161 13 100       39 if( $item->type ne "item" ) {
    100          
    100          
    50          
162             # non-items just stand as they are + indent
163             }
164             elsif( $listtype eq "bullet" ) {
165 5         21 $leader = String::Tagged->new( "•" );
166             }
167             elsif( $listtype eq "number" ) {
168 3         14 $leader = String::Tagged->from_sprintf( "%d.", $n++ );
169             }
170             elsif( $listtype eq "text" ) {
171 3         10 $leader = App::sdview::Style->convert_str( $item->term );
172             }
173              
174 13 50       630 my $code = $self->can( "output_" . ( $item->type =~ s/-/_/gr ) ) or
175             die "TODO: Unhandled item type " . $item->type;
176              
177 13         47 $self->$code( $item,
178             margin => $margin + $indent,
179             indent => $para->indent,
180             leader => $leader,
181             );
182             }
183             }
184              
185 2         3 method output_table ( $para, %opts )
  2         4  
  2         3  
  2         3  
186 2     2 0 7 {
187 2   50     12 my $margin = $opts{margin} // 0;
188 2         4 my $indent = $opts{indent};
189              
190 2         8 my %typestyle = App::sdview::Style->para_style( "table" )->%*;
191              
192 2   33     12 $indent //= $typestyle{indent};
193 2   50     5 $indent //= 0;
194              
195 2         8 my @rows = $para->rows;
196 2         4 my $ncols = scalar $rows[0]->@*;
197 2         5 my $maxcol = $ncols - 1;
198              
199             my @colwidths = map {
200 2         5 my $colidx = $_;
  5         25  
201 5         9 max map { length $rows[$_][$colidx]->text } 0 .. $#rows;
  10         49  
202             } 0 .. $maxcol;
203              
204 2         15 my @hrules = map { "─" x ($colwidths[$_] + 2) } 0 .. $maxcol;
  5         15  
205              
206 2         14 $self->say( " " x $indent, "┌", join( "┬", @hrules ), "┐" );
207              
208             # TODO: Much splitting / reflowing of content
209 2         6 my $firstrow = 1;
210 2         3 foreach my $row ( @rows ) {
211 4 100       11 if( !$firstrow ) {
212 2         12 $self->say( " " x $indent, "├", join( "┼", @hrules ), "┤" );
213             }
214              
215 4         26 my %rowstyle = %typestyle;
216 4 100       17 %rowstyle = ( App::sdview::Style->para_style( "table-heading" )->%*, %rowstyle ) if $firstrow;
217              
218 4         9 my $out = "│";
219              
220 4         11 foreach my $colidx ( 0 .. $maxcol ) {
221 10         136 my $cell = $row->[$colidx];
222              
223 10         26 my $text = App::sdview::Style->convert_str( $cell->text );
224              
225             $rowstyle{$_} and $text->apply_tag( 0, -1, $_ => $rowstyle{$_} )
226 10   66     551 for qw( fg bg bold under italic monospace );
227              
228 10         199 my $spare = $colwidths[$colidx] - length $text;
229 10 100       60 my $leftpad = ( $cell->align eq "right" ) ? " "x$spare :
    100          
230             ( $cell->align eq "centre" ) ? " "x($spare/2) :
231             "";
232 10         22 my $rightpad = " "x($spare - length $leftpad);
233              
234 10         45 $out .= " " . $leftpad . $text . $rightpad . " ";
235 10         2805 $out .= "│";
236             }
237 4         100 $self->say( " "x$indent, $out );
238              
239 4         43 undef $firstrow;
240             }
241              
242 2         13 $self->say( " " x $indent, "└", join( "┴", @hrules ), "┘" );
243             }
244              
245             =head1 AUTHOR
246              
247             Paul Evans
248              
249             =cut
250              
251             0x55AA;