If (m{

# начало Строки

\s * # О и более символов-пропусков

С: # начало первой несохраненной группировки

( й начать сохранение $1

["\w\s] # один байт - не пробел и не буквенный символ

+ # 1 или более

) й закончить сохранение $1

( \s* ) й занести О и более пропусков в буфер $2

.* \п й искать до конца первой строки

) й конец первой группировки

С: # начало второй несохраненной группировки

\s * » О и более символов-пропусков

\1 й строка, предназначенная для $1

\2 ? # то, что будет в $2, но дополнительно

.* \п # искать до конца строки

) + й повторить идею с группами 1 и более раз

$ # до конца строки

EVER ON AND ON

print "Heres your poem:\n\n$poem\n;

Результат будет выглядеть так:

Heres your poem:

Now far ahead the Road has gone,

And I must follow, If I can, Pursuing it with eager feet,

Until it joins some larger way Where may paths and errands meet.

And whither then? I cannot say.

--Bilbo in /usr/src/perl/pp ctl.c

Приведенная ниже функция dequote снравляется со всеми описанными проблемами. При вызове ей в качестве аргумента передается встроенный документ. Функция проверяет, начинается ли каждая строка с общей подстроки (префикса), и если это так - удаляет эту подстроку. В противном случае она берет начальный пропуск из первой строки и удаляет его из всех последующих строк.

sub dequote {

local $ = shift;

my ($white, $leader); # пропуск и префикс, общие для всех строк If (/-\s.C:(["\w\s]+)(\s.).An)CAsA1\2. Ап)+$/) {

($white, $leader) = ($2, quotemeta($1)); ) else {

($white, $leader = (/"(\s+)/, );

s/\s*$leader(:$white) gm, return $ ;

Если при виде этого шаблона у вас стекленеют глаза, его всегда можно разбить на несколько строк и добавить комментарии с помощью модификатора /х:

1.12. Переформатирование абзацев 51

(Swhite, Sleader) = ($2, quotemeta($1)); ) else {

(Swhite, Sleader) = (/"(\s+)/, );

# начало каждой строки (из-за /ш)

\s * # любое количество начальных пропусков

# с минимальным совпадением Sleader # сохраненный префикс

С # начать несохраненную группировку

Swhite # то же количество

) # если после префикса следует конец строки

}{)xgm;

Разве не стало понятнее? Пожалуй, нет. Нет смысла уснащать программу банальными комментариями, которые просто дублируют код. Возможно, перед вами один из таких случаев.

> Смотри также-

Раздел «Scalar Value Constructors* perldata(l); описание оператора s / в perlre(l) иperlop(l).

1.12. Переформатирование абзацев

Проблема

Длина текста не позволяет разместить его в одной строке. Требуется разделить его на несколько строк без переноса слов. Например, сценарий проверки стиля читает текстовый файл по одному абзацу и заменяет неудачные обороты хорошими. Замена оборота «применяет функциональные возможности» словом «использует» приводит к изменению количества символов, поэтому перед выводом абзаца его придется переформатировать.

Решение

Воспользуйтесь стандартным модулем Text::Wrap для расстановки разрывов строк в нужных местах:

use Text:.Wrap;

©OUTPUT = wrap($LEADTAB, SNEXTTAB, @PARA);

Комментарий

в модуле Text::Wrap присутствует функция wrap (см. пример 1.3), которая получает список строк и переформатирует их в абзац с длиной строки не более $Text. :Wrap: :columns символов. Мы присваиваем переменной $columns значение 20; это гарантирует, что ни одна строка не будет длиннее 20 символов. Перед

списком строк функции wrap передаются два аргумента: один определяет отступ первой строки абзаца, а второй - отступы всех последующих строк

Пример 1,3. wrapdemo

#/usr/bin/perl -w

# wrapdemo - демонстрация работы Text Wrap

@input = ( Folding and splicing is the work of an editor , not a mere collection of silicon , and ,

mobile electrons ) use Text Wrap qw($columns Swrap), Scolumns = 20,

print 0123455789 x 2 \n ,

print wrap( , , @input) \n ,

Результат выглядит так:

01234567890123456789 Folding and splicing is the work of an editor, not a mere collection of silicon and mobile electrons>

В результате мы получаем один абзац, в которой каждая строка, кроме последней, завершается символом перевода строки:

# Объединение нескольких строк с переносом текста use Text Wrap,

undef $/,

print wrap( , split(/\s*\n\s*/, <>),

Если на вашем компьютере установлен модуль Term::ReadKey с CPAN, вы можете воспользоваться им для определения размеров окна, чтобы длина строк соответствовала текущему размеру экрана. Если этого модуля нет, размер экрана иногда можно взять из $ENV{COHJMNS} или определить по выходным данным команды stty.

Следующая программа переформатирует и слишком короткие, и слишком длинные строки абзаца по аналогии с программой fmt. Для этого разделителем входных записей $/ назначается пустая строка (благодаря чему о читает целые абзацы), а разделителем выходных записей $\ - два перевода строки. Затем абзац преобразуется в одну длинную строку посредством замены всех символов перевода строки (вместе с окружающими пропусками) одиночными пробелами. Наконец, мы вызываем функцию wrap с пустыми отступами первой и всех последующих строк.