# Copyright (c) 2011 bivio Software Inc.  All Rights Reserved.
#
# Visit http://www.bivio.biz for more info.
# 
# This library is free software; you can redistribute it and/or modify
# it under the terms of the GNU Lesser General Public License as
# published by the Free Software Foundation; either version 2.1 of the
# License, or (at your option) any later version.
# 
# This library is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
# 
# You should have received a copy of the GNU Lesser General Public
# License along with this library;  If not, you may get a copy from:
# http://www.opensource.org/licenses/lgpl-license.html
# 
# $Id: JSON.pm,v 2.10 2011/09/07 22:31:25 moeller Exp $
package Bivio::MIME::JSON;
use strict;
use Bivio::Base 'Bivio.UNIVERSAL';

our($VERSION) = sprintf('%d.%02d', q$Revision: 2.10 $ =~ /\d+/g);
my($_IDI) = __PACKAGE__->instance_data_index;

# Using BNF at http://www.json.org/
# expanded to allow strings in single quote and unquoted object keys

sub from_text {
    my($proto, $text) = @_;
    my($self) = $proto->new;
    my($fields) = $self->[$_IDI] = {
	text => ref($text) ? $text : \$text,
	char_count => 0,
    };
    my($res) = _parse_text($self);
    b_die('leftover data at char index: ', $fields->{char_count})
	if length(_peek_char($self, 1));
    return $res;
}

sub to_text {
    my($proto, $value) = @_;
    my($res);

    if (! defined($value)) {
	$res = '';
    }
    elsif (! ref($value)) {
	$value =~ s{('|"|\\|\/)}{\\$1}g;
	$res = join('', '"', $value, '"');
    }
    elsif (ref($value) eq 'HASH') {
	$res = '{'
	    . join(',',
		   map(join(':', ${$proto->to_text($_)},
		       ${$proto->to_text($value->{$_})}), keys(%$value)),
	    ) . '}';
    }
    elsif (ref($value) eq 'ARRAY') {
	$res = '['
	    . join(',', map(${$proto->to_text($_)}, @$value))
	    . ']';
    }
    else {
	b_die($value);
    }
    return \$res;
}

sub _next_char {
    my($self, $expected_char) = @_;
    my($fields) = $self->[$_IDI];
    my($res) = _peek_char($self);
    b_die('unexpected end of input') unless length($res);
    b_die('unexpected char: ', $res, ' != ', $expected_char)
	if defined($expected_char) && $res ne $expected_char;
    $fields->{char_count}++;
    return $res;
}

sub _parse_array {
    my($self) = @_;
    my($res) = [];
    _next_char($self, '[');

    while (_peek_char($self, 1) ne ']') {
	push(@$res, _parse_text($self));
	_next_char($self, ',')
	    unless _peek_char($self, 1) eq ']';
    }
    _next_char($self, ']');
    return $res;
}

sub _parse_constant {
    my($self, $expected_value) = @_;

    foreach my $expected_char (split('', $expected_value)) {
	_next_char($self, $expected_char);
    }
    return $expected_value;
}

sub _parse_digits {
    my($self) = @_;
    my($res) = _next_char($self);
    b_die('expecting digit but found: ', $res)
	unless $res =~ /\d/;

    while (_peek_char($self) =~ /\d/) {
	$res .= _next_char($self);
    }
    return $res;
}

sub _parse_number {
    my($self) = @_;
    my($res) = '';

    if (_peek_char($self) eq '-') {
	$res .= _next_char($self, '-');
    }
    $res .= _parse_digits($self);

    if (_peek_char($self) eq '.') {
	$res .= _next_char($self, '.') . _parse_digits($self);
    }

    if (_peek_char($self) =~ /e/i) {
	$res .= lc(_next_char($self))
	    . (_peek_char($self) =~ /\+|\-/
	        ? _next_char($self)
		: '')
	    . _parse_digits($self);
    }
    return $res;
}

sub _parse_object {
    my($self) = @_;
    my($res) = {};
    _next_char($self, '{');

    while (_peek_char($self, 1) ne '}') {
	my($k) = _parse_string($self, ':');
	_skip_whitespace($self);
	_next_char($self, ':');
	b_die('key exists: ', $k, ' object: ', $res)
	    if exists($res->{$k});
	$res->{$k} = _parse_text($self);
	_next_char($self, ',')
	    unless _peek_char($self, 1) eq '}';
    }
    _next_char($self, '}');
    return $res;
}

sub _parse_string {
    my($self, $end_char) = @_;

    if (_peek_char($self) =~ /'|"/) {
	$end_char = _next_char($self);
    }
    else {
	b_die('invalid quote char')
	    unless $end_char;
    }
    my($res) = '';

    while (_peek_char($self) ne $end_char) {
	my($c) = _next_char($self);

	if ($c eq '\\') {
	    $c = _next_char($self);

	    if ($c eq 'n') {
		$res .= "\n";
	    }
	    elsif ($c eq 't') {
		$res .= "\t";
	    }
	    elsif ($c =~ /b|f|r/) {
		# ignore formfeed or backspace
	    }
	    elsif ($c =~ /'|"|\\|\//) {
		$res .= $c;
	    }
	    elsif ($c eq 'u') {
		$res .= _parse_unicode_char($self);
	    }
	    else {
		b_die('unexpected char: ', $c);
	    }
	}
	else {
	    $res .= $c;
	}
    }
    _next_char($self, $end_char)
	if $end_char =~ /'|"/;
    return $res;
}

sub _parse_text {
    my($self) = @_;
    my($c) = _peek_char($self, 1);
    return _parse_object($self)
	if $c eq '{';
    return _parse_array($self)
	if $c eq '[';
    return _parse_string($self)
	if $c =~ /'|"/;
    return _parse_constant($self, 'true')
	if $c eq 't';
    return _parse_constant($self, 'false')
	if $c eq 'f';
    return _parse_constant($self, 'null')
	if $c eq 'n';
    return _parse_number($self)
	if $c =~ /\d|\-/;
    b_die('invalid value start: ', $c);
}

sub _parse_unicode_char {
    my($self) = @_;
    my($hex) = join('', map(_next_char($self), 1 .. 4));
    b_die('invalid hex value: ', $hex)
	unless $hex =~ /^[0-9a-f]{4}$/i;
    return pack('U', hex($hex));
}

sub _peek_char {
    my($self, $skip_whitespace) = @_;
    my($fields) = $self->[$_IDI];
    _skip_whitespace($self)
	if $skip_whitespace;
    return $fields->{char_count} >= length(${$fields->{text}})
	? ''
	: substr(${$fields->{text}}, $fields->{char_count}, 1);
}

sub _skip_whitespace {
    my($self) = @_;

    while (_peek_char($self) =~ /\s/) {
	_next_char($self);
    }
    return;
}

1;