use strict;
use warnings;

use Parse::RecDescent qw( );

my $grammar = <<'EOG';
   <autotree>
  
   {
      # These affect the entire parser.
      use strict;
      use warnings;
      
      sub dequote {
         my $s = $_[0];
         $s =~ s/^"//;
         $s =~ s/"\z//;
         return $s;
      }
   }

   parse      : stmt(s) /\Z/

   stmt       : clause
              | def

   clause     : "include" pathname
 
   # Pathname may or may not be surrounded by double quotes
   pathname   : STRING
              | BAREWORD

   def        : IDENT def_[ $item[1] ] { $item[2] }
   def_       : { $arg[0] eq "cluster" ?1:0 } IDENT "(" attr(s?) ")"
              | { $arg[0] eq "system"  ?1:0 } IDENT "(" attr(s?) ")"

   attr       : ATTRNAME '=' attr_val
   
   attr_val   : ident
              | string
              | number
              | key_list
              | assoc_list
              
   val        : ident
              | string
              | number

   # These aren't inlined because of <autotree>
   ident      : IDENT 
   string     : STRING
   number     : NUMBER
   key_list   : '{' <leftop: IDENT /[,;]/ IDENT> '}'
   assoc_list : '{' <leftop: key_value /[,;]/ key_value> '}'

   key_value  : IDENT '=' val


   # === Tokens ===
   
   IDENT    : /[a-zA-Z]\w*/    { $item[1] }
   ATTRNAME : /[a-zA-Z][\w@]*/ { $item[1] }
   STRING   : /"(?:[^"]+)"/    { dequote($item[1]) }
   NUMBER   : /\d+/            { $item[1] }      # Need work.
   BAREWORD : /(?:[^"]+)/      { $item[1] }

EOG

Parse::RecDescent->Precompile($grammar, 'VCSConfigParser')
   or die("Bad grammar\n");

##</code><code>##

use strict;
use warnings;

use VCSConfigParser qw( );
use Data::Dumper    qw( Dumper );

#$::RD_TRACE = '';

my $vcs_parser = VCSConfigParser->new();
my $vcs_config = do { local $/; <DATA> };

my $tree = $vcs_parser->parse( $vcs_config );
print Dumper $tree;

__DATA__
include "types.cf"
include "LBSybase.cf"
include "OracleTypes.cf"

cluster vcs (
        UserNames = { vcs = X1Nh6WIWs6ATQ }
        Administrators = { vcs }
        CounterInterval = abc
        )

system njengsunvcs1 (
        )

system njengsunvcs2 (
        )

##</code><code>##

def : IDENT { $item[1] eq "cluster" ?1:0 } IDENT "(" attr(s?) ")"
    | IDENT { $item[1] eq "system"  ?1:0 } IDENT "(" attr(s?) ")"