Изменения в работе given/when в Perl 5.10.1 (часть 1)

В недавно вышедшем релизе 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;
}