my $char = $self->_peek_char(); #### > perl isJson.pl < file.json Valid JSON. Took 38s. > perl loops.pl okTook 446s. #### > perl skip.pl okTook 235s. #### > perl loops.pl panicTook 402s. > perl isJson.pl < file.json Invalid bare word (troo) at line 1020000, pos 8 (t) Took 39s. #### #!/usr/bin/perl -w use strict; END { warn "Took ", time()-$^T, "s.\n"; } sub fail { my( $off, @msg ) = @_; my $line = $.; die @msg, " at line $line (end of file)\n" if ! defined $off; my $pos = pos $_ || 0; my $char = substr( $_, $pos+$off, 1 ); $pos++; die @msg, " at line $line, pos $pos ($char)\n"; } my $v1 = @ARGV ? 1 : 0; my %bare = qw< null 1 true 1 false 1 >; my $num = qr{ -? (?: 0 | [1-9][0-9]* ) (?: [.][0-9]+ )? (?: [eE][-+]?[0-9]+ )? }x; my @stack; my $end = '1'; while( ) { /\G\s+/gc; while( ! /\G$/gc ) { my $in = $stack[-1] || ''; if( '"' eq $end ) { while( /\G(?:[^\\"]+|\\(.))/gcs ) { ; } fail( -1, "Trailing \\ at end of file" ) if /\G\\$/gc; $end = ',' if /\G"/gc; } elsif( ':' eq $end ) { fail( 0, "Expected colon" ) if ! /\G:/gc; push @stack, ':'; $end = ''; } elsif( /\G([\]\}])/gc ) { my $got = $1; my $want = $end !~ /[,2]/ || ':' eq $in ? 'value' : $in || 'end of file'; fail( -1, "Found close bracket, $got, when expecting $want" ) if $got ne $want; pop @stack; $end = ','; } elsif( ',' eq $end ) { fail( 0, "Expected end of file" ) if ! $in; fail( 0, "Expected comma" ) if ! /\G,/gc; $end = ''; } elsif( "\}" eq $in ) { fail( 0, "Expected string (key)" ) if ! /\G"/gc; $end = '"'; } elsif( /\G([\[\{])/gc ) { push @stack, {qw< [ ] { } >}->{$1}; $end = '2'; } elsif( '1' eq $end && $v1 ) { fail( 0, "JSON of just a scalar not allowed" ); } elsif( /\G"/gc ) { $end = '"'; } elsif( /\G$num/gc ) { $end = ','; } elsif( /\G([a-z]+)/gc ) { fail( -length($1), "Invalid bare word ($1)" ) if ! $bare{$1}; $end = ','; } else { fail( 0, "Expected value" ); } if( ',' eq $end && @stack ) { $end = ":" if "\}" eq $stack[-1]; pop @stack if ':' eq $stack[-1]; } /\G\s+/gc; } } fail( undef, "Empty JSON string" ) if 1 eq $end; fail( undef, "Unclosed string" ) if '"' eq $end; fail( undef, "Unclosed aggregate $stack[-1]" ) if @stack; warn "Valid JSON.\n";