Извлечение блока текста, где закрывающее выражение зависит от открывающего

Question

У меня есть текстовая строка, структурированная так:

= Some Heading (1)

Some text

== Some Sub-Heading (2)

Some more text

=== Some Sub-sub-heading (3)

Some details here

= Some other Heading (4)

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

В приведенном выше примере это даст:

== Some Sub-Heading (2)

Some more text

=== Some Sub-sub-heading (3)

Some details here

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

Answer 1

Только для смеха:

/^(?>(=+).*\(2\))(?>[\r\n]+(?=\1=|[^=]).*)*/m

Предварительный просмотр гарантирует, что если строка начинается со знака равенства, то есть по крайней мере еще один знак равенства, чем в префиксе исходной строки. Обратите внимание, что вторая часть заглядывания соответствует любому символу, кроме знака равенства, , включая перевод строки или возврат каретки. Это позволяет ему соответствовать пустой строке, но не концу строки.

Answer 2

daotoad и jrockway абсолютно правы. Если вы пытаетесь проанализировать древовидную структуру данных, то сгибание регулярного выражения по своей воле приведет только к хрупкому непостижимому и все еще недостаточно общему сложному фрагменту кода.

Однако, если вы настаиваете, вот исправленный фрагмент, который работает. Сопоставление с разделителем одинаковой глубины ИЛИ концом строки - одно осложнение. Сопоставление строк на глубинах меньше или равных текущей глубине является более сложной задачей и требует двухэтапного.

#!/usr/bin/perl

my $all_lines = join "", <>;
# match a Heading that ends with (2) and read everything between that match
# and the next heading of the same depth (\2 matches the 2nd parenthesized group)
if ( $all_lines =~ m/((=+) [^\n]*\(2\)(.*?))(\n\2 |\z)/s ) {
    # then trim it down to just the point before any heading at lesser depth
    my $some_lines = $1;
    my $depth = length($2);
    if ($some_lines =~ m/(.*?)(\n={1,$depth} |\z)/s) {
        print "$1\n";
    }
}

Но я советую избегать этого маршрута и анализировать его с помощью чего-то удобочитаемого и обслуживаемого!

Answer 3

Это разбивает файл на разделы:

my @all = split /(?=^= )/m, join "", <$filehandle>;
shift @all;

Answer 4

Я бы пропустил попытку использовать сложное регулярное выражение. Вместо этого напишите простой парсер и постройте дерево.

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

#!/usr/bin/perl

use strict;
use warnings;

my $document = Node->new();
my $current = $document;

while ( my $line = <DATA> ) {

    if ( $line =~ /^=+\s/ ) {

        my $current_depth = $current->depth;
        my $line_depth = Node->Heading_Depth( $line );

        if ( $line_depth > $current_depth ) {
            # child node.
            my $line_node = Node->new();
            $line_node->heading( $line );
            $line_node->parent( $current );
            $current->add_children( $line_node );
            $current = $line_node;
        }
        else {

            my $line_node = Node->new();
            while ( my $parent = $current->parent ) {

                if ( $line_depth == $current_depth ) {
                    # sibling node.
                    $line_node->heading( $line );
                    $line_node->parent( $parent );
                    $current = $line_node;
                    $parent->add_children( $current );

                    last;
                }

                # step up one level.
                $current = $parent;
            }
        }

    }
    else {
        $current->add_children( $line );
    }


}

use Data::Dumper;
print Dumper $document;

BEGIN {
    package Node;
    use Scalar::Util qw(weaken blessed );

    sub new {
        my $class = shift;

        my $self = {
            children => [],
            parent   => undef,
            heading  => undef,
        };

        bless $self, $class;
    }

    sub heading {
        my $self = shift;
        if ( @_ ) {
            $self->{heading} = shift;
        }
        return $self->{heading};
    }

    sub depth {
        my $self = shift;

        return $self->Heading_Depth( $self->heading );
    }

    sub parent {
        my $self = shift;
        if ( @_ ) {
            $self->{parent} = shift;
            weaken $self->{parent};
        }
        return $self->{parent};
    }

    sub children {
        my $self = shift;
        return @{ $self->{children} || [] };
    }

    sub add_children {
        my $self = shift;
        push @{$self->{children}}, @_;
    }

    sub stringify {
        my $self = shift;

        my $text = $self->heading;
        foreach my $child ( $self->children ) {
            no warnings 'uninitialized';
            $text .= blessed($child) ? $child->stringify : $child;
        }

        return $text;
    }

    sub Heading_Depth {
        my $class  = shift;
        my $heading = shift || '';

        $heading =~ /^(=*)/;
        my $depth = length $1;


        return $depth;
    }

}

__DATA__
= Heading (1)

Some text

= Heading (2)

Some more text

== Subheading (3)

Some details here

== Subheading (3)

Some details here

= Heading (4)

Answer 5

#!/usr/bin/perl

my $all_lines = join "", <>;

# match a Heading that ends with (2) and read everything between that match
# and the next heading of the same depth (\1 matches the 1st matched group)
if ( $all_lines =~ /(=+ Heading )\([2]\)(.*?)\1/s ) {
    print "$2";
}