Глава б Поиск по шаблону

6.6. Межстрочный поиск

Проблема

Решение

Комментарий

Шаблон s/<[">]*>//g работает намного быстрее, но такой подход наивен: он приведет к неправильной обработке тегов в комментариях HTML или угловых скобок в кавычках (). В рецепте 20.6 показано, как решаются подобные проблемы. Программа из примера 6.3 получает простой текстовый документ и ищет в начале абзацев строки вида "Chapter 20: Better Living Through Chemisery". Такие строки оформляются заголовками HTML первого уровня. Поскольку шаблон получился довольно сложным, мы воспользовались модификатором /х, который разрешает внутренние пропуски и комментарии.

Пример 6.3. headerfy
#!/usr/bin/perl
# headerfy: оформление заголовков глав в HTML
$/ = oo;
while ( о ) { # Получить абзац s{
\А #Начало записи
( # Сохранить в
$1 Chapter # Текстовая строка
\s+ # Обязательный пропуск
\d+ # Десятичное число
\s* # Необязательный пропуск
: # Двоеточие .
* # Все, кроме перевода строки, до конца строки
) }{<Н1>$К}gх;
print;
}

Если комментарии лишь затрудняют понимание, ниже тот же пример переписан в виде короткой командной строки:
% perl -OOpe os{\A(Chapter\s+\d+\s*:.*)}{<Н1> $K }gx' datafile
Возникает интересная проблема: в одном шаблоне требуется указывать как начало записи, так и конец строки. Начало записи можно было бы определить с помощью ~, но символ $ должен определять не только конец записи, но и конец строки. Мы добавляем модификатор /т, отчего изменяется смысл как ", так и $. Начало записи вместо " определяется с помощью \А. Кстати говоря, метасимвол \Z (хотя в нашем примере он не используется) совпадает с концом записи даже при наличии модификатора /т. Следующий пример демонстрирует совместное применение /s и /т. На этот раз мы хотим, чтобы символ " совпадал с началом любой строки абзаца, а точка -с переводом строки. Эти модификаторы никак не связаны, и их совместное применение ничем не ограничено. Стандартная переменная $. содержит число записей последнего прочитанного файла. Стандартная переменная $ARGV содержит файл, автоматически открываемый при обработке .

$/=''; # Режим чтения абзацев
while () {
while (m#"START(,*?)"END#sm) { # /s - совпадение . с переводом строки
# /m - совпадение ~ с началом
}
}
внутренних строк
print "chunk $. in $ARGV has <<$1"\n"; Если вы уже привыкли работать с модификатором /m, то ~ и $ можно заменить на \А и \Z. Но что делать, если вы предпочитаете /s и хотите сохранить исходный смысл .? Воспользуйтесь конструкцией ["\п]. Если вы не намерены использовать /s, но хотите иметь конструкцию, совпадающую с любым байтом, сконструируйте символьный класс вида [\000-\377] или даже [\d\D]. Использовать [ .\п] нельзя, поскольку в символьных классах . не обладает особой интерпретацией.

> Смотри также ------------------------------- Описание переменной $/ в perlvar(1); описание модификаторов /s и /m uperlre(1). Мы вернемся к специальной переменной $/ в главе 8.

6.7. Чтение записей с разделением по шаблону

Проблема

Решение

Комментарий

STDIN {
local $/ = undef;
@chunks = split(/"\.(Ch|Se|Ss)$/m, о);
} print "I read ", scalar(@chunks), "chunks,\n";

Мы создаем локальную версию переменной $/, чтобы после завершения блок;! было восстановлено ее прежнее значение. Если шаблон содержит круглые скобки, функция split также возвращает разделители. Это означает, что данные в возвращаемом списке будут чередоваться с элементами "Se", "Ch" и "Ss". Если разделители вам не нужны, но вы все равно хотите использовал. круглые скобки, воспользуйтесь "несохраняющими" скобками в шаблоне вид;) /"\.C?:Ch|Se|Ss)$/m. Чтобы записи разделялись перед шаблоном, но шаблон включался в возвращаемые записи, воспользуйтесь опережающей проверкой: /PC^V (7: Ch | Se | Ss) )/m. В этом случае каждый фрагмент будет начинаться со строки-разделителя. Учтите, что для больших файлов такое решение потребует значительных расходов памяти. Однако для современных компьютеров и типичных текстовых файлов эта проблема уже не так серьезна. Конечно, не стоит применять это решение для 200-мегабайтного файла журнала, не располагая достаточным местом H;I диске для подкачки. Впрочем, даже при избытке виртуальной памяти ничего хорошего не выйдет.

> Смотри также -------------------------------
Описание переменной $/ в perlvar(l) и в главе 8; описание функции split в perlfunc(1).

6.8. Извлечение строк из определенного интервала

Решение

while (<>) {
if (/НАЧАЛЬНЫЙ ШАБЛОН/ .. /КОНЕЧНЫЙ ШАБЛОН/) { # Строка находится между начальным
# и конечным шаблонами включительно.
}
}
while (<>) {
if ($НОМЕР_НАЧАЛЬНОЙ_СТРОКИ .. $НОМЕР_КОНЕЧНОЙ_СТРОКИ) {
# Строка находится между начальной
# и конечной включительно.
}
}

Если первое условие оказывается истинным, оператор ... не проверяет второе условие.
while (<>) {
if (/НАЧАЛЬНЫЙ ШАБЛОН/ ... /КОНЕЧНЫЙ ШАБЛОН/) { # Строка находится между начальным
# и конечным шаблонами, расположенными в разных строках.
}
}
while (<>) {
if ($НОМЕР_НАЧАЛЬНОЙ_СТРОКИ ... $НОМЕР_КОНЕЧНОЙ_СТРОКИ)
# Строка находится между начальной
# и конечной, расположенными в разных строках,
}
}

Комментарий

#i .. m##i;

}

# To же, но в виде команды интерпретатора

% perl -ne 'print if m#

#i .. m##i' document.html
Если хотя бы один из операндов задан в виде числовой константы, интервальные операторы осуществляют неявное сравнение с переменной $. ($NR или $INPUT_I_INE_NUMBER при действующей директиве use English). Поосторожнее с неявными числовыми сравнениями! В программе необходимо указывать числовые константы, а не переменные. Это означает, что в условии можно написать 3 . . 5, но не $п . . $т, даже если значения $п и $т равны 3 и 5 соответственно. Вам придется непосредственно проверить переменную $..

#Команда не работает 

perl -ne 'BEGIN { $top=3; $bottom=5 } print if Stop .. $bottom' /etc/passwd

# Работает

perl -ne 'BEGIN {$top=3; $bottom=5 } \

print if $. == $top .. $. == $bottom' /etc/passwd

# Тоже работает

perl -ne 'print if 3 ,. 5' /etc/passwd

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

print if /begin/ .. /end/, print if /begin/ ... /end/;


Для строки "You may not end here you begin" оба интервальных оператора возвращают true. Однако оператор . . не будет выводить дальнейшие строки. Дело в том, что после выполнения первого условия он проверяет второе условие в той же строке; вторая проверка сообщает о найденном конце интервала. С другой стороны, оператор . . , продолжит поиск до следующей строки, в которой найдется /end/, - он никогда не проверяет оба операнда одновременно.

Разнотипные условия можно смешивать:

while (<>) {

$in_header =    1 .. /"$/;

$in_body   = /"$/ .. eof();

}


Переменная $in_header будет истинной, начиная с первой входной строки и заканчивая пустой строкой, отделяющей заголовок от основного текста, - например, в почтовых сообщениях, новостях Usenet и даже в заголовках HTTP (теоретически строки в заголовках HTTP должны завершаться комбинацией CR/ LF, но на практике серверы относятся к их формату весьма либерально). Переменная $in_body становится истинной в момент обнаружения первой пустой строки и до конца файла. Поскольку интервальные операторы не перепроверяют начальное условие, остальные пустые строки (например, между абзацами) игнорируются.
Рассмотрим пример. Следующий фрагмент читает файлы с почтовыми сообщениями и выводит адреса, найденные в заголовках. Каждый адрес выводится один раз. Заголовок начинается строкой "From:" и завершается первой пустой строкой. Хотя это определение и не соответствует RFC-822, оно легко формулируется.

%seen =();

while (<>) {

next unless /"From:?\s/i .. /"$/;

while (/([o-<>(), ;\s]+\@r<>(),;\s]+)/g) { print "$1\n" unless $seen{$1}++;

}

}
Если интервальные операторы Perl покажутся вам странными, записывайтесь в команды поддержки s2p и а2р - трансляторов для переноса кода sed и awk в Perl. В обоих языках есть свои интервальные операторы, которые должны работать в Perl.


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

Описание операторов . . и . . . в разделе "Range Operator" perlop(1) описание переменной $NR в perlvar{1).

6.9. Работа с универсальными символами командных интерпретаторов

Проблема

Решение

Комментарий

> Смотри также --------------------------------
Страницы руководства csh(1) и ksh(1) вашей системы; описание функции glob в perlfunc(1); документация по модулю Glob::DosGlob от CPAN; раздел "I/O Operators" perlop(1); рецепт 9.6.

6.10. Ускорение интерполированного поиска

Проблема

Решение

while ($line = о) {
ir ($line =~ /$pattern/o) {
# Сделать что-то
}
} Однако для нескольких шаблонов это решение не работает. Три приема, описанные в комментарии, позволяют ускорить поиск на порядок или около того.

Комментарий

# popgrepi - поиск строк с названиями штатов
# версия 1: медленная, но понятная
@popstates = qw(CO ON MI WI MN);
LINE: while (defined($line = <>)) { for $state (Opopstates) {
if ($line ="o /\b$state\b/) { print; next LINE;
}
}
}
Столь примитивное, убогое, "силовое" решение оказывается ужасно медленным - для каждой входной строки все шаблоны приходится перекомпилировать заново. Мы рассмотрим три варианта решения этой проблемы. Первый вариант генерирует строку кода Perl и вычисляет ее с помощью eval; второй кэширует внутренние представления регулярных выражений в замыканиях; третий использует модуль Regexp с CPAN для хранения откомпилированных регулярных выражений. Традиционный подход к ускорению многократного поиска в Perl - построение строки, содержащей нужный код, и последующий вызов eval "$code". Подобная методика использована в примере 6.5.
Пример 6.5. рордгер2

#!/usr/bin/perl
# рорgrер2 - поиск строк с названиями штатов
# версия 2: eval; быстрая, но сложная в написании
@popstates = qw(CO ON MI WI MN);
$code = 'while (defined($line = <>)) {';
for $state ((oipopstates) {
$code .= "\tif (\$line =` /\\b$state\\b/) { print \$line; next; }\n";
}
$code ,= '}';
print "CODE IS\n----\n$code\n----\n" if 0; # Отладочный вывод eval $code;
die if $@;
Программа рорgrер2 генерирует строки следующего вида:
while (defined($line = о) {
if ($line =~ /bCO\b/) { print $line; next; }
if ($line =~ /bON\b/) { print $line; next; }
if ($line =~ /bMI\b/) { print $line; next; }
if ($line =~ /bWI\b/) { print $line; next; }
if ($line =~ /bMN\b/) { print $line; next; } }

Как видите, получается что-то вроде строковых констант, вычисляемых eval. В текст включен весь цикл вместе с поиском по шаблону, что ускоряет работу программы. Самое неприятное в таком решении - то, что правильно записать все строки и служебные символы довольно трудно. Функция dequote из рецепта 1.11 может упростить чтение программы, но проблема с конструированием переменных, используемых позже, остается насущной. Кроме того, в строках нельзя использовать символ /, поскольку он служит ограничителем в операторе т//. Существует изящный выход, впервые предложенный Джеффри Фридлом (Jeffrey Friedl). Он сводится к построению анонимной функции, которая кэширу-ет откомпилированные шаблоны в созданном ей замыкании. Для этого функция eval вызывается для строки, содержащей определение анонимной функции, которая проверяет совпадения с передаваемыми ей шаблонами. Perl компилирует шаблон всего только при определении анонимной функции. После вызова eval появляется возможность относительно быстрого поиска. В примере 6.6 приведена очередная версия программы popgrep, в которой используется данный прием. Пример 6.6. рордгерЗ

#!/usr/bin/perl
# рордгерЗ - поиск строк с названиями штатов
# версия 3: алгоритм с построением вспомогательной функции
@popstates = qw(CO ON MI WI MN);
$expr = joinCII', map { "m/\\b\$popstates[$_]\\b/o" } 0. .$#popstates);
$match_any = eval "sub { $expr }";
die if $@;
while (<>) {
print if &$match_any;
}
В результате функции eval передается следующая строка (за вычетом форматирования):
sub {
m/\b$popstates[0]\b/o || m/\b$popstates[1]\b/o |
m/\b$popstates[2]\b/o || m/\b$popstates[3]\b/o ||
m/\b$popstates[4]\b/o } Ссылка на массив @popstates находится внутри замыкания. Применение модификатора /о в данном случае безопасно. Пример 6.7 представляет собой обобщенный вариант этой методики. Создаваемые в нем функции возвращают true, если происходит совпадение хотя бы с одним (и более) шаблоном. Пример 6.7. grepauth
#!/usr/bin/perl
# grepauth - вывод строк, в которых присутствуют Тот и Nat
$multimatch = build_match_all(q/-Tom/, q/Nat/);
while (<>) {
print it &$multimatch;
}
exit;
sub build_match_any { build_match_tunc(' | [', @>_) }
sub build_match_all { build_match_tunc( '&&', @>_) }
sub build_match_func { my $condition = shift;
my (nipattern = @_; # Переменная должна быть лексической,
# а не динамической
mу $ехрr = join $condition => map { "m/\$pattern[$_]/o" } (0..$#pattern);
my $match_tunc = eval "sub { local \$_ = shift if \@i_; $expr }":
die if $@; # Проверить $C?; переменная должна быть пустой!
return $match_func;
}

Конечно, вызов eval для интерполированных строк (см. popgrep2) представляет собой фокус, кое-как но работающий. Зато применение лексических переменных в замыканиях, как в рордгерЗ и функциях build_match_*, - это уже высший пилотаж. Даже матерый программист Perl не сразу поверит, что такое решение действительно работает. Впрочем, программа будет работать независимо от того, поверили в нее или нет. На самом деле нам хотелось бы, чтобы Perl один раз компилировал каждый шаблон и позволял позднее ссылаться на него в откомпилированном виде. Такая возможность появилась в версии 5.005 в виде оператора определения регулярных выражений qr//. В предыдущих версиях для этого был разработан экспериментальный модуль Regexp с CPAN. Объекты, создаваемые этим модулем, представляют откомпилированные регулярные выражения. При вызове метода match объекты выполняют поиск по шаблону в строковом аргументе. Существуют специальные методы для извлечения обратных ссылок, определения позиции совпадения и передачи флагов, соответствующих определенным модификаторам - например, / В примере 6.8 приведена версия программы popgrep, демонстрирующая простейшее применение этого модуля. Пример 6.8. рорgrер4

#!/usr/bin/perl
# рорgrер4 - поиск строк с названиями штатов
# версия 4: применение модуля Regexp
use Regexp;
@popstates = qw(CO ONMI WI MN);
@poppats = map { Regexp->new( '\b' . $_ . '\b') } @popstates;
while (defined($line = <>)) {
for $patobj (@poppats) {
print $line if $patobj->match($line);
}
}

Возможно, вам захочется сравнить эти решения по скорости. Текстовый файл, состоящий из 22 000 строк ("файл Жаргона"), был обработан версией 1 за 7,92 секунды, версией 2 - всего за 0,53 секунды, версией 3 - за 0,79 секунды и версией 4 - за 1,74 секунды. Последний вариант намного понятнее других, хотя и работает несколько медленнее. Кроме того, он более универсален. > Смотри также ------------------------------- Описание интерполяции в разделе "Scalar Value Constructors" perldata(1)\ описание модификатора /о poрgrep{1)\ документация по модулю Regexp с СРАМ.

6.11. Проверка правильности шаблона

Проблема

Решение

do {
print "Pattern?";
chomp($pat = о);
eval { "" =~ /Spat/ };
warn "INVALID PATTERN $@" if $@>;
} while $@;

Отдельная функция для проверки шаблона выглядит так:

sub is_valid_pattern {
my Spat = shift;
return eval { "" =~ /$pat/; 1 } || 0;
}

Работа функции основана на том, что при успешном завершении блока возвращается 1. При возникновении исключения этого никогда не произойдет. Комментарий Некомпилируемые шаблоны встречаются сплошь и рядом. Пользователь может по ошибке ввести "", "*** GET RICH ***" или "+5-i". Если слепо воспользоваться введенным шаблоном в программе, возникнет исключение - как правило, это приводит к аварийному завершению программы. Крошечная программа из примера 6.9 показывает, как проверяются шаблоны. Пример 6.9. paragrep

#!/usr/bin/perl
# paragrep - простейший поиск
die "usage: $0 pat [files]\n" unless @ARGV;
$/ = o o;
Spat = shift;
eval { "" =~ /$pat/; 1 } or die "$0: Bad pattern Spat: $@>\n";
while (<>) {
print "$ARGV $.: $_oo if /$pat/o;
} Модификатор /о обещает Perl, что значение интерполируемой переменной останется постоянным во время всей работы программы - это фокус для повышения быстродействия. Даже если значение $pat изменится, Perl этого не заметит. Проверку можно инкапсулировать в функции, которая возвращает 1 при успешном завершении блока и 0 в противном случае (см. выше функцию is_valid_ pattern). Хотя исключение можно также перехватить с помощью eval "/$pat/", у такого решения есть два недостатка. Во-первых, во введенной пользователем строке не должно быть символов / (или других выбранных ограничителей). Во-вторых, в системе безопасности открывается зияющая брешь, которую было бы крайне желательно избежать. Некоторые строки могут сильно испортить настроение:
$pat = "You lose @{[ system('rm -rf *')]} big here";
Если вы не желаете предоставлять пользователю настоящие шаблоны, сначала всегда можно выполнить метапреобразование строки:

$safe_pat = quotemeta($pat);
something() if /$safe_pat/;
Или еще проще:

something() if /\Q$pat/:
Но если вы делаете нечто подобное, зачем вообще связываться с поиском по шаблону? В таких случаях достаточно простого применения index. Разрешая пользователю вводить настоящие шаблоны, вы открываете перед ним много интересных и полезных возможностей. Это, конечно, хорошо. Просто придется проявить некоторую осторожность, вот и все. Допустим, пользователь желает выполнять поиск без учета регистра, а вы не предусмотрели в своей программе параметр вроде -i в дгер. Работая с полными шаблонами. пользователь сможет ввести внутренний модификатор /i в виде (?i) - например, /(?i)stuff/. Что произойдет, если в результате интерполяции получается пустая строка? Если $pat - пустая строка, с чем совпадет /$pat/ - иначе говоря, что произойдет при пустом поиске //? С началом любой возможной строки? Неправильно. Как ни странно, при поиске по пустому шаблону повторно используется шаблон предыдущего успешного поиска. Подобная семантика выглядит сомнительно, и ее практическое использование в Perl затруднительно. Даже если шаблон проверяется с помощью eval, учтите: время поиска по некоторым шаблонам связано с длиной строки экспоненциальной зависимостью. Надежно идентифицировать такие шаблоны не удается. Если пользователь введет один из них, программа надолго задумается и покажется "зависшей". Возможно, из тупика можно выйти с помощью установленного таймера, однако в версии 5.004 прерывание работы Perl в неподходящий момент может привести к аварийному завершению.

> Смотри также -------------------------------
Описание функции eval в perlfunc(1). 

© copyright 2000 Soft group