A shell for running JSON-RPC 2.0 queries
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 

155 lines
3.7 KiB

  1. #!/usr/bin/env perl
  2. use strict;
  3. use warnings;
  4. use Term::ANSIColor;
  5. use Getopt::Long;
  6. my $reset = color('reset');
  7. my %format = (
  8. FIELD => color('bold'),
  9. NULL => color('cyan'),
  10. BOOL => color('red'),
  11. NUMBER => color('magenta'),
  12. STRING => color('blue'),
  13. ERROR => color('bold white on_red'),
  14. );
  15. my ($color, $keep_ws, $help) = 'auto';
  16. if (!GetOptions('color=s' => \$color, 'keep-ws' => \$keep_ws, 'help' => \$help)
  17. || $help) {
  18. print STDERR
  19. "Usage: $0 [OPTION...] [FILE...]\n" .
  20. "Pretty-print and colorify JSON\n" .
  21. "\n" .
  22. " --help print this help\n" .
  23. " --keep-ws retain all original whitespace\n" .
  24. " --color=COLOR 'always', 'never' or 'auto' (the default)\n";
  25. exit 2;
  26. }
  27. %format = ()
  28. if $color eq 'never' || $color eq 'auto' && !-t STDOUT;
  29. # Hash lookup is the fastest way to qualify tokens, however it cannot be used
  30. # for everything and we need to fall back to regular expressions
  31. my %lookup = (
  32. '[' => 'LBRACKET', '{' => 'LBRACE',
  33. ']' => 'RBRACKET', '}' => 'RBRACE',
  34. ':' => 'COLON', ',' => 'COMMA',
  35. 'true' => 'BOOL', 'false' => 'BOOL', 'null' => 'NULL',
  36. );
  37. my @pats = (
  38. ['"(?:[^\\\\"]*|\\\\(?:u[\da-f]{4}|["\\\\/bfnrt]))*"' => 'STRING'],
  39. ['-?\d+(?:\.\d+)?(?:[eE][-+]?\d+)?' => 'NUMBER'],
  40. ['[ \t\r\n]+' => 'WS'],
  41. );
  42. my @tokens = map {[qr/^$_->[0]$/s, $_->[1]]} @pats;
  43. # m//g is the fastest way to explode text into tokens in the first place
  44. # and we need to construct an all-encompassing regular expression for it
  45. my @all_pats = map {$_->[0]} @pats;
  46. push @all_pats, quotemeta for keys %lookup;
  47. my $any_token = qr/\G(${\join '|', @all_pats})/;
  48. # FIXME: this probably shouldn't be a global variable
  49. my $indent = 0;
  50. sub nexttoken ($) {
  51. my $json = shift;
  52. if (!@$json) {
  53. return unless defined (my $line = <>);
  54. push @$json, $line =~ /$any_token/gsc;
  55. push @$json, substr $line, pos $line
  56. if pos $line != length $line;
  57. }
  58. my $text = shift @$json;
  59. if (my $s = $lookup{$text}) {
  60. return $s, $text;
  61. }
  62. for my $s (@tokens) {
  63. return $s->[1], $text if $text =~ $s->[0];
  64. }
  65. return 'ERROR', $text;
  66. }
  67. sub gettoken ($) {
  68. my $json = shift;
  69. while (my ($token, $text) = nexttoken $json) {
  70. next if !$keep_ws && $token eq 'WS';
  71. return $token, $text;
  72. }
  73. return;
  74. }
  75. sub printindent () {
  76. print "\n", ' ' x $indent;
  77. }
  78. sub do_value ($$$);
  79. sub do_object ($) {
  80. my $json = shift;
  81. my $in_field_name = 1;
  82. my $first = 1;
  83. while (my ($token, $text) = gettoken $json) {
  84. if ($token eq 'COLON') {
  85. $in_field_name = 0;
  86. } elsif ($token eq 'COMMA') {
  87. $in_field_name = 1;
  88. } elsif ($token eq 'STRING') {
  89. $token = 'FIELD' if $in_field_name;
  90. }
  91. if ($token eq 'RBRACE') {
  92. $indent--;
  93. printindent unless $keep_ws;
  94. } elsif ($first) {
  95. printindent unless $keep_ws;
  96. $first = 0;
  97. }
  98. do_value $token, $text, $json;
  99. return if $token eq 'RBRACE';
  100. }
  101. }
  102. sub do_array ($) {
  103. my $json = shift;
  104. my $first = 1;
  105. while (my ($token, $text) = gettoken $json) {
  106. if ($token eq 'RBRACKET') {
  107. $indent--;
  108. printindent unless $keep_ws;
  109. } elsif ($first) {
  110. printindent unless $keep_ws;
  111. $first = 0;
  112. }
  113. do_value $token, $text, $json;
  114. return if $token eq 'RBRACKET';
  115. }
  116. }
  117. sub do_value ($$$) {
  118. my ($token, $text, $json) = @_;
  119. if (my $format = $format{$token}) {
  120. print $format, $text, $reset;
  121. } else {
  122. print $text;
  123. }
  124. if ($token eq 'LBRACE') {
  125. $indent++;
  126. do_object $json;
  127. } elsif ($token eq 'LBRACKET') {
  128. $indent++;
  129. do_array $json;
  130. } elsif ($token eq 'COMMA') {
  131. printindent unless $keep_ws;
  132. } elsif ($token eq 'COLON') {
  133. print ' ' unless $keep_ws;
  134. }
  135. }
  136. my @buffer;
  137. while (my ($token, $text) = gettoken \@buffer) {
  138. do_value $token, $text, \@buffer;
  139. print "\n" unless $keep_ws;
  140. }