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   374367 use strict;
  5         47  
  5         160  
4 5     5   27 use warnings;
  5         10  
  5         152  
5 5     5   24 use base qw(Exporter);
  5         10  
  5         957  
6 5     5   2674 use boolean qw(true);
  5         17377  
  5         25  
7              
8 5     5   403 use Carp qw(croak);
  5         9  
  5         220  
9 5     5   6124 use Math::BigFloat ();
  5         282753  
  5         210  
10 5     5   3793 use Params::Validate ':all';
  5         51153  
  5         1345  
11              
12             our ($VERSION, @EXPORT_OK, %EXPORT_TAGS);
13             my @subs;
14              
15             $VERSION = '0.8_01';
16             @subs = qw(exact_wrap fuzzy_wrap);
17             @EXPORT_OK = @subs;
18             %EXPORT_TAGS = ('all' => [ @subs ]);
19              
20 5     5   47 use constant WRAP_AT_DEFAULT => 160;
  5         10  
  5         5270  
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 4807 _validate(@_);
61 10         636 my ($text, $wrap_at) = @_;
62              
63 10         51 $pre_process->(\$text);
64 10 100       41 return () unless length $text;
65              
66 8   100     21 $wrap_at ||= WRAP_AT_DEFAULT;
67 8         21 my $average = $calc_average->($text, $wrap_at);
68              
69 8         23 return _exact_wrap($text, $average);
70             }
71              
72             sub fuzzy_wrap
73             {
74 20     20 1 19240 _validate(@_);
75 20         966 my ($text, $wrap_at) = @_;
76              
77 20         74 $pre_process->(\$text);
78 20 100       67 return () unless length $text;
79              
80 18   100     47 $wrap_at ||= WRAP_AT_DEFAULT;
81 18         40 my $average = $calc_average->($text, $wrap_at);
82              
83 18         54 return _fuzzy_wrap($text, $average);
84             }
85              
86             sub _exact_wrap
87             {
88 8     8   22 my ($text, $average) = @_;
89              
90 8         11 my @chunks;
91              
92 8         31 for (my $offset = 0; $offset < length $text; $offset += $average) {
93 18         6431 push @chunks, substr($text, $offset, $average);
94             }
95              
96 8         4990 return @chunks;
97             }
98              
99             sub _fuzzy_wrap
100             {
101 18     18   47 my ($text, $average) = @_;
102              
103 18         30 my @spaces;
104 18         608 push @spaces, pos $text while $text =~ /(?= )/g;
105              
106 18         31 my $pos = $average;
107 18         32 my $start_offset = 0;
108 18         27 my $skip_space = 1;
109              
110 18         26 my @offsets;
111              
112 18         51 while (true) {
113 95 100       28027 my $begin = @offsets ? ($offsets[-1] + $skip_space) : $start_offset;
114              
115 95 100       322 my $index = index($text, ' ', ($begin == $start_offset ? $start_offset : $begin - $skip_space) + $average);
116 95 100       34180 last if $index == -1;
117              
118 77         250 my @spaces_prev = grep $_ <= $pos, @spaces;
119              
120 77   100     373061 my $space_prev = $spaces_prev[-1] || undef;
121 77         127 my $space_next = $index;
122              
123 77         155 splice(@spaces, 0, scalar @spaces_prev);
124 77         355 @spaces = grep $_ != $space_next, @spaces;
125              
126 77 100 100     429 if (defined $space_prev && substr($text, $begin, $space_prev - $begin) =~ / /) {
127 35         74 push @offsets, $space_prev;
128             }
129             else {
130 42         82 push @offsets, $space_next;
131             }
132 77         239 $pos = $offsets[-1] + $skip_space + $average;
133             }
134              
135 18         32 my @chunks;
136              
137 18         30 my $begin = $start_offset;
138 18         43 foreach my $offset (@offsets) {
139 77         143 my $range = $offset - $begin;
140 77 50       1259 if ($text =~ /\G(.{$range}) (?=[^ ])/g) {
141 77         213 push @chunks, $1;
142             }
143 77         256 $begin = $offset + $skip_space;
144             }
145 18 50       99 push @chunks, $1 if $text =~ /\G(.+)$/;
146              
147 18         232 return @chunks;
148             }
149              
150             sub _validate
151             {
152 30     30   172 validate_pos(@_,
153             { type => SCALAR },
154             { type => SCALAR, optional => true, regex => qr/^\d+$/ },
155             );
156             }
157              
158             1;
159             __END__