В недавно вышедшем релизе Perl 5.10.1 слегка изменилась работа оператора when.
В частности, оператор when теперь понимает конструкцию «флип-флоп».
«Флип-флоп» — это оператор диапазона .. в булевом контексте. В документации приводится пример выражения для поиска POD-комментариев:
when (/^=begin/ .. /^=end/) {
# do something
}
Аналогично возможно, например, находить определение функций во многих языках программирования, в частности, PIR:
use v5.10.1;
my $lineno = 0;
for (<DATA>) {
chomp;
print 'Line ', ++$lineno, ': ';
when (/^\.HLL/) {say "switching language to $_"}
when (/^\.sub/ .. /^\.end/) {say "subroutine body: $_"}
}
__DATA__
.HLL unknown
.sub main :main
say "Demonstrating inc"
$I = 2
inc $I
say $I
.end
Эта программа напечатает комментарии к каждой строке кода, объясняя его назначение:
Line 1: switching language to .HLL unknown
Line 2: subroutine body: .sub main :main
Line 3: subroutine body: say "Demonstrating inc"
Line 4: subroutine body: $I = 2
Line 5: subroutine body: inc $I
Line 6: subroutine body: say $I
Line 7: subroutine body: .end
Cледует обратить внимание на два момента. Во-первых, выражение, переданное when, срабатывает на всех строках подпрограммы, включая первую и последнюю, заданные границами /\^.sub/ и /\^.end/.
Во-вторых, оператор ведет себя «нежадно», что позволяет находить непересекающиеся последовательности. Вот программа, в которую дописана дополнительная подпрограмма на PIR, и строка when, находящая пустую строку:
use v5.10.1;
my $lineno = 0;
for (<DATA>) {
chomp;
print 'Line ', ++$lineno, ': ';
when (/^\.HLL/) {say "switching language to $_"}
when (/^\.sub/ .. /^\.end/) {say "subroutine body: $_"}
when (/^$/) {say "empty line"}
}
__DATA__
.HLL unknown
.sub main :main
say "Demonstrating inc"
$I = 2
inc $I
say $I
.end
.sub another
say 'Hey, you!'
.end
Вывод программы подтверждает правильность ее работы:
Line 1: switching language to .HLL unknown
Line 2: subroutine body: .sub main :main
Line 3: subroutine body: say "Demonstrating inc"
Line 4: subroutine body: $I = 2
Line 5: subroutine body: inc $I
Line 6: subroutine body: say $I
Line 7: subroutine body: .end
Line 8: empty line
Line 9: subroutine body: .sub another
Line 10: subroutine body: say 'Hey, you!'
Line 11: subroutine body: .end
Другой пример использования — поиск и сохранение фрагмента алфавитно отсортированного списке, как это делают в бумажных словарях по двум-трем начальным буквам.
use v5.10.1;
my @programming_languages = qw(
Pascal Pawn PCASTL PCF PEARL Perl PHP Phrogram Pico Pict Piet Pike PIKT PILOT Pizza PL/0 PL/B PL/C PL/I PL/M PL/P PL/SQL PL360 PLANC Plankalkül PLEX PLEXIL Pliant POP-11 Poplog PostScript PortablE Powerhouse PPL Processing Prograph PROIV Prolog Promela PROTEL Proteus ProvideX Pure Python
);
for (@programming_languages) {
when (/^pa/i .. /^pi/i) {push @page, $_}
}
pop @page;
say join ', ', @page;
Программа подготовит данные для страницы словаря PA—PI:
Pascal, Pawn, PCASTL, PCF, PEARL, Perl, PHP, Phrogram
Разумеется, в последнем примере возможно было воспользоваться одним регулярным выражением:
my @page = ();
for (@programming_languages) {
when (/^p[a-h]/i) {push @page, $_}
}
say join ', ', @page;
Но первый вариант в данном случае более нагляден и, к тому же, более расширяем. Напрмер, метод возможно вынести в отдельную функцию и передавать ей границы диапазона в виде параметров:
say join ', ', select_range('pa', 'pi');
sub select_range {
my ($from, $to) = @_;
my @page = ();
for (@programming_languages) {
when (/^$from/i .. /^$to/i) {push @page, $_}
}
pop @page;
return @page;
}
