File Coverage

blib/lib/Term/Table/Cell.pm
Criterion Covered Total %
statement 55 55 100.0
branch 7 10 70.0
condition 20 26 76.9
subroutine 17 17 100.0
pod 0 11 0.0
total 99 119 83.1


line stmt bran cond sub pod time code
1             package Term::Table::Cell;
2 5     5   6404 use strict;
  5         15  
  5         175  
3 5     5   46 use warnings;
  5         11  
  5         337  
4              
5             our $VERSION = '0.028';
6              
7 5     5   2389 use Term::Table::LineBreak();
  5         22  
  5         223  
8 5     5   40 use Term::Table::Util qw/uni_length/;
  5         10  
  5         320  
9              
10 5     5   50 use List::Util qw/sum/;
  5         10  
  5         364  
11              
12 5     5   27 use Term::Table::HashBase qw/value border_left border_right _break _widths border_color value_color reset_color/;
  5         9  
  5         23  
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 157 my $self = shift;
29              
30             # Stringify
31 138 100       366 $self->{+VALUE} = defined $self->{+VALUE} ? "$self->{+VALUE}" : '';
32             }
33              
34             sub char_id {
35 33     33 0 41 my $class = shift;
36 33         50 my ($char) = @_;
37 33         184 return "\\N{U+" . sprintf("\%X", utf8::native_to_unicode(ord($char))) . "}";
38             }
39              
40             sub show_char {
41 190     190 0 309509 my $class = shift;
42 190         268 my ($char, %props) = @_;
43 190 50 33     313 return $char if $props{no_newline} && $char eq "\n";
44 190   66     484 return $CHAR_MAP{$char} || $class->char_id($char);
45             }
46              
47             sub sanitize {
48 142     142 0 152 my $self = shift;
49 142         377 $self->{+VALUE} =~ s/([\s\t\p{Zl}\p{C}\p{Zp}])/$self->show_char($1)/ge; # All whitespace except normal space
  178         219  
50             }
51              
52             sub mark_tail {
53 141     141 0 137 my $self = shift;
54 141 50       300 $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         6  
55             }
56              
57             sub value_width {
58 141     141 0 156 my $self = shift;
59              
60 141   50     235 my $w = $self->{+_WIDTHS} ||= {};
61 141 50       230 return $w->{value} if defined $w->{value};
62              
63 141         302 my @parts = split /(\n)/, $self->{+VALUE};
64              
65 141         144 my $max = 0;
66 141         226 while (@parts) {
67 137         167 my $text = shift @parts;
68 137   100     355 my $sep = shift @parts || '';
69 137         305 my $len = uni_length("$text");
70 137 100       2030 $max = $len if $len > $max;
71             }
72              
73 141         318 return $w->{value} = $max;
74             }
75              
76             sub border_left_width {
77 617     617 0 728 my $self = shift;
78 617   100     2374 $self->{+_WIDTHS}->{left} ||= uni_length($self->{+BORDER_LEFT} || '');
      100        
79             }
80              
81             sub border_right_width {
82 617     617 0 755 my $self = shift;
83 617   100     2149 $self->{+_WIDTHS}->{right} ||= uni_length($self->{+BORDER_RIGHT} || '');
      100        
84             }
85              
86             sub width {
87 141     141 0 152 my $self = shift;
88 141   66     386 $self->{+_WIDTHS}->{all} ||= sum(map { $self->$_ } qw/value_width border_left_width border_right_width/);
  423         2039  
89             }
90              
91             sub break {
92 476     476 0 592 my $self = shift;
93 476   66     1391 $self->{+_BREAK} ||= Term::Table::LineBreak->new(string => $self->{+VALUE});
94             }
95              
96             sub reset {
97 136     136 0 152 my $self = shift;
98 136         215 delete $self->{+_BREAK};
99             }
100              
101             1;
102              
103             __END__