use strict;
use warnings;

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

$::RD_WARN  = 0 || undef;       # if defined, report non-fatal probs
$::RD_HINT  = 0 || undef;       # if defined, give suggestion remedies
$::RD_TRACE = 0 || undef;       # if defined trace the parse

$::RD_AUTOACTION ='$item[1]';
my $parser = Parse::RecDescent->new(<<'ENDGRAMMAR');
# BEGIN GRAMMAR

# we want to parse things like...
# ({ 1, 2, "three", 0, ({ "internal", "array", 0, }), "end", })

# Base Rule (start-rule)
expr : value /\z/

# Recursion point
value : array
      | hash
      | string
      | number
      | bareword

# list of items. returns an arrayref
# we grep out the undefs so  ",,1,," is treated as one element and not
# three or five or any other number :-)
list  : <leftop: val_or_empty comma val_or_empty >
      {
         my @items=grep !UNIVERSAL::isa($_,"Value::Empty"),@{$item[1]};
         $return=[];
         while (@items) {
         	if (UNIVERSAL::isa($items[0],"Value::Bareword")) {
         		if (!UNIVERSAL::isa($items[1],"List::Seperator")
         		    or ${$items[1]} ne "=>") {
         	    	warn "Dont know what to do with bareword '$items[1]'\n";
         	    	undef $return;
         	    	last;
         		} else {
         			$items[0]=${$items[0]};
         		}
         	}
         	push @$return,shift @items;
         	shift @items while UNIVERSAL::isa($items[0],"List::Seperator");
         }
         $return
      }

array : "({" list "})"
      {
      	$item[2]
      }

hash  : "{{" list "}}"
       {
       	  my $items=$item[2];
       	  if (@$items % 2) {
       	  	push @$items,undef;
       	  	warn "Uneven list in hash creation\n";
       	  }
       	  $return = { @$items };
       }


val_or_empty : value
             | ""
             {
       	       bless \do{my $x},"Value::Empty"
             }

# quoted escaped string. escaping reversed and quotes removed.
string : /"((?:[^"\\]+|\\"|\\)+)"/
       {
       	 my $ret=$1;
       	 $ret=~s/\\"/"/g;
       	 $ret;
       }

# number. could be a better regex
number : /\d+/

# a bareword. well figurout if its legal later
bareword : /\w+/
         {
         	bless \do{ my $x=$item[1] },"Value::Bareword"
         }

comma : /,|=>/
         {
         	bless \do{ my $x=$item[1] },"List::Seperator"
         }
ENDGRAMMAR


my $tests=<<'ENDTEST';

({ 1, 2, "three", 0, ({ "internal", "array", 0, }), "end", })
1
"This is \"quoted\" dude"
({})
({({}),({})})
({"wow",({1}),"bob",({1}),"cool"})
{{"cool",1,subhash=>{{b=>"c",1=>2}},a=>({1,2,3,{{}},}),}}
({what=>a=>mess=>this=>all=>"is"})
({what=>=>=>is=>=>=>the=>=>=>point=>=>=>of=>=>=>it=>=>=>"all?",,,})
ENDTEST

foreach my $test (split /\n/,$tests) {
	print "------------------\n\n";
	my $value=$parser->expr($test);
	print "'$test'\n";
	if ( defined $value ) {

		print "\nproduced the following structure:\n\n";
		print Data::Dumper->new([$value])
		                  ->Terse(1)
		                  ->Indent(1)
		                  ->Dump(),"\n";
	} else {
		print "Failed to parse!\n";
	}
}