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   77911 use strict;
  5         18  
  5         129  
3 5     5   81 use warnings;
  5         9  
  5         212  
4              
5             our $VERSION = '0.015';
6              
7 5     5   2037 use Term::Table::LineBreak();
  5         13  
  5         128  
8 5     5   30 use Term::Table::Util qw/uni_length/;
  5         7  
  5         29  
9              
10 5     5   155 use List::Util qw/sum/;
  5         10  
  5         360  
11              
12 5     5   29 use Term::Table::HashBase qw/value border_left border_right _break _widths border_color value_color reset_color/;
  5         8  
  5         17  
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 174 my $self = shift;
29              
30             # Stringify
31 138 100       414 $self->{+VALUE} = defined $self->{+VALUE} ? "$self->{+VALUE}" : '';
32             }
33              
34             sub char_id {
35 33     33 0 45 my $class = shift;
36 33         81 my ($char) = @_;
37 33         249 return "\\N{U+" . sprintf("\%X", ord($char)) . "}";
38             }
39              
40             sub show_char {
41 190     190 0 6494 my $class = shift;
42 190         299 my ($char, %props) = @_;
43 190 50 33     328 return $char if $props{no_newline} && $char eq "\n";
44 190   66     566 return $CHAR_MAP{$char} || $class->char_id($char);
45             }
46              
47             sub sanitize {
48 142     142 0 200 my $self = shift;
49 5     5   2727 $self->{+VALUE} =~ s/([\s\t\p{Zl}\p{C}\p{Zp}])/$self->show_char($1)/ge; # All whitespace except normal space
  5         65  
  5         68  
  142         389  
  178         298  
50             }
51              
52             sub mark_tail {
53 141     141 0 200 my $self = shift;
54 141 50       377 $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         7  
55             }
56              
57             sub value_width {
58 141     141 0 210 my $self = shift;
59              
60 141   50     287 my $w = $self->{+_WIDTHS} ||= {};
61 141 50       244 return $w->{value} if defined $w->{value};
62              
63 141         389 my @parts = split /(\n)/, $self->{+VALUE};
64              
65 141         186 my $max = 0;
66 141         272 while (@parts) {
67 137         234 my $text = shift @parts;
68 137   100     338 my $sep = shift @parts || '';
69 137         358 my $len = uni_length("$text");
70 137 100       2308 $max = $len if $len > $max;
71             }
72              
73 141         347 return $w->{value} = $max;
74             }
75              
76             sub border_left_width {
77 617     617 0 791 my $self = shift;
78 617   100     2331 $self->{+_WIDTHS}->{left} ||= uni_length($self->{+BORDER_LEFT} || '');
      100        
79             }
80              
81             sub border_right_width {
82 617     617 0 916 my $self = shift;
83 617   100     2109 $self->{+_WIDTHS}->{right} ||= uni_length($self->{+BORDER_RIGHT} || '');
      100        
84             }
85              
86             sub width {
87 141     141 0 202 my $self = shift;
88 141   66     424 $self->{+_WIDTHS}->{all} ||= sum(map { $self->$_ } qw/value_width border_left_width border_right_width/);
  423         2832  
89             }
90              
91             sub break {
92 476     476 0 610 my $self = shift;
93 476   66     1392 $self->{+_BREAK} ||= Term::Table::LineBreak->new(string => $self->{+VALUE});
94             }
95              
96             sub reset {
97 136     136 0 176 my $self = shift;
98 136         249 delete $self->{+_BREAK};
99             }
100              
101             1;
102              
103             __END__