Приглашаем посетить
6.17. Логические AND, OR и NOT в одном шаблоне
Проблема
Имеется готовая программа, которой в качестве аргумента или входных данных передается шаблон. В нее невозможно включить дополнительную логику -например, параметры для управления учетом регистра при поиске, AND и NOT. Следовательно, вы должны написать один шаблон, который будет совпадать с любым из двух разных шаблонов (OR), двумя шаблонами сразу (AND) или менять смысл поиска на противоположный (NOT).
Подобная задача часто возникает при получении данных из конфигурационных файлов, Web-форм или аргументов командной строки. Пусть у вас имеется программа, в которой присутствует следующий фрагмент:
chomp($pattern = );' if ( $data =~ /$pattern/ ){...}
Если вы отвечаете за содержимое CONFIG_FH, вам понадобятся средства для передачи программе поиска логических условий через один-единственный шаблон.
Решение
Выражение истинно при совпадении /ALPHA/ или /BETA/ (аналогично /ALPHA/ || / BETA/):
/ALPHA[BETA/
Выражение истинно, если и /ALPHA/, и /BETA/ совпадают при разрешенных перекрытиях (то есть когда подходит строка "BETALPHA"). Аналогично /ALPHA/ && / BETA/:
/"(?=*ALPHA)(?=.*BETA)/s
Выражение истинно, если и /ALPHA/, и /BETA/ совпадают при запрещенных перекрытиях (то есть когда "BETALPHA" не подходит):
/ALPHA,*BETA|BETA.*ALPHA/s Выражение истинно, если шаблон /PAT/ не совпадает (аналогично
$var ! ~ /PAT/):
/"('?:(?! PAT), )"$/s Выражение истинно, если шаблон BAD не совпадает, а шаблон GOOD -
совпадает:
/(?="(?:(?!BAD),)*$)GOOD/s
Комментарий
Предположим, вы пишете программу и хотите проверить некоторый шаблон на несовпадение. Воспользуйтесь одним из вариантов:
if (!($string =~ /pattern/)) {somethingO } # Некрасиво
if ( $string !~ /pattern/) {somethingO } # Рекомендуется
Если потребовалось убедиться в совпадении обоих шаблонов, примените следующую запись:
if ($string =~ /pat1/ && $string =~ /pat2/ ) { something() } Проверка совпадения хотя бы одного из двух шаблонов выполняется так:
if ($string =~ /pat1/ | $string =~ /pat2/ ) { something() }
Короче говоря, нормальные логические связки Perl позволяют комбинировать логические выражения вместо того, чтобы объединять их в одном шаблоне. Но давайте рассмотрим программу minigrep из примера 6.12, которая в качестве аргумента получает всего один шаблон.
Пример 6.12. minigrep
#!/usr/bin/perl
# minigrep - тривиальный поиск
$pat = shift;
while (<>) {
print if /$pat/o;
}
Если потребуется сообщить minigrep, что некоторый шаблон не должен совпадать или что должны совпасть оба мини-шаблона в произвольном порядке, вы оказываетесь в тупике. Программа просто не предусматривает подобных конструкций. Как сделать все в одном шаблоне? Другими словами, вы хотите выполнить программу minigrep с параметром PAT, который не совпадает или содержит несколько логически связанных шаблонов. Такая задача нередко возникает в программах, читающих шаблоны из конфигурационных файлов.
Проблема с OR решается просто благодаря символу альтернативного выбора |. Однако AND и OR потребуют особого кодирования.
В случае с AND придется различать перекрывающиеся и неперекрывающиеся совпадения. Допустим, вы хотите узнать, совпадают ли в некоторой строке шаблоны "bell" и "lab". Если разрешить перекрытия, слово "labelled" пройдет проверку, а если отказаться от перекрытий - пет. Случай с перекрытиями потребует двух опережающих проверок:
"labelled" =~ /"(^=.*bell)(^=.*lab)/s
Помните: в нормальной программе подобные извращения не нужны. Достаточно сказать:
. $string =~ /bell/ && $stnng =~ /lab/
Мы воспользуемся модификатором /х с комментариями. Развернутая версия шаблона выглядит так:
if ($murray_hill =~ m{ # Начало строки
(?= : # Опережающая проверка нулевой ширины
. * # Любое количество промежуточных символов
bell # Искомая строка bell
) # Вернуться, мы лишь проверяем
(?= # Повторить
. * # Любое количество промежуточных символов
lab # Искомая строка labs )
}sx ) # /s разрешает совпадение . с переводом строки
{
print "Looks like Bell Labs might be in Murray Hill!\n";
}
Мы не воспользовались . *? для раннего завершения поиска, поскольку минимальный поиск обходится дороже максимального. Поэтому для произвольных входных данных, где совпадение с равной вероятностью может произойти как в начале, так и в конце строки, . * будет эффективнее нашего решения. Разумеется, выбор между . * и . *? иногда определяется правильностью программы, а не эффективностью, но не в данном случае.
Для обработки перекрывающихся совпадений шаблон будет состоять из двух частей, разделенных OR. В первой части "lab" следует после "bell", а во второй -наоборот:
"labelled" =~ /(?:".*bell.*lab)|(?:".*lab.*bell)/ или в развернутой форме:
$brand = "labelled";
if ($brand =~ m{
(?: # Группировка без сохранения
".*? # Любое количество начальных символов
bell # Искомая строка bell
.*? # Любое количество промежуточных символов
lab # Искомая строка
lab ) # Конец группировки
| # Или попробовать другой порядок
(?: # Группировка без сохранения
".*? # Любое количество начальных символов
lab # Искомая строка
lab .*? # Любое количество промежуточных символов
bell # Искомая строка
bell ) # Конец группировки
}sx ) # /s разрешает совпадение . с переводом строки
{
print "Our brand has bell and lab separate.\n";
}
Такие шаблоны не всегда работают быстрее. $murray_h ill =~ /bell/ && $murray_ hille =~/lab/ сканирует строку не более двух раз, однако для (?=", *?Ье11 )(?=". *?lab) механизм поиска ищет "lab" для каждого экземпляра "bell", что в наихудшем случае приводит к квадратичному времени выполнения.
Тем, кто внимательно рассмотрел эти два случае, шаблон NOT покажется тривиальным. Обобщенная форма выглядит так:
$map =~ /~(?:(?!waldo).)*$/s
То же в развернутой форме:
if ($map =~ m{
# Начало строки
(?: # Группировка без сохранения
(?! # Опережающая отрицательная проверка
waldo # Нашли впереди?
) # Если да, отрицание не выполняется
# Любой символ (благодаря /s)
) * # Повторить группировку 0 и более раз
$ # До конца строки
}sx ) # /s разрешает совпадение . с переводом строки {
print "There's no waldo here!\n";
Как объединить в одном шаблоне AND, OR и NOT? Результат выглядит отвратительно, и в обычных программах делать нечто подобное практически никогда не следует. Однако при обработке конфигурационных файлов или командных строк, где вводится всего один шаблон, у вас нет выбора. Объедините все изложенное выше. Будьте осторожны.
Предположим, вы хотите запустить программу UNIX w и узнать, зарегистрировался ли пользователь tchrist с любого терминала, имя которого начинается не с ttyp; иначе говоря, шаблон "tchrist" должен совпадать, a "ttyp" - нет.
Примерный вывод w в моей системе Linux выглядит так:
7:15am up 206 days, 13:30,
4 users, load average: 1.04, 1.07, 1.04 USER TTY FROM LOGIN@ IDLE JCPU PCPU WHAT tchrist tty1
5:16pm 36days 24:43 0.03s xinit
tchrist tty2
5:19pm 6days 0,43s 0.43s -tcsh tchrist ttypO chthon 7:58ani 3days 23:44s 0.44s -tcsh gnat ttys4 coprolith 2:01pm 13:36m 0,30s 0,30s -tcsh
Посмотрим, как поставленная задача решается с помощью приведенной выше программы minigrep или программы tcgrep, приведенной в конце главы:
%w | minigrep '"(?!.*ttyp).*tchrist' Расшифруем структуру шаблона:
m {
# Привязка к началу строки
(?! # Опережающая проверка нулевой ширины
.* # Любое количество любых символов (быстрее .*?)
ttyp # Строка, которая не должна находиться
) # Опережающая отрицательная проверка; возврат к началу
.* # # Любое количество любых символов (быстрее ."?)
tchrist # Пытаемся найти пользователя tchrist
}х
Неважно, что любой нормальный человек в такой ситуации дважды вызывает дгер (из них один - с параметром -v, чтобы отобрать несовпадения):
% w | grep tchrist | grер -v ttyp
Главное - что логические конъюнкции и отрицания можно закодировать в одном шаблоне. Однако подобные вещи следует снабжать комментариями - пожалейте тех, кто займется ими после вас.
Как внедрить модификатор /s в шаблон, передаваемый программе из командной строки? По аналогии с /I, который в шаблоне превращается в (?1). Модифика-торы /s и /т также безболезненно внедряются в шаблоны в виде /(^s) или /(?т). Их даже можно группировать - например, /(?smi). Следующие две строки фактически эквивалентны:
% grep -i 'ШАБЛОН' ФАЙЛЫ % minigrep '(?1)ШАБЛОН' ФАЙЛЫ
Смотри также: Описание опережающих проверок в разделе "Regular Expressions" perlre(1);
man-страницы grep(1) и w(1) вашей системы. Работа с конфигурационными файлами рассматривается в рецепте 8.16.
Проблема
Требуется выполнить поиск регулярных выражений для строк с многобайтовой кодировкой символов.
Кодировка определяет соответствие между символами и их числовыми представлениями. В кодировке ASCII каждый символ соответствует ровно одному
байту, однако языки с иероглифической письменностью (китайский, японский и корейский) содержат так много символов, что в их кодировках символы приходится представлять несколькими байтами.
Perl исходит из предположения, что один байт соответствует одному символу. В ASCII все работает нормально, но поиск по шаблону в строках, содержащих многобайтовые символы, - задача по меньшей мере нетривиальная. Механизм поиска не понимает, где в последовательности байтов расположены границы символов, и может вернуть "совпадения" от середины одного символа до середины другого.
Решение
Воспользуйтесь кодировкой и преобразуйте шаблон в последовательность байтов, образующих многобайтовые символы. Основная мысль заключается в построении шаблона, который совпадает с одним (многобайтовым) символом кодировки, а затем применить этот шаблон "любого символа" в более сложных шаблонах.
Комментарий
В качестве примера мы рассмотрим одну из кодировок японского языка, EUC-JP, и разберемся, как воспользоваться ей для решения многих проблем, связанных с многобайтовыми символами. В EUC-JP можно представить тысячи символов, но в сущности эта кодировка является надмножеством ASCII. Байты с 0 по 127 (0х00 - Ox7F) почти точно совпадают с ASCII-аналогами и соответствуют однобайтовым символам. Некоторые символы представляются двумя байтами; первый байт равен Ох8Е, а второй принимает значения из интервала OxAO-OxDF. Другие символы представляются тремя байтами; первый байт равен 0х8 F, а остальные принадлежат интервалу OxAI-OxFE. Наконец, часть символов представляется двумя байтами, каждый из которых принадлежит интервалу OxAI-OxFE.
Исходя из этих данных, можно построить регулярное выражение. Для удобства последующего применения мы определим строку $eucjp с регулярным выражением, которое совпадает с одним символом кодировки EUC-JP:
my $eucjp = q{ # Компоненты кодировки euc-jp:
[\xOO-\x7F] # ASCII/JIS-Roman (один байт/символ)
| \x8E[\xAO-\xDF] # катакана половинной ширины (два байта/символ)
| \x8F[\xA1-xFE][\xA1-\xFE] # JIS Х 0212-1990 (три байта/символ)
| [\xA1-\xFE][\xA1-\xFE] # JIS X 0208:1997 (два байта/символ)
};
(строка содержит комментарии и пропуски, поэтому при ее использовании для поиска или замены необходимо указывать модификатор /х). Располагая этим шаблоном, мы расскажем, как:
o Выполнить обычный поиск без "ложных" совпадений.
o Подсчитать, преобразовать (в другую кодировку) и/или отфильтровать символы.
o Убедиться в том, что проверяемый текст содержит символы данной кодировки.
o Узнать, какая кодировка используется в некотором тексте.
Во-всех приведенных примерах используется кодировка EUC-JP, однако они будут работать и в большинстве других распространенных многобайтовых кодировок, встречающихся при обработке текстов - например, Unicode, Big-5 и т. д.
Страховка от ложных совпадений
Ложное совпадение происходит, когда найденное совпадение приходится на середину многобайтового представления одного символа. Чтобы избежать ложных совпадений, необходимо контролировать процесс поиска и следить, чтобы механизм поиска синхронизировался с границами символов.
Для этого можно связать шаблон с началом строки и вручную пропустить байты, для которых в текущей позиции не может произойти нормальное совпадение. В примере с EUC-JP за "пропуск символов" отвечает часть шаблона /(? : $eucjp)*?/. $eucjp совпадает с любым допустимым символом. Поскольку он применяется с минимальным квантификатором *?, совпадение возможно лишь в том случае, если не совпадает то, что идет после него (искомый текст). Рассмотрим реальный пример:
/" (?: $eucjp )*? \xC5\xEC\xB5\xFE/ox # Пытаемся найти Токио
В кодировке EUC-JP японское название Токио записывается двумя символами - первый кодируется двумя байтами \хС5\хЕС, а второй - двумя байтами \xB5\xFE. С точки зрения Perl мы имеем дело с обычной 4-байтовой последовательностью \xC5\xEC\xB5\xFE. Однако, поскольку использование (?:$eucjp)*? обеспечивает перемещение в строке только по символам целевой кодировки, мы знаем, что синхронизация сохраняется.
Не забывайте о модификаторах /ох. Модификатор /х особенно важен из-за наличия пропусков в шаблоне $eucjp. Модификатор /о повышает эффективность, поскольку значение $eucjp заведомо остается неизменным.
Аналогично выполняется и замена, но поскольку текст перед настоящим совпадением также является частью общего совпадения, мы должны заключить его в круглые скобки и включить в заменяющую строку. Предположим, переменным $Tokyo и $Osaka были присвоены последовательности байтов с названиями городов Токио и Осака в кодировке EUC-JP. Замена Токио на Осаку происходит следующим образом:
/" ( C^eucjp)*'.' ) $Tokyo/$10saka/ox
При использовании модификатора /д поиск должен быть привязан не к началу строки, а к концу предыдущего совпадения. Для этого достаточно заменить "
на \G:
/\G ( (?:eucjp)*? ) $Tokyo/$10saka/gox
Разделение строк в многобайтовой кодировке Другая распространенная задача - разбивка входной строки на символы. Для однобайтовой кодировки достаточно вызвать 4)у"кцию split//, но для многобайтовых конструкция будет выглядеть так:
@chars = /$eucjp/gox; # По одному символу на каждый элемент списка
Теперь каждый элемент @chars содержит один символ строки. В следующем фрагменте этот прием используется для создания фильтра:
while (<>) {
my Ochars = /$eucjp/gox: # Каждый элемент списка содержит один символ
for my $char
(@chars) { if (length($char) == 1) {
# Сделать что-то интересное с однобайтовым символом
} else {
# Сделать что-то интересное с многобайтовым символом
}
}
my $line = join("",@chars); # Объединить символы списка в строке print $line;
}
Любые изменения $char в двух фрагментах, где происходит "что-то интересное", отражаются на выходных данных при объединении символов @chars.
Проверка многобайтовых строк
Успешная работа приемов, подобных /$eucjp/gox, существенно зависит от правильного форматирования входных строк в предполагаемой кодировке (EUC-JP). Если кодировка не соблюдается, шаблон /$eucj p/ не будет работать, что приведет к пропуску байтов.
Одно из возможных решений - использование /\G$eucjp/gox. Этот шаблон запрещает механизму поиска пропускать байты при поиске совпадений (модификатор \G означает, что новое совпадение должно находиться сразу же после предыдущего). Но и такой подход не идеален, потому что он просто прекращает выдавать совпадения для входных данных неправильного формата.
Более удачный способ убедиться в правильности кодировки строки - воспользоваться конструкцией следующего вида:
$is_eucjp = m/"(?:$eucjp)*$/xo;
Если строка от начала до конца состоит только из допустимых символов, значит, она имеет правильную кодировку.
И все же существует потенциальная проблема, связанная с особенностями работы метасимвола конца строки $: совпадения возможны как в конце строки (что нам и требуется), так и перед символом перевода строки в ее конце. Следовательно, успешное совпадение возможно даже в том случае, если символ перевода строки не является допустимым в кодировке. Проблема решается заменой $ более сложной конструкцией (?!\п).
Базовая методика проверки позволяет определить кодировку. Например, японский текст обычно кодируется либо в EUC-JP, либо в другой кодировке, которая называется Shift-JIS. Имея шаблоны $eucjp и $sjis, можно определить кодировку следующим образом:
$is_eucjp = m/"(?:$eucjp)*$/xo;
$is_sjis = m/"(?:$sjis)*$/xo;
Если обе проверки дают истинный результат, вероятно, мы имеем дело с ASCII-текстом (поскольку ASCII, в сущности, является подмножеством обеих кодировок). Однако такое решение не дает стопроцентной гарантии, поскольку некоторые строки с многобайтовыми символами могут оказаться допустимыми в обеих кодировках. В таких случаях автоматическое распознавание становится невозможным, хотя по относительным частотам символов можно выдвинуть разумное предположение.
Преобразование кодировок
Преобразование может сводиться к простому расширению описанного выше процесса перебора символов. Для некоторых взаимосвязанных кодировок достаточно тривиальных математических операций с байтами, в других случаях потребуются огромные таблицы соответствия. В любом случае код вставляется в те фрагменты, где происходит "что-то интересное" (см. выше).
Следующий пример преобразует строки из EUC-JP в Unicode, при этом в качестве таблицы соответствия используется хэш %euc2uni:
while (<>) {
my @chars = /$eucjp/gox; # Каждый элемент списка содержит один символ
for my $char (@chars) { my $uni = $euc2uni{$char};
if (defined $uni) { $euc = $uni;
} else {
# Обработать неизвестное преобразование из EUC в Unicode
}
}
my $line = join( ",@chars);
print $line;
Поиск и обработка многобайтовых символов играет особенно важную роль в Unicode, имеющей несколько разновидностей. В UCS-2 и UCS-4 символы кодируются фиксированным числом байтов. UTF-8 использует от одного до шести бантов на символ. UTF-16, наиболее распространенный вариант Unicode, представляет собой 16-битную кодировку переменной длины.
Проблема
Требуется построить шаблон для проверки адресов электронной почты.
Решение
Задача в принципе неразрешима, проверка адреса электронной почты в реальном времени невозможна. Приходится выбирать один из возможных компромиссов.
Комментарий
Многие шаблоны, предлагаемые для решения этой проблемы, попросту неверны. Допустим, адрес fred&barney@stonehedge. corn правилен и по нему возможна доставка почты (на момент написания книги), однако большинство шаблонов, претендующих на проверку почтовых адресов, бесславно споткнутся на нем.
Документы RFC-822 содержат формальную спецификацию синтаксически правильного почтового адреса. Однако полная обработка требует рекурсивного анализа вложенных комментариев - задача, с которой одно регулярное выражение не справится. Если предварительно удалить комментарии:
1 while $addr =~ s/\([-()]*\)//g;
тогда теоретически можно воспользоваться довольно длинным шаблоном для проверки соответствия стандарту RFC, но и это недостаточно хорошо по трем причинам.
Во-первых, не по всем адресам, соответствующим спецификации RFC, возможна доставка. Например, адрес foo@foo. foo. foo, too теоретически правилен, но на практике доставить на него почту невозможно. Некоторые программисты пытаются искать записи MX на серверах DNS или даже проверяют адрес на хосте, обрабатывающем его почту. Такой подход неудачен, поскольку большинство узлов не может напрямую подключиться к любому другому узлу, но даже если бы это было возможно, получающие почту узлы обычно либо игнорируют команду SMTP VRFY, либо откровенно врут.
Во-вторых, почта может прекрасно доставляться по адресам, не соответствующим RFC. Например, сообщение по адресу postmaster почти наверняка будет доставлено, но этот адрес не соответствует канонам RFC - в нем нет символа @.
В-третьих (самая важная причина), даже если адрес правилен и по нему возможна доставка, это еще не означает, что он вам подойдет. Например, адрес president@whitehouse.gov соответствует стандартам RFC и обеспечивает доставку. И все же крайне маловероятно, чтобы этот адресат стал поставлять информацию для вашего сценария CGI.
Отважная (хотя и далеко не безупречная) попытка приведена в сценарии по адресу http://wv)w.perl.com/CPAN/authors/Tom_Christiansen/scripts/ckaddr.gz. Эта программа выкидывает множество фортелей, среди которых - проверка регулярного выражения на соответствие RFC-822, просмотр записей MX DNS и стоп-спис-ки для ругательств и имен знаменитостей. Но и такой подход оказывается откровенно слабым.
При проверке почтового адреса мы рекомендуем организовать его повторный ввод, как это часто делается при проверке пароля. При этом обычно исключаются опечатки. Если обе версии совпадут, отправьте на этот адрес личное сообщение следующего содержания:
Дорогой someuser@host.com,
Просим подтвердить почтовый адрес, сообщенный вами в 09:38:41 6 мая 1999 года. Для этого достаточно ответить на настоящее сообщение. Включите в ответ строку "Rumpelstiltskin", но в обратном порядке (то есть начиная с "Nik..."). После этого ваш подтвержденный адрес будет занесен в нашу базу данных.
Если вы получите ответное сообщение и ваши указания будут выполнены, можно с достаточной уверенностью предположить, что адрес правилен.
Возможна и другая стратегия, которая обеспечивает лучшую защиту от подделок, - присвойте своему адресату личный идентификатор (желательно случайный) и сохраните его вместе с адресом для последующей обработки. В отправленном сообщении попросите адресата включать личный идентификатор в свои ответы. Однако идентификатор будет присутствовать и при возврате недоставленного сообщения, и при включении рассылки в сценарий. Поэтому попросите адресата слегка изменить идентификатор - например, поменять порядок символов, прибавить или вычесть 1 из каждой цифры и т. д.
Смотри также: Рецепт 18.9.
Проблема
Предположим, у вас имеется список команд - например, "send", "abort", "list" и "edit". Пользователь вводит лишь часть имени команды, и вы не хотите заставлять его вводить всю команду до конца.
Решение
Воспользуйтесь следующим решением, если все строки начинаются с разных символов или если одни совпадения имеют более высокий приоритет по сравнению с другими (например, если "SEND" отдается предпочтение перед "STOP"):-
chomp ($answer = о);
if ("SEND" =" /~\q$answer\i) { print "action is send\n" }
elsit ("STOP" =~ /~\q$answer\i)
{ print "Action is stop\n" }
elsif ("ABORT" =~ /"\q$answer\i)
{ print "Action is abort\n" } elsif
("LIST" =~ /"\q$answer\i)
{ print "Action is list\n" }
elsif ("EDIT" =~ /"\q$answer\i)
{ print "Action is edit\n" }
Кроме того, можно воспользоваться модулем Text::Abbrev:
use Text::Abbrev;
$href = abbrev qw(send abort list edit):
for (print "Action: "; <>; print "Action: ") {
chomp;
my $action = $href->{ lc($_) };
print "Action is $action\n";
}
Комментарий
В первом решении изменяется стандартный порядок поиска; обычно слева указывается переменная, а справа - шаблон. Мы бы также могли попытаться опре-
делить, какое действие выбрал пользователь, с помощью конструкции $answer= =~ /"abort/i. Выражение будет истинным, если $answer начинается со строки "abort". Однако совпадение произойдет и в случае, если после "abort" в $answer следует что-то еще - скажем, для строки "abort later". Обработка сокращений обычно выглядит весьма уродливо: $answer =~
/"A(B(0(R(T)?)?)?)^$/i.
Сравните классическую конструкцию "переменная =~ шаблон" с "abort" =" / "\q$answer/i. \q подавляет интерпретацию метасимволов, чтобы ваша программа не "рухнула" при вводе пользователем неверного шаблона. Когда пользователь вводит что-нибудь типа "ab", после замены переменной шаблон принимает вид "abort" =~ /"аЬ/1. Происходит совпадение.
Стандартный модуль text::abbrev работает иначе. Вы передаете ему список слов и получаете ссылку на хэш, ключи которого представляют собой все однозначные сокращения, а значения - полные строки. Если ссылка $href создается так, как показано в решении, $href->{$var} возвращает строку "abort".
Подобная методика часто используется для вызова функции по имени, вводимому пользователем. При этом применяется символическая ссылка:
$name = 'send';
&$name();
Впрочем, это небезопасно - пользователь сможет выполнить любую функцию нашей программы, если он знает ее имя. Кроме того, такое решение противоречит директиве use strict 'refs'.
Ниже приведена часть программы, создающая хэш, в котором ключ представляет собой имя команды, а значение - ссылку на функцию, вызываемую этой командой:
# Предполагается, что &invoke_editor, &deliver_message,
# $file и $PAGER определяются в другом месте. use Text::Abbrev;
my($href, %actions, $errors);
%actions = (
"edit" => \&invoke_editor,
"send" => \&deliver_message,
"list" => sub { system($PAGER, Stile) },
"abort" => sub {
print "See ya!\n";
exit;
}
=> sub {
print "Unknown command: $cmd\n";
$errors++;
}
};
$href = abbrev(keys %actions);
local $_;
for (print "Action: "; <>; print "Action: ") {
s/-\s+//:
s/\s+$//;
next unless $_;
$actions->{ $href->{ lc($_) } }->();
}
Если вы не любите слишком кратких выражений или хотите приобрести навыки машинистки, последнюю команду можно записать так:
$abbreviation = 1с($_);
$expansion = $href->{$abbreviation};
$coderef = $actions->{$expansion};
&$coderef();
Смотри также: Документация по стандартному модулю Text::Abbrev. Интерполяция рассматривается в разделе "Scalar Value Constructors" perldata(1).
Программа uriify оформляет URL-адреса, найденные в файлах, в виде ссылок HTML. Она работает не для всех возможных URL, но справляется с наиболее распространенными. Программа старается избежать включения знаков препинания, завершающих предложения, в помеченный URL.
Программа является типичным фильтром Perl и потому может использоваться для перенаправленного ввода:
% gunzip -с '/mail/archive.gz j uriify > archive.uriified Исходный текст программы приведен в примере 6.13.
Пример 6.13. uriify
#!/usr/bin/perl
# uriify - оформление URL-подобных конструкций в виде ссылок HTML
$urls = '(http|telnet|gopher|file]wais|ftp)';
$ltrs = o\w';
$gunk = -/#-:.?+=&%@!\-';
$punc = '. :Л-';
$any = "${ltrs}${gunk}${punc}";
while (<>) { s{ \b (
$urls: [$any] +?
# Начать с границы слова
# Начать сохранение $1 {
# Искать имя ресурса и двоеточие,
# за которыми следует один или более
# любых допустимых символов, но
# проявлять умеренность и брать лишь то,
# что действительно необходимо ....
} # Завершить сохранение $1 }
(?= # Опережающая проверка без смещения
[$punc]* # либо 0, либо знак препинания, [
"$аnу] # за которыми следует символ, не входящий в url,
| # или
$ # конец строки
)
}{<А HREF= $1">$^}igox;
print;
}
