Perl. Сборник рецептов для профессионалов. Строки. Библиотека I2R. Perl проектировался для обработки текста. На самом деле в Perl существует такое количество текстовых операций, что их невозможно описать в одной главе, мы рассмотрим лишь основные.

":И открыл легкомысленно уста свои, и безрассудно расточает слова".
Книга Иова, 35:16

темы материала:

1.0. Введение

Многие языки программирования заставляют нас мыслить на неудобном низком уровне. Вам понадобилась строка, а язык хочет, чтобы вы работали с указателями или байтами. Подобные мелочи лишь отвлекают программиста от основной задачи. Впрочем, не отчаивайтесь - Perl не относится к языкам низкого уровня, и в нем удобно работать со строками.

Perl проектировался для обработки текста. На самом деле в Perl существует такое количество текстовых операций, что их невозможно описать в одной главе. Рецепты обработки текста встречаются и в других главах. В частности, обратитесь к главе 6 "Поиск по шаблону" и главе 8 "Содержимое файлов" - в них описаны интересные приемы, не рассмотренные в этой главе.

Основной единицей для работы с данными в Perl является скаляр (scalar), то есть отдельное значение, хранящееся в отдельной (скалярной) переменной. В скалярных переменных хранятся строки, числа и ссылки. Массивы и хэши представляют собой соответственно списки или ассоциативные массивы скаляров. Ссылки используются для косвенных обращений к другим величинам; они отчасти похожи на указатели в языках низкого уровня. Числа обычно хранятся в вещественном формате с двойной точностью. Строки в Perl могут иметь произвольную длину (ограниченную только объемом виртуальной памяти вашего компьютера) и содержат произвольные данные - даже двоичные последовательности с нулевыми байтами.

Строка Perl не является массивом символов или байтов. К отдельному символу нельзя обратиться по индексу, как к элементу массива, - для этого следует воспользоваться функцией substr. Строки, как и все типы данных Perl, увеличиваются и уменьшаются в размерах по мере необходимости. Неиспользуемые данные уничтожаются системой сборки мусора Perl (обычно при выходе переменной из области видимости или после вычисления выражения, в которое входит строка). Иначе говоря, об управлении памятью можно не беспокоиться - об этом уже позаботились до вас.

Скалярная величина может быть определенной или неопределенной. Определенная величина содержит строку, число или ссылку. Единственным неопределенным значением является undef, все остальные значения считаются определенными - даже 0 и пустая строка. Однако определенность не следует путать с логической истиной; чтобы проверить, определена ли некоторая величина, следует воспользоваться функций defined. Логическая истина имеет особое значение, которое проверяется логическими операторами && и ||, а также в условии блока while.

Две определенных строки считаются ложными: пустая строка ("") и строка единичной длины, содержащая цифру "ноль" ("0"). Все остальные определенные значения (такие, как "false", 15 или \$x) истинны. Возможно, вас несколько удивит, что строковое значение "0" считается ложным, но это связано с тем, что Perl выполняет преобразования между числами и строками по мере необходимости. Значения 0., 0.00 и 0.0000000 являются числами и поэтому без кавычек считаются ложными, поскольку число "ноль" в любом обличии ложно. Но эти же три строковых значения ("0.", "0.00" и "0.0000000") становятся истинными, когда они используются в программе в форме строковых литералов, заключенных в кавычки, или читаются из командной строки, переменной окружения или входного файла.

Обычно эти различия несущественны, поскольку при использовании значения в числовом контексте автоматически выполняется преобразование. Но если значение еще не использовалось в числовом контексте, то проверка его истинности или ложности иногда приводит к неожиданному результату - логические проверки никогда не вынуждают каких-либо преобразований. Прибавление 0 к переменной заставляет Perl преобразовать строку в число:

print "Gimme a number: ";
0.00000
chomp($n = ); # $n теперь содержит "0.00000";

print "The value $n is ", $n ? "TRUE" : "FALSE", "\n";
The value 0.00000 is TRUE

$n += 0;
print "The value $n is now ", $n ? "TRUE" : "FALSE", "\n";
The value 0 is now FALSE

В строковом контексте значение undef интерпретируется как пустая строка (""). В числовом контексте undef интерпретируется как 0, а в ссылочном - как нуль-ссылка. При этом во всех случаях оно считается ложным. Использование неопределенной величины там, где Perl ожидает получить определенную, приводит к выводу в STDERR предупреждения времени выполнения (если предупреждения не были запрещены). Простая проверка истинности или ложности не требует конкретного значения, поэтому предупреждение в этом случае не выдается. Некоторые операции не выдают предупреждений при использовании переменных, содержащих неопределенные значения. К их числу относятся операторы автоматического увеличения и уменьшения, ++ и --, а также сложение и конкатенация с присваиванием, += и .=.

В программах строки записываются в апострофах или в кавычках, в форме q// или qq// или "встроенных документов" (here-documents). Независимо от выбранной формы записи, строковые литералы делятся на интерполируемые и неинтерполируемые. Под интерполяцией понимается замена ссылок на переменные и специальных последовательностей символов. В большинстве случаев по умолчанию интерполяция выполняется - в частности, в шаблонах (/regex/) и при выполнении команд ($x = 'cmd').

В некоторых ситуациях отдельные символы имеют особую интерпретацию. С префиксом \ любой специальный символ становится обычным символом; другими словами, он превращается в простой литерал. Такое преобразование обычно называется экранированием (escaping).

В каноническом варианте создания неинтерполируемых строковых литералов строка заключается в апострофы. В таких строках распознаются всего три специальных последовательности: ' завершает строку, \' вставляет в нее апостроф, а \\ - обратную косую черту:


$string = '\n';                     # Два символа, \ и n
$string = 'Jon \'Maddog\' Orwant';  # Внутренние апострофы-литералы

В строках, заключенных в кавычки, возможна интерполяция имен переменных (но не вызовов функций - о том, как это делается, см. рецепт 1.15). В них также поддерживаются различные служебные последовательности: "\n" (перевод строки) "\033" (символ с восьмеричным кодом 33), "\cJ" - Ctrl+J, "\x1B" (символ с шестнадцатеричным кодом 0x1B) и т. д. Полный список приведен на странице руководства perlop(1).

$string = "\n";                     # Символ перевода строки
$string = "Jon \"Maddog\" Orwant";  # Внутренние кавычки

Если строка не содержит расширяемых служебных последовательностей или переменных, вы можете использовать любую запись по своему усмотрению. Выбирая между 'this' и "this", некоторые программисты Perl предпочитают второй вариант, чтобы строки лучше выделялись. К тому же кавычки предотвращают даже малейшую вероятность того, что читатель программы спутает простой апостроф с обратным. Для Perl это несущественно, но чтение программы упрощается.

Операторы q// и qq// позволяют использовать произвольные ограничители с интерполируемыми и неинтерполируемыми литералами; они являются аналогами строк, заключенных соответственно в апострофы и кавычки. Например, для записи неинтерполируемой строки с внутренними апострофами проще воспользоваться оператором q// вместо того, чтобы использовать экранированные символы \':

$string = 'Jon \'Maddog\' Orwant';  # Внутренние апострофы
$string = q/Jon 'Maddog' Orwant/;   # То же самое, но более наглядно

В качестве разделителей могут использоваться одинаковые символы, как / в приведенном примере, или любая из четырех комбинаций парных ограничителей (различных типов скобок):

$string = q[Jon 'Maddog' Orwant];   # Внутренние апострофы
$string = q{Jon 'Maddog' Orwant};   # Внутренние апострофы
$string = q(Jon 'Maddog' Orwant);   # Внутренние апострофы
$string = q;   # Внутренние апострофы

Концепция "встроенных документов" позаимствована из командных интерпретаторов (shell) и предназначается для определения строк, содержащих большое количество текста. Текст может интерпретироваться по правилам для строк, заключенных в апострофы или кавычки, и даже как перечень исполняемых команд - в зависимости от того, как задается завершающий идентификатор. В неинтерполируемых встроенных документах не расширяются три основные служебные последовательности, которые расширяются в литералах, заключенных в апострофы. Например, следующий встроенный документ будет интерпретироваться по правилам для строк, заключенных в кавычки:

$a = <<"EOF";
This is a multiline here document
terminated by EOF on a line by itself
EOF

Обратите внимание: после завершающего ограничителя EOF точка с запятой не ставится. Встроенные документы более подробно рассматриваются в рецепте 1.16.

Универсальная кодировка символов

С точки зрения компьютера любые данные (даже цепочки битов) представляют собой последовательность отдельных чисел. Даже текстовая строка - всего лишь последовательность числовых кодов, которые интерпретируются как символы браузерами, почтовыми программами, редакторами и системами печати.

В те времена, когда памяти было мало, а стоила она гораздо дороже, программисты вытворяли настоящие чудеса ради экономии памяти. На практике часто применялись такие приемы, как упаковка шести символов в одно 32-разрядное слово или трех символов - в одно 16-разрядное слово. Даже в наши дни длина числовых кодов, используемых для обозначения отдельных символов, обычно не превышает 7 или 8 бит (как в кодировках ASCII и Latin1 соответственно).

Малое количество битов на символ приводит к тому, что количество представляемых символов также невелико. Как известно, палитра графического файла с 8-разрядным цветом ограничивается всего 256 цветами. Аналогично, при хранении символов в виде отдельных октетов (то есть байтов, состоящих из 8 бит) документ может содержать не более 256 различных букв, знаков препинаний и знаков.

Кодировка ASCII (American Standard Code for Information Interchange) не решала всех проблем за пределами Соединенных Штатов, поскольку в нее входили лишь символы слегка усеченного американского диалекта английского языка. Из-за этого многие страны разработали собственные, несовместимые 8-разрядные кодировки на базе 7-разрядной кодировки ASCII. Появились конфликтные схемы назначения символам числовых кодов из одного ограниченного интервала. Это означало, что в разных системах одно число могло обозначать разные символы, а одному символу могли быть сопоставлены разные коды.

Одной из первых попыток решения этих и других проблем, обусловленных национальной и языковой спецификой, стали локальные контексты (locales). Они до сих пор неплохо справляются с задачами, не связанными с кодировкой символов, - в частности, с настройкой региональных параметров (формата денежных единиц, даты и времени) и даже с обработкой объединяющих последовательностей. Но в области использования 8-разрядного пространства для разных кодировок локальные контексты приносят гораздо меньше пользы.

Если потребуется создать документ, содержащий латинские и греческие символы, а также кириллицу, у вас возникнут большие проблемы, поскольку один числовой код может представлять разные символы в каждой из этих кодировок. Например, код 196 представляет символ Д в кодировке ISO 8859-1 (Latin 1), а в кодировке ISO 8859-7 этому коду соответствует греческая буква ?. Получается, что программа, интерпретирующая код символа в ISO 8859-1, увидит один символ, а в 8859-7 символ будет совершенно иным.

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

Поддержка Юникода в Perl

На помощь программисту приходит Юникод.

Эта кодировка пытается объединить все наборы символов всего мира, включая многочисленные неалфавитные знаки и даже вымышленные наборы символов. Юникод позволяет использовать в документе десятки тысяч (и даже больше) разных символов без всякой путаницы.

Все проблемы с Д и ? моментально исчезают. Первому символу, который формально называется "латинской буквой A верхнего регистра с тремой", назначается код U+00C4 (рекомендуемая форма записи в Юникоде). Второму символу, "греческая буква дельта верхнего регистра", теперь соответствует код U+0394. Разным символам всегда соответствуют разные коды, что исключает любые конфликты.

Поддержка Юникода в Perl появилась примерно с версии 5.6, но лишь с версии 5.8 она стала действительно надежной и пригодной для практического применения. Тогда же в Perl появились уровни ввода/вывода и их поддержка при программировании; такое совпадение вовсе не случайно. Эта тема более подробно обсуждается в главе 8.

Все строковые функции и операторы Perl, в том числе и используемые при поиске по шаблону, теперь работают не с октетами, а с символами. Так, при вызове для строки функции length Perl возвращает размер строки в символах, а не в байтах. При извлечении из строки первых трех символов функцией substr длина результата может быть отлична от трех байт: а может быть равна трем байтам. Вы этого не знаете, да это и не важно. К базовому низкоуровневому представлению вообще не стоит слишком пристально приглядываться - если вам приходится думать о нем, то, скорее всего, вы рассматриваете происходящее со слишком близкого расстояния. Выбор представления не должен влиять на работу программиста - а если он все же влияет, это может означать, что реализация Perl еще не идеальна. Мы над этим работаем.

Поддержка символов с кодами, превышающими 256, означает, что аргумент функции chr уже не ограничивается значением 256, а функция ord может возвращать числа, большие этого значения. Например, по запросу chr(0x394) будет возвращена греческая буква "дельта" верхнего регистра:

$char = chr(0x394);
$code = ord($char);
printf "char %s is code %d, %#04x\n", $char, $code, $code;
char ? is code 916, 0x394

При проверке длины такой строки вы получите 1, потому что строка содержит всего один символ. Обратите внимание: речь идет именно о символах, а не о длине строки в байтах. Конечно, во внутреннем представлении такой большой числовой код невозможно представить всего 8 битами. Но программист должен работать с символами как с абстракциями, а не как с физическими октетами. Все низкоуровневые детали такого рода лучше оставить Perl.

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

Существует несколько способов включения символов Юникода в литералы Perl. Если ваш текстовый редактор позволяет вводить Юникод непосредственно в программы Perl, то вы можете сообщить об этом при помощи директивы use utf8. Другой способ основан на использовании служебных последовательностей \x в интерполируемых строках Perl и задании шестнадцатеричного кода символа (например, \xC4). Если код символа больше 0xFF, то для его представления потребуется более двух шестнадцатеричных цифр, поэтому такие коды должны заключаться в фигурные скобки:

print "\xC4 and \x look different\n";
char Д and ? look different

В рецепте 1.5 рассказано, как использовать названия символов для включения в строковые литералы конструкций \N. Например, символ ? может задаваться в виде \N{GREEK CAPITAL LETTER DELTA}, \N и даже просто \N.

Чтобы работать с Юникодом в Perl, достаточно и этого, но для взаимодействия Perl с другими программами потребуется кое-что еще.

В старых однобайтовых кодировках (таких, как ASCII или ISO 8859-n) при выводе символа с числовым кодом NN выводился один байт с числовым значением NN. Конкретный вывод зависел от доступных шрифтов, от выбранного локального контекста и ряда других факторов. Но в Юникоде уже не существует однозначного соответствия между логическими кодами символов (кодовыми пунктами) и выводимыми физическими байтами. Теперь логические коды могут представляться в любом из нескольких доступных выходных форматов.

Во внутренней работе Perl используется формат UTF-8, но для Юникода существует много других форматов выходной кодировки; Perl может работать и с этими форматами. Директива use encoding сообщает Perl, в какой кодировке написан сам сценарий и какая кодировка должна использоваться для стандартных файловых манипуляторов. Директива use open задает выходную кодировку по умолчанию для всех манипуляторов. Формат кодировки для конкретного файлового манипулятора задается при помощи специальных аргументов функций open и binmode. Ключ командной строки -C задает кодировку для всех (или только для стандартных) манипуляторов, а также для самих аргументов программы. Переменные окружения PERLIO, PERL_ENCODING и PERL_UNICODE сообщают Perl дополнительную информацию, относящуюся к этой теме.

1.1. Работа с подстроками

Проблема

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

Решение

Функция substr предназначена для чтения и записи отдельных частей строки:

$value = substr($string, $offset, $count);
$value = substr($string, $offset);

substr($string, $offset, $count) = $newstring;
substr($string, $offset, $count, $newstring); # Эквивалент предыдущей строки 
substr($string, $offset)         = $newtail;

Функция unpack ограничивается доступом только для чтения, но при извлечении нескольких подстрок работает быстрее:

# Получить 5-байтовую строку, пропустить 3 байта,
# затем извлечь две 8-байтовых строки, затем все остальное
# (Примечание: работает только с ASCII-данными, но не с Юникодом)
($leading, $s1, $s2, $trailing) =
    unpack("A5 x3 A8 A8 A*", $data);

# Деление на группы из пяти байт
@fivers = unpack("A5" x (length($string)/5), $string);

# Деление строки на однобайтовые символы
@chars = unpack("A1" x length($string), $string);

Комментарий

Строки Perl входят в число базовых типов данных; они не являются массивами, содержащими элементы базовых типов. Это означает, что для работы с отдельными символами или подстроками вместо индексирования, как в других языках программирования, в Perl применяются такие функции, как unpack или substr.

Второй аргумент substr (смещение) определяет начало интересующей вас подстроки; положительные значения отсчитываются от начала строки, а отрицательные - с конца. Если смещение равно 0, подстрока начинается с начала. Третий аргумент определяет длину подстроки.


$string = "This is what you have";
#         +012345678901234567890   Прямое индексирование (слева направо)
#          109876543210987654321-  Обратное индексирование (слева направо)
           0 соответствует 10, 20 и т. д.

$first = substr($string, 0, 1);  # "T"
$start = substr($string, 5, 2);  # "is"
$rest  = substr($string, 13);    # "you have"
$last  = substr($string, -1);    # "e"
$end   = substr($string, -4);    # "have"
$piece = substr($string, -8, 3); # "you"

Однако функция substr позволяет не только просматривать части строки, но и изменять их. Дело в том, что substr относится к экзотической категории левосторонних функций, то есть таких, которым при вызове можно присвоить значение. К тому же семейству относятся функции vec, pos и keys (а при некоторой фантазии функции local, my и our также можно рассматривать как левосторонние).


$string = "This is what you have";
print $string;
This is what you have
substr($string, 5, 2) = "wasn't"; # заменить "is" на "wasn't"
This wasn't what you have
substr($string, -12) = "ondrous"; # "This wasn't wondrous"
This wasn't wondrous
substr($string, 0, 1) = "";       # Удалить первый символ
his wasn't wondrous
substr($string, -10) = "";        # Удалить последние 10 символов
his wasn'

Применяя оператор =~ в сочетании с операторами s///, m// или tr///, можно заставить их работать только с определенной частью строки:


# Проверка подстрок по шаблону
if (substr($string, -10) =~ /pattern/) {
    print "Pattern matches in last 10 characters\n";
}

# Подставить "at" вместо "is" в первых пяти символах строки
substr($string, 0, 5) =~ s/is/at/g;

Более того, подстроки даже можно поменять местами, используя с каждой стороны присваивания несколько вызовов substr:


# Поменять местами первый и последний символы строки
$a = "make a hat";
(substr($a,0,1), substr($a,-1)) = (substr($a,-1), substr($a,0,1));
print $a;
take a ham

Хотя функция unpack не является левосторонней, она работает значительно быстрее substr, особенно при одновременном извлечении нескольких величин. Структура извлекаемой записи определяется специальной форматной строкой, в которой символ "x" нижнего регистра с числом пропускает заданное количество байт в прямом направлении, а символ "X" верхнего регистра - в обратном направлении. Символ "@" перемещается к заданному смещению в байтах внутри записи. Если вы работаете со строковыми данными Юникода, будьте осторожны при использовании этих трех спецификаторов: они работают только на уровне байтов, а выполнять байтовые операции в многобайтовых кодировках в лучшем случае рискованно.


# Извлечение подстроки функцией unpack
$a = "To be or not to be";
$b = unpack("x6 A6", $a); # Пропустить 6 символов, прочитать 6 символов
print $b;
or not

($b, $c) = unpack("x6 A2 X5 A2", $a); # Вперед 6, прочитать 2;
                                      # назад 5, прочитать 2
print "$b\n$c\n";
or
be

Иногда строка "режется" на части в определенных позициях. Предположим, вам захотелось установить позиции разделения перед символами 8, 14, 20, 26 и 30 - в каждом из перечисленных столбцов начинается новое поле. В принципе форматная строка unpack вычисляется просто - "A7 A6 A6 A4 A*", но программист на Perl по природе ленив и не желает попусту напрягаться. Пусть за него работает Perl. Воспользуйтесь приведенной ниже функцией cut2fmt:

sub cut2fmt {
    my(@positions) = @_;
    my $template   = '';
    my $lastpos    = 1;
    foreach $place(positions) {
        $template .= "A" . ($place - $lastpos) . " ";
        $lastpos   = $place;
    }
    $template .= "A*";
    return $template;
}

$fmt = cut2fmt(8, 14, 20, 26, 30);
print "$fmt\n";
A7 A6 A6 A6 A4 A*

Возможности функции unpack выходят далеко за пределы обычной обработки текста. Она также может использоваться для преобразования между текстовыми и двоичными данными.

В настоящем рецепте предполагается, что все символы представляются в 7- или 8-разрядной кодировке, иначе байтовые операции unpack не будут работать так, как предполагается.

См. также

Описание функций unpack и substr в perlfunc(1); процедура cut2fmt из рецепта 1.24. Применение unpack для двоичных данных продемонстрировано в рецепте 8.24.

1.2. Выбор значения по умолчанию

Проблема

Требуется закрепить за скалярной переменной значение по умолчанию, но лишь в том случае, если оно не было задано явно в программе. Довольно часто требуется, чтобы стандартное значение переменной было жестко закодировано в программе, но его можно было переопределить из командной строки или переменной окружения.

Решение

Воспользуйтесь оператором || или ||=, работающим как со строками, так и с числами:


# Использовать $b, если значение $b истинно, и $c в противном случае
$a = $b || $c;

# Присвоить $x значение $y, но лишь в том случае, 
# если $x не является истиной
$x ||= $y;

Если переменная может принимать значения 0, "0" и "", воспользуйтесь функцией defined:


# Использовать $b, если значение $b определено, и $c в противном случае
$a = defined($b) ? $b : $c;

# "Новый" оператор "определено-или" из будущей версии Perl
use 5.9;
$a = $b // $c;

Комментарий

Главное отличие между этими двумя решениями (defined и ||) состоит, прежде всего, в том, что именно проверяется - определенность или истинность. В мире Perl три определенных значения являются ложными: 0, "0" и "". Если ваша переменная содержит одну из этих величин, но вы не хотите изменять ее, || не подойдет - приходится выполнять неуклюжие проверки с defined. Часто бывает удобно организовать программу так, чтобы принималась в расчет истинность или ложность переменных, а не их определенность.

В отличие от других языков, где возвращаемые значения ограничиваются 0 и 1, в Perl оператор || обладает более интересным свойством: он возвращает первый (левый) операнд, если тот имеет истинное значение; в противном случае возвращается второй операнд. Оператор && ведет себя аналогично (для второго выражения), но этот факт используется реже. Для этих операторов несущественно, что представляют собой их операнды - строки, числа или ссылки; подойдет любое скалярное значение. Они просто возвращают первый операнд, из-за которого все выражение становится истинным или ложным. Возможно, это расходится с возвращаемым значением в смысле булевой алгебры, но такими операторами удобнее пользоваться.

Это позволяет установить значение по умолчанию для переменной, функции или более длинного выражения в том случае, если первый операнд не подходит. Ниже приведен пример использования ||, в котором $foo присваивается либо $bar, либо, если значение $bar ложно, - строка "DEFAULT VALUE":


$foo = $bar || "DEFAULT VALUE"

В другом примере переменной $dir присваивается либо первый аргумент командной строки программы, либо "/tmp", если аргумент не указан:

$dir = shift(@ARGV) || "/tmp"

То же самое можно сделать и без изменения @ARGV:


$dir = $ARGV[0] || "/tmp"

Если 0 является допустимым значением $ARGV[0], использовать || нельзя, потому что вполне нормальное значение будет интерпретировано как ложное. Приходится обращаться к тернарному оператору выбора:

$dir = defined($ARGV[0]) ? shift(@ARGV) : "/tmp";

То же можно записать и иначе, со слегка измененной семантикой:

$dir = @ARGV ? $ARGV[0] : "/tmp"

Мы проверяем количество элементов в @ARGV. В условии оператора выбора (?:) @ARGV интерпретируется в скалярном контексте. Значение будет ложным лишь при нулевом количестве элементов, в этом случае будет использоваться "/tmp". В остальных ситуациях (то есть при заданных аргументах) переменной будет присвоен первый аргумент командной строки.

Следующая строка увеличивает значение %count, при этом в качестве ключа используется значение $shell, а если оно ложно - строка "/bin/sh":

$count{ $shell || "/bin/sh" }++;

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

# Определить имя пользователя в системе Unix
$user = $ENV
     || $ENV
     || getlogin()
     || (getwuid($<))[0]
     || "Unknown uid number $<";

Оператор && работает аналогично; он возвращает свой первый операнд, если этот операнд ложен. В противном случае возвращается второй операнд. Поскольку ложные значения представляют интерес существенно реже, чем истинные, это свойство используется не так часто. Некоторые возможные применения продемонстрированы в рецептах 13.12 и 14.19.

Оператор присваивания ||= выглядит странно, но работает точно так же, как и остальные операторы присваивания. Практически для всех бинарных операторов Perl $VAR OP= VALUE означает $VAR = $VAR OP VALUE; например, $a += $b - то же, что и $a = $a + $b. Следовательно, оператор ||= может использоваться для присваивания переменной, значение которой интерпретируется как ложное. Поскольку || выполняет простую логическую проверку (истина или ложь), у него не бывает проблем с неопределенными значениями, даже при включенном выводе предупреждений. В следующем примере ||= присваивает переменной $starting_point строку "Greenwich", если значение переменной не было задано ранее. Предполагается, что $starting_point не принимает значений 0 или "0", а если принимает - то такие значения должны быть заменены.

$starting_point ||= "Greenwich"

В операторах присваивания || нельзя заменять оператором or, поскольку or имеет слишком низкий приоритет. Выражение $a = $b or $c эквивалентно ($a = $b) or $c. В этом случае переменной $b всегда присваивается $a, а это совсем не то, чего вы добивались.

Не пытайтесь распространить это любопытное применение || и ||= со скалярных величин на массивы и хэши. У вас ничего не выйдет, потому что левый операнд интерпретируется в скалярном контексте. Вместо этого приходится делать что-нибудь подобное:


@a = @b unless @a;     # Копировать, если массив пуст
@a = @b ? @b : @c;     # Присвоить @b, если он не пуст, иначе @c

Ожидается, что когда-нибудь в Perl будут поддерживаться новые операторы //, //= и err. Возможно, это уже произойдет к тому моменту, когда вы будете читать эту книгу. Новые операторы будут работать аналогично оператору ||, но вместо истинности они будут проверять определенность переменных, поэтому следующие пары станут эквивалентными:


$a = defined($b) ? $b : $c;
$a = $b // $c;

$x = defined($x) ? $x : $y;
$x //= $y;

defined(read(FH, $buf, $count)  or  die "read failed: $!";
read(FH, $buf, $count)          err die "read failed: $!";

Эти три оператора уже включены в Perl версии 5.9. Как и все версии с нечетными номерами, версия 5.9 является экспериментальной, поэтому использовать ее в среде реальной эксплуатации не рекомендуется. Видимо, операторы останутся в стабильной версии 5.10 и наверняка будут поддерживаться в версии 6, дата выхода которой пока остается неопределенной.

См. также

Описание оператора || в perlop(1); описание функций defined и exists в perlfunc(1).

1.3. Перестановка значений без использования временных переменных

Проблема

Требуется поменять значения двух скалярных переменных, но вы не хотите использовать временную переменную.

Решение

Воспользуйтесь присваиванием по списку:

 ($VAR1, $VAR2) = ($VAR2, $VAR1);

Комментарий

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


$temp = $a;
$a    = $b;
$b    = $temp;

В Perl дело обстоит иначе. Язык следит за обеими сторонами присваивания и гарантирует, что ни одно значение не будет случайно стерто. Это позволяет избавиться от временных переменных:


$a    = "alpha";
$b    = "omega";
($a, $b) = ($b, $a);   # Первый становится последним - и наоборот

Подобным способом можно поменять местами сразу несколько переменных:

 ($alpha, $beta, $production) = qw(January March August);
# beta перемещается в alpha,
# production - в beta,
# alpha - в production
($alpha, $beta, $production) = ($beta, $production, $alpha);

Значения переменных $alpha, $beta и $production после завершения этого фрагмента будут равны соответственно "March", "August" и "January".

См. также

Раздел "List value constructors" perlop(1).

1.4. Преобразование между символами и ASCII-кодами

Проблема

Требуется вывести код, соответствующий некоторому символу в кодировке ASCII, или наоборот - символ по ASCII-коду.

Решение

Воспользуйтесь функцией ord для преобразования символа в числовой код или функцией chr - для преобразования числового кода в символ:


$num  = ord($char);
$char = chr($num);

Формат %c в функциях printf и sprintf также преобразует число в символ:


$char = sprintf("%c", $num);        # Медленнее, чем chr($num)
printf("Number %d is character %c\n", $num, $num);
Number 101 is character e

Шаблон C*, используемый в функциях pack и unpack, позволяет быстро преобразовать несколько 8-разрядных символов; для символов Юникода следует использовать шаблон U*:


@bytes  = unpack("C*", $string);
@string = pack("C*", @bytes);

$unistr = pack("U4",0x24b6,0x24b7,0x24b8,0x24b9);
@unichars = unpack("U*", $unistr);

Комментарий

В отличие от низкоуровневых, нетипизованных языков вроде ассемблера, Perl не считает эквивалентными символы и числа; эквивалентными считаются строки и числа. Это означает, что вы не можете произвольно присвоить вместо символа его числовое представление или наоборот. Для преобразования между символами и их числовыми значениями в Perl существуют функции chr и ord, взятые из Pascal:


$value     = ord("e");   # Теперь 101
$character = chr(101);   # Теперь "e"

Символ в действительности представляется строкой единичной длины, поэтому его можно просто вывести функцией print или с помощью формата %s функций printf и sprintf. Формат %c заставляет printf или sprintf преобразовать число в символ, однако он не позволяет вывести символ, который уже хранится в символьном формате (то есть в виде строки).

printf("Number %d is character %c\n", 101, 101);

Функции pack, unpack, chr и ord работают быстрее, чем sprintf. Ниже приведены примеры практического применения pack и unpack:

@ascii_character_numbers = unpack("C*", "sample");
print "@ascii_character_numbers\n";
115 97 109 112 108 101

$word = pack("C*", ascii_character_numbers);
$word = pack("C*", 115, 97, 109, 112, 108, 101);  # То же самое
print "$word\n"
sample

А вот как превратить HAL в IBM:

$hal = "HAL";
@byte = unpack("C*", $hal);
foreach $val (@byte) {
    $val++;             # Увеличивает каждый ASCII-код на 1
}
$ibm = pack("C*", @byte);
print "$ibm\n";         # Выводит "IBM"

Для однобайтовых символьных данных (таких, как старая добрая кодировка ASCII или любые наборы семейства ISO 8859) функция ord возвращает числа от 0 до 255. Этот диапазон соответствует типу данных unsigned char языка C.

Однако Perl этим не ограничивается: в нем появилась интегрированная поддержка универсальной кодировки Юникода. Если при вызове chr, sprintf "%c" или pack "U*" передаются значения, превышающие 255, то полученный результат будет представлять собой строку Юникода.

Ниже приведен аналог предыдущего фрагмента в Юникоде:


@unicode_points = unpack("U*", "fac\xade");
print "@unicode_points\n";
102 97 99 807 97 100 101

$word = pack("U*", @unicode_points);
print "$word\n";
faзade

Если требуется лишь вывести коды символов, возможно, вам даже не придется использовать unpack. У функций Perl printf и sprintf существует модификатор v, который работает следующим образом:

printf "%vd\n", "fac\xade";
102.97.99.807.97.100.101

printf "%vx\n", "fac\xade";
66.61.63.327.61.64.65

Функции выводят числовые коды всех символов строки (в терминологии Юникода - "кодовые пункты"), разделенные точками.

См. также

Описание функций chr, ord, printf, sprintf, pack и unpack в perlfunc(1).

1.5. Использование именованных символов Юникода

Проблема

Требуется обозначать нестандартные символы в программе по именам, без возни с их числовыми кодами.

Решение

Включите в начало файла директиву use charnames, а затем свободно включайте в строковые литералы служебные последовательности "\N".

Комментарий

Директива use charnames позволяет использовать символические имена для символов Юникода. Имена представляют собой константы времени компиляции, для обращения к которым используются служебные последовательности вида \N. Для директивы use charnames поддерживается ряд поддиректив. Поддиректива :full открывает доступ ко всему интервалу имен символов, но вам придется записывать их полностью и точно в таком виде, как они хранятся в базе данных символов Юникода (в частности, имена должны записываться в верхнем регистре). Поддиректива :short позволяет использовать удобные сокращения. Импортируемое имя без префикса ":" воспринимается как имя алфавита, что дает возможность использовать для указанного алфавита сокращенные имена символов с учетом регистра.

use charnames ':full';
print "\N{GREEK CAPITAL LETTER DELTA} is called delta.\n";

? is called delta.

use charnames ':short';
print "\N is an upper-case delta.\n";

? is an upper-case delta.

use charnames qw(cyrillic greek);
print "\N and \N are Greek sigmas.\n";
print "\N and \N are Cyrillic bes.\n";

? and ? are greek sigmas.
Б and б are Cyrillic bes.

Функции charnames::viacode и charnames::vianame выполняют преобразования между числовыми кодовыми пунктами и длинными именами. В документации Юникода символ с кодовым пунктом XXXX обозначается как U+XXXX, поэтому мы также воспользуемся этим обозначением при выводе данных в следующем примере:


use charnames qw(:full);
for $code (0xC4, 0x394) {
    printf "Character U+%04X (%s) is named %s\n",
        $code, chr($code), charnames::viacode($code);
}

Character U+00C4 (Д) is named LATIN CAPITAL LETTER A WITH DIAERESIS
Character U+0394 (?) is named GREEK CAPITAL LETTER DELTA

use charnames qw(:full);
$name = "MUSIC SHARP SIGN";
$code = charnames::vianame($name);
printf "%s is character U+%04X (%s)\n",
    $name, $code, chr($code);

MUSIC SHARP SIGN is character U+266F ( # )

Имя копии базы данных символов Юникода в Perl определяется так:

% perl -MConfig -le 'print "$Config/unicore/NamesList.txt"'
/usr/local/lib/perl5/5.8.1/unicore/NamesList.txt

Из этого файла можно узнать доступные имена символов.

См. также

Charnames(3); база данных символов Юникода по адресу http://www.unicode.org.

1.6. Посимвольная обработка строк

Проблема

Требуется последовательно обрабатывать строку по одному символу.

Решение

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


@array = split(//, $string);    # Список содержит отдельные символы
@array = unpack("U*", $string); # Список содержит кодовые пункты (числа)

Также можно последовательно выделять очередной символ в цикле:

while (/(.)/g) {      # Символ . не совпадает с символом перевода строки
   # Переменная $1 содержит символ, ord($1) - числовой код символа.
}

Комментарий

Как говорилось выше, базовой единицей текста в Perl является строка, а не символ. Необходимость посимвольной обработки строк возникает достаточно редко. Обычно такие задачи легче решаются с помощью высокоуровневых операций Perl (например, поиск по шаблону). Пример приведен в рецепте 7.14, где для поиска аргументов командной строки используются подстановки.

Если вызвать split с шаблоном, который совпадает с пустой строкой, функция вернет список отдельных символов строки. При намеренном использовании эта особенность оказывается удобной, однако с ней можно столкнуться и случайно. Например, /X*/ совпадает с любыми строками, включая пустую строку. Не исключено, что вам встретятся и другие ненамеренные совпадения.

Следующий пример выводит символы строки "an apple a day", отсортированные по возрастанию:

%seen = ();
$string = "an apple a day";
foreach $char (split //, $string) {
    $seen++;
}
print "unique chars are: ", sort(keys %seen), "\n";
unique chars are: adelnpy

Решения с функциями split и unpack предоставляют массив символов, с которым можно выполнять дальнейшие операции. Если массив не нужен, воспользуйтесь поиском по шаблону в цикле while с флагом /g, который извлекает по одному символу из строки:

%seen = ();
$string = "an apple a day";
while ($string =~ /(.)/g) {
    $seen++;
}
print "unique chars are: ", sort(keys %seen), "\n";
unique chars are: adelnpy

Как правило, посимвольная обработка строк не является оптимальным решением. Иногда вместо использования index/substr или split/unpack проще воспользоваться шаблоном. В следующем примере 32-разрядная контрольная сумма вычисляется вручную, но лучше поручить работу функции unpack - она сделает то же самое намного эффективнее.

Следующий пример вычисляет контрольную сумму символов $string в цикле foreach. Приведенный алгоритм не оптимален; просто мы используем традиционную и относительно легко вычисляемую сумму. Если вам потребуются более совершенные средства вычисления контрольной суммы, воспользуйтесь стандартным модулем Digest::MD5.

$sum = 0;
foreach $byteval (unpack("C*", $string)) {
    $sum += $byteval;
}
print "sum is $sum\n";
# Для строки "an apple a day" выводится сумма 1248

Следующий вариант делает то же самое, но намного быстрее:

$sum = unpack("%32C*", $string);

Это позволяет эмулировать программу вычисления контрольной суммы SysV:

#!/usr/bin/perl
# sum - вычисление 16-разрядной контрольной суммы всех входных файлов
$checksum = 0;
while (<>) { $checksum += unpack("%16C*", $_) }
$checksum %= (2 ** 16) - 1;
print "$checksum\n";

Фактически это выглядит так:

% perl sum /etc/termcap
1510

Если у вас установлена GNU-версия sum, то для получения идентичного ответа для того же файла ее следует вызвать с параметром -sysv:

% sum -sysv /etc/termcap
1510 851 /etc/termcap

В примере 1.1 приведена еще одна крошечная программа, в которой также реализована посимвольная обработка входных данных. Идея заключается в том, чтобы вывод каждого символа сопровождался небольшой паузой - текст отображается перед читателями в замедленном темпе, чтобы его было удобнее читать.

Пример 1.1. slowcat
#!/usr/bin/perl
# slowcat - з а м е д л е н н ы й вывод
# использование: slowcat [-DELAY] [files...],
# где DELAY - задержка
$DELAY = ($ARGV[0] =~ /^-([.\d]+)/) ? (shift, $1) : 1;
$| = 1;
while (<>) {
    for (split(//)) {
        print;
        select(undef,undef,undef, 0.005 * $DELAY);
    }
}

См. также

Описание функций split и unpack в perlfunc(1); применение select для организации задержки объясняется в рецепте 3.10.

1.7. Обратная перестановка слов или символов

Проблема

Требуется изменить порядок символов или слов в строке на противоположный.

Решение

Для перестановки байтов воспользуйтесь функцией reverse в скалярном контексте:

$revchars = reverse($string);

Для перестановки слов воспользуйтесь reverse в списковом контексте с функциями split и join:


$revwords = join(" ", reverse split(" ", $string);

Комментарий

У функции reverse существует два варианта применения. В скалярном контексте функция объединяет аргументы и возвращает полученную строку в обратном порядке. В списковом контексте функция возвращает свои аргументы в обратном порядке. Если функция reverse применяется для перестановки символов в неочевидной ситуации, воспользуйтесь функцией scalar для форсированного применения скалярного контекста.


$gnirts = reverse($string);   # Перестановка символов $string

$sdrow  = reverse(@words);    # Перестановка элементов @words

$confused = reverse(@words);  # Перестановка букв в join("", @words)

Рассмотрим пример обратной перестановки слов в строке. Вызов функции split с шаблоном " " является особым случаем: он заставляет split использовать в качестве разделителя смежные пропуски (whitespace) и отбрасывать начальные пустые поля (по аналогии с awk). Обычно split отбрасывает только конечные пустые поля.


# Обратная перестановка слов
$string = 'Yoda said, "can you see this?"';
@allwords = split(" ", $string);
@revwords = join(" ", reverse @allwords);
print $revwords, "\n";
this?" see you "can said, Yoda

Временный массив @allwords можно убрать и сделать все в одной строке:


$revwords = join(" ", reverse split(" ", $string);

Смежные пропуски в $string превращаются в один пробел в $revwords. Чтобы сохранить существующие пропуски, поступите так:

$revwords = join("", reverse split (/(\s+)/, $string));

С помощью функции reverse можно проверить, является ли слово палиндромом (то есть читается ли одинаково в обоих направлениях):


$word = "reviver";
$is_palindrome = ($word eq reverse($word));

Программа для поиска длинных палиндромов в файле /usr/dict/words записывается в одну строку:


% perl -nle 'print if $_ eq reverse && length >5' /usr/dict/words
 deedeed
 degged
 deified
 denned
 hallah
 kakkak
 murdrum
 redder
 repaper
 retter
 reviver
 rotator
 sooloos
 tebbet
 terret
 tut-tut

См. также

Описание функций split, reverse и scalar в perlfunc(1); рецепт 1.8.

1.8. Интерпретация комбинированных символов Юникода как одиночных символов

Проблема

Строка Юникода содержит комбинированные символы. Требуется интерпретировать каждую из комбинированных последовательностей как один логический символ.

Решение

Обработайте строку, используя регулярное выражение с метасимволом \X:


$string =  "fac\xade";      # faзade
$string =~ "fa.ade";              # Неудача
$string =~ "fa\Xade";             # Совпадение

@chars = split(//, $string);      # 7 букв в @chars
@chars = $string =~ /(.)/g;       # То же самое
@chars = $string =~ /(\X)/g;      # 6 "букв" в @chars

Комментарий

В Юникоде базовые символы могут комбинироваться с одним или несколькими символами нулевой ширины, следующими за ним (обычно это всевозможные диакритические знаки: акценты, седили, тильды и т. д.). Главным образом для поддержки старых символьных систем существуют два варианта записи символов.

Например, слово "faзade" можно записать так, чтобы между двумя буквами "a" находился один символ "\x" из кодировки Latin1 (ISO 8859-1). Возможно, в кодировке UTF-8, используемой во внутренней работе Perl, эти два символа представляются двухбайтовой последовательностью, но эти два байта все равно интерпретируются как отдельный символ.

Однако существует и другой способ записи. Символ U+00E7 может быть представлен двумя кодовыми пунктами: обычной буквой "c", за которой следует "\x". Кодовый пункт U+0327 соответствует комбинационному символу нулевой ширины, который означает, что под предыдущим базовым символом должен находиться седиль.

Иногда бывает нужно, чтобы Perl интерпретировал каждый комбинированный символ как один логический символ. Но поскольку комбинированный символ представлен несколькими кодовыми пунктами, символьные операции Perl (включая функции substr и length, а также метасимволы регулярных выражений /./ и /[^abc]/) интерпретируют комбинационные символы нулевой ширины как самостоятельные символы.

В регулярном выражении метасимвол \X совпадает с последовательностью, определяющей комбинированный символ Юникода. Он в точности эквивалентен конструкции (?:\PM\pM*), или в расширенной записи:


(?x:                   # Начало несохраняющей группы
      \PM              # Один символ без свойства M (знак) 
                       # (например, буква);
           \pM         # один символ со свойством M (знак)
                       # (например, акцент),
           *           # который может повторяться любое количество раз
)

Без метасимвола \X присутствие этих противных комбинаций в строке основательно запутывает даже простейшие операции. Рассмотрим пример с обратной перестановкой символов слова из предыдущего рецепта. В комбинированной записи слова "annйe" и "niсo" представляются в Perl в виде "anne\xe" и "nin\xo".


for $word ("anne\xe", "nin\xo") {
    printf "%s simple reversed to %s\n", $word,
        scalar reverse $word;
    printf "%s better reversed to %s\n", $word,
        join("", reverse $word =~ /\X/g);
}

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

annйe simple reversed to йenna
annйe better reversed to eйnna
niсo simple reversed to хnin
niсo better reversed to oсin

В примитивных перестановках первой и третьей строки диакритический знак перескочил с одного базового символа на другой. Дело в том, что комбинационный символ всегда следует за своим базовым символом, а мы переставили все символы в строке. Захватывая всю последовательность из базового символа и всех комбинационных символов, следующих за ним, мы избавляемся от этой проблемы при последующей перестановке элементов списка.

См. также

Perlre(1) и perluniintro(1); рецепт 1.9.

1.9. Приведение строк с комбинированными символами Юникода к каноническому виду

Проблема

Две строки одинаково выглядят при выводе, но при проверке равенства они считаются различными, а иногда даже имеют разную длину. Как добиться того, чтобы Perl считал эти строки одинаковыми?

Решение

Если хотя бы некоторые из сравниваемых строк содержат комбинированные символы Юникода, то при сравнении следует использовать результаты обработки этих строк функцией NFD()модуля Unicode::Normalize:


use Unicode::Normalize;
$s1 = "fa\xade";
$s2 = "fac\xade";
if (NFD($s1) eq NFD($s2)) { print "Yup!\n" }

Комментарий

Одни и те же символы в некоторых случаях могут определяться разными способами. Иногда это происходит при использовании старых кодировок - например, букв с диакритическими знаками из кодировки Latin1. Такие буквы задаются либо непосредственно в виде отдельного символа (например, U+00E7, строчная латинская буква "c" с седилем), либо косвенно, как сочетание базового символа (U+0063, строчная латинская буква "c") с комбинационным символом (U+0327, седиль).

Возможен и другой вариант: если за базовым символом следуют два и более знака, которые могут следовать в разном порядке. Допустим, вы хотите использовать символ "c" с седилем и коронкой, чтобы на печати выводился символ . Такой символ может определяться несколькими способами:

$string = v231.780;
#   Строчная латинская буква C с седилем
#   Комбинационная коронка
$string = v99.807.780;
#   Строчная латинская буква C
#   Комбинационная коронка
#   Комбинационный седиль

$string = v99.780.807;
#   Строчная латинская буква C
#   Комбинационный седиль
#   Комбинационная коронка

Функции нормализации приводят эти варианты к единому порядку. Существует несколько таких функций, в том числе функция NFD() для выполнения канонической декомпозиции и функция NFC() для выполнения канонической декомпозиции с последующей канонической композицией. Какой бы из трех вариантов не был избран для определения символа , NFD всегда возвращает v99.807.780, а NFC - v321.780.

Иногда бывает удобнее использовать функции NFKD() и NFKC(), аналогичные предыдущим функциям, но в отличие от них выполняющие совместимую декомпозицию, после которой в случае NFKC() следует каноническая композиция. Например, \x определяет лигатуру !!!?!!!. Формы NFD и NFC возвращают одну и ту же строку "\x", но формы NFKD и NFKC возвращают строку из двух символов "\x\x".

См. также

Раздел "Универсальная кодировка символов" в начале этой главы; документация Юникода; модуль Unicode::Normalize; рецепт 8.20.

1.10. Интерпретация строки Юникода как последовательности октетов

Проблема

Требуется интерпретировать строку Юникода в Perl как последовательность октетов (например, для вычисления ее длины или в контексте ввода/вывода).

Решение

Директива use bytes заставляет все операции Perl в своей лексической области видимости интерпретировать строку как группу октетов. Используйте ее при вызове символьных функций Perl:


$ff = "\x";         # Лигатура ff
$chars = length($ff);     # Длина равна одному символу
{
  use bytes;              # Принудительное использование байтовой семантики
  $octets = length($ff);  # Длина равна двум октетам
}
$chars = length($ff);     # Возврат к символьной семантике

Существует и другое решение: модуль Encode позволяет преобразовать строку Юникода в строку октетов и наоборот. Используйте его в том случае, если код с символьной семантикой не находится в лексической области видимости:


use Encode qw(encode_utf8);

sub somefunc;                  # Определяется в другом месте

$ff = "\x";              # Лигатура ff
$ff_oct = encode_utf8($ff);    # Преобразование в октеты

$chars = somefunc($ff);        # Функция работает с символьной строкой
$octets = somefunc($ff_oct);   # Функция работает с цепочкой октетов

Комментарий

Как объяснялось во введении настоящей главы, Perl различает две разновидности строк: строки, состоящие из простых неинтерпретированных октетов, и строки, состоящие из символов Юникода, в которых представление UTF-8 может потребовать более одного октета. С каждой конкретной строкой связывается флаг, идентифицирующий ее как строку октетов или строку UTF-8. Строковые функции Perl (такие, как length) и средства ввода/вывода проверяют состояние флага и применяют символьную или октетную семантику в зависимости от результата проверки.

Иногда приходится работать с байтами, а не с символами. Например, во многих протоколах существует заголовок Content-Length, определяющий размер тела сообщения в октетах. Простое вычисление размера length не подходит - если строка, для которой вызывается length, помечена как строка UTF-8, вы получите размер в символах.

Директива use bytes заставляет все функции Perl в лексической области видимости использовать в строковых операциях октетную семантику вместо символьной. Под влиянием этой директивы length всегда возвращает длину строки в октетах, а функция read всегда возвращает количество прочитанных октетов. Однако директива use bytes имеет лексическую видимость, поэтому она не может использоваться для влияния на работу кода в другой области видимости (например, функции, написанной кем-то другим).

В этом случае вам придется создать копию строки UTF-8, перекодированную в октеты. Конечно, в памяти обе строки будут содержать одну и ту же последовательность байтов. Различие состоит только в том, что в октетной копии строки сброшен флаг UTF-8. Функции, работающие с октетной копией, всегда будут использовать объектную семантику независимо от того, в какой области видимости они находятся.

Директива no bytes обеспечивает принудительное использование символьной семантики, а функция decode_utf8 преобразует октетную строку в строку UTF-8. Впрочем, на практике они применяются реже, потому что не каждая октетная строка является действительной строкой UTF-8, тогда как все строки UTF-8 являются действительными октетными строками.

См. также

Документация по директиве use bytes; документация по стандартному модулю Encode.

1.11. Расширение и сжатие символов табуляции

Проблема

Требуется заменить символы табуляции в строке соответствующим количеством пробелов или наоборот. Замена пробелов табуляцией сокращает объем файлов, содержащих много смежных пробелов. Преобразование символов табуляции в пробелы может понадобиться при выводе на устройства, которые не воспринимают символы табуляции или предполагают, что они находятся в других позициях.

Решение

Примените подстановку весьма странного вида:


while ($string =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e) {
    # Выполнять пустой цикл до тех пор,
    # пока выполняется условие подстановки
}

Также можно воспользоваться стандартным модулем Text::Tabs:


use Text::Tabs;
@expanded_lines  = expand(@lines_with_tabs);
@tabulated_lines = unexpand(@lines_without_tabs);

Комментарий

Если позиции табуляции следуют через каждые N символов (где N обычно равно 8), их несложно преобразовать в пробелы. В стандартном, "книжном" методе не используется модуль Text::Tabs, однако разобраться в нем непросто. Кроме того, в нем используется переменная $`, одно упоминание которой замедляет поиск по шаблону в программе. Причина объясняется в разделе "Специальные переменные" главы 6. Следующий алгоритм заменяет каждый символ табуляции во входных данных восемью пробелами:


while (<>) {
    1 while s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;
    print;
}

Чтобы обойтись без $`, можно воспользоваться более сложным решением, в котором части совпадения сохраняются в именованных переменных. Следующий цикл заменяет один символ табуляции четырьмя пробелами вместо восьми:


1 while s/^(.*?)(\t+)/$1 . ' ' x (length($2) * 4 - length($1) % 4)/e;

Другой прием основан на прямом использовании смещений из массивов @+ и @-. В следующем примере символ табуляции тоже расширяется до четырех пробелов:


1 while s/\t+/' ' x (($+[0] - $-[0]) * 4 - $-[0] % 4)/e;

Вы смотрите на все эти циклы 1 while и не можете понять, почему их нельзя было записать в виде простой конструкции s///g? Потому что нам приходится каждый раз заново пересчитывать длину от начала строки, а не от последнего совпадения.

Конструкция 1 while УСЛОВИЕ эквивалентна while (УСЛОВИЕ) {}, но более компактна. Она появилась в те дни, когда первая конструкция работала в Perl несравнимо быстрее второй. Хотя сейчас второй вариант почти не уступает по скорости, удобный первый вариант вошел в привычку.

Стандартный модуль Text::Tabs содержит функции преобразований в обоих направлениях и экспортирует переменную $tabstop, которая определяет число пробелов на символ табуляции. Кроме того, применение модуля не приводит к снижению быстродействия, потому что вместо $& и $` используются переменные $1 и $2:


use Text::Tabs;
$tabstop = 4;
while (<>) { print expand($_) }

Модуль Text::Tabs также может применяться для "свертки" табуляции. В следующем примере используется стандартное значение $tabstop, равное 8:


use Text::Tabs;
while (<>) { print unexpand($_) }

См. также

Страница руководства модуля Text::Tabs; описание оператора s/// в perlre(1) и perlop(1).

1.12. Расширение переменных во входных данных

Проблема

Программа читает строку, внутри которой присутствует ссылка на переменную:

You owe $debt to me.

Требуется заменить имя переменной $debt в строке ее текущим значением.

Решение

Если все переменные являются глобальными, воспользуйтесь подстановкой с символическими ссылками:

$text =~ s/\$(\w+)/$/g;

Но если среди переменных могут встречаться лексические (my) переменные, следует использовать /ee:

$text =~ s/(\$\w+)/$1/gee;

Комментарий

Первый способ фактически сводится к следующему: мы ищем нечто похожее на имя переменной, а затем интерполируем ее значение посредством символического разыменования (dereferencing). Если $1 содержит строку somevar, то $ будет равно содержимому $somevar. Такой вариант не будет работать при действующей директиве use strict 'refs', потому что она запрещает символическое разыменование.

Приведем пример:

our ($rows $cols);
no strict 'refs';      # для приведенного ниже $/g
my $text;

($rows, $cols) = (24, 80);
$text = q(I am $ rows high and $cols long); # Как строка в апострофах!
$text =~ s/\$(\w+)/$/g;
print $text;
I am 24 high and 80 long

Возможно, вам уже приходилось видеть, как модификатор подстановки /e используется для вычисления заменяющего выражения, а не строки. Допустим, вам потребовалось удвоить каждое целое число в строке:

$text = "I am 17 years old";
$text =~ s/(\d+)/2 * $1/eg;

Перед запуском программы, встречая /e при подстановке, Perl компилирует код заменяющего выражения вместе с остальной программой, задолго до фактической подстановки. При выполнении подстановки $1 заменяется найденной строкой. В нашем примере будет вычислено следующее выражение:

2 * 17

Но если попытаться выполнить следующий фрагмент:

$text = 'I am $AGE years old';  # Обратите внимание на апострофы!
$text =~ s/(\$\w+)/$1/eg;       # НЕВЕРНО

при условии, что $text содержит имя переменной $AGE, Perl послушно заменит $1 на $AGE и вычислит следующее выражение:

'$AGE'

В результате мы возвращаемся к исходной строке. Чтобы получить значение переменной, необходимо снова вычислить результат. Для этого в строку добавляется еще один модификатор /e:

$text =~ s/(\$\w+)/$1/eeg;      # Находит переменные my()

Да, количество модификаторов /e может быть любым. Только первый модификатор компилируется вместе с программой и проверяется на правильность синтаксиса. В результате он работает аналогично конструкции eval , хотя и не перехватывает исключений. Возможно, лучше провести аналогию с do .

Остальные модификаторы /e ведут себя иначе и больше напоминают конструкцию eval "STRING". Они не компилируются до выполнения программы. Маленькое преимущество этой схемы заключается в том, что вам не придется вставлять в блок директиву no strict 'refs'. Есть и другое, огромное преимущество: этот механизм позволяет находить лексические переменные, созданные с помощью my - символические ссылки на это не способны.

В следующем примере модификатор /x разрешает пропуски и комментарии в шаблоне подстановки, а модификатор /e вычисляет правостороннее выражение на программном уровне. Модификатор /e позволяет лучше управлять обработкой ошибок или других экстренных ситуаций:


# Расширить переменные в $text. Если переменная не определена,
# вставить сообщение об ошибке.
$text =~ s{
     \$                        # Найти знак доллара
    (\w+)                      # Найти "слово" и сохранить его в $1
}{
    no strict 'refs';          # Для $$1
    if (defined $) {
        $;                 # Расширять только глобальные переменные
    } else {
        "[NO VARIABLE: \$$1]"; # Сообщение об ошибке
    }
}egx;

В незапамятные времена выражение $$1 в строках обозначало $1, то есть переменную $$, за которой следует 1. Такая интерпретация принималась для удобства расширения переменной $$ как идентификатора процесса (PID) при формировании имен временных файлов. Сейчас $$1 всегда обозначает $, то есть разыменование содержимого переменной $1. В приведенной программе уточненная запись используется только для наглядности, поскольку программа и так работает правильно.

См. также

Описание оператора s/// в perlre(1) и perlop(1); описание функции eval в perlfunc(1). Похожее использование подстановок встречается в рецепте 20.9.

1.13. Преобразование регистра

Проблема

Строку с символами верхнего регистра необходимо преобразовать в нижний регистр или наоборот.

Решение

Воспользуйтесь функциями lc и uc или модификаторами \L и \U:


$big = uc($little);         # "bo peep" -> "BO PEEP"
$little = lc($big);         # "JOHN"    -> "john"
$big = "\U$little";         # "bo peep" -> "BO PEEP"
$little = "\L$big";         # "JOHN"    -> "john"

Для замены отдельного символа используйте функции lcfirst и ucfirst или модификаторы \l и \u:


$big = "\u$little";         # "bo"      -> "Bo"
$little = "\l$big";         # "BoPeep"  -> "boPeep"

Комментарий

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


$beast   = "dromedary";
# Изменить регистр разных символов $beast
$capit   = ucfirst($beast);      # Dromedary
$capit   = "\u\L$beast";         # (то же)
$capall  = uc($beast);           # DROMEDARY
$capall  = "\U$beast";           # (то же)
$caprest = lcfirst(uc($beast));  # dROMEDARY
$caprest = "\l\U$beast";         # (то же)

Как правило, модификаторы обеспечивают единый стиль применения регистра в строке:


# Сделать первый символ каждого слова заглавным,
# а остальные символы привести к нижнему регистру
$text = "tHIS is a loNG liNE";
$text =~ s/(w+)/\u\L$1/g;
print $text;
This Is A Long Line

Ими также можно пользоваться для сравнения строк без учета регистра:

if (uc($a) eq uc($b)) { print "a and b are the same\n"; }

Программа randcap из примера 1.2 случайным образом преобразует в верхний регистр примерно 20 процентов вводимых символов. Пользуясь ею, вы сможете свободно общаться с 14-летними кРУтЫми ХаЦкЕРамИ:


Пример 1.2. randcap
#!/usr/bin/perl -p
# randcap: фильтр, который случайным образом
# преобразует к верхнему регистру 20% символов
# Начиная с версии 5.4, вызов srand() необязателен.
BEGIN { srand(time() ^ ($$ + ($$ << 15))) }
sub randcase { rand(100) < 20 ? "\u$_[0]" : "\l$_[0]" }
s/(\w)/randcase($1)/ge;

% randcap < genesis | head -9
boOk 01 genesis

001:001 in the BEginning goD created the heaven and tHe earTH.

001:002 and the earth wAS without ForM, aND void; AnD darkneSS was
        upon The Face of the dEEp. an the spIrit of GOd movEd upOn
        tHe face of the Waters.

001:003 and god Said, let there be ligHt: and therE wAs LigHt.

В письменности некоторых языков различаются символы верхнего регистра и заглавные (titlecase) символы. В таких случаях функция ucfirst() (и ее аналог-модификатор \u) преобразует символы в заглавные. Например, в венгерском языке существует последовательность "dz". В верхнем регистре она записывается в виде "DZ", в заглавном - "Dz ", а в нижнем - "dz". Соответственно, в Юникоде для этих трех случаев предусмотрены три разных символа:

Кодовый пункт	Запись	Название
01F1	DZ	LATIN CAPITAL LETTER DZ
01F2	Dz	LATIN CAPITAL LETTER D WITH SMALL LETTER Z
01F3	dz	LATIN SMALL LETTER DZ

Преобразования регистра конструкциями типа tr[a-z][A-Z] или чем-нибудь в этом роде выглядят соблазнительно, однако поступать так не рекомендуется. Такое решение ошибочно, поскольку из него выпадают все символы с умляутами, седилями и прочими диакритическими элементами, встречающимися во многих языках (в том числе и в английском). Впрочем, задача правильного отображения регистра в символьных данных с диакритическими знаками вообще гораздо сложнее, чем кажется на первый взгляд. Простого решения не существует, но если все данные хранятся в Юникоде, все не так плохо, потому что регистровые функции Perl безупречно работают с Юникодом. За дополнительной информацией обращайтесь к разделу "Универсальная кодировка символов" во введении настоящей главы.

См. также

Описание функций uc, lc, ucfirst и lcfirst в perlfunc(1); описание модификаторов \L, \U, \l и \u в разделе "Quote and Quote-like Operators" perlop(1).

1.14. Расстановка прописных букв в заголовках

Проблема

Имеется строка с заголовком статьи, названием книги и т. д. Требуется правильно расставить в ней прописные буквы.

Решение

Воспользуйтесь разновидностью функции tc():


INIT {
    our %nocap;
    for (qw(
            a an the
            and but or
            as at but by for from in into of off on onto per to with
        ))
    {
        $nocap++;
    }
}

sub tc {
    local $_ = shift;

    # Начать со строчной буквы, если слово присутствует в списке,
    # иначе использовать заглавную букву.
    s/(\pL[\pL']*)/$nocap ? lc($1) : ucfirst(lc($1))/ge;

    s/^(\pL[\pL']*) /\u\L$1/x; # Последнее слово всегда
                               # начинается с заглавной буквы
    s/ (\pL[\pL']*)$/\u\L$1/x; # Последнее слово всегда
                               # начинается с заглавной буквы

    # Часть в круглых скобках интерпретируется как полное название
    s/\( (\pL[\pL']*) /(\u\L$1/x;
    s/(\pL[\pL']*) \) /\u\L$1)/x;

    # Первое слово после двоеточия или точки с запятой
    # начинается с заглавной буквы
    s/ ( [:;] \s+ ) (\pL[\pL']* ) /$1\u\L$2/x;

    return $_;
}

Комментарий

Правила расстановки прописных букв в английских заголовках и названиях сложнее, чем может показаться на первый взгляд. Если бы они сводились к простой замене первой буквы каждого слова, то задача решалась бы подстановкой вида


s/(\w+\S*\w*)/\u\L$1/g;

В большинстве стилевых руководств рекомендуется начинать с прописных букв первое и последнее слово в названии, а также все остальные слова, кроме артиклей, частицы "to" в инфинитиве, сочинительных союзов и предлогов.

Следующий пример демонстрирует отличительные особенности заглавных символов (в нем используется функция tc() из приведенного Решения):


@data = (
            "the enchantress of \xur mountain",
    "meeting the enchantress of \xur mountain",
    "the lord of the rings: the fellowship of the ring",
);

$mask = "%-20s: %s\n";

sub tc_lame {
    local $_ = shift;
    s/(\w+\S*\w*)/\u\L$1/g;
    return $_;
}

for $datum (@data) {
    printf $mask, "ALL CAPITALS", uc($datum);
    printf $mask, "no capitals", lc($datum);
    printf $mask, "simple titlecase", tc_lame($datum);
    printf $mask, "better titlecase", tc($datum);
    print "\n";
}

ALL CAPITALS : THE ENCHANTRESS OF DZUR MOUNTAIN
no capitals : the enchantress of dzur mountain
simple titlecase : The Enchantress Of Dzur Mountain
better titlecase : The Enchantress of Dzur Mountain

ALL CAPITALS : MEETING THE ENCHANTRESS OF DZUR MOUNTAIN
no capitals : meeting the enchantress of dzur mountain
simple titlecase : Meeting The Enchantress Of Dzur Mountain
better titlecase : Meeting the Enchantress of Dzur Mountain

ALL CAPITALS : THE LORD OF THE RINGS: THE FELLOWSHIP OF THE RING
no capitals : the lord of the rings: the fellowship of the ring
simple titlecase : The Lord Of The Rings: The Fellowship Of The Ring
better titlecase : The Lord of the Rings: The Fellowship of the Ring

Также стоит учитывать, что некоторые стилевые руководства рекомендуют начинать с прописных букв предлоги длиной более трех, четырех, а в отдельных случаях - пяти символов. Так, по правилам издательства "O'Reilly & Associates" предлоги из четырех и менее символов записываются со строчной буквы. Ниже приведен расширенный список предлогов; измените его так, как сочтете нужным:


@all_prepositions = qw{
    about above absent across after against along amid amidst
    among amongst around as at athwart before behind below
    beneath beside besides between betwixt beyond but by circa
    down during ere except for from in into near of off on onto
    out over past per since than through till to toward towards
    under until unto up upon versus via with within without
};

Но и такое решение не идеально, потому что оно не различает слова, относящиеся к нескольким частям речи. Некоторые предлоги в этом списке не отличаются от слов, которые всегда записываются с прописной буквы - подчинительные союзы, наречия и даже прилагательные. Например, "Down by the Riverside", но "Getting By on Just $30 a Day"; "A Ringing in My Ears", но "Bringing In the Sheaves".

Еще одно обстоятельство, которое также следует учитывать, - возможное применение \u и ucfirst без принудительного перевода строки в нижний регистр. В этом случае слова, уже записанные прописными буквами (например, акронимы), не изменят своего написания. Вероятно, сокращения "FBI" и "LBJ" не должны преобразовываться в "Fbi" и "Lbj".

См. также

Описание функций uc, lc, ucfirst и lcfirst в perlfunc(1); описание модификаторов \L, \U, \l и \u в разделе "Quote and Quote-like Operators" perlop(1).

1.15. Интерполяция функций и выражений в строках

Проблема

Требуется интерполировать вызов функции или выражение, содержащиеся в строке. По сравнению с интерполяцией простых скалярных переменных это позволит конструировать более сложные шаблоны.

Решение

Выражение можно разбить на отдельные фрагменты и произвести конкатенацию:


$answer = $var1 . func(). $var2;  # Только для скалярных величин

Также можно воспользоваться несколько неочевидными расширениями @{[LIST EXPR]} или ${\(SCALAR EXPR)}:


$answer = "STRING @{[ LIST EXPR ]} MORE STRING";
$answer = "STRING ${\( SCALAR EXPR )} MORE STRING";

Комментарий

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


$phrase = "I have " . ($n + 1) . " guanacos.";
$phrase = "I have ${\($n + 1)} guanacos.";

В первом варианте строка-результат строится посредством конкатенации более мелких строк; таким образом мы добиваемся нужного результата без интерполяции. Функция print фактически выполняет конкатенацию для всего списка аргументов, и если вы собираетесь вызвать print $phrase, можно было бы просто написать:


print "I have ", $n + 1, " guanacos.\n";

Если интерполяция абсолютно неизбежна, придется воспользоваться вторым вариантом, изобилующим знаками препинания. Только символы @, $ и \ имеют особое значение в кавычках и в обратных апострофах. Как и в случаях с m// и s///, синоним qx() не подчиняется правилам расширения для кавычек, если в качестве ограничителя использованы апострофы! В выражении $home = qx'echo home is $HOME'; переменная $HOME будет взята из командного интерпретатора, а не из Perl! Итак, единственный способ добиться расширения произвольных выражений - расширить ${} или @{}, в чьих блоках присутствуют ссылки.

В примере


$phrase = "I have ${\( count_em() )} guanacos.";

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


$phrase = "I have ${\( scalar count_em() )} guanacos.";

Однако вы можете сделать нечто большее, чем просто присвоить переменной значение, полученное в результате интерполяции. Мы имеем дело с универсальным механизмом, который может использоваться с любыми строками, заключенными в кавычки. Так, в следующем примере мы конструируем строку с интерполированным выражением и передаем результат функции:


some_func("What you want is @{[ split /:/, $rec ]} items");

Интерполяция может выполняться и во встроенных документах:

die "Couldn't send mail" unless send_mail(<<"EOTEXT", $target);
To: $naughty
From: Your Bank
Cc: @{ get_manager_list($naughty) }
Date: @{[ do { my $now = `date`; chomp $now; $now} ]} (today)

Dear $naughty,

Today, you bounced check number @{[ 500 + int rand(100) ]} to us.
Your account is now closed.

Sincerely,
the management

EOTEXT

Расширение строк в обратных апострофах (``) оказывается особенно творческой задачей, поскольку оно часто сопровождается появлением ложных символов перевода строки. Создавая блок в фигурных скобках за @ в разыменовании анонимного массива @, как это было сделано в последнем примере, вы можете создавать закрытые (private) переменные.

Все эти приемы работают, однако простое разделение задачи на несколько этапов или хранение всех данных во временных переменных почти всегда оказывается более понятным для читателя.

Модуль Interpolation из архива CPAN позволяет решить эту задачу с использованием более приятного синтаксиса. Например, в следующем фрагменте вычисляется ключ и возвращается значение из хэша %E:


use Interpolation E => 'eval';
print "You bounced check number $E{500 + int rand(100)}\n";

В другом примере для хэша %money вызывается указанная вами функция:


use Interpolation money => \&currency_commify;
print "That will be $money{ 4 * $payment }, right now.\n";

Результат будет выглядеть примерно так:


That will be $3,232.421.04, right now.

См. также

perlref(1); модуль Interpolation из CPAN.

1.16. Отступы во встроенных документах

Проблема

При использовании механизма определения длинных строк (встроенных документов) текст должен выравниваться вдоль левого поля; в программе это неудобно. Требуется снабдить отступами текст документа в программе, но исключить отступы из окончательного содержимого документа.

Решение

Воспользуйтесь оператором s/// для отсечения начальных пропусков:


# Все сразу
($var = << HERE_TARGET) =~ s/^\s+//gm;
    далее следует
    ваш текст
HERE_TARGET

# Или за два этапа
$var = << HERE_TARGET;
    далее следует
    ваш текст
HERE_TARGET
$var =~ s/^\s+//gm;

Комментарий

Подстановка получается весьма прямолинейной: она удаляет начальные пропуски из текста встроенного документа. Модификатор /m разрешает совпадение метасимвола ^ в начале каждой логической строки документа, а модификатор /g заставляет механизм поиска повторять подстановку с максимальной частотой (то есть для каждой строки встроенного документа).


($definition = <<'FINIS') =~s/^\s+//gm;
    The five variations of camelids
    are the familiar camel, his frieds
    the llama and the alpaca, and the
    rather less well-known guanaco
    and vicuсa.
FINIS

Учтите: во всех шаблонах этого рецепта используется метасимвол \s, обозначающий один символ-пропуск, который также может обозначать символ перевода строки. В результате из встроенного документа будут удалены все пустые строки. Если вы не хотите этого, замените в шаблонах \s на [^\S\n].

В подстановке используется то обстоятельство, что результат присваивания может использоваться в левой части =~. Появляется возможность сделать все в одной строке, но она работает лишь при присваивании переменной. При непосредственном использовании встроенный документ интерпретируется как неизменяемый объект, и вы не сможете модифицировать его. Более того, содержимое встроенного документа нельзя изменить без предварительного сохранения его в переменной.

Впрочем, для беспокойства нет причин. Существует простой обходной путь, особенно удобный при частом выполнении этой операции. Достаточно написать небольшую процедуру:


sub fix {
    my $string = shift;
    $string =~ s/^\s+//gm;
    return $string;
}

print fix(<<"END");
    Наш документ
END

# Если функция была объявлена заранее, скобки можно опустить:
print fix <<"END";
    Наш документ
END

Как и во всех встроенных документах, маркер конца документа (END в нашем примере) должен быть выровнен по левому полю. Если вы хотите снабдить отступом и его, в документ придется добавить соответствующее количество пропусков:


($quote = <<'    FINIS') =~s/^\s+//gm;
        ...we will have peace, when you and all you works have
        perished--and the works of your dark master to whom you would
        deliver us. You are a liar, Saruman, and a corrupter of men's
        hearts.  --Theoden in /usr/src/perl/taint.c

    FINIS
$quote =~ s/\s+--/\n--;  # Перенести на отдельную строку

Если эта операция выполняется с документами, содержащими программный код для eval или просто выводимый текст, массовое удаление всех начальных пропусков нежелательно, поскольку оно уничтожит отступы в тексте. Конечно, это безразлично для eval, но не для читателей.

Мы подходим к следующему усовершенствованию - специальным префиксам для строк, которые должны снабжаться отступами. Например, в следующем примере каждая строка начинается с @@@ и нужного отступа:


if ($REMEMBER_THE_MAIN) {
    $perl_main_C = dequote<<'    MAIN_INTERPRETER_LOOP';
        @@@ int
        @@@ runops() {
        @@@     SAVEI32(runlevel);
        @@@     runlevel++;
        @@@     while ( op = (*op->op_ppaddr)() ) ;
        @@@     TAINT_NOT;
        @@@     return 0;
        @@@ }
    MAIN_INTERPRETER_LOOP
    # При желании добавьте дополнительный код
}

При уничтожении отступов также возникают проблемы со стихами.


sub dequote;
$poem = dequote<Результат будет выглядеть так:
Here's 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*(?:([^\w\s]+)(\s*).*\n)(?:\s*\1\2?.*\n)+$/) {
        ($white, $leader) = ($2, quotemeta($1));
    } else {
        ($white, $leader_ = (/^(\s+)/, '');
    }
    s/^\s*?$leader(?:$white)?//gm;
    return $_;
}

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


if (m{
        ^                     # начало строки
        \s *                  # 0 и более символов-пропусков
        (?:                   # начало первой несохраняющей группы
            (                 #   начать сохранение $1
               [^\w\s]        #     один байт - не пробел и не символ слова
               +              #     1 или более 
            )                 #   закончить сохранение $1
            ( \s* )           #   занести 0 и более пропусков в буфер $2
            .* \n             #   искать до конца первой строки
        )                     # конец первой группировки
        (?:                   # начало второй несохраняющей группы
           \s *               #   0 и более символов-пропусков
           \1                 #   строка, предназначенная для $1
           \2 ?               #   то, что будет в $2, но дополнительно
           .* \n              #   искать до конца строки
        ) +                   # повторить идею с группами 1 и более раз
        $                     # до конца строки
     }x
   }
{
    ($white, $leader) = ($2, quotemeta($1));
} else {
    ($white, $leader) = (/^(\s+)/, '');
}
s{                            
     ^                        # начало каждой строки (из-за /m)
     \s *                     # любое количество начальных пропусков
        ?                     # с минимальным совпадением
     $leader                  # сохраненный префикс
     (?:                      # начать несохраняющую группу
        $white                # то же количество
     ) ?                      # если после префикса следует конец строки
}{}xgm;

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

См. также

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

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

Проблема

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

Решение

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


use Text::Wrap;
@output = wrap($leadtab, $nexttab, @para);

Можно воспользоваться более интеллектуальным модулем Text::Autoformat из CPAN:


use Text::Autoformat;
$formatted = autoformat $rawtext;

Комментарий

В модуле 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 &wrap); $columns = 20; print "0123456789" 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 или определить по выходным данным команды stty.

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


use Text::Wrap       qw(&wrap $columns);
use Term::ReadKey    qw(GetTerminalSize);
($columns) = GetTerminalSize();
($/, $\) = ('', "\n\n");    # Читать по абзацам, выводить два перевода строки
while (<>) {                # Читать весь абзац
    s/\s*\n\s*/ /g;         # Заменить промежуточные переводы строк пробелами
    print wrap('', '', $_); # и отформатировать
}

Модуль CPAN Text::Autoformat гораздо умнее. Прежде всего он пытается избежать "висячих строк", то есть очень коротких завершающих строк. Но самое замечательное, что он правильно переформатирует абзацы с множественными уровнями цитирования. Пример из документации этого модуля показывает, как простой вызов print autoformat($badparagraph) преобразует текст:


In comp.lang.perl.misc you wrote:
: >  writes:
: > CN> PERL sux because:
: > CN>    * It doesn't have a switch statement and you have to put $
: > CN>signs in front of everything
: > CN>    * There are too many OR operators: having |, || and 'or'
: > CN>operators is confusing
: > CN>    * VB rools, yeah!!!!!!!!!
: > CN> So anyway, how can I stop reloads on a web page?
: > CN> Email replies only, thanks - I don't read this newsgroup.
: >
: > Begone, sirrah! You are a pathetic, Bill-loving, microcephalic
: > script-infant.
: Sheesh, what's with this group - ask a question, get toasted! And how
: *dare* you accuse me of Ianuphilia!

к следующему виду:


In comp.lang.perl.misc you wrote:
: >  writes:
: > CN> PERL sux because:
: > CN>    * It doesn't have a switch statement and you
: > CN>      have to put $ signs in front of everything
: > CN>    * There are too many OR operators: having |, ||
: > CN>      and 'or' operators is confusing
: > CN>    * VB rools, yeah!!!!!!!!! So anyway, how can I
: > CN>      stop reloads on a web page? Email replies
: > CN>      only, thanks - I don't read this newsgroup.
: >
: > Begone, sirrah! You are a pathetic, Bill-loving,
: > microcephalic script-infant.
: Sheesh, what's with this group - ask a question, get toasted!
: And how *dare* you accuse me of Ianuphilia!

Эффектно, не правда ли?

В следующей мини-программе этот модуль используется для переформатирования каждого абзаца во входном потоке:


use Text::Autoformat;
$/ = '';
while (<>) {
    print autoformat($_, {squeeze => 0, all => 1}), "\n";
}

См. также

Описание функций split и join в perlfunc(1), страница руководства стандартного модуля Text::Wrap; модуль Term::ReadKey из CPAN и пример его использования в рецепте 15.6, а также модуль CPAN Text::Autoformat.

1.18. Экранирование символов

Проблема

Некоторые символы выводимой строки (апострофы, запятые и т. д.) требуется экранировать, то есть преобразовать к специальному виду. Предположим, вы конструируете форматную строку для sprintf и хотите заменить символы % последовательностями %%.

Решение

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


# Обратная косая черта
$var =~ s/([CHARLIST])/\\$1/g;

# Удвоение
$var =~ s/([CHARLIST])/$1$1/g;

Комментарий

В приведенных выше решениях $var - модифицируемая переменная, а CHARLIST - список преобразуемых символов, который может включать комбинации типа \t или \n. Если преобразуется всего один символ, можно обойтись без скобок:


$string =~ s/%/%%/g;

Преобразования, выполняемые в следующем примере, позволяют подготовить строку для передачи командному интерпретатору. На практике преобразование символов ' и " еще не сделает произвольную строку полностью безопасной для командного интерпретатора. Правильно собрать весь список символов так сложно, а риск так велик, что для запуска программ лучше воспользоваться списковыми формами system и exec (см. рецепт 16.2) - в этом случае вы вообще избегаете взаимодействия с интерпретатором.


$string = q(Mom said, "Don't do that.");
$string =~ s/(['"])/\\$1/g;

Две обратные косые черты в секции заменителя были использованы потому, что эта секция интерпретируется по правилам для строк в кавычках. Следовательно, чтобы получить одну обратную косую черту, приходится писать две. Приведем аналогичный пример для VMS DCL, где дублируются все апострофы и кавычки:


$string = q(Mom said, "Don't do that.");
$string =~ s/(['"])/$1$1/g;

С командными интерпретаторами Microsoft дело обстоит еще сложнее. В Windows COMMAND.COM работает с кавычками, но не с апострофами; не имеет представления о применении обратных апострофов для запуска команд, а для превращения кавычек в литерал используется обратная косая черта. Впрочем, почти во всех бесплатных и коммерческих Unix-подобных командных интерпретаторах для Windows этот недостаток исправлен.

В регулярных выражениях поддерживаются символьные классы, поэтому также можно определить интервал с помощью -, а затем инвертировать его метасимволом ^. Следующая команда экранирует все символы, не входящие в интервал от A до Z:


$string =~ s/([^A-Z])/\\$1/g;

Для преобразования всех неалфавитных символов следует воспользоваться метасимволами \Q и \E или функцией quotemeta. Например, следующие команды эквивалентны:


$string = "this \Qis a test!\E";
$string = "this is\\ a\\ test!";
$string = "this " . quotemeta("is a test!");

См. также

Описание оператора s/// в perlre(1) и perlop(1); описание функции quotemeta рассматривается в perlfunc(1). В рецепте 19.1 рассматривается экранирование служебных символов в HTML, а в рецепте 19.5 говорится о том, как избежать экранирования при передаче строк командному интерпретатору.

1.19. Удаление пропусков в обоих концах строки

Проблема

В полученную строку могут входить начальные или конечные пропуски. Требуется удалить их.

Решение

Воспользуйтесь парой подстановок:


$string =~ s/^\s+//;
$string =~ s/\s+$//;

Или напишите специальную функцию, которая возвращает нужное значение:


$string = trim($string);
@many   = trim(@many);

sub trim {
        my @out = @_;
        for (@out) {
            s/^\s+//;      # Удаление пропусков слева
            s/\s+$//;      # Удаление пропусков справа
    }
    return @out == 1
              ? $out[0]    # Возвращается одна строка
              : @out[0];   # Возвращается много строк
}

Комментарий

У этой проблемы имеются различные решения, однако в большинстве случаев приведенный вариант является наиболее эффективным. Функция возвращает новые версии переданных строк, из которых удалены начальные и конечные пробелы. Функция работает как с отдельными строками, так и со списками.

Для удаления последнего символа из строки воспользуйтесь функцией chop. Будьте внимательны и не перепутайте ее с похожей функцией chomp, которая удаляет последнюю часть строки в том и только в том случае, если она содержится в переменной $/ (по умолчанию - "\n"). Чаще всего она применяется для удаления завершающего символа перевода строки из введенного текста:


# Вывести полученный текст заключенным в ><
while() {
    chomp;
    print ">$_<\n";
}

Функцию можно усовершенствовать несколькими способами.

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

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


s/\s+/ /g;            # Свертка внутренних пропусков

Строка вида " but\t\tnot here\n" превращается в "but not here". Три последовательных подстановки


s/^\s+//;
s/\s+$//;
s/\s+/ /g;

эффективнее заменить командой


$_ = join(' ', split(' '));

Если функция вызывается вообще без аргументов, можно последовать примеру chop и chomp и по умолчанию использовать $_. После всех перечисленных усовершенствований мы получаем следующую функцию:


# 1. Отсечение начальных и конечных пропусков
# 2. Свертка внутренних пропусков в одиночные пробелы
# 3. При отсутствии аргументов входные данные берутся из $_
# 4. При возвращении в скалярном контексте
#    список объединяется в скаляр с промежуточными пробелами.
sub trim {
    my @out = @_ ? @_ : $_;
    $_ = join(' ', split(' ')) for @out;
    return wantarray ? @out : "@out";
}

См. также

Описание оператора s/// в perlre(1) и perlop(1); описание функций chop и chomp в perlfunc(1). Начальные пропуски удаляются в функции getnum из рецепта 2.1.

1.20. Анализ данных, разделенных запятыми

Проблема

Имеется файл данных, поля которого разделены запятыми. Требуется прочитать данные из файла. Однако в полях могут присутствовать свои запятые (находящиеся внутри строк или экранированные). Во многих электронных таблицах и СУБД списки полей, разделенных запятыми, поддерживаются в качестве стандартного формата для импорта/экспорта данных.

Решение

Если содержимое файла данных соответствует стандартным правилам экранирования Unix (то есть внутренние кавычки в полях экранируются обратной косой чертой: "like \"this\"", воспользуйтесь стандартным модулем Text::ParseWords и простой программой:


use Text::ParseWords;
sub parse_csv0 {
    return quotewords("," => 0, $_[0]);
}

Если кавычки в полях экранируются удваиванием ("like ""this"""), можно воспользоваться стандартной процедурой из книги Джеффри Фридла "Регулярные выражения: Библиотека программиста, 2 издание" (издательство "Питер", 2003 г.):


sub parse_csv1 {
    my $text = shift; # Запись со значениями, разделенными запятыми
    my @fields = ( );
    while ($text =~ m{
        # Произвольная последовательность символов, кроме запятых и кавычек:
         ( [^"',] + )
        # ...или...
          |
        # ... поле в кавычках (внутри поля разрешаются удвоенные кавычки)

         " # Открывающая кавычка поля (не сохраняем)
          ( # Теперь поле содержит либо
           (?: [^"] # символы, отличные от кавычек, либо
             |
               "" # смежные кавычки
            ) * # Повторяется сколько угодно раз
          )
         " # Закрывающая кавычка поля (не сохраняем)

      }gx)
      {
        if (defined $1) {
            $field = $1;
        } else {
            ($field = $2) =~ s/""/"/g;
        }
        push @fields, $field;
      }
      return @fields;
}

Также можно воспользоваться модулем CPAN Text::CSV:


use Text::CSV;
sub parse_csv1 {
    my $line = shift;
    my $csv = Text::CSV->new( );
    return $csv->parse($line) && $csv->fields( );
}

Или модулем CPAN Tie::CSV_File:


tie @data, "Tie::CSV_File", "data.csv";

for ($i = 0; $i < @data; $i++) {
    printf "Row %d (Line %d) is %s\n", $i, $i+1, "@";
    for ($j = 0; $j < @; $j++) {
        print "Column $j is <$data[$i][$j]>\n";
    }
}

Комментарий

Ввод данных, разделенных запятыми, - коварная и непростая задача. На первый взгляд все просто, но в действительности приходится учитывать довольно сложные возможности экранирования, поскольку сами поля могут содержать внутренние запятые. В результате поиск по шаблону получается весьма сложным, а о простом вызове функции split /,/ лучше и не думать. Что еще хуже, в файлах стандарта Unix и в устаревших системах используются разные правила экранирования. Из-за этого разработать единый алгоритм для всех файлов данных CSV оказывается невозможно.

Стандартный модуль Text::ParseWords предназначен для обработки данных по стандартам, используемым в большинстве файлов данных Unix. Благодаря этому он чрезвычайно удобен для разбора всевозможных системных файлов Unix, в которых поля разделяются двоеточиями - disktab(5), gettytab(5), printcap(5) и termcap(5). Функции quotewords этого модуля передаются два аргумента и строка разделенных данных. Первый аргумент определяет символ-разделитель (в нашем случае запятая, но часто используется двоеточие), а второй - логический флаг, который показывает, должны ли строки возвращаться вместе с кавычками, в которые они заключены.

В таких файлах данных кавычки внутри полей экранируются обратной косой чертой: "like \"this\". Кавычки, апострофы и обратная косая черта - единственные символы, для которых этот префикс имеет специальное значение. Все остальные экземпляры \ остаются в итоговой строке. Для работы с такими данными достаточно функции quotewords стандартного модуля Text::ParseWords.

Однако это решение не подходит для файлов данных из устаревших систем, в которых внутренние кавычки экранируются удваиванием: "like ""this""". В таких случаях приходится прибегать к другим решениям. Первое из них основано на регулярном выражении, приведенном во втором издании книги Джеффри Фридла "Регулярные выражения: Библиотека программиста". Его преимуществом следует считать то, что решение работает в любой системе без установки дополнительных модулей, не входящих в стандартную поставку. Фактически оно вообще не требует никаких модулей. Тем не менее, несмотря на обилие комментариев это решение вызывает легкий шок у неподготовленного читателя.

Объектно-ориентированный модуль CPAN Text::CSV, задействованный в следующем решении, скрывает сложности разбора в более удобных "обертках". Модуль Tie::CSV из CPAN предлагает еще более элегантное решение: вы работаете с объектом, похожим на двумерный массив. Первый индекс представляет строки файла, а второй - его столбцы.

Рассмотрим примеры практического использования наших функций parse_csv. Здесь q() - всего лишь хитроумный заменитель кавычек, чтобы нам не приходилось расставлять повсюду символы \.


$line = q(XYZZY,"","O'Reilly, Inc","Wall, Larry","a \"glug\" bit,",5,"Error, Core Dumped");
@fields = parse_csv0($line);
for ($i = 0;$i < @fields; $i++) {
    print "$i : $fields[$i]\n";
}
0 : XYZZY
1 :
2 : O'Reilly, Inc
3 : Wall, Larry
4 : a "glug" bit,
5 : 5
6 : Error, Core Dumped

Если бы второй аргумент quotewords был равен 1 вместо 0, то кавычки были бы сохранены, а результат принял бы следующий вид:


0 : XYZZY
1 : ""
2 : "O'Reilly, Inc"
3 : "Wall, Larry"
4 : "a \"glug\" bit,"
5 : 5
6 : "Error, Core Dumped"

Другая разновидность файлов данных обрабатывается точно так же, но вместо parse_csv0 используется parse_csv1. Обратите внимание на удвоение кавычек вместо экранирования префиксом:


$line = q(Ten Thousand,10000, 2710 ,,"10,000",
"It's ""10 Grand"", baby",10K);
@fields = parse_csv1($line);
for ($i = 0; $i < @fields; $i++) {
    print "$i : $fields[$i]\n";
}
0 : Ten Thousand
1 : 10000
2 : 2710
3 :
4 : 10,000
5 : It's "10 Grand", baby
6 : 10K

См. также

Описание синтаксиса регулярных выражений в perlre(1); документация по стандартному модулю Text::ParseWords; раздел "Разбор данных, разделенных запятыми" главы 5 книги "Регулярные выражения: Библиотека программиста, 2 издание".

1.21. Константы

Проблема

Требуется создать переменную, значение которой не может изменяться после первоначального присваивания.

Решение

Если величина не обязана быть скалярной переменной, которая может интерполироваться, можно обойтись директивой use constant:


use constant AVOGADRO => 6.02252e23;

printf "You need %g of those for guac\n", AVOGADRO;

Если нужна именно переменная, присвойте тип-глобу ссылку на литеральную строку или число, а затем используйте скалярную переменную:


*AVOGADRO = \6.02252e23;
print "You need $AVOGADRO of those for guac\n";

Но самый надежный способ основан на использовании маленького класса tie с выдачей исключения в методе STORE:


package Tie::Constvar;
use Carp;
sub TIESCALAR {
    my ($class, $initval) = @_;
    my $var = $initval;
    return bless \$var => $class;
}
sub FETCH {
    my $selfref = shift;
    return $$selfref;
}
sub STORE {
    confess "Meddle not with the constants of the universe";
}

Комментарий

Проще всего воспользоваться директивой use constant, но у нее есть ряд недостатков, самый большой из которых - то, что она не создает нормальной переменной, которая бы интерполировалась в строках, заключенных в кавычки. Другой недостаток - отсутствие области видимости; директива включает процедуру с заданным именем в пространство имен пакета.

В действительности директива use constant создает процедуру с заданным именем, которая вызывается без аргументов и всегда возвращает одно и то же значение (или несколько значений в виде списка). Это означает, что процедура входит в пространство имен текущего пакета и не ограничивается по области видимости. Такую же процедуру можно самостоятельно определить в программе:


sub AVOGADRO() { 6.02252e23 }

Чтобы область видимости константы ограничивалась текущим блоком, можно создать временную процедуру, для чего анонимная процедура присваивается тип-глобу с нужным именем:


use subs qw(AVOGADRO);
local *AVOGADRO = sub () { 6.0225e23 };

Надо признать, такие фокусы выглядят довольно загадочно. Если вы отказываетесь от использования директивы, прокомментируйте свой код.

Если вместо ссылки на процедуру присвоить тип-глобу ссылку на констатный скаляр, то вы сможете использовать переменную с соответствующим именем. На этом основан второй прием, приведенный в Решении. У него есть свои недостатки: тип-глобы доступны только для пакетных переменных, но не для лексических, созданных с ключевым словом my. Под действием рекомендуемой директивы use strict с необъявленными пакетными переменными возникнут проблемы, но переменную можно объявить при помощи our:


our $AVOGADRO;
local *AVOGADRO = \6.02252e23;

Третье решение - с созданием маленького класса tie - может показаться самым запутанным, но оно обеспечивает наибольшую гибкость. Кроме того, при желании константу можно объявить как лексическую переменную:


tie my $AVOGARO, Tie::Constvar, 6.02252e23;

После этого можно спокойно использовать конструкции вида


print "You need $AVOGADRO of those for guac\n";

Любые попытки модификации константы будут отвергнуты:


$AVOGADRO = 6.6256e-34;   # Ничего не выйдет

См. также

Рецепты 1.15 и 5.3; некоторые идеи также можно почерпнуть из модуля CPAN Tie::Scalar::RestrictUpdates.

1.22. Сравнение слов с похожим звучанием

Проблема

Имеются две английских фамилии. Требуется узнать, звучат ли они похожим образом (независимо от написания). Это позволит выполнять "неформальный поиск" в телефонной книге, в результатах которого наряду со Smith будут присутствовать и другие похожие имена - например, Smythe, Smite и Smote.

Решение

Воспользуйтесь стандартным модулем Text::Soundex:


use Text::Soundex;
$CODE = soundex($STRING);
@CODES = soundex(@LIST);

Также можно воспользоваться модулем CPAN Text::Metaphone:


use Text::Metaphone;
$phoned_words = Metaphone('Schwern');

Комментарий

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

Следующая программа предлагает ввести имя и ищет в файле паролей имена с похожим звучанием. Аналогичный подход может использоваться для баз данных имен, поэтому при желании можно индексировать базу данных по ключам Soundex. Конечно, такой индекс не будет уникальным.


use Text::Soundex;
use User::pwent;
print "Lookup user: ";
chomp($user = );
exit unless defined $user;
$name_code = soundex($user);

while($uent = getpwent()) {
    ($firstname, $lastname) = $uent->gecos =~ /(\w+)[^,]*\b(\w+)/;

    if ($name_code eq soundex($uent->name) ||
        $name_code eq soundex($lastname)   ||
        $name_code eq soundex($firstname)  )
    {
        printf "%s: %s %s\n", $uent->name, $firstname, $lastname;
    }
}

Модуль Text::Metaphone из архива CPAN решает ту же задачу другим, более разумным способом. Функция soundex возвращает код из буквы и трех цифр для начала входной строки, а функция Metaphone возвращает код в виде последовательности букв переменной длины. Пример:

	soundex	metaphone
Christiansen	C623	KRSXNSN
Kris Jenson	K625	KRSJNSN

Kyrie Eleison	K642	KRLSN
Curious Liaison	C624	KRSLSN

Чтобы в полной мере реализовать возможности Metaphone, следует также воспользоваться модулем String::Approx из CPAN, более подробно описанным в рецепте 6.13. Этот модуль позволяет найти успешное совпадение даже при наличии отдельных ошибок в строках. Количество изменений, необходимых для перехода от одной строки к другой, называется расстоянием между этими строками. Следующая команда проверяет совпадение строк, разделенных расстоянием 2 и менее:

if (amatch("string1", [2], "string2") { }

Также присутствует функция adist, которая возвращает расстояние между строками. Например, расстояние между "Kris Jenson" и "Christiansen" равно 6, тогда как расстояние между их кодами Metaphone равно всего 1. Расстояние между компонентами другой пары в исходном варианте равно 8, а при сравнении кодов Metaphone оно снова уменьшается до 1:


use Text::Metaphone qw(Metaphone);
use String::Approx qw(amatch);

if (amatch(Metaphone($s1), [1], Metaphone($s1)) {
    print "Close enough!\n";
}

Этот фрагмент найдет успешные совпадения для обеих пар из рассмотренного примера.

См. также

Документация по стандартным модулям Text::Soundex и User::pwent; модули CPAN Text::Metaphone и String::Approx; страница руководства passwd(5) вашей системы; том 3, глава 6 "Искусства программирования".

1.23. Программа: fixstyle

Представьте себе таблицу с парами устаревших и новых слов: bonnet
Старые слова Новые слова
Hood

rubber Eraser

lorry Truck

trousers Pants

Программа из примера 1.4 представляет собой фильтр, который заменяет все встречающиеся в тексте слова из первого столбца соответствующими элементами второго столбца.

При вызове без файловых аргументов программа выполняет функции простого фильтра. Если в командной строке передаются имена файлов, то программа записывает в них изменения, а прежние версии сохраняются в файлах с расширениями *.orig (см. рецепт 7.16). При наличии параметра командной строки -v сообщения обо всех изменениях записываются в STDERR.

Таблица пар "исходное слово/заменитель" хранится в основной программе, начиная с маркера __END__ (см. рецепт 7.12). Пары преобразуются в подстановки (с экранированием символов) и накапливается в переменной $code так же, как это делается в программе popgrep2 из рецепта 6.10.

Параметр -t выводит сообщение об ожидании ввода с клавиатуры при отсутствии других аргументов. Если пользователь забыл ввести имя файла, он сразу поймет, чего ожидает программа.


Пример 1.4. fixstyle
#!/usr/bin/perl -w
# fixstyle - замена строк секции  парными строками
# использование: $0 [-v] [файлы...]
use strict;
my $verbose = (@ARGV && $ARGV[0] eq '-v' && shift);
if (@ARGV) {
    $^I = ".orig";         # Сохранить старые файлы
} else {
    warn "$0: Reading from stdin\n" if -t STDIN;
}
my $code = "while (<>) {\n";
# Читать данные и строить код для eval
while () {
    chomp;
    my ($in, $out) = split /\s*=>\s*/;
    next unless $in && $out;
    $code .= "sg";
    $code .= "&& printf STDERR qq($in => $out at \$ARGV line \$.\\n)"
                                                        if $verbose;
    $code .= ";\n";
}
$code .= "print;\n}\n";
eval "{ $code } 1" || die;
__END__
analysed       => analyzed
built-in       => builtin
chastized      => chastised
commandline    => command-line
de-allocate    => deallocate
dropin         => drop-in
hardcode       => hard-code
meta-data      => metadata
multicharacter => multi-character
multiway       => multi-way
non-empty      => nonempty
non-profit     => nonprofit
non-trappable  => nontrappable
pre-define     => predefine
preextend      => pre-extend
re-compiling   => recompiling
reenter        => re-enter
turnkey        => turn-key

Небольшое предупреждение: программа работает быстро, но не в тех случаях, когда количество замен измеряется сотнями. Чем больше секция DATA, тем больше времени потребуется. Несколько десятков замен не вызовут существенного замедления. Более того, для малого количества замен эта версия работает быстрее следующей. Но если запустить программу с несколькими сотнями замен, она начнет заметно отставать.

В примере 1.5 приведена другая версия программы. При малом количестве замен она работает медленнее, а при большом - быстрее.


Пример 1.5. fixstyle2
#!/usr/bin/perl -w
# fixstyle2 = аналог fixstyle для большого количества замен
use strict;
my $verbose = (@ARGV && $ARGV[0] eq '-v' && shift);
my %change = ();
while () {
    chomp;
    my ($in, $out) = split /\s*=>\s*/;
    next unless $in && $out;
    $change = $out;
}
if (@ARGV) {
    $^I = ".orig";
} else {
    warn "$0: Reading from stdin\n" if -t STDIN;
}
while (<>) {
    my $i =0;
    s/^(\s+)// && print $1;    # Выдать начальный пропуск
    for (split /(\s+)/, $_, -1) {   # Сохранить конечные пропуски
        print( ($i++ & 1) ? $_ : ($change || $_));
    }
}
_ _END_ _
analysed       => analyzed
built-in       => builtin
chastized      => chastised
commandline    => command-line
de-allocate    => deallocate
dropin         => drop-in
hardcode       => hard-code
meta-data      => metadata
multicharacter => multi-character
multiway       => multi-way
non-empty      => nonempty
non-profit     => nonprofit
non-trappable  => nontrappable
pre-define     => predefine
preextend      => pre-extend
re-compiling   => recompiling
reenter        => re-enter
turnkey        => turn-key

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

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


# Работает очень быстро, но со сверткой пропусков
while (<>) {
    for (split) {
        print $change || $_, " ";
    }
    print "\n";
}

В конце каждой строки появляется лишний пробел. Если это нежелательно, воспользуйтесь методикой рецепта 16.5 и создайте выходной фильтр. Вставьте следующий фрагмент перед циклом while, сжимающим пропуски:


my $pid = open(STDOUT, "|=");
die "cannot fork: $!" unless defined $pid;
unless ($pid) {
        while () {
        s/ $//;
        print;
    }
    exit;
}

1.24. Программа: psgrep

Многие программы (в том числе ps, netstat, ls -l, find -ls и tcpdump) часто выдают большие объемы данных. Файлы журналов тоже быстро увеличиваются в размерах, что затрудняет их просмотр. Такие данные можно обработать программой-фильтром типа grep и отобрать из них лишь часть строк, однако регулярные выражения плохо согласуются со сложной логикой - достаточно взглянуть на ухищрения, на которые приходится пускаться в рецепте 6.18.

На самом деле нам хотелось бы иметь возможность обращаться с полноценными запросами к выводу программы или файлу журнала. Допустим, вы спрашиваете у ps: "Покажи мне все непривилегированные процессы размером больше 10 Кбайт" или "Какие команды работают на псевдоконсолях?"

Программа psgrep умеет делать все это - и бесконечно большее, потому что в ней критерии отбора не являются регулярными выражениями; они состоят из полноценного кода Perl. Каждый критерий последовательно применяется к каждой строке вывода. В результате выводятся лишь те данные, которые удовлетворяют всем аргументам. Ниже приведены примеры критериев поиска и соответствующие им командные строки:

Строки со словами, заканчивающимися на sh:

% psgrep '/sh\b/'

Процессы с именами команд, заканчивающимися на sh:

% psgrep 'command =~ /sh$/'

Процессы с идентификатором пользователя, меньшим 10:

% psgrep 'uid < 10'

Интерпретаторы с активными консолями:

% psgrep 'command =~ '/^-/' 'tty ne "?"'

Процессы, запущенные на псевдоконсолях:

% psgrep 'tty =~ /^[p-t]'

Отсоединенные непривилегированные процессы:

% psgrep 'uid && tty eq "?"'

Большие непривилегированные процессы:

% psgrep 'size > 10 * 2**10' 'uid != 0'

Ниже показаны данные, полученные при последнем вызове psgrep на нашем компьютере. Как и следовало ожидать, в них попал только netscape и его вспомогательный процесс:

FLAGS	UID	PID	PPID	PRI	NI	SIZE	RSS	WCHAN	STA	TTY	TIME	COMMAND
0	101	9751	1	0	0	14932	9652	do_select	S	p1	0:25	netscape
100000	101	9752	9751	0	0	10636	812	do_select	S	p1	0:00	(dns helper)

В примере 1.6 приведен исходный текст программы psgrep.


Пример 1.6. psgrep
#!/usr/bin/perl -w
# psgrep - фильтрация выходных данных ps 
#          с компиляцией пользовательских запросов в программный код
#
use strict;
# Все поля из заголовка PS
my @fieldnames = qw(FLAGS UID PID PPID PRI NICE SIZE
                    RSS WCHAN STAT TTY TIME COMMAND);
# Определение формата распаковки (в примере
# жестко закодирован формат ps для Linux)
my $fmt = cut2fmt(8, 14, 20, 26, 30, 34, 41, 47, 59, 63, 67, 72);
my %fields;           # Для хранения данных
die << Thanatos unless @ARGV;
usage: $0 criterion ...
    Each criterion is a Perl expression involving:
    @fieldnames
    All criteria must be met for a line to be printed.
Thanatos
# Создать синонимы для uid, size, UID, SIZE и т.д.
# Пустые скобки необходимы для создания прототипа без аргументов
for my $name (@fieldnames) {
    no strict 'refs';
    *name = *{lc $name} = sub () { $fields };
}
my $code = "sub is_desirable { " . join(" and ", @ARGV) . " } ";
unless (eval $code.1) {
    die "Error in code: $@\n\t$code\n";
}
open (PS, "ps wwaxl |")             || die "cannot fork: $!";
print scalar ;          # Строка-заголовок
while ( {
    @fields = trim(unpack($fmt, $_));
    print if is_desirable();        # Строки, удовлетворяющие критериям
}
close(PS)                           || die "ps failed!";

# Преобразовать позиции разреза в формат распаковки
sub cut2fmt {
    my(@positions) = @_;
    my $template   = '';
    my $lastpos    = 1;
    foreach $place(positions) {
        $template .= "A" . ($place - $lastpos) . " ";
        $lastpos   = $place;
    }
    $template .= "A*";
    return $template;
}
sub trim {
    my @strings = @_;
    for (@strings) {
        s/^\s+//;
        s/\s+$//;
    }
    return wantarray ? @strings : $strings[0];
}
# Следующий шаблон использовался для определения позиций разреза.
# Далее следует пример входных данных
#123456789012345678901234567890123456789012345678901234567890123456789012345
#         1         2         3         4         5         6         7
# Позиции:
#       8     14    20    26  30  34     41    47          59  63  67   72
#       |     |     |     |   |   |      |     |           |   |   |    |
_ _END_ _
 FLAGS   UID   PID  PPID PRI  NI   SIZE   RSS WCHAN       STA TTY TIME COMMAND
   100     0     1     0   0   0    760   432 do_select   S   ?   0:02 init
   140     0   187     1   0   0    784   452 do_select   S   ?   0:02 syslogd
100100   101   428     1   0   0   1436   944 do_exit     S    1  0:00 /bin/login
100140    99 30217   402   0   0   1552  1008 posix_lock  S   ?   0:00 httpd
     0   101   593   428   0   0   1780  1260 copy_thread S    1  0:00 -tcsh
100000   101 30639  9562  17   0    924   496             R   p1  0:00 ps axl
     0   101 25145  9563   0   0   2964  2360 idetape_rea S   p2  0:06 trn
100100     0 10116  9564   0   0   1412   928 setup_frame T   p3  0:00 ssh -C www
100100     0 26560 26554   0   0   1076   572 setup_frame T   p2  0:00 less
100000   101 19058  9562   0   0   1396   900 setup_frame T   p1  0:02 nvi /tmp/a

В программе psgrep объединены многие приемы, представленные в книге. Об удалении начальных и конечных пропусков рассказано в рецепте 1.19. Преобразование позиций разреза в формат unpack для извлечения полей с фиксированным положением рассматривается в рецепте 1.1. Поиску по регулярным выражениям посвящена вся глава 6.

Многострочный текст, передаваемый die, представляет собой встроенный документ (см. рецепты 1.15 и 1.16). Присваивание @fields заносит сразу несколько величин в хэш %fields. Срезы хэшей рассматриваются в рецептах 4.8 и 5.11.

Входные данные программы-примера, расположенные под __END__, описаны в рецепте 7.12. На стадии разработки для тестирования использовались "консервированные" данные, полученные через файловый манипулятор DATA. Когда программа заработала, мы перевели ее на получение данных из присоединенной команды ps, однако исходные данные были оставлены для будущего переноса на другие платформы и сопровождения. Конвейерный запуск других программ рассматривается в главе 16 "Управление процессами и межпроцессные взаимодействия" более подробно в рецептах 16.10 и 16.13.

Настоящая сила и выразительность psgrep обусловлена тем, что в Perl строковые аргументы могут представлять собой не просто строки, а программный код Perl. Похожий прием использован в рецепте 9.9, за исключением того, что в psgrep аргументы пользователя "упакованы" в процедуру is_desirable. При этом строки компилируются в код Perl всего один раз - еще перед запуском той программы, чей вывод мы обрабатываем. Например, при запросе UID ниже 10 будет сгенерирована следующая строка:

eval "sub is_desirable { uid < 10 } " . 1;

Загадочное .1 в конце присутствует для того, чтобы при компиляции пользовательского кода команда eval возвращала истинное значение. В этом случае нам даже не придется проверять $@ на предмет ошибок компиляции, как это делается в рецепте 10.12.

Использование произвольного кода Perl в фильтрах для отбора записей - невероятно мощная возможность, но она не является абсолютно оригинальной. Perl многим обязан языку программирования awk, который часто применялся для подобной фильтрации. Один из недостатков awk заключался в том, что он не мог легко интерпретировать входные данные в виде полей фиксированной длины (вместо полей, разделенных особыми символами). Другой недостаток - отсутствие мнемонических имен полей; в awk использовались имена $1, $2 и т. д. К тому же Perl может делать многое из того, на что не способен awk.

Пользовательские критерии даже не обязаны быть простыми выражениями. Например, следующий вызов инициализирует переменную $id номером пользователя nobody и затем использует ее в выражении:


% psgrep 'no strict "vars";
         BEGIN { $id = getpwnam("nobody") }
         uid == $id '

Но как использовать слова uid, command и size, даже не снабжая их символом $ для представления соответствующих полей входных записей? Мы напрямую манипулируем с таблицей символических имен, присваивая замыкания (closures) неявным тип-глобам (typeglobs), которые создают функции с соответствующими именами. Имена функций создаются с использованием записи, как в верхнем, так и в нижнем регистре, что позволяет использовать как "UID < 10", так и "uid > 10". Замыкания описаны в рецепте 11.4, а их присвоение тип-глобам для создания синонимов функций - в рецепте 10.14.

Однако в psgrep встречается нюанс, отсутствующий в этих рецептах, - речь идет о пустых скобках в замыкании. Благодаря скобкам функция может использоваться в выражениях везде, где допускается отдельная величина (например, строка или числовая константа). В результате создается пустой прототип, а функция обращения к полю (например, uid) вызывается без аргументов, по аналогии со встроенной функцией time. Если не создать для функций прототипы с пустыми списками аргументов, выражения "uid < 10" или "size/2 > rss" приведут в замешательство лексический анализатор - он увидит в них незаконченный глоб (wildcard glob) или шаблон поиска соответственно. Прототипы рассматриваются в рецепте 10.11.

Показанная версия psgrep получает входные данные от команды ps в формате Red Hat Linux. Чтобы адаптировать ее для другой системы, посмотрите, в каких столбцах начинаются заголовки. Такой подход не ограничивается спецификой ps или системы Unix. Это общая методика фильтрации входных записей с использованием выражений Perl, которая легко адаптируется для другой структуры записи. Поля могут быть выстроены в столбцы, разделены запятыми или быть получены в результате поиска по шаблону с применением сохраняющих круглых скобок.

После небольшого изменения в функциях отбора программа даже подойдет для работы с пользовательской базой данных. Если у вас имеется массив записей (см. рецепт 11.9), пользователь может указать произвольный критерий отбора:


sub id()       { $_->   }
sub title()    { $_-> }
sub executive  { title =~/(?:vice-)?president/i }

# Критерии отбора указываются при вызове grep
@slowburners = grep { id < 10 && !executive } @employees;

По причинам, связанным с безопасностью и быстродействием, такой подход редко встречается в реальных механизмах, описанных в главе 14 "Доступ к базам данных". В частности, он не поддерживается в SQL, но, имея в своем распоряжении Perl и некоторую долю изобретательности, нетрудно создать свой собственный вариант.

Если вас заинтересовал данный материал, заказать книгу полностью вы можете в Издательском доме "Питер"

	Библиотека Интернет Индустрии I2R.ru	Малобюджетные сайты... Продвижение веб-сайта... Контент и авторское право...
Забобрить! Блог		Поиск:	Рассылки для занятых...»

Библиотека Интернет Индустрии I2R.ru

Perl. Сборник рецептов для профессионалов. Строки

темы материала:

Поддержка Юникода в Perl