package Text::Wrap;

use warnings::register;
require Exporter;

@ISA = qw(Exporter);
@EXPORT = qw(wrap fill);
@EXPORT_OK = qw($columns $break $huge);

$VERSION = 2012.0818;
$SUBVERSION = 'modern';

use 5.010_000;

use vars qw($VERSION $SUBVERSION $columns $debug $break $huge $unexpand $tabstop $separator $separator2);
use strict;

BEGIN {
$columns = 76; # <= screen width
$debug = 0;
$break = '(?=\s)\X';
$huge = 'wrap'; # alternatively: 'die' or 'overflow'
$unexpand = 1;
$tabstop = 8;
$separator = "\n";
$separator2 = undef;
}

my $CHUNK = qr/\X/;

sub _xlen(_) { scalar(() = $_[0] =~ /$CHUNK/g) }

sub _xpos(_) { _xlen( substr( $_[0], 0, pos($_[0]) ) ) }

use Text::Tabs qw(expand unexpand);

sub wrap
{
my ($ip, $xp, @t) = @_;

local($Text::Tabs::tabstop) = $tabstop;
my $r = "";
my $tail = pop(@t);
my $t = expand(join("", (map { /\s+\z/ ? ( $_ ) : ($_, ' ') } @t), $tail));
my $lead = $ip;
my $nll = $columns - _xlen(expand($xp)) - 1;
if ($nll <= 0 && $xp ne '') {
my $nc = _xlen(expand($xp)) + 2;
warnings::warnif "Increasing \$Text::Wrap::columns from $columns to $nc to accommodate length of subsequent tab";
$columns = $nc;
$nll = 1;
}
my $ll = $columns - _xlen(expand($ip)) - 1;
$ll = 0 if $ll < 0;
my $nl = "";
my $remainder = "";

use re 'taint';

pos($t) = 0;
while ($t !~ /\G(?:$break)*\Z/gc) {
if ($t =~ /\G((?:(?=[^\n])\X){0,$ll})($break|\n+|\z)/xmgc) {
$r .= $unexpand
? unexpand($nl . $lead . $1)
: $nl . $lead . $1;
$remainder = $2;
} elsif ($huge eq 'wrap' && $t =~ /\G((?:(?!=[^\n])\X){$ll})/gc) {
$r .= $unexpand
? unexpand($nl . $lead . $1)
: $nl . $lead . $1;
$remainder = defined($separator2) ? $separator2 : $separator;
} elsif ($huge eq 'overflow' && $t =~ /\G((?:(?=[^\n])\X)*?)($break|\n+|\z)/xmgc) {
$r .= $unexpand
? unexpand($nl . $lead . $1)
: $nl . $lead . $1;
$remainder = $2;
} elsif ($huge eq 'die') {
die "couldn't wrap '$t'";
} elsif ($columns < 2) {
warnings::warnif "Increasing \$Text::Wrap::columns from $columns to 2";
$columns = 2;
return ($ip, $xp, @t);
} else {
die "This shouldn't happen";
}

$lead = $xp;
$ll = $nll;
$nl = defined($separator2)
? ($remainder eq "\n"
? "\n"
: $separator2)
: $separator;
}
$r .= $remainder;

print "-----------$r---------\n" if $debug;

print "Finish up with '$lead'\n" if $debug;

my($opos) = pos($t);

$r .= $lead . substr($t, pos($t), length($t) - pos($t))
if pos($t) ne length($t);

print "-----------$r---------\n" if $debug;;

return $r;
}

sub fill
{
my ($ip, $xp, @raw) = @_;
my @para;
my $pp;

for $pp (split(/\n\s+/, join("\n",@raw))) {
$pp =~ s/\s+/ /g;
my $x = wrap($ip, $xp, $pp);
push(@para, $x);
}

# if paragraph_indent is the same as line_indent,
# separate paragraphs with blank lines

my $ps = ($ip eq $xp) ? "\n\n" : "\n";
return join ($ps, @para);
}

1;
__END__