diff options
author | Tobi Oetiker <tobi@oetiker.ch> | 2007-11-14 18:33:19 +0100 |
---|---|---|
committer | Tobi Oetiker <tobi@oetiker.ch> | 2007-11-14 18:33:19 +0100 |
commit | ff7b9de82908baf1d5f9af71e35dad2369bfdc2f (patch) | |
tree | 1f9821bf2323786cbe68b4d3b0964ca449332766 /qooxdoo/source/perl/JSON/PP.pm | |
parent | d546419d19b89633f8ac3c461eb900f4c4f29b90 (diff) | |
download | smokeping-ff7b9de82908baf1d5f9af71e35dad2369bfdc2f.tar.gz smokeping-ff7b9de82908baf1d5f9af71e35dad2369bfdc2f.tar.xz |
initial qooxdoo drop for smokeping
Diffstat (limited to 'qooxdoo/source/perl/JSON/PP.pm')
-rwxr-xr-x | qooxdoo/source/perl/JSON/PP.pm | 1355 |
1 files changed, 1355 insertions, 0 deletions
diff --git a/qooxdoo/source/perl/JSON/PP.pm b/qooxdoo/source/perl/JSON/PP.pm new file mode 100755 index 0000000..dc2d39a --- /dev/null +++ b/qooxdoo/source/perl/JSON/PP.pm @@ -0,0 +1,1355 @@ +package JSON::PP; + +# JSON-2.0 + +use 5.005; +use strict; +use base qw(Exporter); +use overload; + +use Carp (); +use B (); +#use Devel::Peek; + +$JSON::PP::VERSION = '0.96'; + +@JSON::PP::EXPORT = qw(from_json to_json jsonToObj objToJson); + +*jsonToObj = *from_json; +*objToJson = *to_json; + + + +BEGIN { + my @properties = qw( + utf8 allow_nonref indent space_before space_after canonical max_depth shrink + allow_tied self_encode singlequote allow_bigint disable_UTF8 strict + allow_barekey escape_slash literal_value + ); + + # Perl version check, ascii() is enable? + # Helper module may set @JSON::PP::_properties. + if ($] >= 5.008) { + require Encode; + push @properties, 'ascii', 'latin1'; + + *utf8::is_utf8 = *Encode::is_utf8 if ($] == 5.008); + + *JSON_encode_ascii = *_encode_ascii; + *JSON_encode_latin1 = *_encode_latin1; + *JSON_decode_unicode = *_decode_unicode; + } + else { + my $helper = $] >= 5.006 ? 'JSON::PP56' : 'JSON::PP5005'; + eval qq| require $helper |; + if ($@) { Carp::croak $@; } + push @properties, @JSON::PP::_properties; + } + + for my $name (@properties) { + eval qq| + sub $name { + \$_[0]->{$name} = defined \$_[1] ? \$_[1] : 1; + \$_[0]; + } + |; + } + +} + + + +# Functions + +my %encode_allow_method + = map {($_ => 1)} qw/utf8 pretty allow_nonref latin1 allow_tied self_encode escape_slash/; +my %decode_allow_method + = map {($_ => 1)} qw/utf8 allow_nonref disable_UTF8 strict singlequote allow_bigint + allow_barekey literal_value/; + + +sub to_json { # encode + my ($obj, $opt) = @_; + + if ($opt) { + my $json = JSON::PP->new->utf8; + + for my $method (keys %$opt) { + Carp::croak("non acceptble option") + unless (exists $encode_allow_method{$method}); + $json->$method($opt->{$method}); + } + + return $json->encode($obj); + } + else { + return __PACKAGE__->new->utf8->encode($obj); + } + +} + + +sub from_json { # decode + my ($obj, $opt) = @_; + + if ($opt) { + my $json = JSON::PP->new->utf8; + + for my $method (keys %$opt) { + Carp::croak("non acceptble option") + unless (exists $decode_allow_method{$method}); + $json->$method($opt->{$method}); + } + + return $json->decode($obj); + } + else { + __PACKAGE__->new->utf8->decode(shift); + } +} + + +# Methods + +sub new { + my $class = shift; + my $self = { + max_depth => 32, + unmap => 1, + indent => 0, + fallback => sub { encode_error('Invalid value. JSON can only reference.') }, + }; + + bless $self, $class; +} + + +sub encode { + return $_[0]->encode_json($_[1]); +} + + +sub decode { + return $_[0]->decode_json($_[1], 0x00000000); +} + + +sub decode_prefix { + return $_[0]->decode_json($_[1], 0x00000001); +} + + +# accessor + +sub property { + my ($self, $name, $value) = @_; + + if (@_ == 1) { + Carp::croak('property() requires 1 or 2 arguments.'); + } + elsif (@_ == 2) { + $self->{$name}; + } + else { + $self->$name($value); + } +} + + +# pretty printing + +sub pretty { + my ($self, $v) = @_; + $self->{pretty} = defined $v ? $v : 1; + + if ($v) { # JSON::XS compati + $self->indent(3); + $self->space_before(1); + $self->space_after(1); + } + else { + $self->indent(0); + $self->space_before(0); + $self->space_after(0); + } + + $self; +} + +############################### + +sub JSON::true () { JSON::Literal::true->new; } + +sub JSON::false () { JSON::Literal::false->new; } + +sub JSON::null () { JSON::Literal::null->new; } + +############################### + +### +### Perl => JSON +### + +{ # Convert + + my $depth; + my $max_depth; + my $keysort; + my $indent; + my $indent_count; + my $ascii; + my $utf8; + my $self_encode; + my $disable_UTF8; + my $escape_slash; + + my $latin1; + + + sub encode_json { + my $self = shift; + my $obj = shift; + + $indent_count = 0; + $depth = 0; + + ($indent, $ascii, $utf8, $self_encode, $max_depth, $disable_UTF8, $escape_slash, $latin1) + = @{$self}{qw/indent ascii utf8 self_encode max_depth disable_UTF8 escape_slash latin1/}; + + $keysort = !$self->{canonical} ? undef + : ref($self->{canonical}) eq 'CODE' ? $self->{canonical} + : $self->{canonical} =~ /\D+/ ? $self->{canonical} + : sub { $a cmp $b }; + + my $str = $self->toJson($obj); + + if (!defined $str and $self->{allow_nonref}){ + $str = $self->valueToJson($obj); + } + + encode_error("non ref") unless(defined $str); + + return $str; + } + + + sub toJson { + my ($self, $obj) = @_; + my $type = ref($obj); + + if($type eq 'HASH'){ + return $self->hashToJson($obj); + } + elsif($type eq 'ARRAY'){ + return $self->arrayToJson($obj); + } + elsif ($type) { # blessed object? + if (blessed($obj)) { + if ($self->{self_encode} and $obj->can('toJson')) { + return $self->selfToJson($obj); + } + elsif (!$obj->isa('JSON::Literal')) { # handling in valueToJson + ($type) = B::svref_2object($obj) =~ /(.+)=/; + return $type eq 'B::AV' ? $self->arrayToJson($obj) + : $type eq 'B::HV' ? $self->hashToJson($obj) + : undef; + } + } + else { + return $self->valueToJson($obj); + } + } + else{ + return; + } + } + + + sub hashToJson { + my ($self, $obj) = @_; + my ($k,$v); + my %res; + + encode_error("data structure too deep (hit recursion limit)") + if (++$depth > $max_depth); + + $self->_tie_object($obj, \%res) if ($self->{allow_tied}); + + my ($pre, $post) = $indent ? $self->_upIndent() : ('', ''); + my $del = ($self->{space_before} ? ' ' : '') . ':' . ($self->{space_after} ? ' ' : ''); + + for my $k (keys %$obj) { + my $v = $obj->{$k}; + $res{$k} = $self->toJson($v) || $self->valueToJson($v); + } + + $self->_downIndent() if ($indent); + + return '{' . $pre + . join(",$pre", map { utf8::decode($_) if ($] < 5.008); + _stringfy($self, $_) + . $del . $res{$_} } _sort($self, \%res)) + . $post + . '}'; + } + + + sub arrayToJson { + my ($self, $obj) = @_; + my @res; + + encode_error("data structure too deep (hit recursion limit)") + if (++$depth > $max_depth); + + $self->_tie_object($obj, \@res) if ($self->{allow_tied}); + + my ($pre, $post) = $indent ? $self->_upIndent() : ('', ''); + + for my $v (@$obj){ + push @res, $self->toJson($v) || $self->valueToJson($v); + } + + $self->_downIndent() if ($indent); + + return '[' . $pre . join(",$pre" ,@res) . $post . ']'; + } + + + sub valueToJson { + my ($self, $value) = @_; + + return 'null' if(!defined $value); + + my $b_obj = B::svref_2object(\$value); # for round trip problem + # SvTYPE is IV or NV? + return $value # as is + if ($b_obj->FLAGS & B::SVf_IOK or $b_obj->FLAGS & B::SVf_NOK); + + my $type = ref($value); + + if(!$type){ + return _stringfy($self, $value); + } + elsif( blessed($value) and $value->isa('JSON::Literal') ){ + return $value->{str}; + } + elsif ($type) { + if ((overload::StrVal($value) =~ /=(\w+)/)[0]) { + return $self->valueToJson("$value"); + } + + if ($type eq 'SCALAR' and defined $$value) { + return $$value eq '1' ? 'true' + : $$value eq '0' ? 'false' : encode_error("cannot encode reference."); + } + + if ($type eq 'CODE') { + encode_error("JSON can only reference."); + } + else { + encode_error("cannot encode reference."); + } + + } + else { + return $self->{fallback}->($value) + if ($self->{fallback} and ref($self->{fallback}) eq 'CODE'); + return 'null'; + } + + } + + + my %esc = ( + "\n" => '\n', + "\r" => '\r', + "\t" => '\t', + "\f" => '\f', + "\b" => '\b', + "\"" => '\"', + "\\" => '\\\\', + "\'" => '\\\'', + ); + + + sub _stringfy { + my ($self, $arg) = @_; + + $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/eg; + $arg =~ s/\//\\\//g if ($escape_slash); + $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg; + + if ($ascii) { + $arg = JSON_encode_ascii($arg); + } + + if ($latin1) { + $arg = JSON_encode_latin1($arg); + } + + if ($utf8 or $disable_UTF8) { + utf8::encode($arg); + } + + return '"' . $arg . '"'; + } + + + sub selfToJson { + my ($self, $obj) = @_; + return $obj->toJson($self); + } + + + sub encode_error { + my $error = shift; + Carp::croak "$error"; + } + + + sub _sort { + my ($self, $res) = @_; + defined $keysort ? (sort $keysort (keys %$res)) : keys %$res; + } + + + sub _tie_object { + my ($self, $obj, $res) = @_; + my $class; + # by ddascalescu+perl [at] gmail.com + if (ref($obj) eq 'ARRAY' and $class = tied @$obj) { + $class =~ s/=.*//; + tie @$res, $class; + } + elsif (ref($obj) eq 'HASH' and $class = tied %$obj) { + $class =~ s/=.*//; + tie %$res, $class; + } + } + + + sub _upIndent { + my $self = shift; + my $space = ' ' x $indent; + + my ($pre,$post) = ('',''); + + $post = "\n" . $space x $indent_count; + + $indent_count++; + + $pre = "\n" . $space x $indent_count; + + return ($pre,$post); + } + + + sub _downIndent { $_[0]->{indent_count}--; } + +} # Convert + + + +sub _encode_ascii { + join('', + map { + $_ <= 127 ? + chr($_) : + $_ <= 65535 ? + sprintf('\u%04x', $_) : + join("", map { '\u' . $_ } + unpack("H4H4", Encode::encode('UTF-16BE', pack("U", $_)))); + } unpack('U*', $_[0]) + ); +} + + +sub _encode_latin1 { + join('', + map { + $_ <= 255 ? + chr($_) : + $_ <= 65535 ? + sprintf('\u%04x', $_) : + join("", map { '\u' . $_ } + unpack("H4H4", Encode::encode('UTF-16BE', pack("U", $_)))); + } unpack('U*', $_[0]) + ); +} + + + +# +# JSON => Perl +# + +# from Adam Sussman +use Config; +my $max_intsize = length(((1 << (8 * $Config{intsize} - 2))-1)*2 + 1) - 1; +#my $max_intsize = length(2 ** ($Config{intsize} * 8)) - 1; + + +{ # PARSE + + my %escapes = ( # by Jeremy Muhlich <jmuhlich [at] bitflood.org> + b => "\x8", + t => "\x9", + n => "\xA", + f => "\xC", + r => "\xD", + '\\' => '\\', + ); + + my $text; # json data + my $at; # offset + my $ch; # 1chracter + my $len; # text length (changed according to UTF8 or NON UTF8) + + my $is_utf8; + my $depth; + my $encoding; + + my $literal_value; # unmmaping + my $utf8; # + my $max_depth; # max nest nubmer of objects and arrays + my $allow_bigint; # using Math::BigInt + my $disable_UTF8; # don't flag UTF8 on + my $singlequote; # loosely quoting + my $strict; # + my $allow_barekey; # bareKey + + # $opt flag + # 0x00000001 .... decode_prefix + + sub decode_json { + my ($self, $opt); # $opt is an effective flag during this decode_json. + + ($self, $text, $opt) = @_; + + ($at, $ch, $depth) = (0, '', 0); + + if (!defined $text or ref $text) { + decode_error("malformed text data."); + } + + $is_utf8 = 1 if (utf8::is_utf8($text)); + + $len = length $text; + + ($utf8, $literal_value, $max_depth, $allow_bigint, $disable_UTF8, $strict, $singlequote, $allow_barekey) + = @{$self}{qw/utf8 literal_value max_depth allow_bigint disable_UTF8 strict singlequote allow_barekey/}; + + unless ($self->{allow_nonref}) { + white(); + unless (defined $ch and ($ch eq '{' or $ch eq '[')) { + decode_error('JSON text must be an object or array' + . ' (but found number, string, true, false or null,' + . ' use allow_nonref to allow this)', 1); + } + } + + # Currently no effective + my @octets = unpack('C4', $text); + $encoding = ( $octets[0] and $octets[1]) ? 'UTF-8' + : (!$octets[0] and $octets[1]) ? 'UTF-16BE' + : (!$octets[0] and !$octets[1]) ? 'UTF-32BE' + : ( $octets[2] ) ? 'UTF-16LE' + : (!$octets[2] ) ? 'UTF-32LE' + : 'unknown'; + + my $result = value(); + + if ($len > $at) { + my $consumed = $at - 1; + white(); + if ($ch) { + decode_error("garbage after JSON object") unless ($opt & 0x00000001); + return ($result, $consumed); + } + } + + $result; + } + + + sub next_chr { + return $ch = undef if($at >= $len); + $ch = substr($text, $at++, 1); + } + + + sub value { + white(); + return if(!defined $ch); + return object() if($ch eq '{'); + return array() if($ch eq '['); + return string() if($ch eq '"' or ($singlequote and $ch eq "'")); + return number() if($ch eq '-'); + return $ch =~ /\d/ ? number() : word(); + } + + + sub string { + my ($i,$s,$t,$u); + my @utf16; + + $s = ''; # basically UTF8 flag on + + if($ch eq '"' or ($singlequote and $ch eq "'")){ + my $boundChar = $ch if ($singlequote); + + OUTER: while( defined(next_chr()) ){ + + if((!$singlequote and $ch eq '"') or ($singlequote and $ch eq $boundChar)){ + next_chr(); + + if (@utf16) { + decode_error("missing low surrogate character in surrogate pair"); + } + + if($disable_UTF8) { + utf8::encode($s) if (utf8::is_utf8($s)); + } + else { + utf8::decode($s); + } + + return $s; + } + elsif($ch eq '\\'){ + next_chr(); + if(exists $escapes{$ch}){ + $s .= $escapes{$ch}; + } + elsif($ch eq 'u'){ # UNICODE handling + my $u = ''; + + for(1..4){ + $ch = next_chr(); + last OUTER if($ch !~ /[0-9a-fA-F]/); + $u .= $ch; + } + + $s .= JSON_decode_unicode($u, \@utf16) || next; + + } + else{ + $s .= $ch; + } + } + else{ + if ($utf8 and $is_utf8) { + if( hex(unpack('H*', $ch)) > 255 ) { + decode_error("malformed UTF-8 character in JSON string"); + } + } + elsif ($strict) { + if ($ch =~ /[\x00-\x1f\x22\x2f\x5c]/) { + decode_error('invalid character'); + } + } + + $s .= $ch; + } + } + } + + decode_error("Bad string (unexpected end)"); + } + + + sub white { + while( defined $ch ){ + if($ch le ' '){ + next_chr(); + } + elsif($ch eq '/'){ + next_chr(); + if($ch eq '/'){ + 1 while(defined(next_chr()) and $ch ne "\n" and $ch ne "\r"); + } + elsif($ch eq '*'){ + next_chr(); + while(1){ + if(defined $ch){ + if($ch eq '*'){ + if(defined(next_chr()) and $ch eq '/'){ + next_chr(); + last; + } + } + else{ + next_chr(); + } + } + else{ + decode_error("Unterminated comment"); + } + } + next; + } + else{ + decode_error("Syntax decode_error (whitespace)"); + } + } + else{ + last; + } + } + } + + + sub object { + my $o = {}; + my $k; + + if($ch eq '{'){ + decode_error('json structure too deep (hit recursion limit)', ) + if (++$depth > $max_depth); + next_chr(); + white(); + if(defined $ch and $ch eq '}'){ + next_chr(); + return $o; + } + while(defined $ch){ + $k = ($allow_barekey and $ch ne '"' and $ch ne "'") ? bareKey() : string(); + white(); + + if(!defined $ch or $ch ne ':'){ + decode_error("Bad object ; ':' expected"); + } + + next_chr(); + $o->{$k} = value(); + white(); + + last if (!defined $ch); + + if($ch eq '}'){ + next_chr(); + return $o; + } + elsif($ch ne ','){ + last; + } + next_chr(); + white(); + } + + decode_error("Bad object ; ,or } expected while parsing object/hash"); + } + } + + + sub bareKey { # doesn't strictly follow Standard ECMA-262 3rd Edition + my $key; + while($ch =~ /[^\x00-\x23\x25-\x2F\x3A-\x40\x5B-\x5E\x60\x7B-\x7F]/){ + $key .= $ch; + next_chr(); + } + return $key; + } + + + sub word { + my $word = substr($text,$at-1,4); + + if($word eq 'true'){ + $at += 3; + next_chr; + return $literal_value ? JSON::true : 1; + } + elsif($word eq 'null'){ + $at += 3; + next_chr; + return $literal_value ? JSON::null : undef; + } + elsif($word eq 'fals'){ + $at += 3; + if(substr($text,$at,1) eq 'e'){ + $at++; + next_chr; + return $literal_value ? JSON::false : 0; + } + } + + $at--; # for decode_error report + + decode_error("Syntax decode_error (word) 'null' expected") if ($word =~ /^n/); + decode_error("Syntax decode_error (word) 'true' expected") if ($word =~ /^t/); + decode_error("Syntax decode_error (word) 'false' expected") if ($word =~ /^f/); + decode_error("Syntax decode_error (word)" . + " malformed json string, neither array, object, number, string or atom"); + } + + + sub number { + my $n = ''; + my $v; + + # According to RFC4627, hex or oct digts are invalid. + if($ch eq '0'){ + my $peek = substr($text,$at,1); + my $hex = $peek =~ /[xX]/; # 0 or 1 + + if($hex){ + ($n) = ( substr($text, $at+1) =~ /^([0-9a-fA-F]+)/); + } + else{ # oct + ($n) = ( substr($text, $at) =~ /^([0-7]+)/); + } + + if(defined $n and length($n)){ + if (!$hex and length($n) == 1) { + decode_error("malformed number (leading zero must not be followed by another digit)"); + } + $at += length($n) + $hex; + next_chr; + return $hex ? hex($n) : oct($n); + } + } + + if($ch eq '-'){ + $n = '-'; + next_chr; + if (!defined $ch or $ch !~ /\d/) { + decode_error("malformed number (no digits after initial minus)"); + } + } + + while(defined $ch and $ch =~ /\d/){ + $n .= $ch; + next_chr; + } + + if(defined $ch and $ch eq '.'){ + $n .= '.'; + + next_chr; + if (!defined $ch or $ch !~ /\d/) { + decode_error("malformed number (no digits after decimal point)"); + } + else { + $n .= $ch; + } + + while(defined(next_chr) and $ch =~ /\d/){ + $n .= $ch; + } + } + + if(defined $ch and ($ch eq 'e' or $ch eq 'E')){ + $n .= $ch; + next_chr; + + if(defined($ch) and ($ch eq '+' or $ch eq '-' or $ch =~ /\d/)){ + $n .= $ch; + } + else { + decode_error("malformed number (no digits after exp sign)"); + } + + while(defined(next_chr) and $ch =~ /\d/){ + $n .= $ch; + } + + } + + $v .= $n; + + if ($allow_bigint) { # from Adam Sussman + require Math::BigInt; + return Math::BigInt->new($v) if ($v !~ /[.eE]/ and length $v > $max_intsize); + } + + return 0+$v; + } + + + sub array { + my $a = []; + + if ($ch eq '[') { + decode_error('json structure too deep (hit recursion limit)', 1) + if (++$depth > $max_depth); + next_chr(); + white(); + if(defined $ch and $ch eq ']'){ + next_chr(); + return $a; + } + + while(defined($ch)){ + push @$a, value(); + white(); + + if (!defined $ch) { + last; + } + + if($ch eq ']'){ + next_chr(); + return $a; + } + elsif($ch ne ','){ + last; + } + next_chr(); + white(); + } + } + + decode_error(", or ] expected while parsing array"); + } + + + sub decode_error { + my $error = shift; + my $no_rep = shift; + my $str = defined $text ? substr($text, $at) : ''; + + unless (length $str) { $str = '(end of string)'; } + + if ($no_rep) { + Carp::croak "$error"; + } + else { + Carp::croak "$error, at character offset $at ($str)"; + } + } + +} # PARSE + + +sub _decode_unicode { + my $u = $_[0]; + my $utf16 = $_[1]; + + # U+10000 - U+10FFFF + + # U+D800 - U+DBFF + if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/) { # UTF-16 high surrogate? + push @$utf16, $u; + } + # U+DC00 - U+DFFF + elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/) { # UTF-16 low surrogate? + unless (scalar(@$utf16)) { + decode_error("missing high surrogate character in surrogate pair"); + } + my $str = pack('H4H4', @$utf16, $u); + @$utf16 = (); + return Encode::decode('UTF-16BE', $str); # UTF-8 flag on + } + else { + if (scalar(@$utf16)) { + decode_error("surrogate pair expected"); + } + + return chr(hex($u)); + } + + return; +} + + +############################### +# Utilities +# + +BEGIN { + eval 'require Scalar::Util'; + unless($@){ + *JSON::PP::blessed = \&Scalar::Util::blessed; + } + else{ # This code is from Sclar::Util. + # warn $@; + eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }'; + *JSON::PP::blessed = sub { + local($@, $SIG{__DIE__}, $SIG{__WARN__}); + ref($_[0]) ? eval { $_[0]->a_sub_not_likely_to_be_here } : undef; + }; + } +} + + +############################### + +package JSON::Literal; +use overload ( + '""' => sub { $_[0]->{str} }, + 'bool' => sub { $_[0]->{value} }, + 'eq' => sub { $_[0]->{str} eq $_[1] }, + 'ne' => sub { $_[0]->{str} ne $_[1] }, +); + + +package JSON::Literal::true; +use base qw(JSON::Literal); + +use overload ( + '==' => sub { 1 == $_[1] }, + '!=' => sub { 1 != $_[1] }, +); + +sub new { bless { str => 'true', value => 1 }; } + + +package JSON::Literal::false; +use base qw(JSON::Literal); + +use overload ( + '==' => sub { 0 == $_[1] }, + '!=' => sub { 0 != $_[1] }, +); + +sub new { bless { str => 'false', value => 0 }; } + +package JSON::Literal::null; +use base qw(JSON::Literal); + +use overload ( + '==' => sub { -1 == $_[1] }, + '!=' => sub { -1 != $_[1] }, +); + +sub new { bless { str => 'null', value => undef }; } + +############################### + + +1; +__END__ +=pod + +=head1 NAME + +JSON::PP - An experimental JSON::XS compatible Pure Perl module. + +=head1 SYNOPSIS + + use JSON::PP; + + $obj = from_json($json_text); + $json_text = to_json($obj); + + # or + + $obj = jsonToObj($json_text); + $json_text = objToJson($obj); + + $json = new JSON; + $json_text = $json->ascii->pretty($obj); + + # you can set options to functions. + + $json_text = to_json($obj, {ascii => 1, intend => 2}); + $obj = from_json($json_text, {utf8 => 0}); + + +=head1 DESCRIPTION + +This module is L<JSON::XS> compatible Pure Perl module. +( Perl better than 5.008 is recommended) + +Module variables ($JSON::*) were abolished. + +JSON::PP will be renamed JSON (JSON-2.0). + +Many things including error handling are learned from L<JSON::XS>. +For t/02_error.t compatible, error messages was copied partially from JSON::XS. + + +=head2 FEATURES + +=over + +=item * perhaps correct unicode handling + +This module knows how to handle Unicode (perhaps), +but not yet documents how and when it does so. + +In Perl5.6x, Unicode handling requires L<Unicode::String> module. + +Perl 5.005_xx, Unicode handling is disable currenlty. + + +=item * round-trip integrity + +This module solved the problem pointed out by JSON::XS +using L<B> module. + +=item * strict checking of JSON correctness + +I want to bring close to XS. +How do you want to carry out? + +you can set C<strict> decoding method. + +=item * slow + +Compared to other JSON modules, this module does not compare +favourably in terms of speed. Very slowly! + +=item * simple to use + +This module became very simple. +Since its interface were anyway made the same as JSON::XS. + + +=item * reasonably versatile output formats + +See to L<JSON::XS>. + +=back + +=head1 FUNCTIONS + +=over + +=item to_json + +See to JSON::XS. +C<objToJson> is an alias. + +=item from_json + +See to JSON::XS. +C<jsonToObj> is an alias. + + +=item JSON::true + +Returns JSON true value which is blessed object. +It C<isa> JSON::Literal object. + +=item JSON::false + +Returns JSON false value which is blessed object. +It C<isa> JSON::Literal object. + + +=item JSON::null + +Returns JSON null value which is blessed object. +It C<isa> JSON::Literal object. + + +=back + + +=head1 METHODS + +=over + +=item new + +Returns JSON::PP object. + +=item ascii + +See to JSON::XS. + +In Perl 5.6, this method requires L<Unicode::String>. +If you don't have Unicode::String, +the method is always set to false and warns. + +In Perl 5.005, this option is currently disable. + + +=item latin1 + +See to JSON::XS. + +In Perl 5.6, this method requires L<Unicode::String>. +If you don't have Unicode::String, +the method is always set to false and warns. + +In Perl 5.005, this option is currently disable. + + +=item utf8 + +See to JSON::XS. + +Currently this module always handles UTF-16 as UTF-16BE. + +=item pretty + +See to JSON::XS. + +=item indent + +See to JSON::XS. +Strictly, this module does not carry out equivalent to XS. + + $json->indent(4); + +is not the same as this: + + $json->indent(); + + +=item space_before + +See to JSON::XS. + +=item space_after + +See JSON::XS. + +=item canonical + +See to JSON::XS. +Strictly, this module does not carry out equivalent to XS. +This method can take a subref for sorting (see to L<JSON>). + + +=item allow_nonref + +See to JSON::XS. + +=item shrink + +Not yet implemented. + +=item max_depth + +See to JSON::XS. +Strictly, this module does not carry out equivalent to XS. +By default, not 512 (JSON::XS) but 32. + +=item encode + +See to JSON::XS. + +=item decode + +See to JSON::XS. +In Perl 5.6, if you don't have Unicode::String, +the method can't handle UTF-16(BE) char and returns as is. + + +=item property + +Accessor. + + $json->property(utf8 => 1); # $json->utf8(1); + + $value = $json->property('utf8'); # returns 1. + + +=item self_encode + +See L<JSON/BLESSED OBJECT>'s I<self convert> function. + + +=item disable_UTF8 + +If this option is set, UTF8 flag in strings generated +by C<encode>/C<decode> is off. + + +=item allow_tied + +Enable. + +This option will be obsoleted. + + +=item singlequote + +Allows to decode single quoted strings. + +Unlike L<JSON> module, this module does not encode +Perl string into single quoted string any longer. + + +=item allow_barekey + +Allows to decode bare key of member. + + +=item allow_bigint + +When json text has any integer in decoding more than Perl can't handle, +If this option is on, they are converted into L<Math::BigInt> objects. + + +=item strict + +For JSON format, unescaped [\x00-\x1f\x22\x2f\x5c] strings are invalid and +JSON::XS decodes just like that. While this module can deocde thoese. +But if this option is set, the module strictly decodes. + + +=item escape_slash + +By default, JSON::PP encodes strings without escaping slash (U+002F). +Setting the option to escape slash. + + +=item literal_value + + + +=back + + +=head1 MAPPING + + + +=head1 COMPARISON + +Using a benchmark program in the JSON::XS (v1.11) distribution. + + module | encode | decode | + -----------|------------|------------| + JSON::PP | 11092.260 | 4482.033 | + -----------+------------+------------+ + JSON::XS | 341513.380 | 226138.509 | + -----------+------------+------------+ + +In case t/12_binary.t (JSON::XS distribution). +(shrink of JSON::PP has no effect.) + +JSON::PP takes 147 (sec). + +JSON::XS takes 4. + + +=head1 TODO + +=over + +=item Document! + +It is troublesome. + +=item clean up + +Under the cleaning. + +=back + + +=head1 SEE ALSO + +L<JSON>, L<JSON::XS> + +RFC4627 + +=head1 AUTHOR + +Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt> + + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007 by Makamaka Hannyaharamitu + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut |