Re: looping with conditions and print newline

[choroba]

Write a proper parser for the format.

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

use Marpa::R2;

my $dsl = << '__DSL__';

lexeme default = latm => 1
:default ::= action => list

Top       ::= AttrName ('{') Structs ('}')            action => top

Structs   ::= Struct+

Struct    ::= AttrName ('{') Attr S_structs ('}')     action => struct

S_structs ::= S_struct+

S_struct  ::= StructName ('{') Attrs ('}') Size (';') action => s_stru
+ct

Attrs     ::= Attr+

Attr      ::= ('@') AttrName ('=') AttrVal (';')      action => attr

AttrVal   ::= Num                                     action => First
            | Quoted                                  action => First

Quoted    ::= ('"') String ('"')                      action => remove
+_newlines

Size      ::= ('[') Num (':') Num (']')               action => size

Num        ~ [0-9]+
StructName ~ [[:alpha:]]+
AttrName   ~ [[:upper:]]+
String     ~ [^"]*                      # No " in comments.
:discard   ~ Whitespace
Whitespace ~ [\s]+

__DSL__

sub list            { shift; [ @_ ] }
sub top             { +{ $_[1] => $_[2] } }
sub struct          { +{ $_[1] => [ $_[2]{NUM}, { map %$_, @{ $_[3] } 
+} ] } }
sub s_struct        { +{ $_[1] => { size => $_[3], map %$_, @{ $_[2] }
+ } } }
sub attr            { +{ $_[1] => $_[2] } }
sub First           { $_[1] }
sub remove_newlines { $_[1] =~ s/\s+/ /gr }
sub size            { "[$_[1]:$_[2]]" }

my $grammar = 'Marpa::R2::Scanless::G'->new({ source => \$dsl });
my $parsed = $grammar->parse(\ << '__INPUT__', 'main');
NAME {
    ABC {
      @NUM = 1;
        Aaa {
          @COMMENT = "Another way";
          @TYPE = "AC";
        } [0:0];
      }
    DEF {
      @NUM = 84;
        Bbb {
          @COMMENT = "This way";
          @TYPE = "DC";
        } [1:0];
        Ccc {
          @COMMENT = "This is zero (0 length)
          Check the SP file 4 details";
          @TYPE = "AC";
        } [34:28];
      }
    }
__INPUT__

say join "\t", qw( NAME NUM S_NAME COMMENT TYPE SIZE );
for my $struct (@{ $$parsed->{NAME} }) {
    my $name = (keys %$struct)[0];
    my $num  = $struct->{$name}[0];
    my $s_struct = $struct->{$name}[1];
    for my $s_name (keys %{ $struct->{$name}[1] }) {
        say join "\t", $name, $num, $s_name,
                       @{ $s_struct->{$s_name} }{qw{ COMMENT TYPE size
+ }};
    }
}