Интерполяция скаляра

Интерполяция в строку простого скаляра: "Text $name text". Если нет разделителя после имени переменной, то это имя надо взять в фигурные скобки: "Text ${name}text".

Интерполяция в строку переменной с индексами (элемента массива): "Text $name[1] text" или "Text $name[$ind] text". Аналогично происходит интерполяция элемента массива массивов:

my @a=([1,2],[3,4]); $_="aaa$a[1][0]aaa"; print $_;

Будет напечатано:

aaa3aaa

Интерполяция вызова подпрограммы, возвращающей ссылку

Вот пример интерполяции результата вызова подпрограммы, которая возвращает ссылку:

#!/usr/bin/perl -w use strict; no strict 'refs';

sub subr() { return 'abc' }

our $abc=123; $_="${&subr}"; print $_;

На печать выходит 123.

Здесь используется разыменование именной ссылки abc, поэтому переменная $abc должна быть глобальной, т.к. имена переменных my не находятся в глобальной таблице имен typeglob. Кроме того, если вы применяете директиву use strict, то надо разрешить разыменование именных ссылок: no strict 'refs'.

Подпрограмма subr возвращает строку abc, которая является именем переменной.

Конструкция ${&subr} разыменовывает эту ссылку и возвращает значение переменной $abc. Задавая разные значения переменной $abc или разные возвращаемые подпрограммой subr значения, будем получать разные результаты интерполяции.

Здесь обратите внимание на разыменовывающий префикс & перед именем подпрограммы.

Он здесь всегда обязателен. Этот способ интерполяции годится только для написанных вами подпрограмм.

Экранирование метасимволов регулярных выражений

Если вы вставляете в регулярное выражение литерал из ввода пользователя или какую-либо переменную и хотите, чтобы переменная интерпретировалась как текст для поиска, а не как часть регулярного выражения, то для этого имеется эскейп-последовательность \Q, которая включает режим экранирования метасимволов регулярных выражений, таких, как [, *, +, {, ^, $, …: /\Q$userinput\E/. Экранирование осуществляется до эскейп-последовательности \E, а при ее отсутствии - до конца регулярного выражения.

Вставка ввода пользователя в регулярное выражение сопряжена с опасностью выполнения постороннего кода Perl, который может содержать вызов системных программ. Это является большой дырой в защите сервера. Поэтому переменную, содержащую ввод пользователя, надо заключать в специальную конструкцию \Q…\E. Вряд ли вы захотите искать или заменять что-то по регулярному выражению, которое вводит пользователь.

Результат аналогичен применению функции Perl quotemeta(). Но символы \ в неизвестных комбинациях (например, \F) не экранируются. Переменные типа $scalar и @array внутри метапоследовательности \Q…\E интерполируются, также интерполируются специальные переменные, которые должны интерполироваться внутри регулярных выражений.

Например:

$_='[a]bc$ '; print "'$&'" if /^\Q[a]bc$ \E$/;

Напечатается '[a]bc$ '. После символа $ внутри строки $_ и регулярного выражения стоит пробел. Если бы между символами $ и \ не было пробела, то внутри регулярного выражения возникла бы специальная переменная $\, которая стандартно содержит неопределенное значение. Она бы заменилась на пустой фрагмент, символ \ был бы отнят от буквы E и вместо завершителя метапоследовательности \Q…\E и метасимвола $ - конца текста - мы бы получили букву E, за которой стоит простой символ $:

#!/usr/bin/perl -w use strict;

$_='[a]bcE$'; print $& if /^\Q[a]bc$\E$/;

На печати оказывается следующее:

Use of uninitialized value in concatenation (.) or string at a.pl line 6. [a]bcE$

Мы получили предупреждение об использовании неинициализированной переменной ( а именно, $\) внутри регулярного выражения. Но совпадение все же было найдено.

Чтобы яснее проиллюстрировать этот пример, присвоим переменной $\ какое-либо значение, а также вставим его в исходную строку после буквы c:

$\='?'; $_='[a]bc?E$'; print $& if /^\Q[a]bc$\E$/;

Совпадение найдется без предупреждений, и на печати окажется

[a]bc?E$?

Теперь все ясно, только откуда взялся последний знак вопроса? Дело в том, что специальная переменная $\ содержит текст, который оператор print использует как завершитель выходных записей и добавляет после своего вывода, - вот он этот текст и добавил.

Получается, что символы $ и @ внутри последовательности \Q…\E будут интерполироваться, если за ними следуют символы, которые встречаются в именах переменных или специальных переменных. А если, как у нас, после $ будет пробел, то тогда символы $ и @ будут обозначать сами себя. Ничего не даст попытка экранировать их обратным слэшем: \Q\$a\E - этот обратный слэш будет сам экранирован внутри последовательности \Q…\E, и мы получим фрагмент текста $a.

Но внутри переменных интерполяция переменных не происходит, также в них не распознаются метасимволы \Q и \E литералов регулярных выражений:

$_='[a]\\Qbc$\\'; my $a='[a]\\Qbc$\\'; print $& if /^\Q$a\E$/;

На печать выходит

[a]\Qbc$\

Также внутри блоков \Q…\E работают метасимволы литералов регулярных выражений \U, \u, \L и \l.

\L означает, что все буквы до эскейп-последовательности \E или до конца литерала регулярного выражения будут прописными.\l означает, что следующий символ, если он буква, будет прописным.\U означает, что все буквы до эскейп-последовательности \E или до конца литерала регулярного выражения будут заглавными.\u означает, что следующий символ, если он буква, будет заглавным.

Например:

$_='abc'; my $a='ABC'; print $& if /^\L$a/;

Будет напечатано abc.

Или

$_='abc'; print $& if /^\LABC/;

Здесь также напечатается abc.

Обратите внимание на такой нюанс:

$_='a'; print "Found $&" if /^\Q\LA\E$/;

Не найдено!

Печатает

Found a$

Замечу еще, что пустая метапоследователность \Q\E вызывает ошибку синтаксиса, так же как и \U\E и \L\E. Комбинации \U\L и \L\U также почему-то вызывают ошибки синтаксиса.

Внутри классов все эти метапоследовательности \u, \l, \U…\E, \L…\E, \Q…\E также работают. Вот примеры:

$_='A'; print $& if /[\ua]/;

Напечатает A.

$_='AB]'; print $& if /[\Ua]b\E]/;

Напечатает AB].

Здесь обратите внимание на "сквозное" действие метапоследовательности \U…\E, которая продолжает действовать за пределами класса. Ведь рассматриваемые метапоследовательности применяются сразу после интерполяции переменных, поэтому механизм поиска соответствия получит регулярное выражение /[A]B]/.

Вот пример полезной идиомы: в переменной $name задано имя человека буквами произвольного регистра. Мы с помощью последовательности \u\L в любом случае делаем первую букву заглавной, а остальные - строчными:

$_='Andrey'; my $name='aNDreY'; print $& if /\u\L$name\E/;

Напечатает Andrey.

Внутри классов это тоже работает:

$_='Andrey'; my $name='aNDreY'; print $& if /[\u\L$name\E]{6}/;

Будет напечатано Andrey. Регулярное выражение будет иметь вид /[Andrey]{6}/.

Еще раз заметиме, что внутри переменных эти метапоследовательности не распознаются.

Например:

#!/usr/bin/perl -w use strict;

$_='A'; my $name='\\ua'; print $& if /$name/;

Возникает сообщение:

Unrecognized escape \u passed through in regex; marked by <-- HERE in m/\u <-- HERE a/ at a.pl line 6.

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

Сделаю еще одно замечание насчет использования \u, \l, \U…\E и \L…\E. В документации алгоритм их работы не разъяснен, не написано, какую ассоциативность имеют эти операторы - левую или правую. Ведь их действия могут конфликтовать друг с другом. К примеру, какой напечатается строка "\Ua\lAa"? Эскейп-последовательность \l говорит, что следующая буква A будет прописной, а \U говорит, что все после нее до конца строки будет заглавным. В итоге напечатается AAA. Зесь мы видим, что эти операторы имеют правую ассоциативность, т.е. выполняются справа налево. То же справедливо, когда рядом стоят символы \l\u и \u\l. Однако, если вместе стоят символы \U\l, \l\U, \L\u и \u\L, то префиксы \l и \u имеют приоритет перед метасимволами \L и \U. Сравните результаты:

print "\L\uaA\n"; print "\LaA\uaA\n";

Преобразование ftp, http и e-mail ссылок в теги HTML

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

http://www.proxy.com:80@www.site.com/

может трактоваться неоднозначно из-за наличия в ней символа @. Если мы сначала будем искать адреса электронной почты, то программа может "найти" такой e-mail:

80@www.site.com

Конфликт также может возникнуть со ссылками вида

ftp://login:passw@a-aa.com/www/

Чтобы устранить этот конфликт, перепишем регулярные выражения для поиска URL и добавим к ним регулярное выражение для поиска e-mail. Форматировать ссылки будем несколькими операторами подстановки, т.к. для одного оператора эта задача слишком сложна.

Вот текст всей этой программы:

Листинг 8.3.

(html, txt)

А вот результат ее работы:

Листинг 8.4.

(html, txt)

Как видим, в этом тестовом тексте программа правильно отделила e-mail ссылки от остальных ссылок.

Преобразование ftp и http ссылок в теги HTML

Возьмем такой текст:

Зайдите на www.intuit.ru и посмотрите список курсов

Здесь текст www.intuit.ru является ссылкой, несмотря на отсутствие протокола http://, который подразумевается по умолчанию. В итоге наше регулярное выражение должно преобразовать этот текст к такому виду:

Зайдите на <a href="http://www.intuit.ru" target="_blank"> www.intuit.ru</a> и посмотрите список курсов

Может быть и так, что ссылка не отделена пробелом от окружающих слов или после нее идет знак препинания (точка, запятая и т.д.) Желательно, чтобы регулярное выражение это учитывало и не включало такой знак в ссылку. И конечно, оно не должно совпадать там, где ему совпадать не следует. Неплохо было бы, если бы оно также форматировало текст ссылки href: протокол, домен и субдомены должны быть записаны строчными буквами. А сам текст, который будет виден на странице, должен оставаться таким, каким его ввел участник форума. Задача эта непростая и не формализуется. Критерием успешности регулярного выражения является то, как оно справляется с набором тестов, которые провоцируют его к несовпадению или совпадению не в тех местах.

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

Протокол может быть http, https и ftp. Для его обнаружения создадим строковую переменную $protocol:

my $protocol='(?:(?=[FfHh])(?i:http(?>s?)|ftp)://)';

Если в тексте следующий символ F, f, H или h, то этот подшаблон делает проверку следующих за ним символов и, если это протокол, поглощает его вместе с префиксом. Я взял весь шаблон для протокола в скобки, потому что в общем регулярном выражении у этого подшаблона может стоять квантификатор, который должен относиться ко всему этому подшаблону, а не к последнему его символу /.

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

my $host=<<HOST; (?>[A-Za-z0-9]{1,63}\\.) (?>[A-Za-z0-9] (?>[-A-Za-z0-9]{0,62})\\. )* HOST

После имени хоста через двоеточие может идти порт:

my $port="(?::\\d{1,5}$wb)";

А после зоны может идти хвост, который содержит множество всяких параметров, передаваемых с URL:

my $tail=<<TAIL; (?:[/?] (?>[^.,"'<>()[\\]{}\\s\\x7F-\\xFF]*) (?:(?>[.,?]+) (?:[^"'<>()[\\]{}\\s\\x7F-\\xFF]+) )* (?<![,.?!-]) ) TAIL

В конце стоит заглядывание назад

(?<![,.?!-])

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

Все регулярное выражение для поиска URL в тексте выглядит немного страшновато:

my $re=<<RE; ( (?>($protocol)(?(2)(?>$host$zone)|$host$zone) (?![A-Za-z0-9])| (?<![A-Za-z0-9_\\\@-]) (?<!\\.(?!(?i:www))) $subdom$zone(?![A-Za-z0-9_.-]*\\\@) ) (?>(?>$port?(?>\\\@$host$zone(?![A-Za-z0-9_.-]*\\\@))?)?) ) ($tail?) RE

Это выражение учитывает заход через прокси-сервер вида

http://proxy.com@site.com/

Часть URL от начала до хвоста, который может идти после символов / или ?, мы берем в нумерованную переменную $1. Эту часть URL внутри тега <a мы будем выводить маленькими буквами, а для отображения на странице будем выводить в том виде, в котором ее ввел автор сообщения. Протокол мы возьмем в переменную $2. Если протокола нет, то при форматировании ссылки мы подставим на его место текст http://. Хвост $tail мы захватываем в переменную $3.

Внутри переменной $re встречается эскейп-последовательности \@. Но т.к. внутри текста here doc \ и @ являются метасимволами, то, чтобы в результате получить последовательность \@, надо написать \\\@. Тогда при обработке такого текста \\ превратится в \, а \@ превратится в @, и в конце получится нужная последовательность \@. Для проверки напечатайте переменную $re.

Программа должна "подсвечивать" ссылки в тексте. Например, имеем текст

Look at:aaa.Museum.

Это должно превратиться в

Look at:<a href="aaa.museum" target="_blank">aaa.Museum</a>.

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

Возьмем в качестве тестового такой текст:

my $text=<<TEXT; URLs: Ftp://a.com/AAa Look at:aaa.Museum. http://www.proxy.com:80\@www.site.com/ http://proxy.com:80\@site.com/ http://proxy.com\@site.com/ aAaa.com.au.rr.ggg Zwww.Yahoo.co.uk Фforum.abcd.de www.Abc.eu П123.123.123.1234.com/?q=aaa http://Abc.Tk Ahttp://www.Abc.pt/AAa http://abc.au/query/vid.cam.dig/sony.dcrhc15.htm#full_image Ф.Www.old-avto.tk

my $re=<<RE; ( (?>($protocol)(?(2)(?>$host$zone)|$host$zone) (?![A-Za-z0-9])| (?<![A-Za-z0-9_\\\@-]) (?<!\\.(?!(?i:www))) $subdom$zone(?![A-Za-z0-9_.-]*\\\@) ) (?>(?>$port?(?>\\\@$host$zone(?![A-Za-z0-9_.-]*\\\@))?)?) ) ($tail?) RE

my $text=<<TEXT; URLs: Ftp://a.com/AAa Look at:aaa.Museum. http://www.proxy.com:80\@www.site.com/ http://proxy.com:80\@site.com/ http://proxy.com\@site.com/ aAaa.com.au.rr.ggg Zwww.Yabcd.co.uk Фforum.abcd.de www.Abc.eu П123.123.123.1234.com/?q=aaa http://Abc.Tk Ahttp://www.Abc.pt/AAa http://abc.au/query/vid.cam.dig/sony.dcrhc15.htm#full_image Ф.Www.old-avto.tk

NOT URLs: aaa.museumm http://aaa.museumm, http://-aaa.com www._aaa.com www.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.com TEXT

$text =~ s!$re!<a href="${\($2 ? '' : 'http://')}\L$1\E$3" target="_blank">$1$3</a>!gx; print $text;

Листинг 8.1.

А вот текст, который она печатает:

URLs: <a href="ftp://a.com/AAa" target="_blank">Ftp://a.com/AAa</a> Look at:<a href="http://aaa.museum" target="_blank">aaa.Museum</a>. <a href="http://www.proxy.com:80@www.site.com/" target="_blank">http://www.proxy.com:80@www.site.com/</a> <a href="http://proxy.com:80@site.com/" target="_blank">http://proxy.com:80@site.com/</a> <a href="http://proxy.com@site.com/" target="_blank">http://proxy.com@site.com/</a> <a href="http://aaaa.com.au.rr" target="_blank">aAaa.com.au.rr</a>.ggg <a href="http://zwww.yabcd.co.uk" target="_blank">Zwww.Yabcd.co.uk</a> Ф<a href="http://forum.abcd.de" target="_blank">forum.abcd.de</a> <a href="http://www.abc.eu" target="_blank">www.Abc.eu</a> П<a href="http://123.123.123.1234.com/?q=aaa" target="_blank">123.123.123.1234.com/?q=aaa</a> <a href="http://abc.tk" target="_blank">http://Abc.Tk</a> A<a href="http://www.abc.pt/AAa" target="_blank">http://www.Abc.pt/AAa</a> <a href="http://abc.au/query/vid.cam.dig/sony.dcrhc15.htm#full_image" target="_blank">http://abc.au/query/vid.cam.dig/sony.dcrhc15.htm#full_image</a> Ф.<a href="http://www.old-avto.tk" target="_blank">Www.old-avto.tk</a>

NOT URLs: aaa.museumm http://aaa.museumm, http://-aaa.com www._aaa.com www.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.com

Листинг 8.2.

3-я, 10-я и 13-я строка не уместились по ширине страницы.

Обратите внимание, как преобразуется в URL строка

aAaa.com.au.rr.ggg

Получается

<a href="http://aaaa.com.au.rr" target="_blank">aAaa.com.au.rr</a>.ggg

.ggg не считается частью URL. Количество последовательностей символов через точку ограничено, чтобы не захватить в URL следующий за ним текст. Это интуитивное ограничение.

w use

#!/usr/bin/perl - w use strict;
my $protocol='(?:(?=[FfHh])(?i:http(?>s?)|ftp)://)';
my $host=<<HOST; (?>[A-Za-z0-9]{1,63}\\.) (?>[A-Za-z0-9] (?>[-A-Za-z0-9]{0,62})\\. )* HOST
my $subdom=<<SUBDOM; (?: (?>[A-Za-z0-9] (?:[-A-Za-z0-9]{0,61}[A-Za-z0-9])? )\\. )+ SUBDOM
my $wb='(?![A-Za-z0-9])';
my $zone=<<ZONE; (?i:(?(?=[a-z]{3}$wb)(?>com|net|org|edu|biz|gov|int|mil)| (?(?=[a-z]{2}$wb)[a-z]{2}| (?(?=[a-z]{4}$wb)(?>info|aero|name)| (?(?=[a-z]{6}$wb)museum|(?!) ) ) ) ) (?>\\.[a-z]{2}$wb)? ) ZONE
my $port="(?::\\d{1,5}$wb)";
my $tail=<<TAIL; (?:[/?] (?>[^.,"'<>()[\\]{}\\s\\x7F-\\xFF]*) (?:(?>[.,?]+) (?:[^"'<>()[\\]{}\\s\\x7F-\\xFF]+) )* (?<![,.?!-]) ) TAIL
my $re=<<RE; ( (?>($protocol)(?(2)(?>$host$zone)|$host$zone) (?![A-Za-z0-9])| (?<![A-Za-z0-9_\\\@-]) (?<!\\.(?!(?i:www))) $subdom$zone(?![A-Za-z0-9_.-]*\\\@) ) (?>(?>$port?(?>\\\@$host$zone(?![A-Za-z0-9_.-]*\\\@))?)?) ) ($tail?) RE
my $text=<<TEXT; URLs: Ftp://a.com/AAa Look at:aaa.Museum. http://www.proxy.com:80\@www.site.com/ http://proxy.com:80\@site.com/ http://proxy.com\@site.com/ aAaa.com.au.rr.ggg Zwww.Yabcd.co.uk Фforum.abcd.de www.Abc.eu П123.123.123.1234.com/?q=aaa http://Abc.Tk Ahttp://www.Abc.pt/AAa http://abc.au/query/vid.cam.dig/sony.dcrhc15.htm#full_image Ф.Www.old-avto.tk
NOT URLs: aaa.museumm http://aaa.museumm, http://-aaa.com www._aaa.com www.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.com TEXT
$text =~ s!$re!<a href="${\($2 ? '' : 'http://')}\L$1\E$3" target="_blank">$1$3</a>!gx; print $text;

Листинг 8.1.

Закрыть окно

#!/usr/bin/perl -w
use strict;
my $protocol='(?:(?=[FfHh])(?i:http(?>s?)|ftp)://)';
my $host=<
(?>[A-Za-z0-9]{1,63}\\.)
(?>[A-Za-z0-9]
(?>[-A-Za-z0-9]{0,62})\\.
)*
HOST
my $subdom=<
(?:
(?>[A-Za-z0-9]
(?:[-A-Za-z0-9]{0,61}[A-Za-z0-9])?
)\\.
)+
SUBDOM
my $wb='(?![A-Za-z0-9])';
my $zone=<
(?i:(?(?=[a-z]{3}$wb)(?>com|net|org|edu|biz|gov|int|mil)|
(?(?=[a-z]{2}$wb)[a-z]{2}|
(?(?=[a-z]{4}$wb)(?>info|aero|name)|
(?(?=[a-z]{6}$wb)museum|(?!)
)
)
)
)
(?>\\.[a-z]{2}$wb)?
)
ZONE
my $port="(?::\\d{1,5}$wb)";
my $tail=<
(?:[/?]
(?>[^.,"'<>()[\\]{}\\s\\x7F-\\xFF]*)
(?:(?>[.,?]+)
(?:[^"'<>()[\\]{}\\s\\x7F-\\xFF]+)
)*
(? )
TAIL
my $re=<
(
(?>($protocol)(?(2)(?>$host$zone)|$host$zone)
(?![A-Za-z0-9])|
(? (? $subdom$zone(?![A-Za-z0-9_.-]*\\\@)
)
(?>(?>$port?(?>\\\@$host$zone(?![A-Za-z0-9_.-]*\\\@))?)?)
)
($tail?)
RE
my $text=<
URLs:
Ftp://a.com/AAa
Look at:aaa.Museum.
http://www.proxy.com:80\@www.site.com/
http://proxy.com:80\@site.com/
http://proxy.com\@site.com/
aAaa.com.au.rr.ggg
Zwww.Yabcd.co.uk
Фforum.abcd.de
www.Abc.eu
П123.123.123.1234.com/?q=aaa
http://Abc.Tk
Ahttp://www.Abc.pt/AAa
http://abc.au/query/vid.cam.dig/sony.dcrhc15.htm#full_image
Ф.Www.old-avto.tk
NOT URLs:
aaa.museumm
http://aaa.museumm,
http://-aaa.com
www._aaa.com
www.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.com
TEXT
$text =~ s!$re!$1$3!gx;
print $text;

NOT URLs:

URLs: <a href="ftp://a.com/AAa" target="_blank">Ftp://a.com/AAa</a> Look at:<a href="http://aaa.museum" target="_blank">aaa.Museum</a>. <a href="http://www.proxy.com:80@www.site.com/" target="_blank">http://www.proxy.com:80@www.site.com/</a> <a href="http://proxy.com:80@site.com/" target="_blank">http://proxy.com:80@site.com/</a> <a href="http://proxy.com@site.com/" target="_blank">http://proxy.com@site.com/</a> <a href="http://aaaa.com.au.rr" target="_blank">aAaa.com.au.rr</a>.ggg <a href="http://zwww.yabcd.co.uk" target="_blank">Zwww.Yabcd.co.uk</a> Ф<a href="http://forum.abcd.de" target="_blank">forum.abcd.de</a> <a href="http://www.abc.eu" target="_blank">www.Abc.eu</a> П<a href="http://123.123.123.1234.com/?q=aaa" target="_blank">123.123.123.1234.com/?q=aaa</a> <a href="http://abc.tk" target="_blank">http://Abc.Tk</a> A<a href="http://www.abc.pt/AAa" target="_blank">http://www.Abc.pt/AAa</a> <a href="http://abc.au/query/vid.cam.dig/sony.dcrhc15.htm#full_image" target="_blank">http://abc.au/query/vid.cam.dig/sony.dcrhc15.htm#full_image</a> Ф.<a href="http://www.old-avto.tk" target="_blank">Www.old-avto.tk</a>
NOT URLs: aaa.museumm http://aaa.museumm, http://-aaa.com www._aaa.com www.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.com

Листинг 8.2.

Закрыть окно

URLs:
Ftp://a.com/AAa
Look at:aaa.Museum.
http://www.proxy.com:80@www.site.com/
http://proxy.com:80@site.com/
http://proxy.com@site.com/
aAaa.com.au.rr.ggg
Zwww.Yabcd.co.uk
Фforum.abcd.de
www.Abc.eu
П123.123.123.1234.com/?q=aaa
http://Abc.Tk
Ahttp://www.Abc.pt/AAa
http://abc.au/query/vid.cam.dig/sony.dcrhc15.htm#full_image
Ф.Www.old-avto.tk
NOT URLs:
aaa.museumm
http://aaa.museumm,
http://-aaa.com
www._aaa.com
www.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.com

и passw ограничены 32 символами

#!perl -w use strict;
my $wb='(?![A-Za-z0-9])';
my $protocol='(?:(?=[FfHh])(?i:http(?>s?)|ftp)://)';
my $host=<<HOST; (?>[-A-Za-z0-9_]{1,63}\\.) (?>[A-Za-z0-9_] (?>[-A-Za-z0-9_]{0,62})\\. )* HOST
my $subdom=<<SUBDOM; (?: (?>[A-Za-z0-9] (?:[-A-Za-z0-9]{0,61}[A-Za-z0-9])? )\\. )+ SUBDOM
my $subdom1='[A-Za-z0-9](?:[-A-Za-z0-9]{0,61}[A-Za-z0-9])?';
my $zone=<<ZONE; (?i: (?=[a-z]{3}$wb) (?>com|net|org|edu|biz|gov|int|mil)| (?(?=[a-z]{2}$wb)[a-z]{2}| (?(?=[a-z]{4}$wb)(?>info|aero|name)| (?(?=[a-z]{6}$wb)museum|(?!) ) ) ) (?>\\.[a-z]{2}$wb)? ) ZONE
my $port="(?::\\d{1,5}$wb)";
my $tail=<<TAIL; (?:[/?] (?>[^.,"'<>()\\[\\]{}\\s\\x7F-\\xFF]*) (?: (?>[.,?]+) (?:[^"'<>()\\[\\]{}\\s\\x7F-\\xFF]+) )* (?<![,.?!-]) ) TAIL
my $firstchr='(?:[A-Za-z0-9])';
my $namechr='(?:[A-Za-z0-9_+.-])';
my $ip='(?:(?<!\\d)(?>\\d{1,3})\\.(?>\\d{1,3})\\.(?>\\d{1,3})\\.(?>\\d{1,3})(?!\\d))';
# Login и passw ограничены 32 символами my $loginpasswat='(?:(?>[A-Za-z0-9_]{1,32})(?>(?::[A-Za-z0-9_]{1,32})?)\\@)';
my $res;
$_=q(http://www.proxy.com:80@www.site.com/ Ftp://a.com/AAa Ftp://Login:Passw@Www.Aaa.Com/Www/ Ftp://login:passw@a-aa.com/www/ Mailto:aaa@sss.zzz.co. Mailto:aaa@sss.zzz.eee.co. aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa@aaa.com ыы@ddd.com ыы@ddЫd.com ыыsы-sf.ff.com.com@ddd.com ыыsы.-sf.ff@ddd.com Mailto:aaa@sss.co, aaa@sss.comЫЫЫ aaa.Bb.b@aaaa.com.ru.rr.ggg aaa.museumm Look at:aaa.museum. httpS://aaa.museumm, http://www.proxy.com:80@www.site.com/ http://proxy.com:80@site.com/ http://proxy.com@site.com/ aAaa.com.ru.rr.ggg Zwww.Yabcd.co.uk Фforum.abcde.ru www.Eabcd.ru http://Eabcd.Ru Ahttp://www.Eabcd.ru/AAa http://abc.ru/query/vid.cam.dig/sony.dcrhc15.htm#full_image Ф.Www.abcdefg-avto.ru httP://1.2.3.400/aaa/ddd.exe? 1.2.3.400/aaa/ddd.exe?d=c,f=t;&e=h, .0.2.3.400. http://66.123.234.555/ddd michel@ab-cdefg.ru http://99.999.999.999/search?q=cache:w5K8GsupwvcJ:olympus.flexiblesoft.com/c-4000-man.doc+c-4000-man&hl=ru&client=firefox-a );
# Оформляем ссылки без login:passw s#((?>($protocol)(?(2)(?>$ip|$host$zone)|$host$zone)(?![A-Za-z0-9])|(?<![A-Za-z0-9_\@-])(?<!\.(?!(?i:www)))$subdom$zone(?![A-Za-z0-9_.-]*\@))(?>(?>$port?(?>\@$host$zone(?![A-Za-z0-9_.-]*\@))?)?))($tail?)#$res=$2 ? '' : 'http://'; qq!<a href="$res\L$1\E$3" target="_blank">$1$3</a>!#gex; # Оформляем ссылки с login:passw s#($protocol)($loginpasswat)($ip|$host$zone)((?>$port?)$tail?)#<a href=\"\L$1\E$2\L$3\E$4\" target=\"_blank\">$1$2$3$4</a>"#gx; # Оформляем е-мейлы. Этот оператор чувствителен к тексту, на который меняет предыдущие операторы! s#((?<!$firstchr)$firstchr(?>$namechr{0,39})\@(?>$subdom1)(?:\.$subdom1)?\.$zone)(?!(?>[^\s"<]*)(?:"\starget="_blank">|</a>))#<a href="mailto:$1">$1</a>#gx; # Оформляем ссылки с IP s#((?<![>/])$ip(?>$port?))($tail?)#"<a href=\"http://\L$1\E$2\" target=\"_blank\">$1$2</a>"#gx;
print $_;

Листинг 8.3.

Закрыть окно

#!perl -w
use strict;
my $wb='(?![A-Za-z0-9])';
my $protocol='(?:(?=[FfHh])(?i:http(?>s?)|ftp)://)';
my $host=<
(?>[-A-Za-z0-9_]{1,63}\\.)
(?>[A-Za-z0-9_]
(?>[-A-Za-z0-9_]{0,62})\\.
)*
HOST
my $subdom=<
(?:
(?>[A-Za-z0-9]
(?:[-A-Za-z0-9]{0,61}[A-Za-z0-9])?
)\\.
)+
SUBDOM
my $subdom1='[A-Za-z0-9](?:[-A-Za-z0-9]{0,61}[A-Za-z0-9])?';
my $zone=<
(?i:
(?=[a-z]{3}$wb)
(?>com|net|org|edu|biz|gov|int|mil)|
(?(?=[a-z]{2}$wb)[a-z]{2}|
(?(?=[a-z]{4}$wb)(?>info|aero|name)|
(?(?=[a-z]{6}$wb)museum|(?!)
)
)
)
(?>\\.[a-z]{2}$wb)?
)
ZONE
my $port="(?::\\d{1,5}$wb)";
my $tail=<
(?:[/?]
(?>[^.,"'<>()\\[\\]{}\\s\\x7F-\\xFF]*)
(?:
(?>[.,?]+)
(?:[^"'<>()\\[\\]{}\\s\\x7F-\\xFF]+)
)*
(? )
TAIL
my $firstchr='(?:[A-Za-z0-9])';
my $namechr='(?:[A-Za-z0-9_+.-])';
my $ip='(?:(?\\d{1,3})\\.(?>\\d{1,3})\\.(?>\\d{1,3})\\.(?>\\d{1,3})(?!\\d))';
# Login и passw ограничены 32 символами
my $loginpasswat='(?:(?>[A-Za-z0-9_]{1,32})(?>(?::[A-Za-z0-9_]{1,32})?)\\@)';
my $res;
$_=q(http://www.proxy.com:80@www.site.com/
Ftp://a.com/AAa
Ftp://Login:Passw@Www.Aaa.Com/Www/
Ftp://login:passw@a-aa.com/www/
Mailto:aaa@sss.zzz.co.
Mailto:aaa@sss.zzz.eee.co.
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa@aaa.com
ыы@ddd.com
ыы@ddЫd.com
ыыsы-sf.ff.com.com@ddd.com
ыыsы.-sf.ff@ddd.com
Mailto:aaa@sss.co,
aaa@sss.comЫЫЫ
aaa.Bb.b@aaaa.com.ru.rr.ggg
aaa.museumm
Look at:aaa.museum.
httpS://aaa.museumm,
http://www.proxy.com:80@www.site.com/
http://proxy.com:80@site.com/
http://proxy.com@site.com/
aAaa.com.ru.rr.ggg
Zwww.Yabcd.co.uk
Фforum.abcde.ru
www.Eabcd.ru
http://Eabcd.Ru
Ahttp://www.Eabcd.ru/AAa
http://abc.ru/query/vid.cam.dig/sony.dcrhc15.htm#full_image
Ф.Www.abcdefg-avto.ru
httP://1.2.3.400/aaa/ddd.exe?
1.2.3.400/aaa/ddd.exe?d=c,f=t;&e=h,
.0.2.3.400.
http://66.123.234.555/ddd
michel@ab-cdefg.ru
http://99.999.999.999/search?q=cache:w5K8GsupwvcJ:olympus.flexiblesoft.com/c-4000-man.doc+c-4000-man&hl=ru&client=firefox-a
);
# Оформляем ссылки без login:passw
s#((?>($protocol)(?(2)(?>$ip|$host$zone)|$host$zone)(?![A-Za-z0-9])|(?(?>$port?(?>\@$host$zone(?![A-Za-z0-9_.-]*\@))?)?))($tail?)#$res=$2 ? '' : 'http://'; qq!$1$3!#gex;
# Оформляем ссылки с login:passw
s#($protocol)($loginpasswat)($ip|$host$zone)((?>$port?)$tail?)#$1$2$3$4"#gx;
# Оформляем е-мейлы. Этот оператор чувствителен к тексту, на который меняет предыдущие операторы!
s#((?$namechr{0,39})\@(?>$subdom1)(?:\.$subdom1)?\.$zone)(?!(?>[^\s"<]*)(?:"\starget="_blank">|))#$1#gx;
# Оформляем ссылки с IP
s#((?/])$ip(?>$port?))($tail?)#"$1$2"#gx;
print $_;

museumm Look

<a href="http://www.proxy.com:80@www.site.com/" target="_blank">http://www.proxy.com:80@www.site.com/</a> <a href="ftp://a.com/AAa" target="_blank">Ftp://a.com/AAa</a> <a href="ftp://Login:Passw@www.aaa.com/Www/" target="_blank">Ftp://Login:Passw@Www.Aaa.Com/Www/</a>" <a href="ftp://login:passw@a-aa.com/www/" target="_blank">Ftp://login:passw@a-aa.com/www/</a>" Mailto:<a href="mailto:aaa@sss.zzz.co">aaa@sss.zzz.co</a>. Mailto:aaa@sss.zzz.eee.co. aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa@aaa.com ыы@ddd.com ыы@ddЫ<a href="http://d.com" target="_blank">d.com</a> ыыsы-<a href="mailto:sf.ff.com.com@ddd.com">sf.ff.com.com@ddd.com</a> ыыsы.-<a href="mailto:sf.ff@ddd.com">sf.ff@ddd.com</a> Mailto:<a href="mailto:aaa@sss.co">aaa@sss.co</a>, <a href="mailto:aaa@sss.com">aaa@sss.com</a>ЫЫЫ <a href="mailto:aaa.Bb.b@aaaa.com.ru.rr">aaa.Bb.b@aaaa.com.ru.rr</a>.ggg aaa. museumm Look at:<a href="http://aaa.museum" target="_blank">aaa.museum</a>. httpS://aaa.museumm, <a href="http://www.proxy.com:80@www.site.com/" target="_blank">http://www.proxy.com:80@www.site.com/</a> <a href="http://proxy.com:80@site.com/" target="_blank">http://proxy.com:80@site.com/</a> <a href="http://proxy.com@site.com/" target="_blank">http://proxy.com@site.com/</a> <a href="http://aaaa.com.ru.rr" target="_blank">aAaa.com.ru.rr</a>.ggg <a href="http://zwww.yabcd.co.uk" target="_blank">Zwww.Yabcd.co.uk</a> Ф<a href="http://forum.abcde.ru" target="_blank">forum.abcde.ru</a> <a href="http://www.eabcd.ru" target="_blank">www.Eabcd.ru</a> <a href="http://eabcd.ru" target="_blank">http://Eabcd.Ru</a> A<a href="http://www.eabcd.ru/AAa" target="_blank">http://www.Eabcd.ru/AAa</a> <a href="http://abc.ru/query/vid.cam.dig/sony.dcrhc15.htm#full_image" target="_blank">http://abc.ru/query/vid.cam.dig/sony.dcrhc15.htm#full_image</a> Ф.<a href="http://www.abcdefg-avto.ru" target="_blank">Www.abcdefg-avto.ru</a> <a href="http://1.2.3.400/aaa/ddd.exe" target="_blank">httP://1.2.3.400/aaa/ddd.exe</a>? "<a href="http://1.2.3.400/aaa/ddd.exe?d=c,f=t;&e=h" target="_blank">1.2.3.400/aaa/ddd.exe?d=c,f=t;&e=h</a>", ."<a href="http://0.2.3.400" target="_blank">0.2.3.400</a>". <a href="http://66.123.234.555/ddd" target="_blank">http://66.123.234.555/ddd</a> <a href="mailto:michel@ab-cdefg.ru">michel@ab-cdefg.ru</a> <a href="http://99.999.999.999/search?q=cache:w5K8GsupwvcJ:olympus.flexiblesoft.com/c-4000-man.doc+c-4000-man&hl=ru&client=firefox-a" target="_blank">http://99.999.999.999/search?q=cache:w5K8GsupwvcJ:olympus.flexiblesoft.com/c-4000-man.doc+c-4000-man&hl=ru&client=firefox-a</a>

Листинг 8.4.

Закрыть окно

http://www.proxy.com:80@www.site.com/
Ftp://a.com/AAa
Ftp://Login:Passw@Www.Aaa.Com/Www/"
Ftp://login:passw@a-aa.com/www/"
Mailto:aaa@sss.zzz.co.
Mailto:aaa@sss.zzz.eee.co.
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa@aaa.com
ыы@ddd.com
ыы@ddЫd.com
ыыsы-sf.ff.com.com@ddd.com
ыыsы.-sf.ff@ddd.com
Mailto:aaa@sss.co,
aaa@sss.comЫЫЫ
aaa.Bb.b@aaaa.com.ru.rr.ggg
aaa.museumm
Look at:aaa.museum.
httpS://aaa.museumm,
http://www.proxy.com:80@www.site.com/
http://proxy.com:80@site.com/
http://proxy.com@site.com/
aAaa.com.ru.rr.ggg
Zwww.Yabcd.co.uk
Фforum.abcde.ru
www.Eabcd.ru
http://Eabcd.Ru
Ahttp://www.Eabcd.ru/AAa
http://abc.ru/query/vid.cam.dig/sony.dcrhc15.htm#full_image
Ф.Www.abcdefg-avto.ru
httP://1.2.3.400/aaa/ddd.exe?
"1.2.3.400/aaa/ddd.exe?d=c,f=t;&e=h",
."0.2.3.400".
http://66.123.234.555/ddd
michel@ab-cdefg.ru
http://99.999.999.999/search?q=cache:w5K8GsupwvcJ:olympus.flexiblesoft.com/c-4000-man.doc+c-4000-man&hl=ru&client=firefox-a

Встроенный код и директивы my и local

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

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

Для корректной работы переменных внутри встроенного кода их надо локализовать внутри регулярного выражения. Это делается директивой local. Значения таких переменных при возврате за встроенный код, в котором им присваивались значения, восстанавливаются такими, какими были до выполнения этого кода. Такие переменные должны быть глобальными, т.е. созданными не директивой my. Если в программе используется директива use strict, то глобальную переменную можно создать с помощью ключевого слова our. Тогда директива local внутри регулярного выражения делает из этой переменной как бы стек ее значений: при присваивании ей значения во встроенном коде оно наслаивается поверх предыдущего значения этой переменной, а при возврате назад восстанавливается предыдущее значение. После конца работы регулярного выражения эта переменная восстанавливает свое значение, которое имела перед входом в регулярное выражение.

Рассмотрим такой пример:

#!/usr/bin/perl -w use strict;

$_='ab'; our $o=1; my $m=1; / (?: a (?{ $o++; $m++ }) | ab (?{ print "\$o=$o, \$m=$m" }) ) $ /x;

Регулярное выражение содержит конструкцию выбора:

/(a|ab)$/

Вначале будет найден символ a и выберется первая ветка условного шаблона, при этом переменные $o и $m увеличатся на единицу. Но затем этот выбор будет отменен, поскольку за символом a должен идти символ b, и управление получит вторая альтернатива конструкции выбора, в которой будут распечатаны значения переменных $o и $m. На печать выйдет:

$o=2, $m=2

В этом примере различия в работе этих переменных нет. Теперь локализуем глобальную переменную $o в регулярном выражении:

#!/usr/bin/perl -w use strict;

$_='ab'; our $o=1; my $m=1; / (?{ local $o }) (?: a (?{ $o++; $m++ })| ab (?{ print "\$o=$o, \$m=$m" }) ) $ /x;

На сей раз напечатается это:

$o=1, $m=2

Этот пример показывает работу директивы local во встроенном коде.

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

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

$_='ab'; our $o=1; / (?{ my $m=10; local $o }) (?: a (?{ $o++; $m++ })| ab (?{ print "\$o=$o, \$m=$m" }) ) $ /x;

Напечатается

$o=1, $m=1

Мы видим, что во втором встроенном коде переменная $m создалась заново с неопределенным значением, затем к нему применили ++ и получили 1. И это значение потом использовалось при печати.

$_='ab'; our $o=1; my $m=10; / (?{ my $m=5; local $o }) (?: a (?{ $o++; $m++ })| ab (?{ print "\$o=$o, \$m=$m" }) ) $ /x;

Здесь напечатается

$o=1, $m=11

Во втором и третьем встроенном коде использовалась переменная $m, которая была создана до регулярного выражения.

Директиву local можно комбинировать с присваиванием значения этой переменной.

Например:

local ($ctop) = $ctop+1;

Встроенный код и интеллектуализация поиска

Рассмотрим пример, когда встроенный код помогает сделать поиск более интеллектуальным. Путь нам надо найти в тексте самое большое натуральное число. При поиске мы используем цикл while и модификатор g. Результат будем запоминать в переменной $n, которая вначале будет иметь неопределенное значение. Во встроенном коде мы проверяем, имеет ли переменная $n определенное значение или $n меньше очередного найденного числа. Если это так, то мы присваиваем $n новое значение. В результате $n должна хранить первое попавшееся максимальное число.

my $n; $_='20 0 36 35'; while (/(\d+)(?{$n=$+ if !defined $n || $n < $+})/g) {} print "Наибольшее число - это $n" if defined $n;

Напечатается

Наибольшее число - это 36

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

my $n; $_='20 0 36 35'; /(\d+)(?{$n=$+ if !defined $n || $n < $+})(?!)/; print "Наибольшее число - это $n" if defined $n;

Опять напечатается, что

Наибольшее число - это 36

Относительно этого красивого примера хочу сделать такое замечание: если вы распечатаете начальные позиции поиска, то обнаружите, что благодаря работе условной конструкции (?!) поиск стартует, начиная с каждой цифры, т.е. проверяются также "числа" 6 и 5. И только по счастливой случайности это не привело к ошибке в результате. Вообще говоря, перед подшаблоном (\d+) надо поставить условие, что слева нет цифры, тогда поиск будет начинаться только с начала чисел:

my $n; $_='20 0 36 35'; /(?<!\d)(\d+)(?{$n=$+ if !defined($n) || $n < $+})(?!)/; print "Наибольшее число - это $n" if defined $n;

Обратите внимание, что поиск при использовании подшаблона (?!), если он не стоит в альтернативной конструкции и условном операторе, всегда заканчивается неудачей, а такой оператор поиска используется только ради побочных эффектов (установки нумерованных переменных), поэтому неправильно вставлять подобный оператор в заголовок цикла while и в условие оператора if.

А сейчас распространим этот пример на отрицательные числа. Надо учитывать знак минус перед числом. С циклом while и модификатором g все работает так же, как и раньше:

my ($n,$tmp); $_='-200 0 36 35'; while( /(-)? # берем минус в $1, если он есть (\d+) # берем число в $2 (?{ $tmp=$1 ? -$2 : $2; # в $tmp получаем число с учетом знака $n=$tmp if !defined $n || $n < $tmp; }) /gx) {}; print "Наибольшее число - это $n" if defined $n;

Для удобства я применил модификатор x и комментарии. Если переменная $1 определена, то мы в тернарном условном операторе учитываем, что число отрицательное; если $1 имеет неопределенное значение, то берем число из $2 таким, как есть. В операторе

$n=$tmp if !defined($n) || $n < $tmp;

мы не можем аналогично написать

$n=$tmp if !$n || $n < $tmp;

потому что значения $n==0 и $n==undefined будут неразличимы.

В итоге на печать выходит строка

Наибольшее число - это 36

В более красивом случае нужно позаботиться о том, чтобы поиск не начинался сразу после знака минус и чтобы перед подшаблоном (\d+) не было цифры. И все число неплохо заключить в атомарные скобки, т.к. число должно состоять из всех встретившихся подряд цифр и знака минус, если он был.

my ($n,$tmp); $_='-200 0 36 35'; /(?<!-) # перед стартовой позицией не должно быть минуса (?> # атомарная группировка для всего числа (-)? # берем минус в $1, если он есть (?<![\d]) # перед числом не должно быть цифры (\d+) # берем число в $2 ) (?{ $tmp=$1 ? -$2 : $2; # в $tmp получаем число с учетом знака $n=$tmp if !defined $n || $n < $tmp; }) (?!) /x; print "Наибольшее число это $n" if defined $n;

И опять на печать выходит, что

Наибольшее число - это 36

Встроенный код и оптимизация регулярных выражений

Мы уже имели возможность убедиться в полезности встроенного кода при выводе текущей позиции поиска и содержимого специальных переменных, изменяемых при поиске. Встроенный код также необходим во время отладки и ускорения работы регулярного выражения. Часто программист не подозревает, сколько лишней работы производят его конструкции внутри регулярного выражения.

Для примера рассмотрим программу, которая ищет и печатает даты в формате Jan 13 2007, Apr 5 2007 и т.д. Вот такая программа, которая сразу приходит в голову:

$_='Дата1 Jan 13 2007, дата2 Apr 5 2007'; while (/(?:Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)(?:\s+\d+){2}/g) { print "Нашла дату $&\n"; }

Программа выдает:

Нашла дату Jan 13 2007 Нашла дату Apr 5 2007

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

Для любопытства вставим распечатку текущей позиции поиска в начало регулярного выражения:

$_='Дата1 Jan 13 2007, дата2 Apr 5 2007'; while (/(?{print pos($_).' '})(?:Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec) (?:\s+\d+){2}/g) { print "\nНашла дату $&\n"; }

Получим на выходе

0 1 2 3 4 5 6 Нашла дату Jan 13 2007 17 18 19 20 21 22 23 24 25 Нашла дату Apr 5 2007

Вот столько раз (и как правило, безуспешно) эта программа применяет затратную конструкцию выбора.

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

$_='Дата1 Jan 13 2007, дата2 Apr 5 2007'; while (/(?=[ADFJMNOS])(?{print pos($_).' '}) (?:Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)(?:\s+\d+){2}/g) { print "\nНашла дату $&\n"; }

(В этом тексте длинная строка могла быть перенесена на символе пробела.)

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

6 Нашла дату Jan 13 2007 25 Нашла дату Apr 5 2007

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

Встроенный код и поиск вложенных конструкций

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

2*(3+2*(5-1)-2)+12

содержит конструкцию из правильно закрытых скобок, а строки

( ) ) ( )

( ( ) ( )

содержат неправильно сбалансированные круглые скобки.

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

Схема регулярного выражения будет такая:

^ # поиск от начала текста (?> # поиск без возвратов (?: (?> [^()]+ ) # все кроме круглых скобок без возврата | $ # или открывающая круглая скобка | $ # или закрывающая круглая скобка )* # сколько угодно раз ) $ # поиск до конца текста

Вначале счетчик $ctop (count of open parens) содержит 0. При встрече открывающей скобки выполняем код

(?{ ++$ctop })

При встрече закрывающей скобки выполняем условный оператор с кодом Perl в условии:

(?(?{ $ctop }) (?{ --$ctop }) | (?!) )

А если к этому моменту $ctop равен нулю, то подставляем шаблон (?!), который приведет к несовпадению для всего регулярного выражения.

В конец регулярного выражения подставим код

(?(?{ $ctop }) (?!) )

который тоже приведет к несовпадению для всего шаблона, если счетчик $ctop не будет равен нулю.

Теперь вся программа:

$_='( () ) ( ) (()())'; my $ctop=0; if (/ ^ (?> (?: (?> [^()]+ ) | $ (?{ ++$ctop }) | $ (?(?{ $ctop }) (?{ --$ctop }) | (?!) ) )* ) (?(?{ $ctop }) (?!) ) $ /x ) { print 'Match' } else { print 'Not match' }

При этих данных наша программа выводит Match, но если нарушить баланс скобок, то будет выведено Not match.

В этом примере скобки представлялись одним символом, но они могут быть и многосимвольными. Например, мы проверяем правильность вложенности тегов table. В этом случае подшаблон (?> [^()]+ ) нужно заменить на другую конструкцию, т.к. многосимвольные скобки нельзя втиснуть в класс символов. Вместо этого подшаблона используется такая конструкция:

(?> (?: (?! <table|</table ) .)+ )

Эта конструкция проверяет, находится ли в текущей позиции фрагмент <table или </table, и если нет ни того, ни другого фрагмента, то она поглощает один символ с помощью точки.

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

$_=<<EOF; <Table> <tr><td> <Table> <tr><td> </td></tr> </TABLE> </td></tr> </TABLE> EOF

my $ctop=0; if (m% ^ (?> (?: (?> (?: (?! <table|</table ) .)+ ) | <table (?{ ++$ctop }) | </table (?(?{ $ctop }) (?{ --$ctop }) | (?!) ) )* ) (?(?{ $ctop }) (?!) ) $ %isx ) { print 'Match' } else { print 'Not match' }

С данными в переменной $_ будет напечатано Match.

Объекты регулярных выражений и квантификаторы

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

$_='abab'; my $re=qr/ab/; print $& if /$re+/;

Напечатается abab. В случае с интерполяцией текста в регулярное выражение:

$_='abab'; my $re='ab'; print $& if /$re+/;

напечатается только ab, т.е. плюс относится лишь к последнему символу b.

Ограничители в операторе qr/…/

В операторе qr/…/ в качестве ограничителей регулярного выражения не обязательно применять слэши, можно применять все те же символы, что и в операторе поиска m/…/. Но не применяйте в качестве ограничителей вопросительные знаки из-за их специального значения. Когда ограничителями выступают апострофы, при трансляции этого регулярного выражения не будет интерполяции переменных, если переменные будут там присутствовать. Вот пример с интерполяцией переменной:

my $a='ab'; $_='ab'; my $re=qr"^$a$"; print "\$re=$re\n"; print $& if /$re/;

Напечатается

$re=(?-xism:^ab$) ab

Теперь сделаем ограничителями апострофы и попробуем поискать строку '$a':

my $a='ab'; $_='$a'; my $re=qr'^$a$'; print "\$re=$re\n"; print $& if /$re/;

В результате напечатается

$re=(?-xism:^$a$)

Мы видим, что поиск закончился неудачей. Оказывается, символ $ перед именем переменной в операторе qr'…' все равно надо маскировать:

my $a='ab'; $_='$a'; my $re=qr'^\$a$'; print "\$re=$re\n"; print $& if /$re/;

Напечатается

$re=(?-xism:^\$a$) $a

То же касается текстов в интерполированных переменных: если после символа $ (и наверно, после символа @) стоят символы, при которых возможна интерпретация этих символов как имени переменной, то $ и @ должны быть замаскированы обратным слэшем. Символы внутри регулярных выражений, которые должны представлять сами себя, а не быть метасимволами, надо так же маскировать внутри оператора qr'…', как и в операторе qr/…/ со всеми остальными типами ограничителей. Это же касается и интерполируемых в регулярное выражение переменных (что более понятно). Вот пример: пытаемся найти символ |:

my $a='ab'; $_='|'; my $re=qr'^|$'; print "\$re=$re\n"; print "Found $&" if /$re/;

Будет напечатано

$re=(?-xism:^|$) Found

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

my $a='ab'; $_='|'; my $re=qr'^\|$'; print "\$re=$re\n"; print "Found $&" if /$re/;

Напечатается

$re=(?-xism:^|$) Found |

Оператор qr/…/

Наряду с операторами q/…/, qq/…/ и qx/…/ в Perl существует оператор qr/…/. Он получает в качестве операнда регулярное выражение, транслирует его и запоминает в переменной, которой присваивается результат. Например:

$_='123abcd'; my $re=qr/((\d+)\w+)/; /$re/; print "$1 $2";

Будет напечатано

123abcd 123

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

Использование ограничителей вокруг переменной, содержащей оттранслированное регулярное выражение, не обязательно, но в этом примере, где не применяется оператор связывания =~ регулярного выражения с целевой переменной, без ограничителей регулярное выражение работать не будет:

#!/usr/bin/perl -w use strict;

$_='123abcd'; my $re=qr/((\d+)\w+)/; $re; print "$1 $2";

Напечатаются сообщения об ошибках:

Useless use of private variable in void context at a.pl line 6. Use of uninitialized value in concatenation (.) or string at a.pl line 7. Use of uninitialized value in concatenation (.) or string at a.pl line 7.

В случае использование оператора связывания все работает нормально:

$_='123abcd'; my $re=qr/((\d+)\w+)/; $_ =~ $re; print "$1 $2";

Печатается

123abcd 123

Записи

$_ =~ $re;

$_ =~ /$re/;

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

$_ =~ ^$re$;

ни

$_ =~ $re$re;

ни

$_ =~ $re.$re;

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

$_ =~ /^$re$/; $_ =~ /$re$re/; $_ =~ /$re.$re/;

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

После разделителя в команде qr/…/ могут стоять модификаторы. Сравните результаты:

$_='Ab'; my $re=qr/[a-z]+/; print $& if $_ =~ $re;

Печатается b

$_='Ab'; my $re=qr/[a-z]+/i; print $& if $_ =~ $re;

Печатается Ab

Поддерживаются все модификаторы кроме e, g и c. Применение модификатора o с оператором qr/…/ ведет к неприятному эффекту, которы рассматривается в пункте 10.2.

Оператор qr/…/ и интерполяция переменных

Если интерполируемые переменные, которые используются в операторе qr/…/, после трансляции им регулярного выражения изменят свое значение, то это не отразится на объекте регулярного выражения, даже если оператор qr/…/ не имеет модификатора o.

Рассмотрим такие примеры:

my $a=$_='ab'; my $re=qr"$a"; print "Found $&\n" if /$re/; $_=$a='cd'; print "Found $&\n" if /$re/;

Будет напечатано

Found ab

Во второй раз поиск закончился неудачей. Но если опять присвоить переменной $re значение qr"$a", то будет найдено и cd:

my $a=$_='ab'; my $re=qr"$a"; print "Found $&\n" if /$re/; $_=$a='cd'; $re=qr"$a"; print "Found $&\n" if /$re/;

Напечатается

Found ab Found cd

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

my $re=qr/ [a-z]+ # все буквы /x; print $re;

Напечатается

(?x-ism: [a-z]+ # все буквы )

Оператор qr/…/ полезен не только тем, что заранее компилирует регулярное выражение, которое потом применяется в готовом виде, но и тем, что позволяет строить большие и сложные регулярные выражения по кирпичикам. Например:

$_='ABCabc123'; my $re1=qr/[A-Z]+/; my $re2=qr/(\d+)/; print "$&\n$1\n$2" if /$re1([a-z]+)$re2/;

Напечатается

ABCabc123 abc 123

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

$_='abc111abc'; my $re1=qr/[a-z]+/; my $re2=qr/(\d+)\1/; print "$&\n$1" if /$re1$re2/;

Напечатается

abc11 1

А в случае

$_='abc111abc'; my $re1=qr/([a-z]+)/; my $re2=qr/(\d+)\1/; print "$&\n$1" if /$re1$re2/;

напечатается

abc111abc abc

В первом примере обратная ссылка \1 имела значение 1, а во втором - abc, т.е. стала относиться к нумерованной переменной из другого объекта регулярного выражения.

В принципе, в этих двух случаях может помочь переменная $^N, которая дублирует значение нумерованной переменной, соответствующей последней только что закрытой паре захватывающих скобок. Если вам надо сохранить значение нумерованной переменной, то сразу после того, как закроется ее скобка, вставьте код Perl

(?{ $s=$^N })

и последнее значение нумерованной переменной сохранится во внешней переменной $s.

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

(??{ код Perl })

Возвращаемое значение этого кода Perl интерпретируется как текст и как часть общего регулярного выражения.

В последнем примере можно записать так:

$_='abc111abc'; my $re1=qr/([a-z]+)/; my $re2=qr/(\d+)(??{$^N})/; print "$&\n$1" if /$re1$re2/;

На печати получим

abc11 abc

Отсюда видим, что динамическое регулярное выражение (??{$^N}) соответствует обратной ссылке \2. Как и во встроенном коде Perl, в динамических регулярных выражениях переменные не интерполируются при компиляции шаблона, а каждый раз вычисляются заново. Другое дело, что динамические регулярные выражения и встроенный код Perl требуют увеличения времени на работу регулярного выражения.

Оператор qr/…/ и модификаторы

Объект регулярного выражения компилируется вместе со своими модификаторами, эти режимы поиска "вшиваются" в откомпилированное регулярное выражение, и их нельзя потом изменить. Пример:

$_='aB'; my $re=qr/[a-z]+/; print $& if /$re/;

Идет поиск с учетом регистра символов, на печать выводится a. Модификаторы, находящиеся снаружи объекта регулярного выражения, не могут повлиять на его работу:

print $& if /$re/i;

print $& if /(?i)$re/;

print $& if /(?i:$re)/i;

Все равно выводится только буква a. Модификатор должен стоять в самом операторе, который возвращает объект регулярного выражения:

$_='aB'; my $re=qr/[a-z]+/i; print $& if /$re/;

Теперь печатается aB.

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

$_='aB'; my $re=qr/(?i)[a-z]+/; print $& if /${re}b/;

Ничего не напечатается, т.к. режим поиска без учета регистра (?i) не действует вне объекта регулярного выражения $re. Здесь фигурные скобки, окружающие имя переменной, отделяют ее от последующих букв так же, как и в случае с интерполяцией переменных. Следующий пример:

$_='aB'; my $re=qr/(?i)[a-z]+/; print $& if /${re}B/;

напечатает aB.

Оператор qr/…/ и проблемы при использовании модификатора o

Когда в операторе qr/…/ используется модификатор o и есть интерполируемые переменные, этот объект регулярного выражения больше не модифицируется, если ему даже присваивается значение. Т.е. он как бы привязан к действующим на момент первого выполнения значениям интерполируемых переменных. Поэтому не используйте модификатор o с объектами регулярных выражений, если не хотите труднонаходимых сюрпризов. Такой пример:

my $a=$_='ab'; my $re=qr"$a"o; for my $i (0..1) { print "$re\n"; print "Found $&\n" if /$re/; $_=$a='cd'; $re=qr"$a"; }

За циклом мы создаем объект регулярного выражения $re с интерполяцией переменной $a. В цикле перед вторым проходом переменная $a меняет значение, и после этого опять повторяется оператор $re=qr"$a". На печать выходят оба найденных значения:

(?-xism:ab) Found ab (?-xism:cd) Found cd

Теперь внесем первый оператор my $re=qr"$a"o в цикл:

my $a=$_='ab'; for my $i (0..1) { my $re=qr"$a"o; print "$re\n"; print "Found $&\n" if /$re/; $_=$a='cd'; $re=qr"$a"; }

Напечатается

(?-xism:ab) Found ab (?-xism:ab)

Мы видим следующее: хотя переменная $a поменяла свое значение на cd, объект регулярного выражения $re стал как бы константой и продолжает хранить старое ее значение $a='ab', несмотря на то, что мы присваиваем $re новое значение. Виной этому модификатор o. Без него пример работает так, как ожидается:

my $a=$_='ab'; for my $i (0..1) { my $re=qr"$a"; print "$re\n"; print "Found $&\n" if /$re/; $_=$a='cd'; $re=qr"$a"; }

И печатает, как и в первом случае,

(?-xism:ab) Found ab (?-xism:cd) Found cd

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

my $a=$_='ab'; my $re=qr"ab"o; for my $i (0..1) { print "$re\n"; print "Found $&\n" if /$re/; $_=$a='cd'; $re=qr"cd"; }

Выводит

(?-xism:ab) Found ab (?-xism:cd) Found cd

sub subr() { my $b=$_; print "\$b=$b\n"; if (/$b/) { print "Found $&\n" } else { print "Not found\n" } }

Выводится, как и положено,

$b=ab Found ab $b=cd Found cd

При первом обращении к подпрограме subr ее переменная $b имеет значение ab, при втором обращении она имеет значение cd. Пример без модификатора o работает так, как мы ожидали. Теперь поставим модификатор о к регулярному выражению:

$_='ab'; &subr(); $_='cd'; &subr();

sub subr() { my $b=$_; print "\$b=$b\n"; if (/$b/o) { print "Found $&\n" } else { print "Not found\n" } }

Печатается

$b=ab Found ab $b=cd Not found

Как говорится, что и требовалось доказать. Здесь дело даже не в том, что переменная $b объявлена в подпрограмме, она могла быть объявлена просто в каком-нибудь блоке, эффект был бы таким же:

$_='ab'; for my $i (0..1) { my $b=$_; print "\$b=$b\n"; if (/$b/) { print "Found $&\n" } else { print "Not found\n" } $_='cd'; }

Печатается

$b=ab Found ab $b=cd Found cd

А в случае с модификатором о:

$_='ab'; for my $i (0..1) { my $b=$_; print "\$b=$b\n"; if (/$b/o) { print "Found $&\n" } else { print "Not found\n" } $_='cd'; }

Печатается

$b=ab Found ab $b=cd Not found

Но если подобное регулярное выражение используется в подпрограмме многократно в цикле, то отсутствие модификатора о повлечет за собой многократную компиляцию этого регулярного выражения, хотя переменная $b внутри подпрограммы не меняет своего значения. Как тут быть? Эту проблему решают объекты регулярных выражений.

Объект регулярного выражения $re=qr/$b/ будет компилироваться каждый раз при входе в подпрограмму, но внутри цикла можно использовать этот объект многократно без перекомпиляции регулярного выражения:

$_='ab'; &subr(); $_='cd'; &subr();

sub subr() { my $b=$_; my $re=qr/$b/; print "\$b=$b\n"; if (/$re/) { print "Found $&\n" } else { print "Not found\n" } }

Печатает

$b=ab Found ab $b=cd Found cd

Применение объктов регулярных выражений

Объекты регулярных выражений можно применять для повышения эффективности и построения библиотек регулярных выражений, как "кирпичики". Вот пример уже рассмотренного поиска и подсветки ссылок и e-mail в тексте с использованием объектов регулярных выражений вместо интерполяции переменных:

Листинг 10.1.

(html, txt)

На печать выйдет

Листинг 10.2.

(html, txt)

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

# Оформляем ссылки без login:passw s#((?>($protocol)(?(2)(?>$ip|$host$zone)|$host$zone)(?![A-Za-z0-9])|(?<![A-Za-z0-9_\@-])(?<!\.(?!(?i:www)))$subdom$zone(?![A-Za-z0-9_.-]*\@))(?>(?>$port?(?>\@$host$zone(?![A-Za-z0-9_.-]*\@))?)?))($tail?)#$res=$2 ? '' : 'http://'; "<a href=\"$res\L$1\E$3\" target=_blank>$1$3</a>"#ge; # Оформляем ссылки с login:passw s#($protocol)($loginpasswat)($ip|$host$zone)((?>$port?)$tail?)#<a href=\"\L$1\E$2\L$3\E$4\" target=_blank>$1$2$3$4</a>"#g; # Оформляем е-мейлы. Этот оператор чувствителен к тексту, на который меняет предыдущие операторы! s#((?<!$firstchr)$firstchr(?>$namechr{0,39})\@(?>$subdom1)(?:\.$subdom1)?\.$zone)(?!(?>[^\s"<]*)(?:" target=_blank>|</a>))#<a href="mailto:$1">$1</a>#g; # Оформляем ссылки с IP s#((?<![>/])$ip(?>$port?))($tail?)#"<a href=\"http://\L$1\E$2\" target=_blank>$1$2</a>"#g;

print $_;

Листинг 10.1.

На печать выйдет

<a href="http://www.proxy.com:80@www.site.com/" target=_blank>http://www.proxy.com:80@www.site.com/</a> <a href="ftp://a.com/AAa" target=_blank>Ftp://a.com/AAa</a> <a href="ftp://Login:Passw@www.aaa.com/Www/" target=_blank>Ftp://Login:Passw@Www.Aaa.Com/Www/</a>" <a href="ftp://login:passw@a-aa.com/www/" target=_blank>Ftp://login:passw@a-aa.com/www/</a>" Mailto:<a href="mailto:aaa@sss.zzz.co">aaa@sss.zzz.co</a>. Mailto:aaa@sss.zzz.eee.co. aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa@aaa.com ыы@ddd.com ыы@ddЫ<a href="http://d.com" target=_blank>d.com</a> ыыsы-<a href="mailto:sf.ff.com.com@ddd.com">sf.ff.com.com@ddd.com</a> ыыsы.-<a href="mailto:sf.ff@ddd.com">sf.ff@ddd.com</a> Mailto:<a href="mailto:aaa@sss.co">aaa@sss.co</a>, <a href="mailto:aaa@sss.com">aaa@sss.com</a>ЫЫЫ <a href="mailto:aaa.Bb.b@aaaa.com.ru.rr">aaa.Bb.b@aaaa.com.ru.rr</a>.ggg aaa.museumm Look at:<a href="http://aaa.museum" target=_blank>aaa.museum</a>. httpS://aaa.museumm, <a href="http://www.proxy.com:80@www.site.com/" target=_blank>http://www.proxy.com:80@www.site.com/</a> <a href="http://proxy.com:80@site.com/" target=_blank>http://proxy.com:80@site.com/</a> <a href="http://proxy.com@site.com/" target=_blank>http://proxy.com@site.com/</a> <a href="http://aaaa.com.ru.rr" target=_blank>aAaa.com.ru.rr</a>.ggg <a href="http://zwww.yabcd.co.uk" target=_blank>Zwww.Yabcd.co.uk</a> Ф<a href="http://forum.abcde.ru" target=_blank>forum.abcde.ru</a> <a href="http://www.eabcd.ru" target=_blank>www.Eabcd.ru</a> <a href="http://eabcd.ru" target=_blank>http://Eabcd.Ru</a> A<a href="http://www.eabcd.ru/AAa" target=_blank>http://www.Eabcd.ru/AAa</a> <a href="http://abc.ru/query/vid.cam.dig/sony.dcrhc15.htm#full_image" target=_blank>http://abc.ru/query/vid.cam.dig/sony.dcrhc15.htm#full_image</a> Ф.<a href="http://www.abcdefg-avto.ru" target=_blank>Www.abcdefg-avto.ru</a> <a href="http://1.2.3.400/aaa/ddd.exe" target=_blank>httP://1.2.3.400/aaa/ddd.exe</a>? "<a href="http://1.2.3.400/aaa/ddd.exe?d=c,f=t;&e=h" target=_blank>1.2.3.400/aaa/ddd.exe?d=c,f=t;&e=h</a>", ."<a href="http://0.2.3.400" target=_blank>0.2.3.400</a>". <a href="http://66.123.234.555/ddd" target=_blank>http://66.123.234.555/ddd</a> <a href="mailto:michel@ab-cdefg.ru">michel@ab-cdefg.ru</a> <a href="http://99.999.999.999/search?q=cache:w5K8GsupwvcJ:olympus.flexiblesoft.com/c-4000-man.doc+c-4000-man&hl=ru&client=firefox-a" target=_blank>http://99.999.999.999/search?q=cache:w5K8GsupwvcJ:olympus.flexiblesoft.com/c-4000-man.doc+c-4000-man&hl=ru&client=firefox-a</a>

Листинг 10.2.

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

и passw ограничены 32 символами

#!perl -w use strict;
my $wb=qr'(?![A-Za-z0-9])';
my $protocol=qr'(?=[FfHh])(?i:http(?>s?)|ftp)://';
my $host=qr'(?>[-A-Za-z0-9_]{1,63}\.) (?>[A-Za-z0-9_] (?>[-A-Za-z0-9_]{0,62})\. )*'x; # вместе с www
my $subdom=qr'(?:(?>[A-Za-z0-9](?:[-A-Za-z0-9]{0,61}[A-Za-z0-9])?)\.)+';
my $subdom1=qr'[A-Za-z0-9](?:[-A-Za-z0-9]{0,61}[A-Za-z0-9])?';
my $zone=qr"(?(?=[a-z]{3}$wb)(?>com|net|org|edu|biz|gov|int|mil)| (?(?=[a-z]{2}$wb)[a-z]{2}| (?(?=[a-z]{4}$wb)(?>info|aero|name)| (?(?=[a-z]{6}$wb)museum|(?!) ) ) ) ) (?>\.[a-z]{2}$wb)?"ix;
my $port=qr":\d{1,5}$wb";
my $tail=qr#[/?](?>[^.,"'<>()\[\]{}\s\x7F-\xFF]*)(?:(?>[.,?]+)(?:[^"'<>()\[\]{}\s\x7F-\xFF]+))*(?<![,.?!-])#;
my $firstchr=qr'[A-Za-z0-9]';
my $namechr=qr'[A-Za-z0-9_+.-]';
my $ip=qr'(?<!\d)(?>\d{1,3})\.(?>\d{1,3})\.(?>\d{1,3})\.(?>\d{1,3})(?!\d)';
# Login и passw ограничены 32 символами my $loginpasswat=qr'(?>[A-Za-z0-9_]{1,32})(?>(?::[A-Za-z0-9_]{1,32})?)@';
my $res;
$_=q(http://www.proxy.com:80@www.site.com/ Ftp://a.com/AAa Ftp://Login:Passw@Www.Aaa.Com/Www/ Ftp://login:passw@a-aa.com/www/ Mailto:aaa@sss.zzz.co. Mailto:aaa@sss.zzz.eee.co. aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa@aaa.com ыы@ddd.com ыы@ddЫd.com ыыsы-sf.ff.com.com@ddd.com ыыsы.-sf.ff@ddd.com Mailto:aaa@sss.co, aaa@sss.comЫЫЫ aaa.Bb.b@aaaa.com.ru.rr.ggg aaa.museumm Look at:aaa.museum. httpS://aaa.museumm, http://www.proxy.com:80@www.site.com/ http://proxy.com:80@site.com/ http://proxy.com@site.com/ aAaa.com.ru.rr.ggg Zwww.Yabcd.co.uk Фforum.abcde.ru www.Eabcd.ru http://Eabcd.Ru Ahttp://www.Eabcd.ru/AAa http://abc.ru/query/vid.cam.dig/sony.dcrhc15.htm#full_image Ф.Www.abcdefg-avto.ru httP://1.2.3.400/aaa/ddd.exe? 1.2.3.400/aaa/ddd.exe?d=c,f=t;&e=h, .0.2.3.400. http://66.123.234.555/ddd michel@ab-cdefg.ru http://99.999.999.999/search?q=cache:w5K8GsupwvcJ:olympus.flexiblesoft.com/c-4000-man.doc+c-4000-man&hl=ru&client=firefox-a );
# Оформляем ссылки без login:passw s#((?>($protocol)(?(2)(?>$ip|$host$zone)|$host$zone)(?![A-Za-z0-9])|(?<![A-Za-z0-9_\@-])(?<!\.(?!(?i:www)))$subdom$zone(?![A-Za-z0-9_.-]*\@))(?>(?>$port?(?>\@$host$zone(?![A-Za-z0-9_.-]*\@))?)?))($tail?)#$res=$2 ? '' : 'http://'; "<a href=\"$res\L$1\E$3\" target=_blank>$1$3</a>"#ge; # Оформляем ссылки с login:passw s#($protocol)($loginpasswat)($ip|$host$zone)((?>$port?)$tail?)#<a href=\"\L$1\E$2\L$3\E$4\" target=_blank>$1$2$3$4</a>"#g; # Оформляем е-мейлы. Этот оператор чувствителен к тексту, на который меняет предыдущие операторы! s#((?<!$firstchr)$firstchr(?>$namechr{0,39})\@(?>$subdom1)(?:\.$subdom1)?\.$zone)(?!(?>[^\s"<]*)(?:" target=_blank>|</a>))#<a href="mailto:$1">$1</a>#g; # Оформляем ссылки с IP s#((?<![>/])$ip(?>$port?))($tail?)#"<a href=\"http://\L$1\E$2\" target=_blank>$1$2</a>"#g;
print $_;

Листинг 10.1.

Закрыть окно

к тексту, на который меняет

#!perl -w
use strict;
my $wb=qr'(?![A-Za-z0-9])';
my $protocol=qr'(?=[FfHh])(?i:http(?>s?)|ftp)://';
my $host=qr'(?>[-A-Za-z0-9_]{1,63}\.)
(?>[A-Za-z0-9_]
(?>[-A-Za-z0-9_]{0,62})\.
)*'x; # вместе с www
my $subdom=qr'(?:(?>[A-Za-z0-9](?:[-A-Za-z0-9]{0,61}[A-Za-z0-9])?)\.)+';
my $subdom1=qr'[A-Za-z0-9](?:[-A-Za-z0-9]{0,61}[A-Za-z0-9])?';
my $zone=qr"(?(?=[a-z]{3}$wb)(?>com|net|org|edu|biz|gov|int|mil)|
(?(?=[a-z]{2}$wb)[a-z]{2}|
(?(?=[a-z]{4}$wb)(?>info|aero|name)|
(?(?=[a-z]{6}$wb)museum|(?!)
)
)
)
)
(?>\.[a-z]{2}$wb)?"ix;
my $port=qr":\d{1,5}$wb";
my $tail=qr#[/?](?>[^.,"'<>()\[\]{}\s\x7F-\xFF]*)(?:(?>[.,?]+)(?:[^"'<>()\[\]{}\s\x7F-\xFF]+))*(? my $firstchr=qr'[A-Za-z0-9]';
my $namechr=qr'[A-Za-z0-9_+.-]';
my $ip=qr'(?\d{1,3})\.(?>\d{1,3})\.(?>\d{1,3})\.(?>\d{1,3})(?!\d)';
# Login и passw ограничены 32 символами
my $loginpasswat=qr'(?>[A-Za-z0-9_]{1,32})(?>(?::[A-Za-z0-9_]{1,32})?)@';
my $res;
$_=q(http://www.proxy.com:80@www.site.com/
Ftp://a.com/AAa
Ftp://Login:Passw@Www.Aaa.Com/Www/
Ftp://login:passw@a-aa.com/www/
Mailto:aaa@sss.zzz.co.
Mailto:aaa@sss.zzz.eee.co.
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa@aaa.com
ыы@ddd.com
ыы@ddЫd.com
ыыsы-sf.ff.com.com@ddd.com
ыыsы.-sf.ff@ddd.com
Mailto:aaa@sss.co,
aaa@sss.comЫЫЫ
aaa.Bb.b@aaaa.com.ru.rr.ggg
aaa.museumm
Look at:aaa.museum.
httpS://aaa.museumm,
http://www.proxy.com:80@www.site.com/
http://proxy.com:80@site.com/
http://proxy.com@site.com/
aAaa.com.ru.rr.ggg
Zwww.Yabcd.co.uk
Фforum.abcde.ru
www.Eabcd.ru
http://Eabcd.Ru
Ahttp://www.Eabcd.ru/AAa
http://abc.ru/query/vid.cam.dig/sony.dcrhc15.htm#full_image
Ф.Www.abcdefg-avto.ru
httP://1.2.3.400/aaa/ddd.exe?
1.2.3.400/aaa/ddd.exe?d=c,f=t;&e=h,
.0.2.3.400.
http://66.123.234.555/ddd
michel@ab-cdefg.ru
http://99.999.999.999/search?q=cache:w5K8GsupwvcJ:olympus.flexiblesoft.com/c-4000-man.doc+c-4000-man&hl=ru&client=firefox-a
);
# Оформляем ссылки без login:passw
s#((?>($protocol)(?(2)(?>$ip|$host$zone)|$host$zone)(?![A-Za-z0-9])|(?(?>$port?(?>\@$host$zone(?![A-Za-z0-9_.-]*\@))?)?))($tail?)#$res=$2 ? '' : 'http://'; "$1$3"#ge;
# Оформляем ссылки с login:passw
s#($protocol)($loginpasswat)($ip|$host$zone)((?>$port?)$tail?)#$1$2$3$4"#g;
# Оформляем е-мейлы. Этот оператор чувствителен к тексту, на который меняет предыдущие операторы!
s#((?$namechr{0,39})\@(?>$subdom1)(?:\.$subdom1)?\.$zone)(?!(?>[^\s"<]*)(?:" target=_blank>|))#$1#g;
# Оформляем ссылки с IP
s#((?/])$ip(?>$port?))($tail?)#"$1$2"#g;
print $_;

museumm Look

<a href="http://www.proxy.com:80@www.site.com/" target=_blank>http://www.proxy.com:80@www.site.com/</a> <a href="ftp://a.com/AAa" target=_blank>Ftp://a.com/AAa</a> <a href="ftp://Login:Passw@www.aaa.com/Www/" target=_blank>Ftp://Login:Passw@Www.Aaa.Com/Www/</a>" <a href="ftp://login:passw@a-aa.com/www/" target=_blank>Ftp://login:passw@a-aa.com/www/</a>" Mailto:<a href="mailto:aaa@sss.zzz.co">aaa@sss.zzz.co</a>. Mailto:aaa@sss.zzz.eee.co. aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa@aaa.com ыы@ddd.com ыы@ddЫ<a href="http://d.com" target=_blank>d.com</a> ыыsы-<a href="mailto:sf.ff.com.com@ddd.com">sf.ff.com.com@ddd.com</a> ыыsы.-<a href="mailto:sf.ff@ddd.com">sf.ff@ddd.com</a> Mailto:<a href="mailto:aaa@sss.co">aaa@sss.co</a>, <a href="mailto:aaa@sss.com">aaa@sss.com</a>ЫЫЫ <a href="mailto:aaa.Bb.b@aaaa.com.ru.rr">aaa.Bb.b@aaaa.com.ru.rr</a>.ggg aaa. museumm Look at:<a href="http://aaa.museum" target=_blank>aaa.museum</a>. httpS://aaa.museumm, <a href="http://www.proxy.com:80@www.site.com/" target=_blank>http://www.proxy.com:80@www.site.com/</a> <a href="http://proxy.com:80@site.com/" target=_blank>http://proxy.com:80@site.com/</a> <a href="http://proxy.com@site.com/" target=_blank>http://proxy.com@site.com/</a> <a href="http://aaaa.com.ru.rr" target=_blank>aAaa.com.ru.rr</a>.ggg <a href="http://zwww.yabcd.co.uk" target=_blank>Zwww.Yabcd.co.uk</a> Ф<a href="http://forum.abcde.ru" target=_blank>forum.abcde.ru</a> <a href="http://www.eabcd.ru" target=_blank>www.Eabcd.ru</a> <a href="http://eabcd.ru" target=_blank>http://Eabcd.Ru</a> A<a href="http://www.eabcd.ru/AAa" target=_blank>http://www.Eabcd.ru/AAa</a> <a href="http://abc.ru/query/vid.cam.dig/sony.dcrhc15.htm#full_image" target=_blank>http://abc.ru/query/vid.cam.dig/sony.dcrhc15.htm#full_image</a> Ф.<a href="http://www.abcdefg-avto.ru" target=_blank>Www.abcdefg-avto.ru</a> <a href="http://1.2.3.400/aaa/ddd.exe" target=_blank>httP://1.2.3.400/aaa/ddd.exe</a>? "<a href="http://1.2.3.400/aaa/ddd.exe?d=c,f=t;&e=h" target=_blank>1.2.3.400/aaa/ddd.exe?d=c,f=t;&e=h</a>", ."<a href="http://0.2.3.400" target=_blank>0.2.3.400</a>". <a href="http://66.123.234.555/ddd" target=_blank>http://66.123.234.555/ddd</a> <a href="mailto:michel@ab-cdefg.ru">michel@ab-cdefg.ru</a> <a href="http://99.999.999.999/search?q=cache:w5K8GsupwvcJ:olympus.flexiblesoft.com/c-4000-man.doc+c-4000-man&hl=ru&client=firefox-a" target=_blank>http://99.999.999.999/search?q=cache:w5K8GsupwvcJ:olympus.flexiblesoft.com/c-4000-man.doc+c-4000-man&hl=ru&client=firefox-a</a>

Листинг 10.2.

Закрыть окно

Пример Look at:aaa.museum

Автоматическая локализация специальных переменных, относящихся к регулярным выражениям

Теперь рассмотрим такой пример:

my $a=1; $_='a'; /(a)/; print "$1\n"; /(b)/; print "$1\n";

Будет напечатано

a a

Первое регулярное выражение совпало, и переменная $1 получила значение a. Второе регулярное выражение не совпало, но мы этого не проверили и напечатали содержимое переменной $1, которое осталось от первого регулярного выражения. Ведь эти специальные переменные изменяются только при удачном поиске, а при неудачном содержат последние присвоенные значения. Во втором регулярном выражении вообще могло не быть захватывающих скобок, что не повлияло бы на печать. Поэтому, чтобы не ошибиться, надо проверять, было совпадение или нет. А в операторе подстановки надо проверять возвращаемый результат, который содержит число произведенных замен.

Теперь рассмотрим более интересный пример:

my $a=1; $_='ab'; /(a)/; print "$1\n"; if ($a) { /(b)/; print "$1\n"; } print "$1\n";

Будет напечатано

a b a

Во внешнем регулярном выражении переменная $1 получает значение a, в регулярном выражении внутри блока эта переменная получает значение b. Затем при выходе из блока мы пытаемся использовать это последнее присвоенное значение. И тут нас поджидает сюрприз (не знаю, приятный или нет): вне блока переменная $1 опять имеет свое старое значение. Это может породить труднонаходимые ошибки в программе, если не позаботиться о сохранении необходимых специальных переменных в переменных my.

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

$_='ab'; /(a)/; print "$1\n"; &subr(); print "$1\n";

sub subr() { /(b)/; print "$1\n"; }

Напечатается

a b a

Мы видим, что при выходе из подпрограммы переменная $1 вернула себе старое значение, а значение, полученное ею в подпрограмме, потерялось. Это следствие концепции динамической видимости. К специальным переменным, которые не относятся к регулярным выражениям, автоматическая локализация не применяется.

Имитация именованного сохранения

Регулярные выражения в 5-ой версии Perl не поддерживают именованного сохранения найденных фрагментов текста, а поддерживают только переменные с номером. Это создает неудобства, а при использовании объектов регулярных выражений, которые сохраняют найденные фрагменты текста, тяжело модифицировать эти объекты, если надо ввести новую сохраняющую переменную. В 6-й версии Perl должно появиться именованное сохранение, когда вместо номера переменной можно задать ей произвольное имя и обращаться к такой переменной по имени. А пока для этого остается использовать встроенный код и специальную переменную $^N. Например, у нас есть объект регулярного выражения, который сохраняет URL:

my $re=qr/<a\s+href="([^"]+)"/i;

Мы можем его использовать в коде

$_='<a href="http://www.intuit.ru">'; print $1 if /$re/;

И напечатается

http://www.intuit.ru

URL получается в переменной $1. Если объект регулярного выражения $re входит кирпичиком в более крупное регулярное выражение, то нумерованные переменные использовать рискованно, т.к. при вставке новых объектов или редактировании существующих нумерация может сбиться и URL может оказаться уже не в переменной $1, а в другой нумерованной переменной. Мы можем объявить переменную $url и всегда сохранять в ней найденный URL, воспользовавшись тем, что переменная $^N является копией нумерованной переменной, которая соответствует последней паре захватывающих скобок:

my $url; my $re=qr/<a\s+href="([^"]+)(?{$url=$^N})"/i; $_='<a href="http://www.intuit.ru">'; print $url if /$re/;

Опять напечатается

http://www.intuit.ru

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

Избавление от "вредных" специальных переменных и предварительного копирования текста

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

Perl не создает каждый раз при использовании регулярного выражения специальные переменные $1, $+, $` и т.д., он просто создает копию целевого текста и эти переменные ссылаются на фрагменты текста в этой копии. Это экономит время, ведь не всегда эти переменные потом будут затребованы программистом.

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

Будет, т.к. существуют еще переменные $`, $& и $'. Perl не может решить, к какому регулярному выражению применяются эти переменные, и будет создавать копию целевого текста каждый раз, несмотря на отсутствие захватывающих скобок. По этой причине переменные $`, $& и $' называются "вредными". Кроме того, их применение замедляет работу программы.

Транслятор просматривает всю программу и все используемые ею модули на предмет наличия этих "вредных" переменных. И если он их не находит, то выпоняет оптимизацию программы: не создает копию целевого текста для регулярных выражений, которые не используют захватывающих скобок. Базовые модули, которые входят в поставку Perl, за исключением модуля English, не используют этих переменных.

"Вредные" переменные $`, $& и $' можно имитировать с помощью массивов @- и @+. (Предполагаем, что целевой текст находится в переменной $_):

$` соответствует substr($_, 0, $-[0])$& соответствует substr($_, $-[0], $+[0] - $-[0])$' соответствует substr($_, $+[0])

Концепция динамической видимости переменных

В языках программирования существуют глобальные и закрытые (private) переменные, которые объявляются директивой my (…). В Perl специальные глобальные переменные, такие, как $_, $1, @ARGV, не объявляются и доступны из любой точки программы. Если вы не используете директиву use strict (или use strict 'vars') и объявляете в программе переменные ($a и т.д.), то эти переменные будут глобальными для данного пакета. Если вы употребили директиву use strict, вы должны будете объявлять эти переменные директивой our.

Переменные my имеют лексическую видимость и видны в минимальном блоке { … }, в котором находится директива my. (Это утверждение также относится к блоку кода Perl (?{…}) внутри регулярного выражения.

В языке Perl существует также концепция динамической видимости. Perl может сохранить значение глобальной переменной перед входом в блок и восстановить его перед выходом из него. Код внутри блока будет работать с двойником этой глобальной переменной, которой может присвоить другое значение. Динамическая видимость создается директивой local. Например:

$_=1; { local $_=2; print "$_\n"; } print "$_\n";

На печать выведется

2 1

Внутри блока программа работает с копией переменной $_, которая имеет то же имя, а при выходе из блока эта копия уничтожается, и программе становится доступна переменная $_, которая существовала до входа в этот блок. Директива local иногда применяется в подпрограммах, хотя в них логичнее создавать внутренние переменные директивой my. Директива local не применяется к переменным, созданным директивой my.

Специальные переменные, изменяемые при поиске

При совпадении в операторах m/…/ и s/…/…/ изменяют значения специальные переменные регулярных выражений. Напомню их.

$` - текст перед совпадением всего регулярного выражения.$& - текст, с которым совпало все регулярное выражение.$' - текст после совпадения всего регулярного выражения.$1 - текст, совпавший с первой парой захватывающих скобок.$2 - текст, совпавший со второй парой захватывающих скобок.…$99 - текст, совпавший с 99-й парой захватывающих скобок.$+ - Содержимое нумерованной переменной ($1, $2, … ,$99) с максимальным номером (на момент использования переменной $+).$^N - Содержимое нумерованной переменной ($1, $2, … ,$99), соответствующей последней только что закрытой паре скобок (на момент использования переменной $^N). (Эту переменную в отличие от $+ почему-то можно читать сразу после закрывающей захватывающей скобки. Возможно, эта ошибка уже исправлена в новой версии Perl.)@- - массив начальных индексов совпадений в целевом тексте. $-[0] соответствует переменной $&, $-[1] - переменной $1, …, $-[99] - переменной $99.@+- массив конечных индексов (т.е. индексов первого символа после совпадения) совпадений в целевом тексте. $+[0] соответствует переменной $&, $+[1] - переменной $1, …, $+[99] - переменной $99.$^R - стоит немного особняком и допускает присваивание. Результат последней по времени исполняемой части встроенного кода, который расположен не в условии условной конструкции (? if then [ | else ] ).

Все эти переменные кроме $^R предназначены только для чтения. Многие авторы по ошибке считают, что переменная $^R тоже только читается, но мы убедились в противоположном. Также они ошибаются, говоря, что вне регулярного выражения эта переменная не имеет смысла.

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

Переменные $1, $2, …, $99 устанавливаются сразу после закрытия соответствующей скобки, поэтому их можно использовать во встроенном коде или динамических регулярных выражениях внутри регулярного выражения. (Вне встроенного кода и динамических регулярных выражений используйте обратные ссылки \1, \2, …, \99.) То же относится к переменным $+, $^N, @- и @+. Переменная $^R получает значение после завершения соответствующего встроенного кода Perl.

В случае применения модификатора g (gc) при каждой итерации значения этим переменным присваиваются заново. Поэтому в операторе подстановки эти переменные всегда соответствуют соответствующим фрагментам текста из последней итерации.

Поиск вложенных конструкций

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

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

$_=" {a{b{c{{d{}m}e}f}}gf{ }f";

после этого должно остаться ' {agff'.

Будем рассуждать от легкого случая к более сложным. Если бы речь шла только о первом уровне вложенности: …{…}…, то мы могли бы создать такой объект регулярного выражения:

my $level0=qr/(?>[^{}]*)/;

который соответствует всему кроме фгурных скобок. А оператор замены был бы таким:

s/\{$level0}//g;

Напоминаю, что символ } не обязательно маскировать, т.к. он в отличие от символа { не является метасимволом регулярного выражения.

Эта программа корректно бы удаляла комментарии первого уровня вложенности. От строки a{b}c осталось бы ac. Но если бы мы задали этой программе строку

a{b{c}d}e

то в результате получили бы остаток

a{bd}e

Удаляются только скобки с фрагментами, которые не содержат этих скобок. Мы могли бы повторять подстановку, пока оператор s/…/…/ возвращает ненулевой результат, но нам нужен общий метод для любого уровня вложенности. С этой целью расширим наш объект регулярного выражения. Он должен совпадать не только с текстом без скобок, но и с текстом без скобок, который ограничен этими фигурными скобками. Это мы сделаем с помощью конструкции альтернативного шаблона:

my $level1=qr/(?>[^{}]|\{$level0})*/;

Здесь мы воспользовались тем, что у нас уже есть регулярное выражение, которое соответствует фрагменту текста без фигурных скобок, это объект $level0. Чтобы фрагменты текста без скобок поглощались быстрее, можно поставить квантификатор +:

my $level1=qr/(?>[^{}]+|\{$level0})*/;

А чтобы не создавалось ненужных сохраненных состояний, можно это еще взять в атомарные скобки:

my $level1=qr/(?>(?>[^{}]+)|\{$level0})*/;

Программа

$_='a{b{c}d}e'; my $level0=qr/(?>[^{}]*)/; my $level1=qr/(?>(?>[^{}]+)|\{$level0})*/; s/\{$level1}//g; print $_;

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

ae

Но если ей дать текст со скобками третьего уровня вложенности, то она оставляет скобки первого уровня вложенности:

$_='a{b{c{d}}e}f'; my $level0=qr/(?>[^{}]*)/; my $level1=qr/(?>(?>[^{}]+)|\{$level0})*/; s/\{$level1}//g; print $_;

Выводится

a{be}f

Мы могли бы по аналогии создать объект $level3 и т.д., но динамические регулярные выражения позволяют сразу создать объект $levelN для произвольного уровня вложенности:

#!/usr/bin/perl -w use strict;

$_=" {a{b{c{{d{}m}e}f}}gf{ }f"; my $levelN; $levelN=qr /(?> (?>[^{}]+)| # все кроме фигурных скобок \{(??{$levelN})} # или текст, соответств. всему шаблону, ограниченный скобками )* # сколько угодно раз /x; s/\{$levelN}//g; print $_;

В результате получаем

{agff

Это верный результат.

Рассмотрим теперь случай, когда "скобки" представляют собой многосимвольные конструкции, например, теги <table и </table>. Раньше мы уже рассматривали такие "скобки" и выработали технический прием с заменой класса символов на негативную опережающую проверку.

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

$_=<<EOD; aa<table> <tr> ff<table> <tr> </table> <tr> </table>bb ssssssss <table> </table> EOD

my $levelN; $levelN=qr "(?> (?:(?!</?table).)+| # все символы до фрагмента </?table <table[^>]*>(??{$levelN})</table> # или вся следующая таблица )* # сколько угодно раз "isx;

my @tables=m"<table[^>]*>$levelN</table>"gi; print join "\n--\n",@tables if @tables;

Конструкция (?!</?table).)+ с помощью точки будет брать символы до встречи с фрагментом, соответствующим шаблону </?table. На печать выходит

<table> <tr> ff<table> <tr> </table> <tr> </table> -- <table> </table>

Я не стал перегружать это регулярное выражение атомарными скобками, вы можете сделать это самостоятельно.

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

$_='abc'; print "$1 $2" if /(a)(??{"(b)"})(c)/;

В результате напечатается

a c

Если бы мы попытались распечатать "$1 $2 $3", то на печать вышло бы то же самое и еще предупреждение об использовании неинициализированной переменной (это $3).

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

$_='abc'; my $a='(b)'; print "$1 $2" if /(a)(??{$a})(c)/;

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

$_='abc'; my $a=qr'(b)'; print "$1 $2" if /(a)(??{$a})(c)/;

Но как только мы попытаемся внутри всего регулярного выражения использовать одно динамическое регулярное выражение, содержащее захватывающие скобки, то Windows покажет окно с сообщением, что в Perl обнаружена ошибка и это приложение будет закрыто, при этом извиняясь за неудобство. Perl успевает вывести сообщение, что совпадение закончилось успешно. Эта ошибка возникает не только в Perl под Windows.

Вот эти фрагменты кода вызывают ошибку Perl:

$_='abc'; my $a='(b)'; /(??{$a})/;

$_='abc'; print 'Found' if /(??{"(b)"})/;

$_='abc'; my $a=qr'(b)'; print 'Found' if /(??{"$a"})/;

Странно, но в случае использования объекта регулярного выражения, когда внутри динамического регулярного выражения $a присутствует без кавычек, ошибки не возникает:

$_='abc'; my $a=qr'(b)'; print 'Found' if /(??{$a})/;

В остальных случаях Perl аварийно завершается. При использовании незахватывающих скобок:

$_='abc'; my $a='(?:b)'; /(??{$a})/;

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

Примеры применения динамических регулярных выражений

Для начала приведу простой и немного искусственный пример: пусть нам надо проверить правильность строки

Далее стоит 13 нулей: 0000000000000

Причем, число нулей может быть произвольным от 1 и более, например,

Далее стоит 2 нуля: 00

Нам надо составить регулярное выражение, которое проверяет, что число соответствует количеству нарисованных нуликов. Этот шаблон может выглядеть так:

(\d+) \D+(??{"0{$1}"})$

Работает он таким образом: вначале в переменную $1 захватывается число (13, 2 и т.д.).

Затем идет пропуск всех нецифровых символов. Внутри динамического регулярного выражения конструируется подшаблон, состоящий из символа нуля и числителя, который равен содержимому переменной $1. Для фразы

Далее стоит 13 нулей: 0000000000000

Весь шаблон после подстановки результата выполнения кода Perl будет иметь вид

(\d+) \D+0{13}$

В случае строки

Далее стоит 2 нуля: 00

Это регулярное выражение примет вид

(\d+) \D+0{2}$

Даже для строки

Далее стоит 0 нулей:

будет найдено совпадение.

Для начала приведу простой и немного искусственный пример: пусть нам надо проверить правильность строки

Далее стоит 13 нулей: 0000000000000

Причем, число нулей может быть произвольным от 1 и более, например,

Далее стоит 2 нуля: 00

(\d+) \D+(??{"0{$1}"})$

Работает он таким образом: вначале в переменную $1 захватывается число (13, 2 и т.д.).

Далее стоит 13 нулей: 0000000000000

Весь шаблон после подстановки результата выполнения кода Perl будет иметь вид

(\d+) \D+0{13}$

В случае строки

Далее стоит 2 нуля: 00

Это регулярное выражение примет вид

(\d+) \D+0{2}$

Даже для строки

Далее стоит 0 нулей:

будет найдено совпадение.

В документации по Perl приводится пример применения динамических регулярных выражений для того, чтобы выяснить, является ли заданная в тексте последовательность чисел последовательностью Фибоначчи. А мы в качестве более сложного примера поставим немного другую задачу: найти в $_ первую наидлиннейшую последовательность 10-ных цифр, которые стоят подряд и возрастают на 1. Например, в строке

$_='0123 1234345678910 ';

искомая наидлиннейшая последовательность такая: 3456789.

Вот сама программа:

#!/usr/bin/perl -w use strict;

my ($len,$d,$res)=(0); $_='0123 1234345678910 '; no warnings;

/((\d) (?{$d=$+}) (?> (??{ ++$d < 10 ? "$d" : "(?!)" })* ) ) (?{ # Эти символы нельзя разделять if (length $1 > $len) { $len=length $1; $res=$1; } }) # Эту скобку нельзя отделять от предыдущей скобки "}" (?!) /x; print $res if defined $res;

Вначале переменной $len присваивается 0. В комментариях указана особенность конструкций (?{ и }), в которых фигурную скобку нельзя отделять от соседнего символа даже и при свободном форматировании.

Теперь разберемся, как работает это регулярное выражение. Вначале открывается захватывающая скобка. Позже выяснится, что она захватывает очередную длиннейшую последовательность цифр, которые возрастают на единицу. Вторая пара захватывающих скобок захватывает одну цифру. Во второй строке стоит встроенный код Perl, который запоминает эту цифру в переменной $d. Далее идет динамическое регулярное выражение, к которому записан квантификатор *. Оно вставлено в атомарные скобки.

Код в этом динамическом регулярном выражении при каждой итерации, обусловленной квантификатором *, увеличивает на единицу переменную $d, и если ее значение меньше десяти, то он возвращает значение этой переменной, а если $d после инкремента принимает значение 10, которое уже не подходит для цифры, то этот код Perl возвращает уже знакомый нам подшаблон (?!), который заставляет квантификатор * сделать шаг назад и остановиться на своем предыдущем состоянии, при котором было совпадение с наибольшей цифрой. После этого совпадения для атомарных скобок управление передается за них и выполняется код Perl, который проверяет, больше ли длина переменной $1 длины переменной $len. Если больше, значит, мы нашли более длинную последовательность цифр, поэтому мы запоминаем ее в переменной $res и обновляем содержимое переменной $len, которая хранит размер найденной длиннейшей последовательности цифр. После этого кода опять стоит подшаблон (?!), который заставляет все регулярное выражение сделать повтор со следующего символа целевого текста.

Директива no warnings нужна, чтобы отменить предупреждение

matches null string many times in regex; …

которое появится, когда динамическое регулярное выражение вернет подшаблон (?!).

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

Здесь опять замечу, что это регулярное это выражение возвращает несовпадение и используется только ради побочного эффекта (установки переменной $res).

Насколько эффективно работает это регулярное выражение? Вставьте встроенный код

Perl после атомарных скобок, который будет печатать содержимое переменной $1:

/((\d) (?{$d=$+}) (?> (??{ ++$d < 10 ? "$d" : "(?!)" })* ) ) (?{print "$1\n"}) (?{ # Эти символы нельзя разделять if (length $1 > $len) { $len=length $1; $res=$1; } }) # Эту скобку нельзя отделять от предыдущей скобки "}" (?!) /x; print $res if defined $res;

В результате на печати получим:

0123 123 23 3 1234 234 34 4 3456789 456789 56789 6789 789 89 9 1 0 3456789

Видим, что вначале регулярное выражение находит длиннейшую последовательность цифр, а потом перестартовывает с каждой следующей цифры этой последовательности благодаря второму подшаблону (?!). Хотелось бы, чтобы вместо этого начальная позиция при итерациях устанавливалась сразу за найденной последовательностью цифр, дабы не делать лишней работы. Но мне кажется, это невозможно, т.к. присвоение внутри регулярного выражения функции pos (pos($_)=…) не дает эффекта.

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

(?(?{$len == 4})\G(?!))

При достижении этого условия встроенный код Perl вернет истину, и на место всей условной конструкции будет подставлен подшаблон

\G(?!)

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

Что будет, если убрать атомарную группировку?

/((\d) (?{$d=$+})

(??{ ++$d < 10 ? "$d" : "(?!)" })*

) (?{print "$1\n"}) (?{ # Эти символы нельзя разделять if (length $1 > $len) { $len=length $1; $res=$1; } }) # Эту скобку нельзя отделять от предыдущей скобки "}" (?!) /x; print $res if defined $res;

Тогда на печать выйдет гораздо больше строк:

0123 012 01 0 123 12 1 23 2 3 1234 123 12 1 234 23 2 34 3 4 3456789 345678 34567 3456 345 34 3 456789 45678 4567 456 45 4 56789 5678 567 56 5 6789 678 67 6 789 78 7 89 8 9 1 0 3456789

Из этой распечатки видно, что после выполнения второго подшаблона (?!) не происходит итерация всего регулярного выражения, как в первом случае, ведь квантификатор * имеет сохраненные состояния. Он начинает отдавать по одной захваченной цифре, пока не отдаст их все. Только после этого происходит рестарт всего регулярного выражения со следующего символа целевого текста.

Функция study

Функция

study( переменная с целевым текстом )

является еще одной возможностью оптимизации использования регулярных выражений.

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

присваивании значения переменной, содержащей целевой текст, внутренняя информация, привязанная к этой переменной, становится недействительной.

Для применения оптимизаций, которые возможны с функцией study, надо стараться выделять литеральный текст. Например, вместо

надо написать эквивалентный подшаблон

aa*

а вместо

a{3,6}

нужно записать

aaa{0,3}

Если конструкция выбора (альтернативный шаблон) в каждой ветви начинается с одного и того же литерала, то его надо "вынести за скобку" и, к примеру, вместо

that|this

записать

th(?:at|is)

Функция

study( переменная с целевым текстом )

является еще одной возможностью оптимизации использования регулярных выражений.

надо написать эквивалентный подшаблон

aa*

а вместо

a{3,6}

нужно записать

aaa{0,3}

that|this

записать

th(?:at|is)

Хронометраж времени выполнения регулярных выражений

В поставке Perl есть стандартный модуль Benchmark. Он позволяет измерять время выполнения участков кода. При этом можно учитывать только время, которое потрачено процессором на выполнение кода вашей программы, а не на всю систему. Механизм применения этого модуля таков:

use Benchmark; … my $t1=new Benchmark;

# Здесь находится участок кода, время работы которого измеряется …

my $t2=new Benchmark; print timestr(timediff $t2,$t1);

В переменной $t1 запоминается время начала исполнения участка кода, в переменной $t2 запоминается время окончания выполнения этого участка кода. Затем с помощью функций timediff и timestr выводится разница между временем окончания и временем начала работы участка кода, который тестируется. Но не забывайте, что при первом обращении к регулярному выражению тратится время на его компиляцию!

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

$_=' <pppp>' x 13000; $_.='<table>a'; my $re=qr /\A # начало текста (?> # атомарная группировка (?: # цикл пропуска пробелов и тегов (?>\s*) # пропускаем пробельные символы <(?>[^>]*)> # пропускаем тег с его содержимым )* # повтор любое число раз ) \S # и вот он наконец - непробельный символ /x; my $t1=new Benchmark; for (1..1000000) { /$re/; } my $t2=new Benchmark; print timestr(timediff $t2,$t1);

В этом примере избран такой подход: в цикле (?: … )* пропускаются пробельные символы и теги, а после окончания цикла таких пропусков должен встретиться непробельный символ \S. Если он встретится, то поиск завершится удачей. В переменной $_ создается длинная строка с тегами и пробелами, которая завершается непробельным символом a вне тегов. Чтобы время компиляции регулярного выражения> не вошло в интересующий нас интервал времени, мы используем объект регулярного выражения $re. Поскольку регулярное выражение работает быстро, создаем цикл из миллиона повторов применения этого регулярного выражения к тексту.

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

1 wallclock secs ( 1.11 usr + 0.00 sys = 1.11 CPU)

А если этот символ стоит вне тегов, то такого текста найдено не будет, поэтому будет истинен шаблон

(?![^<>]*>)

Вот вся эта программа:

use Benchmark;

$_=' <pppp>' x 13000; $_.='<table>a'; my $re=qr /[^\s<>] (?![^<>]*>) /x; my $t1=new Benchmark; for (1..1000000) { /$re/; } my $t2=new Benchmark; print timestr(timediff $t2,$t1);

На печати получаем:

1 wallclock secs ( 1.09 usr + 0.00 sys = 1.09 CPU)

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

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

use Benchmark;

$_=' <pppp>' x 13000; $_.='<table>a'; my $count=0; my $re=qr /[^\s<>] (?![^<>]*>) (?{ ++$count }) /x; my $t1=new Benchmark; for (1..1000000) { /$re/; } my $t2=new Benchmark; print timestr(timediff $t2,$t1); print "\n$count";

На печати появится:

3 wallclock secs ( 3.44 usr + 0.00 sys = 3.44 CPU) 1000000

Время выполнения увеличилось примерно в 3 раза. Сравним это со временем выполнения самого кода автоприращения:

use Benchmark;

my $count=0; my $t1=new Benchmark; for (1..1000000) { ++$count } my $t2=new Benchmark; print timestr(timediff $t2,$t1); print "\n$count";

Напечатается

0 wallclock secs ( 0.13 usr + 0.00 sys = 0.16 CPU) 1000000

Мы видим, что сам по себе этот код берет времени намного меньше, чем когда он выполняется внутри регулярного выражения.

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

use Benchmark;

$_='Далее стоит 13 нулей: 0000000000000' x 13000; my $re=qr/(\d+)\D+(??{"0{$1}"})/; my $t1=new Benchmark; for (1..1000000) { /$re/; } my $t2=new Benchmark; print timestr(timediff $t2,$t1);

Напечатается

4 wallclock secs ( 4.74 usr + 0.00 sys = 4.74 CPU)

А сейчас заменим динамическое регулярное выражение подшаблоном \d+:

use Benchmark;

$_='Далее стоит 13 нулей: 0000000000000' x 13000; my $re=qr /(\d+)\D+\d+/; my $t1=new Benchmark; for (1..1000000) { /$re/; } my $t2=new Benchmark; print timestr(timediff $t2,$t1);

В этот раз время уменьшится:

1 wallclock secs ( 1.38 usr + 0.00 sys = 1.38 CPU)

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

Аналогично заметно возрастает время выполнения оператора подстановки s/// с модификатором e. Были практические случаи, когда оператор подстановки с модификатором e замедлял работу программы в десятки раз.

Компиляция и кэширование регулярных выражений

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

При компиляции сначала происходит обработка литералов регулярного выражения.

Отыскивается завершающий ограничитель регулярного выражения и читаются модификаторы всего регулярного выражения, которые стоят за этим ограничителем. Наличие модифиатора x учитывается при обработке литерала регулярного выражения.Если регулярное выражение имеет интерполируемые переменные, то вместо них подставляется их значение. При этом учитывается, что последовательности символов $|, $), … не являются переменными и не интерполируются.Далее обрабатываются конструкции изменения регистра /U, /l, … а также конструкции /Q…/E, но в тех частях регулярного выражения, которые получились от интерполяции переменных, эти конструкции не распознаются и не обрабатываются.

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

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

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

Отказ от перекомпиляции регулярного выражения дает очень существенную экономию времени, поэтому используйте объекты регулярных выражений qr/…/. Они содержат уже откомпилированное и готовое к использованию регулярное выражение, представляя собой как бы автономный кэш регулярного выражения.

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

my $a='abc'; my $b='cde'; my $re='(\w)'; $a =~ /$re/; print "$1\n"; $b =~ //; print $1;

На печать выводится

a c

Пояснение: в операторе $a =~ /$re/; мы использовали регулярное выражение, которое совпало, и напечаталась буква a. Далее мы можем множество раз задавать пустое регулярное выражение //. Вместо него будет использоваться это последнее совпавшее кэшированное регулярное выражение. Это видно при печати буквы c. Если теперь изменить содержимое переменной $re, то это не повлияет на результат применения пустого регулярного выражения, потому что интерполированное значение переменной $re (т.е. внутреннее представление литерала (\w)) уже находится в кэшированном регулярном выражении по умолчанию).

Эта оптимизация не является естественной и с приходом объектов регулярных выражений она устарела.

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

my $re=/…/; … if ($_ =~ $re) … или if (m/$re/) …

то в этом операторе напрямую применяется откомпилированный объект регулярного выражения.

Здесь уместно вспомнить об опасности применения модификатора o с объектами регулярных выражений:

my $re=/…/o;

который дает неожиданный и неприятный эффект, описанный ранее.

Отладочная информация регулярных выражений

Если применить директиву

use re qw(debug);

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

use re qw(debug);

'abcd' =~ /abc(d)/;

На печать будет выдано:

Compiling REx `abc(d)' size 9 Got 76 bytes for offset annotations. first at 1 1: EXACT <abc>(3) 3: OPEN1(5) 5: EXACT <d>(7) 7: CLOSE1(9) 9: END(0) anchored `abcd' at 0 (checking anchored) minlen 4 Offsets: [9] 1[3] 0[0] 4[1] 0[0] 5[1] 0[0] 6[1] 0[0] 7[0] Guessing start of match, REx `abc(d)' against `abcd'... Found anchored substr `abcd' at offset 0... Guessed: match at offset 0 Matching REx `abc(d)' against `abcd' Setting an EVAL scope, savestack=3 0 <> <abcd> | 1: EXACT <abc> 3 <abc> <d> | 3: OPEN1 3 <abc> <d> | 5: EXACT <d> 4 <abcd> <v | 7: CLOSE1 4 <abcd> <> | 9: END Match successful! Freeing REx: `"abc(d)"'

Текст

1: EXACT <abc>(3) 3: OPEN1(5) 5: EXACT <d>(7) 7: CLOSE1(9) 9: END(0)

является расшифровкой внутреннего представления регулярного выражения. Например, строка

1: EXACT <abc>(3)

означает, что надо искать строковый литерал abc длиной 3 символа. Строка

anchored `abcd' at 0 (checking anchored) minlen 4

означает, что текст abcd длины 4 привязан к началу регулярного выраения и должен встретиться при любом совпадении. Поэтому, если целевой текст окажется короче этого текста, то Perl не станет применять регулярное выражение, оператор поиска без применения сразу возвратит неудачу. Строка

3: OPEN1(5)

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

Функция grep

Функция grep является мощным инструментом для создания из списков подсписков по определенным критериям. Эта мощь обусловлена тем фактом, что данная функция может использовать регулярные выражения. Модификаторы этого регулярного выражения те же, что и у оператора split. Функция grep имеет две разновидности вызова:

grep { блок команд } список

grep выражение, список

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

open F, 'prog.pl'; print grep { !/^#|^\s*$/m } <F>; close F;

распечатает все строки файла prog.pl, которые не начинаются с символа # и не содержат одни лишь пробельные символы.

Оператор split

Оператор разбиения split выполняет в каком-то смысле противоположную роль оператору поиска m/// с модификатором g в списковом контексте. Если этот оператор m/// возвращает все фрагменты текста, которые совпали с регулярным выражением, то оператор split возвращает фрагменты текста, которые не совпали с регулярным выражением, заданным ему в качестве аргумента. Оператор split разбивает исходный текст на куски, которые разделяются текстом, совпадающим с заданным регулярным выражением и возвращает эти куски текста в виде массива. В качестве разделителя может выступать регуляр ное выражение, которое совпадает только с позицией в тексте, например, оператор

@lines=split /^/m, $text;

вернет в массиве @lines заданный текст, разбитый на логические строки.

Замечу, что в регулярном выражении в операторе split якорь начала текста ^ означает начало логической строки, даже если модификатор m не задан, поэтому оператор

@lines=split /^/, $text;

будет работать точно так же, как и предыдущий оператор с модификатором m. Но можно это неявное правило отменить:

@lines=split /(?-m)^/, $text;

Это будет эквивалентно оператору

@lines=split /\A/, $text;

На метасимвол $ это неявное правило не распространяется.

В регулярном выражении, которое применяется в операторе split, точно так же работает интерполяция переменных и модификатор o, как и в обычных регулярных выражениях.

Оператор split можно использовать в простых случаях, например, когда надо разбить выходные данные от HTML-формы по знаку равенства, но этот оператор можно применять и в более сложных случаях. Однако, оператор split перегружен разными тонкостями и исключениями, которые надо рассмотреть. В общем случае этот оператор имеет вид

split [ совпадение [ , целевой текст [ , ограничение ] ]]

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

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

split

эквивалентен вызову

split ' ', $_, 0

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

Отсутствие побочных эффектов у оператора split

Оператор split не имеет побочных эффектов: он не изменяет регулярное выражение по умолчанию, не устанавливает специальные переменные $1, …, $`, $&, $' и т.д. Существует лишь один побочный эффект, не связанный с регулярными выражениями: при использовании оператора split в скалярном контексте он записывает возвращаемый результа в массив @_, который также используется для передачи параметров функциям.

При применении директивы use warnings или параметра -w при запуске Perl, выдается соответствующее предупреждение:

#!/usr/bin/perl -w use strict;

scalar split /(?=\w)/, "abcd"; print @_;

Напечатается

Use of implicit split to @_ is deprecated at z.pl line 4. abcd

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

split /(\w)(?{ print "=$1=" })/, "abcd";

напечатает текст

=a==b==c==d=

Первый операнд (совпадение)

Рассмотрим варианты для первого операндаоператора split. Это может быть

регулярное выражение;объект регулярного выражения;любое другое выражение, которое будет интерпретироваться как строка.

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

Специальный первый операнд // и ' '

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

print join '-',split //, 'abcde';

напечатает a-b-c-d-e.

Специальный операнд ' ' (строка из одного пробела), разбивает заданный текст по пропускам \s+, но при этом начальные (и конечные) пробельные символы игнорируются.

Например, оператор

print join '-',split ' ', ' a b c de ';

напечатает a-b-c-de, а оператор

print join '-',split m/\s+/, ' a b c de ';

напечатает -a-b-c-de. Как видим, первый оператор игнорирует начальные и конечные пробелы, а второй - только конечные.

Третий операнд (ограничение)

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

print join '-', split ' ', ' a b c de ', 3;

напечатает

a-b-c de

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

print join '-', split ' ', ' a b c de ', 10;

Напечатается: a-b-c-de-. Мы видим, что в этой форме оператор split в отличие от случая, когда третий операнд отсутствует, начинает возвращать конечные пустые элементы.

Также можно ограничить количество возвращаемых значений, если в качестве приемника задать список:

($a,$b,$c) = split /$re/, $text;

После заполнения заданного количества полей Perl прекратит работу оператора split.

Если количество кусков текста меньше заявленного количества элементов списка, то оставшиеся элементы списка получат пустые значения.

Возвращение пустых элементов

Если между совпадениями для первого операнда нет текста (совпадения идут подряд), то на соответствующих местах возвращаются пустые элементы. Оператор

print join '-', split '=', 'a=b==c';

напечатает

a-b--c

В этом случае пустые элементы, расположенные в конце текста, не возвращаются.

Например, оператор

print join '-',split '=', '===a=b==c===';

напечатает

---a-b--c

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

print join '-', split '=', '===a=b==c===', -1;

напечатает

---a-b--c---

Число -1 здесь эквивалентно бесконечно большому положительному числу.

Иногда бывает нужно получить только непустые элементы разбиения текста. Для этого перед оператором split можно поставить вызов функции grep с аргументом length:

print grep { length } split '=', '===a=b==c===', -1;

или вместо length можно подставить само возвращаемое в $_ split значение:

print grep $_, split '=', '===a=b==c===', -1;

Напечатается просто abc. К каждому элементу списка, возвращаемому оператором split, будет применена функция length. И если результат будет равен нулю, то этот элемент будет удален из данного списка.

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

print join '-', split /(?=\w)/, "abcd";

напечатает a-b-c-d, хотя перед буквой a тоже было совпадение.

Обращаю ваше внимание, что оператор

split /^/m, $text;

вернет все логические строки, в том числе и пустые: ведь при совпадении с пустыми строками возвращаются элементы \n, которые сами не являются пустыми.

Второй операнд (целевой текст)

Оператор split не изменяет целевой текст, поэтому в качестве целевого текста можно применять непосредственное значение. Если целевой текст не задан, то используется значение переменной по умолчанию $_.

Захватывающие скобки в первом операнде оператора split

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

Пример:

print join '-', split /(\d+)/, 'a12b23c34d45e56', 3;

Напечатается

a-12-b-23-c34d45e56

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

Вот еще пример - HTML-текст разбивается на текст вне тегов и при этом возвращаются все теги:

$_=<<EOD; <b>жирный текст</b> обычный текст <i>курсив</i> <h1> заголовок </h1> обычный текст EOD

print join '-', split /(<[^>]+>)/;

Будет напечатано:

-<b>-жирный текст-</b>- обычный текст -<i>-курсив-</i>- -<h1>- заголовок -</h1>- обычный текст

Оператор split обычно используется при получении данных от форм HTML. Ниже приведен пример стандартной программы, которая принимает формы, отправленные по методу GET и POST, и записывает имена и значения переменных в ассоциативный хеш contents:

if ($ENV{'REQUEST_METHOD'} eq 'POST') # Принимаем данные по методу POST { # Читаем переданные формой данные read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); # Разбиваем их на пары имя=значение @pairs=split(/&/, $buffer); foreach $pair (@pairs) { # Каждую пару разбиваем на имя и значение ($name,$value)=split(/=/,$pair); # Заменяем плюсы на пробелы (браузеры кодируют пробелы плюсами) $value =~ tr/+/ /; # Заменяем 16-ные байты их значениями $value =~ s/%([a-fA-F0-9][a-fA-f0-9])/pack("C",hex($1))/eg; # Записываем результат в хеш $contents{$name}=$value; } } elsif ($ENV{'REQUEST_METHOD'} eq 'GET') # Принимаем данные по методу GET { @pairs=split(/&/, $ENV{QUERY_STRING}); foreach $pair (@pairs) { ($name,$value)=split(/=/,$pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-f0-9])/pack("C",hex($1))/eg; $contents{$name}=$value; } }

print "Content-Type: text/html\n\n"; print '<html><body>OK</body></html>';

Эту программу можно сократить, т.к. в цикле производятся те же самые операции.