Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Re: looping with conditions and print newline

by choroba (Cardinal)
on Jan 12, 2016 at 18:36 UTC ( [id://1152598]=note: print w/replies, xml ) Need Help??


in reply to looping with conditions and print newline

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 + }}; } }
($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1152598]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others sharing their wisdom with the Monastery: (1)
As of 2024-07-21 23:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?
    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.