File Coverage

blib/lib/Text/WrapProp.pm

Criterion	Covered	Total	%
statement	33	33	100.0
branch	9	10	90.0
condition	3	3	100.0
subroutine	3	3	100.0
pod	0	1	0.0
total	48	50	96.0

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 = qw( wrap_prop

);

$VERSION = '0.01';

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.

1;

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

   my @width_table = @$ref_width_table;

   return '' if $text eq '';

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

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

   my $i=0;

   my $ltext = length $text;

# tried regex scanning, but 50% slower than C-style char processing!
#  like this... while ($text =~ /(.)/gcs) {

   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) {
            # 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);
            foreach (split '', reverse $nextline) { # find separator
               $j--;
               last if /( |:|;|,|\.|-|\(|\)|\/)/o; # 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;
         }
   }

   $out.$nextline;
}

__END__