Отслеживайте состояние на основе отступов с помощью оператора триггера

Question

Я пытаюсь познакомиться с оператором триггера, поэтому я могу использовать его в качестве дополнительной абстракции в голове при выполнении циклов с сохранением состояния, даже если конечный автомат в стиле учебника работает отлично (и многословно, и переменно-богатый) в таком случае.Я хочу отслеживать отступы, и мне кажется, что мне все равно нужно вручную корректировать отступы в начале каждого блока if, в состоянии которого я называю триггерный отступ, верно?Вот что я придумал:

Программа :

use v5.20;
use strict;
use warnings;

my $shiftwidth = 3;

# block_rx: start of indented block marker, without leading spaces
# Keeps state of indentation, which is increased on encountering block marker
# and decreased on matching outdent.
# Function should always get indentation level from context it was called in.
# Returns: true if in indented block, ^ff^, else false

sub indenting_flipflop {
    my $block_rx = $_[0];
    $_ = $_[1];
    my $level = $_[2];
    my $indent = indent($level);
    my $inner_indent = indent($level + 1);
    return ((/^$indent$block_rx/) ... (!/^$inner_indent/)) =~ s/.*E//r;
}

sub indent {
    return ' ' x ($shiftwidth * $_[0]);
}

while (<DATA>) {
    my $level = 0;
    if (indenting_flipflop('books', $_, $level)) {
        $level++;
        if (indenting_flipflop('book', $_, $level)) {
            $level++;
            if (/author: (.*)/) {
              say $1;
            }
        }
    }
}

__DATA__
books:
   book:
      author: Mark Twain
      price: 10.99
   game:
      author: Klaus Teuber
      price: 15.99
   book:
      author: Jane Austen
      price: 12.00

books:
   book:
      author: Mark Twain
      price: 10.99
   game:
      author: Klaus Teuber
      price: 15.99
   book:
      author: Jane Austen
      price: 12.00

Ожидаемый результат :

Mark Twain
Jane Austen
Mark Twain
Jane Austen

Фактический результат :

Mark Twain
Klaus Teuber
Jane Austen
Mark Twain
Klaus Teuber
Jane Austen

Было бы также неплохо, если бы мне не пришлось настраивать $level вручную в цикле.

Answer 1

Операторы триггера с динамическими операндами сложны в использовании и могут не выполнять то, что вы ожидаете.Perl поддерживает одно «состояние» для каждого оператора триггера, который появляется в коде, а не отдельное состояние для каждого выражения, предоставляемого в качестве операндов для оператора триггера.

Рассмотрим этот код:

sub foo { m[<foo>] .. m[</foo>] }
sub bar { m[<bar>] .. m[</bar>] }

while (<DATA>) {    
    print "FOO:$_" if foo();
    print "BAR:$_" if bar();
}    
__DATA__
<foo>
   <bar>
      123
   </bar>
   <baz>
       456
   </baz>
</foo>

Вывод:

FOO:<foo>
FOO:   <bar>
BAR:   <bar>
FOO:      123
BAR:      123
FOO:   </bar>
BAR:   </bar>
FOO:   <baz>
FOO:       456
FOO:   </baz>
FOO:</foo>

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

sub ff { my $tag = shift; m[<$tag>] .. m[</$tag>] }
while (<DATA>) {
    print "FOO:$_" if ff("foo");
    print "BAR:$_" if ff("bar");
}
__DATA__
<foo>
   <bar>
      123
   </bar>
   <baz>
       456
   </baz>
</foo>

Теперь получим

FOO:<foo>
BAR:<foo>
FOO:   <bar>
BAR:   <bar>
FOO:      123
BAR:      123
FOO:   </bar>
BAR:   </bar>

Что случилось?BAR всегда печатается с теми же строками, что и FOO, а последней строкой вывода является строка </bar>, хотя в тегах <foo></foo> все еще заключено больше данных.

Что произошлоявляется то, что код содержит один оператор триггера, определенный в подпрограмме ff, и этот оператор поддерживает одно состояние.Состояние изменяется на «true», когда ff("foo") вызывается с первой строкой ввода, и оно остается «true», пока не встретит ввод и операнд, который удовлетворяет второму выражению в операторе триггера, что происходит с 4-мстрока, когда вызывается ff("bar").Он не поддерживает отдельное состояние для тегов foo и bar, как это было в первом примере.

Передача другого ввода в функцию indenting_flipflop и ожидание, что оператор триггера в этой функции просто будет работатьввод такого типа не будет работать.

---

Обновление : поэтому этот подход, определяющий одну новую функцию для каждого тега, работает:

sub fff { my $tag = shift; sub { m[<$tag>] .. m[</$tag>] } }
my $foo = fff("foo");
my $bar = fff("bar");
while (<DATA>) {
    print "FOO:$_" if $foo->();
    print "BAR:$_" if $bar->();
}
__DATA__
...

но эта (определение новых функций с каждой строкой ввода) не:

sub fff { my $tag = shift; sub { m[<$tag>] .. m[</$tag>] } }
while (<DATA>) {
    print "FOO:$_" if fff("foo")->();
    print "BAR:$_" if fff("bar")->();
}
__DATA__
...

С другой стороны, запомненная версия будет работать:

my %FF;
sub fff { my $tag = shift; $FF{$tag} //= sub { m[<$tag>] .. m[</$tag>] } }
while (<DATA>) {
    print "FOO:$_" if fff("foo")->();
    print "BAR:$_" if fff("bar")->();
}
__DATA__
...

Явсе еще не убежден, что операторы триггера добавят какую-либо ценность к этой проблеме, но чтобы узнать, вам придется использовать запомненные функции генерации операторов триггера.Замените

...
return ((/^$indent$block_rx/) ... (!/^$inner_indent/)) =~ s/.*E//r;

на

my %FF;
sub flipflopfunc {
    my ($expr1,$expr2) = @_;
    return $FF{$expr1}{$expr2} //= 
        sub { /^$expr1/ ... !/^$expr2/ };
}
...
return flipflopfunc("$indent$block_rx",$inner_indent)->() =~ s/.*E//r;

(не уверен, для чего предназначен s/.*E//r)