File Coverage

blib/lib/Term/Table/Cell.pm
Criterion Covered Total %
statement 58 58 100.0
branch 7 10 70.0
condition 20 26 76.9
subroutine 18 18 100.0
pod 0 11 0.0
total 103 123 83.7


line stmt bran cond sub pod time code
1             package Term::Table::Cell;
2 5     5   82217 use strict;
  5         23  
  5         150  
3 5     5   28 use warnings;
  5         11  
  5         207  
4              
5             our $VERSION = '0.017';
6              
7 5     5   2159 use Term::Table::LineBreak();
  5         11  
  5         144  
8 5     5   31 use Term::Table::Util qw/uni_length/;
  5         10  
  5         268  
9              
10 5     5   38 use List::Util qw/sum/;
  5         10  
  5         423  
11              
12 5     5   41 use Term::Table::HashBase qw/value border_left border_right _break _widths border_color value_color reset_color/;
  5         27  
  5         40  
13              
14             my %CHAR_MAP = (
15             # Special case, \n should render as \n, but also actually do the newline thing
16             "\n" => "\\n\n",
17              
18             "\a" => '\\a',
19             "\b" => '\\b',
20             "\e" => '\\e',
21             "\f" => '\\f',
22             "\r" => '\\r',
23             "\t" => '\\t',
24             " " => ' ',
25             );
26              
27             sub init {
28 138     138 0 239 my $self = shift;
29              
30             # Stringify
31 138 100       413 $self->{+VALUE} = defined $self->{+VALUE} ? "$self->{+VALUE}" : '';
32             }
33              
34             sub char_id {
35 33     33 0 47 my $class = shift;
36 33         55 my ($char) = @_;
37 33         230 return "\\N{U+" . sprintf("\%X", ord($char)) . "}";
38             }
39              
40             sub show_char {
41 190     190 0 6753 my $class = shift;
42 190         315 my ($char, %props) = @_;
43 190 50 33     364 return $char if $props{no_newline} && $char eq "\n";
44 190   66     628 return $CHAR_MAP{$char} || $class->char_id($char);
45             }
46              
47             sub sanitize {
48 142     142 0 205 my $self = shift;
49 5     5   3275 $self->{+VALUE} =~ s/([\s\t\p{Zl}\p{C}\p{Zp}])/$self->show_char($1)/ge; # All whitespace except normal space
  5         75  
  5         116  
  142         425  
  178         317  
50             }
51              
52             sub mark_tail {
53 141     141 0 180 my $self = shift;
54 141 50       402 $self->{+VALUE} =~ s/([\s\t\p{Zl}\p{C}\p{Zp}])$/$1 eq ' ' ? $self->char_id($1) : $self->show_char($1, no_newline => 1)/se;
  1         9  
55             }
56              
57             sub value_width {
58 141     141 0 200 my $self = shift;
59              
60 141   50     282 my $w = $self->{+_WIDTHS} ||= {};
61 141 50       275 return $w->{value} if defined $w->{value};
62              
63 141         414 my @parts = split /(\n)/, $self->{+VALUE};
64              
65 141         196 my $max = 0;
66 141         273 while (@parts) {
67 137         234 my $text = shift @parts;
68 137   100     364 my $sep = shift @parts || '';
69 137         355 my $len = uni_length("$text");
70 137 100       2510 $max = $len if $len > $max;
71             }
72              
73 141         358 return $w->{value} = $max;
74             }
75              
76             sub border_left_width {
77 617     617 0 901 my $self = shift;
78 617   100     2476 $self->{+_WIDTHS}->{left} ||= uni_length($self->{+BORDER_LEFT} || '');
      100        
79             }
80              
81             sub border_right_width {
82 617     617 0 914 my $self = shift;
83 617   100     2341 $self->{+_WIDTHS}->{right} ||= uni_length($self->{+BORDER_RIGHT} || '');
      100        
84             }
85              
86             sub width {
87 141     141 0 198 my $self = shift;
88 141   66     534 $self->{+_WIDTHS}->{all} ||= sum(map { $self->$_ } qw/value_width border_left_width border_right_width/);
  423         2560  
89             }
90              
91             sub break {
92 476     476 0 642 my $self = shift;
93 476   66     1420 $self->{+_BREAK} ||= Term::Table::LineBreak->new(string => $self->{+VALUE});
94             }
95              
96             sub reset {
97 136     136 0 185 my $self = shift;
98 136         251 delete $self->{+_BREAK};
99             }
100              
101             1;
102              
103             __END__