File Coverage

blib/lib/App/ansicolumn/Util.pm
Criterion Covered Total %
statement 126 135 93.3
branch 36 56 64.2
condition 18 31 58.0
subroutine 34 38 89.4
pod 0 21 0.0
total 214 281 76.1


line stmt bran cond sub pod time code
1             package App::ansicolumn;
2              
3 32     32   410 use v5.14;
  32         117  
4 32     32   188 use warnings;
  32         71  
  32         1692  
5 32     32   171 use utf8;
  32         62  
  32         192  
6              
7             ######################################################################
8             # Object interface
9             ######################################################################
10              
11             sub get_border {
12 333 100   333 0 965 my $border = shift->{BORDER} or return "";
13 295         837 $border->get(@_);
14             }
15              
16             sub border_width {
17 32     32   3653 use List::Util qw(sum);
  32         106  
  32         4341  
18 70     70 0 332 my $obj = shift;
19 70         266 sum map length($obj->get_border($_)), @_;
20             }
21              
22 32     32   220 use Text::ANSI::Fold qw(:constants);
  32         73  
  32         15989  
23              
24             my %lb_flag = (
25             '' => LINEBREAK_NONE,
26             none => LINEBREAK_NONE,
27             runin => LINEBREAK_RUNIN,
28             runout => LINEBREAK_RUNOUT,
29             all => LINEBREAK_ALL,
30             );
31              
32             sub lb_flag {
33 19     19 0 196 $lb_flag{shift->linebreak};
34             }
35              
36             sub runin_margin {
37 39     39 0 81 my $obj = shift;
38 39 100       137 if ($lb_flag{$obj->linebreak} & LINEBREAK_RUNIN) {
39 10         130 $obj->runin;
40             } else {
41 29         305 0;
42             }
43             }
44              
45             sub term_size {
46 1   50 1 0 2 @{ shift->{TERM_SIZE} //= [ terminal_size() ] };
  1         20  
47             }
48              
49             sub term_width {
50 1     1 0 14 (shift->term_size)[0];
51             }
52              
53             sub term_height {
54 0     0 0 0 (shift->term_size)[1];
55             }
56              
57             sub get_width {
58 20     20 0 42 my $obj = shift;
59 20 100       108 $obj->width || $obj->term_width;
60             }
61              
62             sub effective_height {
63 124     124 0 198 my $obj = shift;
64 124         284 $obj->height - $obj->border_height;
65             }
66              
67             sub foldobj {
68 19     19 0 35 my $obj = shift;
69 19         138 my $width = shift;
70 32     32   259 use Text::ANSI::Fold;
  32         66  
  32         14422  
71 19         69 my $fold = Text::ANSI::Fold->new(
72             width => $width,
73             margin => $obj->runin_margin,
74             boundary => $obj->boundary,
75             linebreak => $obj->lb_flag,
76             runin => $obj->runin,
77             runout => $obj->runout,
78             ambiguous => $obj->ambiguous,
79             padchar => $obj->padchar,
80             padding => 1,
81             );
82 19 50       2548 if ($obj->discard_el) {
83 19         590 $fold->configure(discard => [ 'EL' ] );
84             }
85 19         560 $fold;
86             }
87              
88             sub foldsub {
89 19     19 0 40 my $obj = shift;
90 19         89 my $width = shift;
91 19         82 my $fold = $obj->foldobj($width);
92 19 50       63 if ((my $ls = $obj->linestyle) eq 'truncate') {
    50          
93 0     0   0 sub { ($fold->fold($_[0]))[0] };
  0         0  
94             } elsif ($ls eq 'wrap') {
95 19     271   494 sub { $fold->text($_[0])->chops };
  271         849  
96             } else {
97 0         0 undef;
98             }
99             }
100              
101             sub set_layout {
102 17     17 0 38 my $obj = shift;
103 17         35 my $dp = shift;
104 17         82 $obj->do_space_layout($dp)
105             ->do_fillup($dp);
106 17         118 return $obj;
107             }
108              
109             sub do_space_layout {
110 17     17 0 51 my $obj = shift;
111 17         48 my($dp) = @_;
112 17   50     50 my $height = $obj->effective_height || die;
113 17 50       265 return if $height <= 0;
114 17         75 my $pagebreak = $obj->pagebreak;
115 17         180 for (my $page = 0; (my $top = $page * $height) < @$dp; $page++) {
116             # Handle formfeed within the current page
117 62 50       334 if ($pagebreak) {
118 32     32   251 use List::Util qw(first);
  32         62  
  32         31422  
119 62         108 my $end = $top + $height;
120 62 100       147 $end = @$dp if $end > @$dp;
121 62 100   479   408 if (defined(my $i = first { $dp->[$_] =~ /\f/ } $top .. $end - 1)) {
  479         894  
122 4 50       43 $dp->[$i] =~ s/^([^\f]*)\f// or die;
123 4 50       29 splice @$dp, $i, ($dp->[$i] eq '' ? 1 : 0), ($1 ne '' ? $1 : ());
    50          
124 4 50       16 my $lines = ($i - $top) + ($1 ne '' ? 1 : 0);
125 4 50       12 if ($lines > 0) {
126 4         7 my $fill = $height - $lines;
127 4 50       25 splice @$dp, $top + $lines, 0, ($obj->fillup_str) x $fill if $fill > 0;
128             }
129 4         47 next;
130             }
131             }
132 58 100 66     458 if ($height >= 4 and $top > 2 and !$obj->isolation) {
      100        
133 15 100 66     187 if ($dp->[$top - 2] !~ /\S/ and
134             $dp->[$top - 1] =~ /\S/
135             ) {
136 5         19 splice @$dp, $top - 1, 0, '';
137 5         17 next;
138             }
139             }
140 53 100       272 if (not $obj->white_space) {
141 11   33     162 while ($top < @$dp and $dp->[$top] !~ /\S/) {
142 0         0 splice @$dp, $top, 1;
143             }
144             }
145             }
146 17         144 return $obj;
147             }
148              
149             sub _fillup {
150 15     15   110 my($dp, $len, $str) = @_;
151 15 50       61 if (my $remmant = @$dp % $len) {
152 15         75 push @$dp, ($str) x ($len - $remmant);
153             }
154             }
155              
156             sub do_fillup {
157 17     17 0 118 my $obj = shift;
158 17         42 my $dp = shift;
159 17   50     53 my $line = $obj->effective_height || die;
160 17 100 66     219 defined $obj->fillup and $obj->fillup !~ /^(?:no|none)$/
161             or return;
162 15   50     228 $obj->{fillup} ||= 'pane';
163 15 50       46 $line *= $obj->panes if $obj->fillup eq 'page';
164 15         129 _fillup $dp, $line, $obj->fillup_str;
165 15         33 return $obj;
166             }
167              
168             ######################################################################
169              
170             sub newlist {
171 9     9 0 499 my %arg = (count => 0);
172 9   66     78 while (@_ and not ref $_[0]) {
173 18         180 my($name, $value) = splice(@_, 0, 2);
174 18         93 $arg{$name} = $value;
175             }
176 9         52 my @list = ($arg{default}) x $arg{count};
177 9         47 while (my($index, $value) = splice(@_, 0, 2)) {
178 18 50       50 $index = [ $index ] if not ref $index;
179 18         127 @list[@$index] = ($value) x @$index;
180             }
181 9         53 @list;
182             }
183              
184             sub div {
185 32     32   286 use integer;
  32         63  
  32         257  
186 122     122 0 260 my($a, $b) = @_;
187 122         429 ($a + $b - 1) / $b;
188             }
189              
190             sub roundup ($$;$) {
191 32     32   3085 use integer;
  32         82  
  32         188  
192 30     30 0 287 my($a, $b, $c) = @_;
193 30 50       88 return $a if $b == 0;
194 30   100     217 div($a + ($c // 0), $b) * $b;
195             }
196              
197             sub terminal_size {
198 32     32   21953 use Term::ReadKey;
  32         83808  
  32         5982  
199 1     1 0 4 my @default = (80, 24);
200 1         3 my @size;
201 1 50       56 if (open my $tty, ">", "/dev/tty") {
202             # Term::ReadKey 2.31 on macOS 10.15 has a bug in argument handling
203             # and the latest version 2.38 fails to install.
204             # This code should work on both versions.
205 0         0 @size = GetTerminalSize $tty, $tty;
206             }
207 1 50       18 @size ? @size : @default;
208             }
209              
210             sub xpose {
211 32     32   267 use List::Util 1.56 qw(zip);
  32         908  
  32         4401  
212 11     11 0 169 map { [ grep { defined } @$_ ] } zip @_;
  75         122  
  645         999  
213             }
214              
215             sub insert_space {
216 32     32   225 use List::Util qw(reduce);
  32         66  
  32         7675  
217 0         0 map { @$_ } reduce {
218 0 0 0 0   0 [ @$a, (@$a && $a->[-1] ne '' && $b ne '' ? '' : ()), $b ]
219 0     0 0 0 } [], @_;
220             }
221              
222             sub decode_argv {
223             map {
224 31 50   31 0 163 utf8::is_utf8($_) ? $_ : decode('utf8', $_);
  106         2820  
225             }
226             @_;
227             }
228              
229             1;