ParserZPL.pm

package ParserZPL;
use 5.10.0;
use Marpa::R2 '2.051_010';

sub parse_zpl {
    my ($input) = @_;

    my $grammar = Marpa::R2::Scanless::G->new({
        default_action => '::array',
        source => \<<'SOURCE',
:start      ::= roots

roots       ::= config+

config      ::= (open) name children (close)
children    ::= config*

open        ~ [.]
close       ~ [.]

name        ~ [\w]+

SOURCE
    });

    my $current_depth = 0;

    my $re = Marpa::R2::Scanless::R->new({grammar => $grammar});
    $re->read(\$input,0,0);

    my $pos = 0;
    my $depth = 0;

    while ($pos < length($input)) {
        pos($input) = $pos;
        if ($input =~ m/\G^(?>\w+)/ms) {
            my $d = 1;
            while ($depth > 0) {
                $re->lexeme_read('close', $pos, 0, '') // die $re->show_progress;
                $depth--;
            }
            while ($depth < $d) {
                $re->lexeme_read('open', $pos, 0, '') // die $re->show_progress;
                $depth++;
            }
        }
        $pos = pos($input);
        if ($input =~ m/\G(\w+)/gmsc) {
            $re->lexeme_read('name', $pos, length($1), $1) // die $re->show_progress;
        }
        elsif ($input =~ m/\G\n/gmsc) {
            # skip newline in matching
        }
        elsif ($input =~ m/\G(\s+)/gmsc) {
            my $length = length($1);
            my $d = 1+($length / 4);
            while ($depth > $d) {
                $re->lexeme_read('close', $pos, 0, '') // die $re->show_progress;
                $depth--;
            }
            if ($depth == $d) {
                $re->lexeme_read('close', $pos, 0, '') // die $re->show_progress;
                $re->lexeme_read('open', $pos, 0, '') // die $re->show_progress;
            }
            while ($depth < $d) {
                $re->lexeme_read('open', $pos, 0, '') // die $re->show_progress;
                $depth++;
            }
        }
        $pos = pos($input);
    }

    while ($depth > 0) {
        $re->lexeme_read('close', $pos, 0, '') // die $re->show_progress;
        $depth--;
    }

    my $v = ${$re->value};
    return $v;
}

1;

test.pl

use Data::Dumper;
use ParserZPL;

my $v = ParserZPL::parse_zpl(<<"INPUT");
test1
    test11
    test12
test2
    test22
    test23
        test231
test3
INPUT

print Dumper($v);
print Dumper(hashify($v));

sub hashify {
    my ($list) = @_;
    my %hash;
    for (@$list) {
        $hash{$_->[0]} = hashify($_->[1]);
    }
    return \%hash;
}