Question

I have a text string structured like this:

= Some Heading (1)  Some text  == Some Sub-Heading (2)  Some more text  === Some Sub-sub-heading (3)  Some details here  = Some other Heading (4) 

I want to extract the content of second heading, including any subsection. I do not know beforehand what is the depth of the second heading, so I need to match from there to the next heading that is of the same depth, or shallower, or the end of the string.

In the example above, this would yield:

== Some Sub-Heading (2)  Some more text  === Some Sub-sub-heading (3)  Some details here 

This is where I get stuck. How can I use the matched sub-expression opening the second heading as part of the sub-expression for closing the section.

Answer 1

I’d skip trying to use a complex regex. Instead write a simple parser and build up a tree.

Here’s a rough and ready implementation. It’s only optimized for lazy coding. You may want to use libraries from CPAN to build your parser and your tree nodes.

#!/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)