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   76034 use strict;
  5         20  
  5         146  
3 5     5   24 use warnings;
  5         10  
  5         183  
4              
5             our $VERSION = '0.016';
6              
7 5     5   2106 use Term::Table::LineBreak();
  5         15  
  5         145  
8 5     5   32 use Term::Table::Util qw/uni_length/;
  5         9  
  5         37  
9              
10 5     5   168 use List::Util qw/sum/;
  5         11  
  5         471  
11              
12 5     5   35 use Term::Table::HashBase qw/value border_left border_right _break _widths border_color value_color reset_color/;
  5         9  
  5         22  
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 208 my $self = shift;
29              
30             # Stringify
31 138 100       412 $self->{+VALUE} = defined $self->{+VALUE} ? "$self->{+VALUE}" : '';
32             }
33              
34             sub char_id {
35 33     33 0 52 my $class = shift;
36 33         80 my ($char) = @_;
37 33         232 return "\\N{U+" . sprintf("\%X", ord($char)) . "}";
38             }
39              
40             sub show_char {
41 190     190 0 6219 my $class = shift;
42 190         330 my ($char, %props) = @_;
43 190 50 33     364 return $char if $props{no_newline} && $char eq "\n";
44 190   66     684 return $CHAR_MAP{$char} || $class->char_id($char);
45             }
46              
47             sub sanitize {
48 142     142 0 204 my $self = shift;
49 5     5   3233 $self->{+VALUE} =~ s/([\s\t\p{Zl}\p{C}\p{Zp}])/$self->show_char($1)/ge; # All whitespace except normal space
  5         94  
  5         89  
  142         472  
  178         315  
50             }
51              
52             sub mark_tail {
53 141     141 0 203 my $self = shift;
54 141 50       418 $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         8  
55             }
56              
57             sub value_width {
58 141     141 0 184 my $self = shift;
59              
60 141   50     308 my $w = $self->{+_WIDTHS} ||= {};
61 141 50       282 return $w->{value} if defined $w->{value};
62              
63 141         405 my @parts = split /(\n)/, $self->{+VALUE};
64              
65 141         199 my $max = 0;
66 141         292 while (@parts) {
67 137         243 my $text = shift @parts;
68 137   100     407 my $sep = shift @parts || '';
69 137         388 my $len = uni_length("$text");
70 137 100       2449 $max = $len if $len > $max;
71             }
72              
73 141         352 return $w->{value} = $max;
74             }
75              
76             sub border_left_width {
77 617     617 0 914 my $self = shift;
78 617   100     2395 $self->{+_WIDTHS}->{left} ||= uni_length($self->{+BORDER_LEFT} || '');
      100        
79             }
80              
81             sub border_right_width {
82 617     617 0 955 my $self = shift;
83 617   100     2326 $self->{+_WIDTHS}->{right} ||= uni_length($self->{+BORDER_RIGHT} || '');
      100        
84             }
85              
86             sub width {
87 141     141 0 195 my $self = shift;
88 141   66     499 $self->{+_WIDTHS}->{all} ||= sum(map { $self->$_ } qw/value_width border_left_width border_right_width/);
  423         2553  
89             }
90              
91             sub break {
92 476     476 0 654 my $self = shift;
93 476   66     1451 $self->{+_BREAK} ||= Term::Table::LineBreak->new(string => $self->{+VALUE});
94             }
95              
96             sub reset {
97 136     136 0 175 my $self = shift;
98 136         276 delete $self->{+_BREAK};
99             }
100              
101             1;
102              
103             __END__