p/json-rpc-shell
1
1
Fork 0
Code Issues 8 Pull Requests Projects 1 Releases 3 Wiki Activity

json-format.pl: make it a streaming formatter

Browse Source 
Always pretty-print.
This commit is contained in:
Přemysl Eric Janouch 2017-01-25 20:42:32 +01:00
parent 17331073a4
commit 18c25e8bff
Signed by: p
GPG Key ID: B715679E3A361BE6
1 changed files with 24 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
json-format.pl
View File

@ -56,9 +56,15 @@ my $any_token = qr/\G(${\join '|', @all_pats})/;
my $indent = 0;
sub nexttoken ($) {
my $ref = shift;
return unless @$ref;
my $text = shift @$ref;
my $json = shift;
if (!@$json) {
return unless defined (my $line = <>);
push @$json, $line =~ /$any_token/gsc;
push @$json, substr $line, pos $line
if pos $line != length $line;
}
my $text = shift @$json;
if (my $s = $lookup{$text}) {
return $s, $text;
}
@ -68,6 +74,15 @@ sub nexttoken ($) {
return 'ERROR', $text;
}
sub skip_ws ($) {
my $json = shift;
while (my ($token, $text) = nexttoken $json) {
next if $token eq 'WS';
return $token, $text;
}
return;
}
sub printindent () {
print "\n";
print ' ' x $indent;
@ -78,7 +93,7 @@ sub do_object ($) {
my $json = shift;
my $in_field_name = 1;
my $first = 1;
while (my ($token, $text) = nexttoken $json) {
while (my ($token, $text) = skip_ws $json) {
if ($token eq 'COLON') {
$in_field_name = 0;
} elsif ($token eq 'COMMA') {
@ -101,7 +116,7 @@ sub do_object ($) {
sub do_array ($) {
my $json = shift;
my $first = 1;
while (my ($token, $text) = nexttoken $json) {
while (my ($token, $text) = skip_ws $json) {
if ($token eq 'RBRACKET') {
$indent--;
printindent;
@ -134,16 +149,8 @@ sub do_value ($$$) {
}
}
while (<>) {
# FIXME: this way it doesn't work with pre-formatted JSON
my $json = $_;
my @matches = $json =~ /$any_token/gsc;
push @matches, substr $json, pos $json
if pos $json != length $json;
while (my ($token, $text) = nexttoken \@matches) {
next if $token eq 'WS';
do_value $token, $text, \@matches;
}
print "\n";
my @buffer;
while (my ($token, $text) = skip_ws \@buffer) {
do_value $token, $text, \@buffer;
}
print "\n";