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   83442 use strict;
  6         22  
  6         177  
3 6     6   30 use warnings;
  6         16  
  6         251  
4              
5             our $VERSION = '0.017';
6              
7 6     6   48 use Carp qw/croak/;
  6         12  
  6         398  
8 6     6   43 use Scalar::Util qw/blessed/;
  6         24  
  6         540  
9 6     6   2561 use Term::Table::Util qw/uni_length/;
  6         28  
  6         477  
10              
11 6     6   2916 use Term::Table::HashBase qw/string gcstring _len _parts idx/;
  6         13  
  6         38  
12              
13             sub init {
14 140     140 0 206 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 209 my $self = shift;
24 140         198 my ($len) = @_;
25              
26 140         236 $self->{+_LEN} = $len;
27              
28 140         212 $self->{+IDX} = 0;
29 140         279 my $str = $self->{+STRING} . ""; # Force stringification
30              
31 140         177 my @parts;
32 140         669 my @chars = split //, $str;
33 140         317 while (@chars) {
34 264         369 my $size = 0;
35 264         369 my $part = '';
36 264         466 until ($size == $len) {
37 1826         2622 my $char = shift @chars;
38 1826 100       3094 $char = '' unless defined $char;
39              
40 1826         3713 my $l = uni_length("$char");
41 1826 100       21722 last unless $l;
42              
43 1757 50       3088 last if $char eq "\n";
44              
45 1757 100       2925 if ($size + $l > $len) {
46 1         3 unshift @chars => $char;
47 1         2 last;
48             }
49              
50 1756         2139 $size += $l;
51 1756         3252 $part .= $char;
52             }
53              
54             # If we stopped just before a newline, grab it
55 264 100 100     923 shift @chars if $size == $len && @chars && $chars[0] eq "\n";
      100        
56              
57 264         508 until ($size == $len) {
58 429         534 $part .= ' ';
59 429         689 $size += 1;
60             }
61 264         655 push @parts => $part;
62             }
63              
64 140         345 $self->{+_PARTS} = \@parts;
65             }
66              
67             sub next {
68 495     495 0 734 my $self = shift;
69              
70 495 100       799 if (@_) {
71 476         761 my ($len) = @_;
72 476 100 66     1475 $self->break($len) if !$self->{+_LEN} || $self->{+_LEN} != $len;
73             }
74             else {
75             croak "String has not yet been broken"
76 19 50       37 unless $self->{+_PARTS};
77             }
78              
79 495         738 my $idx = $self->{+IDX}++;
80 495         658 my $parts = $self->{+_PARTS};
81              
82 495 100       1081 return undef if $idx >= @$parts;
83 264         625 return $parts->[$idx];
84             }
85              
86             1;
87              
88             __END__