#!/usr/bin/perl
# vim:ts=4:sw=4

package Text::Flowed;

$VERSION = '0.02';

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw(reformat quote quote_fixed);

use strict;
use POSIX qw(floor);
use vars qw($MAX_LENGTH $OPT_LENGTH);

# MAX_LENGTH: This is the maximum length that a line is allowed to be
# (unless faced with a word that is unreasonably long). This module will
# re-wrap a line if it exceeds this length.
$MAX_LENGTH = 79;

# OPT_LENGTH: When this module wraps a line, the newly created lines
# will be split at this length.
$OPT_LENGTH = 72;

# reformat($text, [\%args])
# Reformats $text, where $text is format=flowed plain text as described
# in RFC 2646.
#
# $args->{quote}: Add a level of quoting to the beginning of each line.
# $args->{fixed}: Interpret unquoted lines as format=fixed.
# $args->{max_length}: The maximum length of any line.
# $args->{opt_length}: The maximum length of wrapped lines.
sub reformat {
	my @input = split("\n", $_[0]);
	my $args = $_[1];
	$args->{max_length} ||= $MAX_LENGTH;
	$args->{opt_length} ||= $OPT_LENGTH;
	my @output = ();

	# Process message line by line
	while (@input) {
		# Count and strip quote levels
		my $line = shift(@input);
		my $num_quotes = _num_quotes($line);
		$line = _unquote($line);

		# Remove space-stuffing if necessary
		$line = _unstuff($line) unless $args->{fixed} && !$num_quotes;

		# While line is flowed, join subsequent lines with flowed text
		unless ($args->{fixed} && !$num_quotes) {
			while (_flowed($line) && @input &&
			       _num_quotes($input[0]) == $num_quotes) {
				$line .= _unstuff(_unquote(shift(@input)));
			}
		}
		# Ensure line is fixed, since we joined all flowed lines
		$line = _trim($line);

		# Increment quote depth if we're quoting
		$num_quotes++ if $args->{quote};

		if (!$line) {
			# Line is empty
			push(@output, '>' x $num_quotes);
		} elsif (length($line) + $num_quotes <= $args->{max_length} - 1) {
			# Line does not require rewrapping
			push(@output, '>' x $num_quotes . _stuff($line, $num_quotes));
		} else {
			# Rewrap this paragraph
			while ($line) {
				# Stuff and re-quote the line
				$line = '>' x $num_quotes . _stuff($line, $num_quotes);
				my $min = $num_quotes + 1;
				if (length($line) <= $OPT_LENGTH) {
					# Remaining section of line is short enough
					push(@output, $line);
					last;
				} elsif ($line =~ /^(.{$min,$args->{opt_length}}) (.*)/ ||
				         (!$args->{break} && $line =~ /^(.{$min,})? (.*)/)) {
					# Further wrapping required
					push(@output, "$1 ");
					$line = $2;
				} else {
					# One excessively long word left on line
					unless ($args->{break}) {
						# Print the word and leave
						push(@output, $line);
						last;
					}

					# Break the word on an even byte in a
					# sometimes-successful attempt to avoid corrupting
					# double-byte strings
					my $max = floor(($args->{opt_length} - $min)/2) * 2
					          + $min;
					push(@output, substr($line, 0, $max).' ');
					$line = substr($line, $max);
				}
			}
		}
	}

	return join("\n", @output)."\n";
}

# quote(<text>)
# A convenience wrapper for reformat(<text>, {quote => 1}).
sub quote {
	return reformat($_[0], {quote => 1});
}

# quote_fixed(<text>)
# A convenience wrapper for reformat(<text>, {quote => 1, fixed => 1}).
sub quote_fixed {
	return reformat($_[0], {quote => 1, fixed => 1});
}

# _num_quotes(<text>)
# Returns the number of leading '>' characters in <text>.
sub _num_quotes {
	$_[0] =~ /^(>*)/;
	return length($1);
}

# _unquote(<text>)
# Removes all leading '>' characters from <text>.
sub _unquote {
	my $line = shift;
	$line =~ s/^(>+)//g;
	return $line;
}

# _flowed(<text>)
# Returns 1 if <text> is flowed; 0 otherwise.
sub _flowed {
	my $line = shift;
	# Lines with only spaces in them are not considered flowed
	# (heuristic to recover from sloppy user input)
	return 0 if $line =~ /^ *$/;
	return $line =~ / $/;
}

# _trim(<text>)
# Removes all trailing ' ' characters from <text>.
sub _trim {
	$_ = shift;
	$_ =~ s/ +$//g;
	return $_;
}

# _stuff(<text>, <num_quotes>)
# Space-stuffs <text> if it starts with " " or ">" or "From ", or if
# quote depth is non-zero (for aesthetic reasons so that there is a
# space after the ">").
sub _stuff {
	my ($text, $num_quotes) = @_;
	if ($text =~ /^ / || $text =~ /^>/ || $text =~ /^From / ||
		$num_quotes > 0) {
		return " $text";
	}
	return $text;
}

# _unstuff(<text>)
# Un-space-stuffs <text>.
sub _unstuff {
	$_ = shift;
	$_ =~ s/^ //;
	return $_;
}

1;

__END__

=head1 NAME

Text::Flowed - text formatting routines for RFC2646 format=flowed

=head1 SYNOPSIS

 use Text::Flowed qw(reformat quote quote_fixed);

 print reformat($text, {
     quote => 1,
     fixed => 1,
     break => 1,
     opt_length => 72,
     max_length => 79
 });

 print quote($text);      # alias for quote => 1
 print quote_fixed(text); # alias for quote => 1, fixed => 1

=head1 DESCRIPTION

This module provides functions that deals with formatting data with
Content-Type 'text/plain; format=flowed' as described in RFC2646
(F<http://www.rfc-editor.org/rfc/rfc2646.txt>). In a nutshell,
format=flowed text solves the problem in plain text files where it is
not known which lines can be considered a logical paragraph, enabling
lines to be automatically flowed (wrapped and/or joined) as appropriate
when displaying.

In format=flowed, a soft newline is expressed as " \n", while hard
newlines are expressed as "\n". Soft newlines can be automatically
deleted or inserted as appropriate when the text is reformatted.

=over 4

=item B<reformat>($text [, \%args])

The reformat() function takes some format=flowed text as input, and
reformats it. Paragraphs will be rewrapped to the optimum width, with
lines being split or combined as necessary.

    my $formatted_text = reformat($text, \%args);

If B<$args-E<gt>{quote}> is true, a level of quoting will be added to
the beginning of every line.

If B<$args-E<gt>{fixed}> is true, unquoted lines in $text will not be
interpreted as format=flowed (with respect to parsing space-stuffing and
flowed lines). This is useful for processing messages posted in
web-based forums, which are not format=flowed, but preserve paragraph
structure due to paragraphs not having internal line breaks.

If B<$args-E<gt>{break}> is true, then excessively long words will be
broken up at $args->{opt_length} characters (in violation of RFC 2646).
This is useful in web-based forums where it is desired to avoid long
words which disrupt the page layout, as well as the text is in
Chinese/Japanese/Korean (which has no spaces). This option should not be
used on strings in international encodings that Perl is not aware of, as
it may corrupt them.

B<$args-E<gt>{max_length}> (default 79) is the maximum length of line
that reformat() or quote() will generate. Any lines longer than this
length will be rewrapped, unless there is an excessively long word that
makes this impossible, in which case it will generate a long line
containing only that word.

B<$args-E<gt>{opt_length}> (default 72) is the optimum line length. When
reformat() or quote() rewraps a paragraph, the resulting lines will not
exceed this length (except perhaps for excessively long words).

If a line exceeds opt_length but does not exceed max_length, it might
not be rewrapped.

=item B<quote>($text)

quote($text) is an alias for reformat($text, {quote => 1}).

    my $quoted_text = quote($text);

=item B<quote_fixed>($text)

quote_fixed($text) is an alias for reformat($text, {quote => 1, fixed =>
1}).

    my $quoted_text = quote_fixed($text);

=back

=head1 COPYRIGHT

Copyright 2002-2003, Philip Mak

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut
