File Coverage

blib/lib/Term/Table/LineBreak.pm
Criterion Covered Total %
statement 56 57 98.2
branch 17 20 85.0
condition 8 9 88.8
subroutine 9 10 90.0
pod 0 4 0.0
total 90 100 90.0


line stmt bran cond sub pod time code
1             package Term::Table::LineBreak;
2 6     6   76165 use strict;
  6         24  
  6         172  
3 6     6   33 use warnings;
  6         11  
  6         250  
4              
5             our $VERSION = '0.016';
6              
7 6     6   33 use Carp qw/croak/;
  6         10  
  6         391  
8 6     6   37 use Scalar::Util qw/blessed/;
  6         13  
  6         481  
9 6     6   2558 use Term::Table::Util qw/uni_length/;
  6         18  
  6         73  
10              
11 6     6   3256 use Term::Table::HashBase qw/string gcstring _len _parts idx/;
  6         16  
  6         40  
12              
13             sub init {
14 140     140 0 218 my $self = shift;
15              
16             croak "string is a required attribute"
17 140 50       346 unless defined $self->{+STRING};
18             }
19              
20 0     0 0 0 sub columns { uni_length($_[0]->{+STRING}) }
21              
22             sub break {
23 140     140 0 218 my $self = shift;
24 140         214 my ($len) = @_;
25              
26 140         237 $self->{+_LEN} = $len;
27              
28 140         234 $self->{+IDX} = 0;
29 140         318 my $str = $self->{+STRING} . ""; # Force stringification
30              
31 140         179 my @parts;
32 140         673 my @chars = split //, $str;
33 140         339 while (@chars) {
34 264         385 my $size = 0;
35 264         356 my $part = '';
36 264         505 until ($size == $len) {
37 1826         2687 my $char = shift @chars;
38 1826 100       3150 $char = '' unless defined $char;
39              
40 1826         3856 my $l = uni_length("$char");
41 1826 100       22187 last unless $l;
42              
43 1757 50       3042 last if $char eq "\n";
44              
45 1757 100       2933 if ($size + $l > $len) {
46 1         13 unshift @chars => $char;
47 1         3 last;
48             }
49              
50 1756         2151 $size += $l;
51 1756         3405 $part .= $char;
52             }
53              
54             # If we stopped just before a newline, grab it
55 264 100 100     936 shift @chars if $size == $len && @chars && $chars[0] eq "\n";
      100        
56              
57 264         516 until ($size == $len) {
58 429         557 $part .= ' ';
59 429         762 $size += 1;
60             }
61 264         655 push @parts => $part;
62             }
63              
64 140         383 $self->{+_PARTS} = \@parts;
65             }
66              
67             sub next {
68 495     495 0 785 my $self = shift;
69              
70 495 100       862 if (@_) {
71 476         786 my ($len) = @_;
72 476 100 66     1494 $self->break($len) if !$self->{+_LEN} || $self->{+_LEN} != $len;
73             }
74             else {
75             croak "String has not yet been broken"
76 19 50       38 unless $self->{+_PARTS};
77             }
78              
79 495         764 my $idx = $self->{+IDX}++;
80 495         695 my $parts = $self->{+_PARTS};
81              
82 495 100       1098 return undef if $idx >= @$parts;
83 264         677 return $parts->[$idx];
84             }
85              
86             1;
87              
88             __END__