Skip to content

Instantly share code, notes, and snippets.

@jeffreykegler
Forked from pstuifzand/MarpaX-JSON.pm
Last active December 11, 2015 09:28
Show Gist options
  • Save jeffreykegler/4579728 to your computer and use it in GitHub Desktop.
Save jeffreykegler/4579728 to your computer and use it in GitHub Desktop.
package MarpaX::JSON;
use 5.010;
use strict;
use warnings;
use Marpa::R2 2.060000;
sub new {
my ($class) = @_;
my $self = bless {}, $class;
$self->{grammar} = Marpa::R2::Scanless::G->new(
{ bless_package => 'My_Nodes',
source => \(<<'END_OF_SOURCE'),
:default ::= action => ::array
:start ::= json
json ::= object action => ::first
| array action => ::first
object ::= ('{') members ('}') bless => hash
members ::= pair* separator => <comma>
pair ::= string (':') value
value ::= string action => ::first
| object action => ::first
| number action => ::first
| array action => ::first
| 'true' bless => true
| 'false' bless => false
| 'null' action => ::undef
array ::= ('[' ']')
| ('[') elements (']') action => ::first
elements ::= value+ separator => <comma>
number ~ int
| int frac
| int exp
| int frac exp
int ~ digits
| '-' digits
digits ~ [\d]+
frac ~ '.' digits
exp ~ e digits
e ~ 'e'
| 'e+'
| 'e-'
| 'E'
| 'E+'
| 'E-'
string ::= <string lexeme> bless => string
<string lexeme> ~ quote <string contents> quote
# This cheats -- it recognizers a superset of legal JSON strings.
# The bad ones can sorted out later, as desired
quote ~ ["]
<string contents> ~ <string char>*
<string char> ~ [^"\\] | '\' <any char>
<any char> ~ [\d\D]
comma ~ ','
:discard ~ whitespace
whitespace ~ [\s]+
END_OF_SOURCE
}
);
return $self;
} ## end sub new
sub eval_json {
my ($thing) = @_;
my $type = ref $thing;
if ( $type eq 'REF' ) {
return \eval_json( ${$thing} );
}
if ( $type eq 'ARRAY' ) {
return [ map { eval_json($_) } @{$thing} ];
}
if ( $type eq 'My_Nodes::string' ) {
my $string = substr $thing->[0], 1, -1;
return decode_string($string) if ( index $string, '\\' ) >= 0;
return $string;
}
if ( $type eq 'My_Nodes::hash' ) {
return { map { eval_json( $_->[0] ), eval_json( $_->[1] ) }
@{ $thing->[0] } };
}
return 1 if $type eq 'My_Nodes::true';
return '' if $type eq 'My_Nodes::false';
return $thing;
} ## end sub eval_json
sub parse {
my ( $self, $string ) = @_;
my $re = Marpa::R2::Scanless::R->new( { grammar => $self->{grammar} } );
my $length = length $string;
my $pos = $re->read( \$string );
die "Read short of end: $pos vs. $length" if $pos < $length;
my $value_ref = $re->value();
die "Parse failed" if not defined $value_ref;
$value_ref = eval_json($value_ref);
return ${$value_ref};
} ## end sub parse
sub parse_json {
my ($string) = @_;
my $parser = MarpaX::JSON->new();
return $parser->parse($string);
}
sub decode_string {
my ($s) = @_;
$s =~ s/\\u([0-9A-Fa-f]{4})/chr(hex($1))/eg;
$s =~ s/\\n/\n/g;
$s =~ s/\\r/\r/g;
$s =~ s/\\b/\b/g;
$s =~ s/\\f/\f/g;
$s =~ s/\\t/\t/g;
$s =~ s/\\\\/\\/g;
$s =~ s{\\/}{/}g;
$s =~ s{\\"}{"}g;
return $s;
} ## end sub decode_string
1;
use 5.010;
use Test::More;
use Test::Exception;
use lib '.';
use lib '../../cpan/lib';
use lib '../../cpan/blib/arch';
use lib 'lib';
use Marpa::R2 2.060_002;
use MarpaX::JSON;
say STDERR "Using Marpa::R2 ", $Marpa::R2::VERSION;
my $data = MarpaX::JSON::parse_json(q${"test":"1"}$);
is($data->{test}, 1);
{
my $test = q${"test":[1,2,3]}$;
$data = MarpaX::JSON::parse_json(q${"test":[1,2,3]}$);
is_deeply( $data->{test}, [ 1, 2, 3 ], $test );
}
$data = MarpaX::JSON::parse_json(q${"test":true}$);
is($data->{test}, 1);
$data = MarpaX::JSON::parse_json(q${"test":false}$);
is($data->{test}, '');
$data = MarpaX::JSON::parse_json(q${"test":null}$);
is($data->{test}, undef);
$data = MarpaX::JSON::parse_json(q${"test":null, "test2":"hello world"}$);
is($data->{test}, undef);
is($data->{test2}, "hello world");
$data = MarpaX::JSON::parse_json(q${"test":"1.25"}$);
is($data->{test}, '1.25', '1.25');
$data = MarpaX::JSON::parse_json(q${"test":"1.25e4"}$);
is($data->{test}, '1.25e4', '1.25e4');
$data = MarpaX::JSON::parse_json(q$[]$);
is_deeply($data, [], '[]');
$data = MarpaX::JSON::parse_json(<<'JSON');
[
{
"precision": "zip",
"Latitude": 37.7668,
"Longitude": -122.3959,
"Address": "",
"City": "SAN FRANCISCO",
"State": "CA",
"Zip": "94107",
"Country": "US"
},
{
"precision": "zip",
"Latitude": 37.371991,
"Longitude": -122.026020,
"Address": "",
"City": "SUNNYVALE",
"State": "CA",
"Zip": "94085",
"Country": "US"
}
]
JSON
is_deeply($data, [
{ "precision"=>"zip", Latitude => "37.7668", Longitude=>"-122.3959",
"Country" => "US", Zip => 94107, Address => '',
City => "SAN FRANCISCO", State => 'CA' },
{ "precision" => "zip", Longitude => "-122.026020", Address => "",
City => "SUNNYVALE", Country => "US", Latitude => "37.371991",
Zip => 94085, State => "CA" }
], 'Geo data');
$data = MarpaX::JSON::parse_json(<<'JSON');
{
"Image": {
"Width": 800,
"Height": 600,
"Title": "View from 15th Floor",
"Thumbnail": {
"Url": "http://www.example.com/image/481989943",
"Height": 125,
"Width": "100"
},
"IDs": [116, 943, 234, 38793]
}
}
JSON
is_deeply($data, {
"Image" => {
"Width" => 800, "Height" => 600,
"Title" => "View from 15th Floor",
"Thumbnail" => {
"Url" => "http://www.example.com/image/481989943",
"Height" => 125,
"Width" => 100,
},
"IDs" => [ 116, 943, 234, 38793 ],
}
}, 'is_deeply test');
$data = MarpaX::JSON::parse_json(<<'JSON');
{
"source" : "<a href=\"http://janetter.net/\" rel=\"nofollow\">Janetter</a>",
"entities" : {
"user_mentions" : [ {
"name" : "James Governor",
"screen_name" : "moankchips",
"indices" : [ 0, 10 ],
"id_str" : "61233",
"id" : 61233
} ],
"media" : [ ],
"hashtags" : [ ],
"urls" : [ ]
},
"in_reply_to_status_id_str" : "281400879465238529",
"geo" : {
},
"id_str" : "281405942321532929",
"in_reply_to_user_id" : 61233,
"text" : "@monkchips Ouch. Some regrets are harsher than others.",
"id" : 281405942321532929,
"in_reply_to_status_id" : 281400879465238529,
"created_at" : "Wed Dec 19 14:29:39 +0000 2012",
"in_reply_to_screen_name" : "monkchips",
"in_reply_to_user_id_str" : "61233",
"user" : {
"name" : "Sarah Bourne",
"screen_name" : "sarahebourne",
"protected" : false,
"id_str" : "16010789",
"profile_image_url_https" : "https://si0.twimg.com/profile_images/638441870/Snapshot-of-sb_normal.jpg",
"id" : 16010789,
"verified" : false
}
}
JSON
$data = MarpaX::JSON::parse_json(<<'JSON');
{ "test": "\u2603" }
JSON
is($data->{test}, "\x{2603}");
done_testing();
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment