File Coverage

blib/lib/Text/Wrap/Smart.pm
Criterion Covered Total %
statement 73 73 100.0
branch 14 16 87.5
condition 9 9 100.0
subroutine 13 13 100.0
pod 2 2 100.0
total 111 113 98.2


line stmt bran cond sub pod time code
1             package Text::Wrap::Smart;
2              
3 5     5   386569 use strict;
  5         61  
  5         164  
4 5     5   29 use warnings;
  5         8  
  5         174  
5 5     5   28 use base qw(Exporter);
  5         9  
  5         945  
6 5     5   2609 use boolean qw(true);
  5         17641  
  5         27  
7              
8 5     5   495 use Carp qw(croak);
  5         11  
  5         223  
9 5     5   6010 use Math::BigFloat ();
  5         302817  
  5         259  
10 5     5   3508 use Params::Validate ':all';
  5         51418  
  5         1413  
11              
12             our ($VERSION, @EXPORT_OK, %EXPORT_TAGS);
13             my @subs;
14              
15             $VERSION = '0.9';
16             @subs = qw(exact_wrap fuzzy_wrap);
17             @EXPORT_OK = @subs;
18             %EXPORT_TAGS = ('all' => [ @subs ]);
19              
20 5     5   55 use constant WRAP_AT_DEFAULT => 160;
  5         12  
  5         5230  
21              
22             validation_options(
23             on_fail => sub
24             {
25             my ($error) = @_;
26             chomp $error;
27             croak $error;
28             },
29             stack_skip => 2,
30             );
31              
32             my $pre_process = sub
33             {
34             local $_ = ${$_[0]};
35              
36             s/^\s+//;
37             s/\s+$//;
38             s/\s+/ /g;
39              
40             ${$_[0]} = $_;
41             };
42              
43             my $calc_average = sub
44             {
45             my ($text, $wrap_at) = @_;
46              
47             my $length = length $text;
48              
49             my $i = int $length / $wrap_at;
50             $i++ if $length % $wrap_at != 0;
51              
52             my $x = Math::BigFloat->new($length / $i);
53             my $average = $x->bceil;
54              
55             return $average;
56             };
57              
58             sub exact_wrap
59             {
60 10     10 1 5699 _validate(@_);
61 10         582 my ($text, $wrap_at) = @_;
62              
63 10         55 $pre_process->(\$text);
64 10 100       39 return () unless length $text;
65              
66 8   100     28 $wrap_at ||= WRAP_AT_DEFAULT;
67 8         24 my $average = $calc_average->($text, $wrap_at);
68              
69 8         24 return _exact_wrap($text, $average);
70             }
71              
72             sub fuzzy_wrap
73             {
74 20     20 1 18610 _validate(@_);
75 20         953 my ($text, $wrap_at) = @_;
76              
77 20         75 $pre_process->(\$text);
78 20 100       72 return () unless length $text;
79              
80 18   100     55 $wrap_at ||= WRAP_AT_DEFAULT;
81 18         52 my $average = $calc_average->($text, $wrap_at);
82              
83 18         73 return _fuzzy_wrap($text, $average);
84             }
85              
86             sub _exact_wrap
87             {
88 8     8   23 my ($text, $average) = @_;
89              
90 8         13 my @chunks;
91              
92 8         34 for (my $offset = 0; $offset < length $text; $offset += $average) {
93 18         6812 push @chunks, substr($text, $offset, $average);
94             }
95              
96 8         5009 return @chunks;
97             }
98              
99             sub _fuzzy_wrap
100             {
101 18     18   49 my ($text, $average) = @_;
102              
103 18         26 my @spaces;
104 18         518 push @spaces, pos $text while $text =~ /(?= )/g;
105              
106 18         29 my $pos = $average;
107 18         28 my $start_offset = 0;
108 18         29 my $skip_space = 1;
109              
110 18         24 my @offsets;
111              
112 18         51 while (true) {
113 95 100       28064 my $begin = @offsets ? ($offsets[-1] + $skip_space) : $start_offset;
114              
115 95 100       421 my $index = index($text, ' ', ($begin == $start_offset ? $start_offset : $begin - $skip_space) + $average);
116 95 100       30856 last if $index == -1;
117              
118 77         230 my @spaces_prev = grep $_ <= $pos, @spaces;
119              
120 77   100     307292 my $space_prev = $spaces_prev[-1] || undef;
121 77         159 my $space_next = $index;
122              
123 77         241 splice(@spaces, 0, scalar @spaces_prev);
124 77         415 @spaces = grep $_ != $space_next, @spaces;
125              
126 77 100 100     605 if (defined $space_prev && substr($text, $begin, $space_prev - $begin) =~ / /) {
127 35         100 push @offsets, $space_prev;
128             }
129             else {
130 42         96 push @offsets, $space_next;
131             }
132 77         376 $pos = $offsets[-1] + $skip_space + $average;
133             }
134              
135 18         35 my @chunks;
136              
137 18         33 my $begin = $start_offset;
138 18         39 foreach my $offset (@offsets) {
139 77         86 my $range = $offset - $begin;
140 77 50       1111 if ($text =~ /\G(.{$range}) (?=[^ ])/g) {
141 77         169 push @chunks, $1;
142             }
143 77         133 $begin = $offset + $skip_space;
144             }
145 18 50       98 push @chunks, $1 if $text =~ /\G(.+)$/;
146              
147 18         167 return @chunks;
148             }
149              
150             sub _validate
151             {
152 30     30   179 validate_pos(@_,
153             { type => SCALAR },
154             { type => SCALAR, optional => true, regex => qr/^\d+$/ },
155             );
156             }
157              
158             1;
159             __END__