Тестовое задание

format-text.pl

#!/usr/bin/perl
# ------------------------------------------------------------------------------
# Дан текст, состоящий из нескольких строк произвольной длины. Нужно разбить его 
# на абзацы и юстифицировать, то есть оформить в виде текста шириной в N (20 - 120) 
# символов, выровняв по правой и по левой границе. Ширину строки следует увеличивать 
# за счет добавления пробелов — по одному, начиная с правого края. Окончанием абзаца 
# считается строка, которая заканчивается на соответствующие знаки пунктуации. 
# Новые абзацы должны начинаться с красной строки в четыре пробела. Абзац из одной 
# строки длиной менее половины N — это заголовок, его юстифицировать не нужно.
# ------------------------------------------------------------------------------
use open qw/:std :utf8/;
use Modern::Perl;

# ------------------------------------------------------------------------------
use constant LINE_WIDTH => 80;
use constant HEADER_MAX => LINE_WIDTH / 2;

# ТРИ пробела (один добавится при join)
use constant PARA_PREFIX   => '   ';
use constant PREFIX_LENGTH => length(PARA_PREFIX);

# ------------------------------------------------------------------------------
usage() unless $ARGV[0];
usage("Can not open '$ARGV[0]'")
	unless open my $f, '<:utf8', $ARGV[0];

my $read;

# Вообще хреновый, очень хреновый, подход. А что если нас решит
# атаковать Макаронный Монстр, и подсунет файл в тыщу терабайт без
# единого перевода строки?
while (<$f>) {

# Не очень понятны критерии разбиения на абзацы. Допустим, это два
# перевода строки подряд. В любом случае эта часть принципиально ни на что
# не влияет.
	chomp;
	unless ($_) {
		next unless $read;
		format_para($read);
		say '';
		$read = '';
		next;
	}
	$read .= $_;
}

close $f;

exit 0;

# ------------------------------------------------------------------------------
sub format_para {
	my ($para) = @_;

	my @words = split(/\s+/, $para);

	my $length = 0;

	$length += length $_ for @words;
	$length += $#words;

	# Заголовок, ничего не делаем.
	if ($length <= HEADER_MAX) {
		say PARA_PREFIX . ' ' . join(' ', @words);
		return;
	}

	$length = PREFIX_LENGTH;    # Текущая длина строки
	my @line = (PARA_PREFIX);

# Первая строка параграфа, используем для обработки ахтунговой ситуации
	my $start_para = 1;

	while (my $word = shift @words) {
		my $word_length = length $word;
		if ($word_length >= LINE_WIDTH) {

# Ахтунг! Длина слова слишком большая.
# Если есть накопленные слова, то сначала выводим их.
# Дальше могут быть варианты. Допустим, если в текущей строке слов мало, да хоть
# и одно короткое слово, а следующее - слишком длинное.
#
# 1 решение:
# мало
# очень-очень-очень-длинное-слово
#
# 2 решение:
# мало очень-очень-очень-длинное-слово
#
# В текущей реализации - вариант 1
			if (!$start_para && $length) {
				format_line(\@line, $length + $#line);
			}
			$word = PARA_PREFIX . ' ' . $word if $start_para;
			say $word;
			$length     = 0;
			$#line      = -1;
			$start_para = 0;
			next;
		}

# Количество вставляемых пробелов без выравнивания - количество
# слов в строке минус 1 ($#line):
		if ($length + $word_length + $#line >= LINE_WIDTH) {

# Хорош, многовато. Возвращаем слово взад и отправляем
# накопленные слова на переработку:
			unshift @words, $word;
			format_line(\@line, $length + $#line);
			$length     = 0;
			$#line      = -1;
			$start_para = 0;
			next;
		}
		push @line, $word;
		$length += $word_length;
	}

# Если остался хвостик, то выводим его без форматирования:
	say join(' ', @line) if @line;
}

# ------------------------------------------------------------------------------
sub format_line {
	my ($words, $length) = @_;

# Проверка на наличие больше одного слова в массиве!
	while ($length < LINE_WIDTH && $#$words > 0) {

# Добавляем пробелы в начало слов, начиная с конца массива.
# Первое слово при этом не трогаем. Второе тоже, если это первая строка абзаца.
		for (my $i = $#$words; $i > 0; $i--) {

		# Вообще-то криво до жути. Но что уж там...
			next if $i == 1 && $words->[0] eq PARA_PREFIX;

			$words->[$i] = ' ' . $words->[$i];
			$length++;
			last if $length >= LINE_WIDTH;
		}
	}

	say join(' ', @{$words});
}

# ------------------------------------------------------------------------------
sub usage {
	die @_ ? @_ : "Usage: $0 file";
}

# ------------------------------------------------------------------------------
# That's All, Folks!
# ------------------------------------------------------------------------------