#!/usr/bin/perl
use warnings;
use strict;
$|++;

use Data::Dumper;
print Dumper parse_string(join "", <DATA>);

sub parse_string {
  local $_ = shift;

  parse_expression();
}

sub parse_expression {
  parse_list() || parse_hash() || parse_item();
}

sub parse_list {
  my $pos = pos;
  {
    last unless parse_left_paren();
    last unless my $list = parse_comma_items();
    last unless parse_right_paren();
    return $list;		# already a list reference
  };
  pos($pos);
  return undef;
}

sub parse_left_paren {
  /\G\s*\(/gc ? 1 : undef;
}

sub parse_comma_items {
  my @result;
  {
    last unless my $item = parse_expression();
    $item = $$item if ref $item eq "SCALAR";
    push @result, $item;
    redo if parse_comma();
  }
  return \@result;
}

sub parse_comma {
  /\G\s*,/gc ? 1 : undef;
}

sub parse_right_paren {
  /\G\s*\)/gc ? 1 : undef;
}

sub parse_hash {
  my $pos = pos;
  {
    last unless parse_left_curly();
    last unless my $list = parse_comma_items();
    last unless parse_right_curly();
    ## list to hash sanity checks
    ## even length?
    last unless @$list % 2 == 0;
    ## no reference keys?
    last if grep { ref $list->[$_] } map { $_ * 2 } 0 .. $#$list / 2;
    ## ok, let it go
    return {@$list};		# convert listref to hashref
  };
  pos($pos);
  return undef;
}

sub parse_left_curly {
  /\G\s*\{/gc ? 1 : undef;
}

sub parse_right_curly {
  /\G\s*\}/gc ? 1 : undef;
}

sub parse_item {
  parse_number() || parse_quoted_string();
}

sub parse_number {
  /\G\s*(\d+)/gc ? \"$1" : undef;
}

sub parse_quoted_string {
  /\G\s*\"([^\"]*)\"/gc ? \"$1" : undef;
}

__DATA__

{ "fred", { 2, { "barney", { 4 , 5}, 6, (7, 8)}}}