2013/06/13(木)JSONを自力でパースするperlスクリプト【pure-Perl】
正しいもののみ正しくパースされるスクリプトです。
- 外部モジュール不要。
- 正しくないものは解析できるところまで動きます。
- かっこ「{[」と「]}」の対応は見てません(閉じかっこの入れ違えがあっても動きます)
- ライセンスはWTFPLですが、一言「使ったよ」ってコメントくれると嬉しいです。
バグがあったら具体的なデータと共にコメントください。
スクリプト
外部モジュールにしない場合は、変数の初期化を perse_join の中に入れてください。
#------------------------------------------------- # Copyright (C)nabe@abk #------------------------------------------------- my %json_esc = ( "/" => "/", '"' => '"', "\\" => "\\", "b" => "\x08", "f" => "\x0c", "n" => "\n", "r" => "\r", "t" => "\t" ); my %json_val = ( 'true' => 1, 'false' => 0, 'null' => undef ); sub parse_json { my $json = shift; my @str; $json =~ s/[\x00-\x01]//g; $json =~ s/\\"/\x01/g; $json =~ s/"([^"]*)"/push(@str,$1),"\x00$#str\x00"/eg; # 文字列の処理 foreach(@str) { $_ =~ s|\\([/\\bfnrt])|$json_esc{$1}|g; $_ =~ s/\x01/"/g; $_ =~ s/\\u([0-9A-Za-z][0-9A-Za-z][0-9A-Za-z][0-9A-Za-z])/ my $x = hex($1); if ($x < 2) { ""; } elsif ($x < 0x100) { chr($x); } else { # UTF-16 to UTF-8 chr(0xE0 | (($x>>12) & 0x0f)) . chr(0x80 | (($x>> 6) & 0x3f)) . chr(0x80 | ( $x & 0x3f)); } /eg; } $json =~ s/\s*//g; #------------------------------------------------------- # JSON解析 #------------------------------------------------------- my @ary; foreach(split(/,/, $json)) { while($_ =~ /^(.*?)([\[\]\{\}])(.*)$/) { if ($1 ne '') { push(@ary, $1); } push(@ary, $2); $_ = $3; } if ($_ ne '') { push(@ary, $_); } } my @stack; my $ret = (shift(@ary) eq '{') ? {} : []; my $c = $ret; eval { while(@ary) { my $v = shift(@ary); if ($v eq '}' || $v eq ']') { $c = pop(@stack); next; } # ハッシュの場合 if (ref($c) eq 'HASH') { my $x = index($v, ':'); my $key = substr($v, 0, $x); my $val = substr($v, $x+1); $key =~ s/^\x00(\d+)\x00$/$str[$1]/; if (exists $json_val{$val}) { $val = $json_val{$val}; } else { $val =~ s/^\x00(\d+)\x00$/$str[$1]/; } if ($ary[0] eq '{') { shift(@ary); push(@stack, $c); $c = $c->{$key} = {}; } elsif ($ary[0] eq '[') { shift(@ary); push(@stack, $c); $c = $c->{$key} = []; } else { $c->{$key} = $val; } next; } # 配列の場合 if ($v eq '{') { push(@stack, $c); push(@$c, {}); $c = $c->[ $#$c ]; } elsif ($v eq '[') { push(@stack, $c); push(@$c, []); $c = $c->[ $#$c ]; } elsif (exists $json_val{$v}) { push(@$c, $json_val{$v}); } else { $v =~ s/^\x00(\d+)\x00$/$str[$1]/; push(@$c, $v); } } }; # eval return $ret; }
パース結果確認用のスクリプト
sub nest_hash_to_string { my $data = shift; my $sp = shift || ''; my $ret = ''; if (ref($data) eq 'HASH') { foreach(sort(keys(%$data))) { my $k = $_; my $v = $data->{$_}; if (ref($v) eq 'ARRAY') { $ret .= "$sp$k=[\n"; $ret .= &nest_hash_to_string($v, " $sp"); $ret .= "$sp]\n"; next; } if (ref($v) eq 'HASH') { $ret .= "$sp$k={\n"; $ret .= &nest_hash_to_string($v, " $sp"); $ret .= "$sp}\n"; next; } $ret .= "$sp$k=$v\n"; } } else { foreach(@$data) { if (ref($_) eq 'ARRAY') { $ret .= "$sp\[\n"; $ret .= &nest_hash_to_string($_, " $sp"); $ret .= "$sp]\n"; next; } if (ref($_) eq 'HASH') { $ret .= "$sp\{\n"; $ret .= &nest_hash_to_string($_, " $sp"); $ret .= "$sp}\n"; next; } $ret .= "$sp$_\n"; } } return $ret; }
速度比較
twitterにstatus updateしたときに戻ってきたJSONでテストしました。
JSON::PP: 4 wallclock secs ( 3.85 usr + 0.00 sys = 3.85 CPU) @ 259.74/s (n=1000) JSON::XS: 0 wallclock secs ( 0.03 usr + 0.00 sys = 0.03 CPU) @ 33333.33/s (n=1000) (warning: too few iterations for a reliable count) parse_json: 1 wallclock secs ( 1.22 usr + 0.00 sys = 1.22 CPU) @ 819.67/s (n=1000)
XSはさすがに圧倒的ですね(苦笑)