File Coverage

blib/lib/Text/WrapProp.pm

Criterion	Covered	Total	%
statement	40	40	100.0
branch	16	16	100.0
condition	12	12	100.0
subroutine	3	3	100.0
pod	0	1	0.0
total	71	72	98.6

package Text::WrapProp;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;

@ISA = qw(Exporter AutoLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

@EXPORT_OK = qw( wrap_prop );
@EXPORT = qw();

$VERSION = '0.05';

1;

sub wrap_prop {
   my ($text, $width, $ref_width_table) = @_;

   if (not defined $text) {
      return('', 1);
   }
   elsif (not defined $width or $width < 0.0000001) {
      return('', 2);
   }
   elsif (not defined $ref_width_table or ref($ref_width_table) ne 'ARRAY' or scalar(@{$ref_width_table}) <= 1) {
      return('', 3);
   }
   elsif ($text eq '') {
      return('', 0);
   }

   my @width_table = @{$ref_width_table};

   # simplify whitespace, including newlines
   $text =~ s/\s+/ /gs;

   my $c;            # current character
   my $ltext    = length $text;
   my $cursor   = 0; # width so far of line
   my $out      = ''; # output buffer
   my $nextline = '';

   my $i=0;

   while ($i < $ltext) {
         # pop off next character
         $c = substr($text, $i++, 1);

         # don't need leading spaces at start of line
         next if $nextline eq '' and $c eq ' ';

         # see if character will fit on line - but don't include if too long
         if ($cursor + $width_table[ord $c] < $width + 0.0000001) {
            # another character fits
            $nextline .= $c;
            $cursor += $width_table[ord $c];
         }
         else {
            # find where we can wrap by checking backwards for separator
            my $j = length($nextline);
            for (split //, reverse $nextline) { # find separator
               $j--;
#               last if /( |:|;|,|\.|-|\(|\)|\/)/o; # separator characters
               last if /[ :;,.()\\\/-]/; # separator characters
            }

            # see if no separator found
            if (!$j) { # no separator, so just truncate line right here
               $i--; # rerun on $c
               $out .= $nextline."\n";
            }
            #
            else { # separator found, so break line at separator
               $i -= length($nextline) - $j; # rerun characters after separator
               $out .= substr($nextline, 0, $j+1)."\n";
            }

            $nextline = '';
            $cursor = 0;
         }
# print "i=$i, ltext=$ltext, cursor=$cursor, out=$out\n\n";
   }

   return($out.$nextline, 0);
}

__END__