Встроенный код, переменные local и my

И еще аналогичный и очень интересный пример:

my $a='1';
$_='2';
print "\$=$\n" if $a =~ /^1(?{$_='z'; print "\$_=$_ \$a=$a\n"})$/;
print "\$_=$_ \$a=$a";

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

$_=z $a=z
$=z
$_=2 $a=z

Из результата мы видим следующее:

Можно сделать вывод, что внутри регулярного выражения переменная $_ является синонимом переменной, содержащей целевой текст, как и в операторах map и for (), и переменная $_ локализуется внутри регулярного выражения. Поэтому изменять $_ внутри регулярного выражения так же опасно, как и переменную с целевым текстом.

И еще относительно встроенного кода: встроенный код, который содержится внутри интерполируемых переменных, тоже выполняется, но для этого нужна директива

use re 'eval';

При выполнении скрипта

$_='aaa';
my $a='(?{print "OK "})';
print "$" if /^aaa$a$/;

Возникнет ошибка

Eval-group not allowed at runtime, use re 'eval' in regex m/^aaa(?{print "OK"})$/ at a.pl line 7.

С директивой use re 'eval' все в порядке:

use re 'eval';

$_='aaa';
my $a='(?{print "OK "})';
print "$" if /^aaa$a$/;

Вывод: OK aaa.

Заметим, что эта директива не действует внутри встроенного кода:

my $a='(?{use re "eval"; print "OK "})';
print "$" if /^aaa$a$/;

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

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

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

Для примера рассмотрим программу, которая ищет и печатает даты в формате 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-ти. Встроенный код помог нам провести оптимизацию регулярного выражения.

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

Рассмотрим пример, когда встроенный код помогает сделать поиск более интеллектуальным. Пусть нам надо найти в тексте самое большое натуральное число. При поиске мы используем цикл 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

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

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

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.

9.4. Встроенный код и директивы 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;