#!/usr/bin/perl

use strict;
use warnings;

use Data::Dumper;
use Parse::RecDescent;

my $grammar = q{
        # --- Tokens ---

        EOF             : /^\Z/

        IDENTIFIER      : /[A-Za-z0-9]\w*/
        LITERAL         : /\d+/
        SCALAR          : '$'

        REL_OP          : />=?|<=?|==/
        EQUAL           : '='
        QUOTE           : '"'

        # --- Tokens ---
       IF_KEYWORD      : IDENTIFIER { $item[1] eq 'if' ? $item [1] : u
+ndef }

        # --- Rules ---

        parse           : statement(s?) ';' EOF { $item[1] }

        statement       : if
                        | assign
                        | call
                        | <error>

        if_rest         : '(' compare ')' '{' statement(s?) '}' { [ @i
+tem[2, 5] ] }
        if              : IF_KEYWORD <commit> if_rest { [ $item[1], @{
+$item[3]} ] }

        label           : IDENTIFIER ':'
                        { [ @item[0, 1] ] }

        assign          : termleft EQUAL term { [ @item[0, 1, 3] ] }
       argument        : term ',' { $item[1] }
                        | term { $item[1] }

        call            : IDENTIFIER '(' argument(s?) ')'
                        { [ @item[0, 1, 3] ] }

        compare         : term REL_OP term
                        { [ @item[2, 1, 3] ] }

        termleft        : SCALAR IDENTIFIER { [ 'scalar', $item[2] ] }
        term            : termleft { 'test', $item[1] }
                        | QUOTE IDENTIFIER QUOTE { [ 'literal', $item[
+2] ] }
                        | LITERAL    { [ 'literal',    $item[1] ] }

};

#$::RD_HINT  = 1;

my $parser = Parse::RecDescent->new($grammar);
die("Bad grammar.\n") unless defined($parser);

my $text = <<'DATA';
func(4);
DATA
#       if ( "XYZ" > 500 ) {dosomething("XYZ", $var);}
#%stuff = { animal => @pets, age => 5, name => "fluffy", colour => $co
+l };



my $lang = Language::C->new();
my $result = $parser->parse($text);
die("Bad text.\n") unless (defined($result));

print Data::Dumper::Dumper($result);

for my $item ( @$result ) {
        print "Trying item : $item->[0]\n";
        my $method = $item->[0];
        #$lang->$method(@$item);
}

package Language::C;

sub new {bless {}, shift }

sub AUTOLOAD {
        my $func = shift;
        print "Oops, handler not defined for : $func\n";
}


sub call { print "Doing a call\n"; }
[download]