Динамические регулярные выражения

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

В процессе работы регулярное выражение подставит $levelN столько раз, сколько раз встретит открывающую фигурную скобку.

Мы могли бы перенести внешние фигурные скобки внутрь нашего объекта $levelN, тогда в операторе подстановки не нужно было бы их выписывать:

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

Во второй альтернативе также нужно убрать фигурные скобки, т.к. в $levelN они уже присутствуют. На печати результат тот же:

{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, которую имеете вы, это уже исправлено.