Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
executable file 185 lines (155 sloc) 4.49 KB
#!/usr/bin/env perl
use v5.28;
use strict;
use warnings;
package JSONScanner {
sub new {
my ($class, $fh_in, $event_handlers) = @_;
my $buf = '';
return bless {
fh_in => $fh_in,
buf => $buf,
buf_cursor => 0,
event_handlers => $event_handlers,
eof => 0,
}, $class;
}
sub err {
my ($self, $message) = @_;
die $message;
}
sub nothing_left {
my ($self) = @_;
return $self->{eof} && $self->{buf_cursor} >= length($self->{buf});
}
sub read_firstpart {
my ($self) = @_;
# 16MB
if (my $nread = read($self->{fh_in}, $self->{buf}, 16777216)) {
$self->{eof} = 1 if $nread < 16777216;
}
}
sub purge_and_readmore {
my ($self) = @_;
return if $self->{eof};
my $buf2 = substr($self->{buf}, $self->{buf_cursor});
my $buf3 = '';
unless (my $nread = read($self->{fh_in}, $buf3, 524288)) {
$self->{eof} = 1;
}
$self->{buf} = $buf2 . $buf3;
$self->{buf_cursor} = 0;
}
sub emit {
my ($self, $event_name, $tok) = @_;
my $cb = $self->{event_handlers}{$event_name} or return 1;
$cb->($self, $tok);
return 1;
}
sub scan_ws {
my ($self) = @_;
pos($self->{buf}) = $self->{buf_cursor};
if ($self->{buf} =~ /\G[\x{0020}\x{000a}\x{000d}\x{0009}]+/g) {
$self->{buf_cursor} = pos($self->{buf});
}
return 1;
}
sub scan_non_ws {
my ($self) = @_;
my $p;
if ( substr($self->{buf}, $self->{buf_cursor}, 1) eq '"' ) {
$p = $self->pos_of_end_of_string($self->{buf_cursor}+1);
} else {
pos($self->{buf}) = $self->{buf_cursor};
if ($self->{buf} =~ /\G(?: [:,\[\]\{\}] | true|false|null | -?[0-9]+(?:\.[0-9]+)?(?:[Ee][+-]?[0-9]+)? )/gx) {
$p = pos($self->{buf});
}
}
return unless $p;
$self->emit(non_ws => substr($self->{buf}, $self->{buf_cursor}, $p - $self->{buf_cursor}));
$self->{buf_cursor} = $p;
return 1;
}
sub pos_of_end_of_string {
my ($self, $pos) = @_;
my $p = index($self->{buf}, '"', $pos);
while( substr($self->{buf}, $p-1, 1) eq "\\" ) {
$p = index($self->{buf}, '"', $p + 1);
}
return $p+1;
}
sub scan_json {
my ($self) = @_;
$self->read_firstpart;
# $self->emit(begin_json => $self->{buf_cursor}, 0);
while ( 1 ) {
my $i = 0;
while ($i++ < 1000) {
$self->scan_ws;
last unless $self->scan_non_ws;
}
last if $self->nothing_left;
if ( ! $self->{eof} && length($self->{buf}) - $self->{buf_cursor} < 1024 ) {
$self->purge_and_readmore;
}
}
$self->emit(end_json => $self->{buf_cursor}, 0);
}
}
package JSONPrinter {
sub new {
my ($class, $fh_in, $fh_out) = @_;
return bless {
fh_in => $fh_in,
fh_out => $fh_out,
handlers => {},
}, $class;
}
sub minify {
my ($self) = @_;
my $fh_out = $self->{fh_out};
my sub print_token {
my ($scanner, $tok) = @_;
print $fh_out $tok;
};
JSONScanner->new(
$self->{fh_in},
+{
non_ws => \&print_token
}
)->scan_json;
}
sub prettify {
my ($self) = @_;
my $indent = 0;
my $fh_out = $self->{fh_out};
my $pre_tok = '';
my sub print_token {
my ($scanner, $tok) = @_;
if ($tok eq '}' || $tok eq ']') {
$indent--;
}
my $pre_space = ( ($tok =~ m/\A[,:]\z/) ? '' : $pre_tok eq ':' ? ' ' : "\n".(' ' x $indent));
print $fh_out $pre_space . $tok;
if ($tok eq '{' || $tok eq '[') {
$indent++;
}
$pre_tok = $tok;
};
JSONScanner->new(
$self->{fh_in},
+{
non_ws => \&print_token,
end_json => sub {
print $fh_out "\n";
},
}
)->scan_json;
}
}
my $json_printer = JSONPrinter->new(\*STDIN, \*STDOUT);
if (grep { $_ =~ /\A(-m|--minify)\z/ } @ARGV) {
$json_printer->minify;
} else {
$json_printer->prettify;
}