use strict;
use warnings;

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

$::RD_WARN  = 0 || undef;       # unless undefined, also report non-fatal problems
$::RD_HINT  = 0 || undef;       # if defined, also 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

# 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 :-)
array : "({" <leftop: val_or_empty ',' val_or_empty > "})"
      {
      	[ grep !UNIVERSAL::isa($_,"Value::Empty"),@{$item[2]} ]
      }

hash  : "([" <leftop: keyvalue ',' keyvalue > "])"
       {
       	  $return={};
       	  !UNIVERSAL::isa($_,"Value::Empty") and
       	     ($return->{$_->[0]}=$_->[1]) foreach @{$item[2]};
       }

keyvalue : string_or_number ":" value
         {
         	[ @item[1,3] ]
         }
         | empty


string_or_number : string
                 | number

val_or_empty : value
             | empty

empty : ""
      {
        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+/

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,([]),}),])
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";
	}
}