1 package # This is JSON::backportPP
15 use vars qw($VERSION);
18 @JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json);
20 # instead of hash-access, i tried index-access for speed.
21 # but this method is not faster than what i expected. so it will be changed.
23 use constant P_ASCII => 0;
24 use constant P_LATIN1 => 1;
25 use constant P_UTF8 => 2;
26 use constant P_INDENT => 3;
27 use constant P_CANONICAL => 4;
28 use constant P_SPACE_BEFORE => 5;
29 use constant P_SPACE_AFTER => 6;
30 use constant P_ALLOW_NONREF => 7;
31 use constant P_SHRINK => 8;
32 use constant P_ALLOW_BLESSED => 9;
33 use constant P_CONVERT_BLESSED => 10;
34 use constant P_RELAXED => 11;
36 use constant P_LOOSE => 12;
37 use constant P_ALLOW_BIGNUM => 13;
38 use constant P_ALLOW_BAREKEY => 14;
39 use constant P_ALLOW_SINGLEQUOTE => 15;
40 use constant P_ESCAPE_SLASH => 16;
41 use constant P_AS_NONBLESSED => 17;
43 use constant P_ALLOW_UNKNOWN => 18;
45 use constant OLD_PERL => $] < 5.008 ? 1 : 0;
48 my @xs_compati_bit_properties = qw(
49 latin1 ascii utf8 indent canonical space_before space_after allow_nonref shrink
50 allow_blessed convert_blessed relaxed allow_unknown
52 my @pp_bit_properties = qw(
53 allow_singlequote allow_bignum loose
54 allow_barekey escape_slash as_nonblessed
57 # Perl version check, Unicode handling is enable?
58 # Helper module sets @JSON::PP::_properties.
60 my $helper = $] >= 5.006 ? 'JSON::backportPP::Compat5006' : 'JSON::backportPP::Compat5005';
61 eval qq| require $helper |;
62 if ($@) { Carp::croak $@; }
65 for my $name (@xs_compati_bit_properties, @pp_bit_properties) {
66 my $flag_name = 'P_' . uc($name);
70 my \$enable = defined \$_[1] ? \$_[1] : 1;
73 \$_[0]->{PROPS}->[$flag_name] = 1;
76 \$_[0]->{PROPS}->[$flag_name] = 0;
83 \$_[0]->{PROPS}->[$flag_name] ? 1 : '';
94 my %encode_allow_method
95 = map {($_ => 1)} qw/utf8 pretty allow_nonref latin1 self_encode escape_slash
96 allow_blessed convert_blessed indent indent_length allow_bignum
99 my %decode_allow_method
100 = map {($_ => 1)} qw/utf8 allow_nonref loose allow_singlequote allow_bignum
101 allow_barekey max_size relaxed/;
106 sub encode_json ($) { # encode
107 ($JSON ||= __PACKAGE__->new->utf8)->encode(@_);
111 sub decode_json { # decode
112 ($JSON ||= __PACKAGE__->new->utf8)->decode(@_);
118 Carp::croak ("JSON::PP::to_json has been renamed to encode_json.");
123 Carp::croak ("JSON::PP::from_json has been renamed to decode_json.");
136 fallback => sub { encode_error('Invalid value. JSON can only reference.') },
145 return $_[0]->PP_encode_json($_[1]);
150 return $_[0]->PP_decode_json($_[1], 0x00000000);
155 return $_[0]->PP_decode_json($_[1], 0x00000001);
166 my $enable = defined $v ? $v : 1;
168 if ($enable) { # indent_length(3) for JSON::XS compatibility
169 $self->indent(1)->indent_length(3)->space_before(1)->space_after(1);
172 $self->indent(0)->space_before(0)->space_after(0);
181 my $max = defined $_[1] ? $_[1] : 0x80000000;
182 $_[0]->{max_depth} = $max;
187 sub get_max_depth { $_[0]->{max_depth}; }
191 my $max = defined $_[1] ? $_[1] : 0;
192 $_[0]->{max_size} = $max;
197 sub get_max_size { $_[0]->{max_size}; }
200 sub filter_json_object {
201 $_[0]->{cb_object} = defined $_[1] ? $_[1] : 0;
202 $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
206 sub filter_json_single_key_object {
208 $_[0]->{cb_sk_object}->{$_[1]} = $_[2];
210 $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
215 if (!defined $_[1] or $_[1] > 15 or $_[1] < 0) {
216 Carp::carp "The acceptable range of indent_length() is 0 to 15.";
219 $_[0]->{indent_length} = $_[1];
224 sub get_indent_length {
225 $_[0]->{indent_length};
229 $_[0]->{sort_by} = defined $_[1] ? $_[1] : 1;
234 Carp::carp("allow_bigint() is obsoleted. use allow_bignum() insted.");
237 ###############################
274 my $idx = $self->{PROPS};
276 ($ascii, $latin1, $utf8, $indent, $canonical, $space_before, $space_after, $allow_blessed,
277 $convert_blessed, $escape_slash, $bignum, $as_nonblessed)
278 = @{$idx}[P_ASCII .. P_SPACE_AFTER, P_ALLOW_BLESSED, P_CONVERT_BLESSED,
279 P_ESCAPE_SLASH, P_ALLOW_BIGNUM, P_AS_NONBLESSED];
281 ($max_depth, $indent_length) = @{$self}{qw/max_depth indent_length/};
283 $keysort = $canonical ? sub { $a cmp $b } : undef;
285 if ($self->{sort_by}) {
286 $keysort = ref($self->{sort_by}) eq 'CODE' ? $self->{sort_by}
287 : $self->{sort_by} =~ /\D+/ ? $self->{sort_by}
291 encode_error("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)")
292 if(!ref $obj and !$idx->[ P_ALLOW_NONREF ]);
294 my $str = $self->object_to_json($obj);
296 $str .= "\n" if ( $indent ); # JSON::XS 2.26 compatible
298 unless ($ascii or $latin1 or $utf8) {
302 if ($idx->[ P_SHRINK ]) {
303 utf8::downgrade($str, 1);
311 my ($self, $obj) = @_;
312 my $type = ref($obj);
315 return $self->hash_to_json($obj);
317 elsif($type eq 'ARRAY'){
318 return $self->array_to_json($obj);
320 elsif ($type) { # blessed object?
323 return $self->value_to_json($obj) if ( $obj->isa('JSON::PP::Boolean') );
325 if ( $convert_blessed and $obj->can('TO_JSON') ) {
326 my $result = $obj->TO_JSON();
327 if ( defined $result and ref( $result ) ) {
328 if ( refaddr( $obj ) eq refaddr( $result ) ) {
329 encode_error( sprintf(
330 "%s::TO_JSON method returned same object as was passed instead of a new one",
336 return $self->object_to_json( $result );
339 return "$obj" if ( $bignum and _is_bignum($obj) );
340 return $self->blessed_to_json($obj) if ($allow_blessed and $as_nonblessed); # will be removed.
342 encode_error( sprintf("encountered object '%s', but neither allow_blessed "
343 . "nor convert_blessed settings are enabled", $obj)
344 ) unless ($allow_blessed);
349 return $self->value_to_json($obj);
353 return $self->value_to_json($obj);
359 my ($self, $obj) = @_;
362 encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
363 if (++$depth > $max_depth);
365 my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');
366 my $del = ($space_before ? ' ' : '') . ':' . ($space_after ? ' ' : '');
368 for my $k ( _sort( $obj ) ) {
369 if ( OLD_PERL ) { utf8::decode($k) } # key for Perl 5.6 / be optimized
370 push @res, string_to_json( $self, $k )
372 . ( $self->object_to_json( $obj->{$k} ) || $self->value_to_json( $obj->{$k} ) );
376 $self->_down_indent() if ($indent);
378 return '{' . ( @res ? $pre : '' ) . ( @res ? join( ",$pre", @res ) . $post : '' ) . '}';
383 my ($self, $obj) = @_;
386 encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
387 if (++$depth > $max_depth);
389 my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');
392 push @res, $self->object_to_json($v) || $self->value_to_json($v);
396 $self->_down_indent() if ($indent);
398 return '[' . ( @res ? $pre : '' ) . ( @res ? join( ",$pre", @res ) . $post : '' ) . ']';
403 my ($self, $value) = @_;
405 return 'null' if(!defined $value);
407 my $b_obj = B::svref_2object(\$value); # for round trip problem
408 my $flags = $b_obj->FLAGS;
410 return $value # as is
411 if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV?
413 my $type = ref($value);
416 return string_to_json($self, $value);
418 elsif( blessed($value) and $value->isa('JSON::PP::Boolean') ){
419 return $$value == 1 ? 'true' : 'false';
422 if ((overload::StrVal($value) =~ /=(\w+)/)[0]) {
423 return $self->value_to_json("$value");
426 if ($type eq 'SCALAR' and defined $$value) {
427 return $$value eq '1' ? 'true'
428 : $$value eq '0' ? 'false'
429 : $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ? 'null'
430 : encode_error("cannot encode reference to scalar");
433 if ( $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ) {
437 if ( $type eq 'SCALAR' or $type eq 'REF' ) {
438 encode_error("cannot encode reference to scalar");
441 encode_error("encountered $value, but JSON can only represent references to arrays or hashes");
447 return $self->{fallback}->($value)
448 if ($self->{fallback} and ref($self->{fallback}) eq 'CODE');
468 my ($self, $arg) = @_;
470 $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;
471 $arg =~ s/\//\\\//g if ($escape_slash);
472 $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;
475 $arg = JSON_PP_encode_ascii($arg);
479 $arg = JSON_PP_encode_latin1($arg);
486 return '"' . $arg . '"';
490 sub blessed_to_json {
491 my $reftype = reftype($_[1]) || '';
492 if ($reftype eq 'HASH') {
493 return $_[0]->hash_to_json($_[1]);
495 elsif ($reftype eq 'ARRAY') {
496 return $_[0]->array_to_json($_[1]);
506 Carp::croak "$error";
511 defined $keysort ? (sort $keysort (keys %{$_[0]})) : keys %{$_[0]};
517 my $space = ' ' x $indent_length;
519 my ($pre,$post) = ('','');
521 $post = "\n" . $space x $indent_count;
525 $pre = "\n" . $space x $indent_count;
531 sub _down_indent { $indent_count--; }
537 indent_count => $indent_count,
550 sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
551 } unpack('U*', $_[0])
562 sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
563 } unpack('U*', $_[0])
568 sub _encode_surrogates { # from perlunicode
569 my $uni = $_[0] - 0x10000;
570 return ($uni / 0x400 + 0xD800, $uni % 0x400 + 0xDC00);
575 $_[0]->isa('Math::BigInt') or $_[0]->isa('Math::BigFloat');
590 my $int = eval qq| $checkint |;
591 if ($int =~ /[eE]/) {
592 $max_intsize = $d - 1;
600 my %escapes = ( # by Jeremy Muhlich <jmuhlich [at] bitflood.org>
611 my $text; # json data
614 my $len; # text length (changed according to UTF8 or NON UTF8)
616 my $depth; # nest counter
617 my $encoding; # json text encoding
618 my $is_valid_utf8; # temp variable
619 my $utf8_len; # utf8 byte length
621 my $utf8; # must be utf8
622 my $max_depth; # max nest number of objects and arrays
630 my $allow_bigint; # using Math::BigInt
631 my $singlequote; # loosely quoting
633 my $allow_barekey; # bareKey
636 # 0x00000001 .... decode_prefix
637 # 0x10000000 .... incr_parse
640 my ($self, $opt); # $opt is an effective flag during this decode_json.
642 ($self, $text, $opt) = @_;
644 ($at, $ch, $depth) = (0, '', 0);
646 if ( !defined $text or ref $text ) {
647 decode_error("malformed JSON string, neither array, object, number, string or atom");
650 my $idx = $self->{PROPS};
652 ($utf8, $relaxed, $loose, $allow_bigint, $allow_barekey, $singlequote)
653 = @{$idx}[P_UTF8, P_RELAXED, P_LOOSE .. P_ALLOW_SINGLEQUOTE];
656 utf8::downgrade( $text, 1 ) or Carp::croak("Wide character in subroutine entry");
659 utf8::upgrade( $text );
664 ($max_depth, $max_size, $cb_object, $cb_sk_object, $F_HOOK)
665 = @{$self}{qw/max_depth max_size cb_object cb_sk_object F_HOOK/};
669 my $bytes = length $text;
671 sprintf("attempted decode of JSON text of %s bytes size, but max_size is set to %s"
672 , $bytes, $max_size), 1
673 ) if ($bytes > $max_size);
676 # Currently no effect
678 my @octets = unpack('C4', $text);
679 $encoding = ( $octets[0] and $octets[1]) ? 'UTF-8'
680 : (!$octets[0] and $octets[1]) ? 'UTF-16BE'
681 : (!$octets[0] and !$octets[1]) ? 'UTF-32BE'
682 : ( $octets[2] ) ? 'UTF-16LE'
683 : (!$octets[2] ) ? 'UTF-32LE'
686 white(); # remove head white space
688 my $valid_start = defined $ch; # Is there a first character for JSON structure?
690 my $result = value();
692 return undef if ( !$result && ( $opt & 0x10000000 ) ); # for incr_parse
694 decode_error("malformed JSON string, neither array, object, number, string or atom") unless $valid_start;
696 if ( !$idx->[ P_ALLOW_NONREF ] and !ref $result ) {
698 'JSON text must be an object or array (but found number, string, true, false or null,'
699 . ' use allow_nonref to allow this)', 1);
702 Carp::croak('something wrong.') if $len < $at; # we won't arrive here.
704 my $consumed = defined $ch ? $at - 1 : $at; # consumed JSON text length
706 white(); # remove tail white space
709 return ( $result, $consumed ) if ($opt & 0x00000001); # all right if decode_prefix
710 decode_error("garbage after JSON object");
713 ( $opt & 0x00000001 ) ? ( $result, $consumed ) : $result;
718 return $ch = undef if($at >= $len);
719 $ch = substr($text, $at++, 1);
725 return if(!defined $ch);
726 return object() if($ch eq '{');
727 return array() if($ch eq '[');
728 return string() if($ch eq '"' or ($singlequote and $ch eq "'"));
729 return number() if($ch =~ /[0-9]/ or $ch eq '-');
738 ($is_valid_utf8, $utf8_len) = ('', 0);
740 $s = ''; # basically UTF8 flag on
742 if($ch eq '"' or ($singlequote and $ch eq "'")){
745 OUTER: while( defined(next_chr()) ){
747 if($ch eq $boundChar){
751 decode_error("missing low surrogate character in surrogate pair");
754 utf8::decode($s) if($is_utf8);
760 if(exists $escapes{$ch}){
763 elsif($ch eq 'u'){ # UNICODE handling
768 last OUTER if($ch !~ /[0-9a-fA-F]/);
773 if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/) { # UTF-16 high surrogate?
777 elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/) { # UTF-16 low surrogate?
778 unless (defined $utf16) {
779 decode_error("missing high surrogate character in surrogate pair");
782 $s .= JSON_PP_decode_surrogates($utf16, $u) || next;
786 if (defined $utf16) {
787 decode_error("surrogate pair expected");
790 if ( ( my $hex = hex( $u ) ) > 127 ) {
792 $s .= JSON_PP_decode_unicode($u) || next;
803 decode_error('illegal backslash escape sequence in string');
810 if ( ord $ch > 127 ) {
812 unless( $ch = is_valid_utf8($ch) ) {
814 decode_error("malformed UTF-8 character in JSON string");
817 $at += $utf8_len - 1;
828 if ($ch =~ /[\x00-\x1f\x22\x5c]/) { # '/' ok
830 decode_error('invalid character encountered while parsing JSON string');
839 decode_error("unexpected end of string while parsing JSON string");
844 while( defined $ch ){
850 if(defined $ch and $ch eq '/'){
851 1 while(defined(next_chr()) and $ch ne "\n" and $ch ne "\r");
853 elsif(defined $ch and $ch eq '*'){
858 if(defined(next_chr()) and $ch eq '/'){
868 decode_error("Unterminated comment");
875 decode_error("malformed JSON string, neither array, object, number, string or atom");
879 if ($relaxed and $ch eq '#') { # correctly?
881 $text =~ /\G([^\n]*(?:\r\n|\r|\n|$))/g;
894 my $a = $_[0] || []; # you can use this code to use another array ref object.
896 decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
897 if (++$depth > $max_depth);
902 if(defined $ch and $ch eq ']'){
930 if ($relaxed and $ch eq ']') {
939 decode_error(", or ] expected while parsing array");
944 my $o = $_[0] || {}; # you can use this code to use another hash ref object.
947 decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
948 if (++$depth > $max_depth);
952 if(defined $ch and $ch eq '}'){
956 return _json_object_hook($o);
961 while (defined $ch) {
962 $k = ($allow_barekey and $ch ne '"' and $ch ne "'") ? bareKey() : string();
965 if(!defined $ch or $ch ne ':'){
967 decode_error("':' expected");
974 last if (!defined $ch);
980 return _json_object_hook($o);
992 if ($relaxed and $ch eq '}') {
996 return _json_object_hook($o);
1006 decode_error(", or } expected while parsing object/hash");
1010 sub bareKey { # doesn't strictly follow Standard ECMA-262 3rd Edition
1012 while($ch =~ /[^\x00-\x23\x25-\x2F\x3A-\x40\x5B-\x5E\x60\x7B-\x7F]/){
1021 my $word = substr($text,$at-1,4);
1023 if($word eq 'true'){
1026 return $JSON::PP::true;
1028 elsif($word eq 'null'){
1033 elsif($word eq 'fals'){
1035 if(substr($text,$at,1) eq 'e'){
1038 return $JSON::PP::false;
1042 $at--; # for decode_error report
1044 decode_error("'null' expected") if ($word =~ /^n/);
1045 decode_error("'true' expected") if ($word =~ /^t/);
1046 decode_error("'false' expected") if ($word =~ /^f/);
1047 decode_error("malformed JSON string, neither array, object, number, string or atom");
1055 # According to RFC4627, hex or oct digits are invalid.
1057 my $peek = substr($text,$at,1);
1058 my $hex = $peek =~ /[xX]/; # 0 or 1
1061 decode_error("malformed number (leading zero must not be followed by another digit)");
1062 ($n) = ( substr($text, $at+1) =~ /^([0-9a-fA-F]+)/);
1065 ($n) = ( substr($text, $at) =~ /^([0-7]+)/);
1066 if (defined $n and length $n > 1) {
1067 decode_error("malformed number (leading zero must not be followed by another digit)");
1071 if(defined $n and length($n)){
1072 if (!$hex and length($n) == 1) {
1073 decode_error("malformed number (leading zero must not be followed by another digit)");
1075 $at += length($n) + $hex;
1077 return $hex ? hex($n) : oct($n);
1084 if (!defined $ch or $ch !~ /\d/) {
1085 decode_error("malformed number (no digits after initial minus)");
1089 while(defined $ch and $ch =~ /\d/){
1094 if(defined $ch and $ch eq '.'){
1098 if (!defined $ch or $ch !~ /\d/) {
1099 decode_error("malformed number (no digits after decimal point)");
1105 while(defined(next_chr) and $ch =~ /\d/){
1110 if(defined $ch and ($ch eq 'e' or $ch eq 'E')){
1114 if(defined($ch) and ($ch eq '+' or $ch eq '-')){
1117 if (!defined $ch or $ch =~ /\D/) {
1118 decode_error("malformed number (no digits after exp sign)");
1122 elsif(defined($ch) and $ch =~ /\d/){
1126 decode_error("malformed number (no digits after exp sign)");
1129 while(defined(next_chr) and $ch =~ /\d/){
1137 if ($v !~ /[.eE]/ and length $v > $max_intsize) {
1138 if ($allow_bigint) { # from Adam Sussman
1139 require Math::BigInt;
1140 return Math::BigInt->new($v);
1146 elsif ($allow_bigint) {
1147 require Math::BigFloat;
1148 return Math::BigFloat->new($v);
1157 $utf8_len = $_[0] =~ /[\x00-\x7F]/ ? 1
1158 : $_[0] =~ /[\xC2-\xDF]/ ? 2
1159 : $_[0] =~ /[\xE0-\xEF]/ ? 3
1160 : $_[0] =~ /[\xF0-\xF4]/ ? 4
1164 return unless $utf8_len;
1166 my $is_valid_utf8 = substr($text, $at - 1, $utf8_len);
1168 return ( $is_valid_utf8 =~ /^(?:
1170 |[\xC2-\xDF][\x80-\xBF]
1171 |[\xE0][\xA0-\xBF][\x80-\xBF]
1172 |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
1173 |[\xED][\x80-\x9F][\x80-\xBF]
1174 |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
1175 |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
1176 |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
1177 |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
1178 )$/x ) ? $is_valid_utf8 : '';
1185 my $str = defined $text ? substr($text, $at) : '';
1187 my $type = $] >= 5.008 ? 'U*'
1189 : utf8::is_utf8( $str ) ? 'U*' # 5.6
1193 for my $c ( unpack( $type, $str ) ) { # emulate pv_uni_display() ?
1194 $mess .= $c == 0x07 ? '\a'
1199 : $c < 0x20 ? sprintf('\x{%x}', $c)
1200 : $c == 0x5c ? '\\\\'
1201 : $c < 0x80 ? chr($c)
1202 : sprintf('\x{%x}', $c)
1204 if ( length $mess >= 20 ) {
1210 unless ( length $mess ) {
1211 $mess = '(end of string)';
1215 $no_rep ? "$error" : "$error, at character offset $at (before \"$mess\")"
1221 sub _json_object_hook {
1223 my @ks = keys %{$o};
1225 if ( $cb_sk_object and @ks == 1 and exists $cb_sk_object->{ $ks[0] } and ref $cb_sk_object->{ $ks[0] } ) {
1226 my @val = $cb_sk_object->{ $ks[0] }->( $o->{$ks[0]} );
1232 my @val = $cb_object->($o) if ($cb_object);
1233 if (@val == 0 or @val > 1) {
1249 encoding => $encoding,
1250 is_valid_utf8 => $is_valid_utf8,
1257 sub _decode_surrogates { # from perlunicode
1258 my $uni = 0x10000 + (hex($_[0]) - 0xD800) * 0x400 + (hex($_[1]) - 0xDC00);
1259 my $un = pack('U*', $uni);
1260 utf8::encode( $un );
1265 sub _decode_unicode {
1266 my $un = pack('U', hex shift);
1267 utf8::encode( $un );
1272 # Setup for various Perl versions (the code from JSON::PP58)
1277 unless ( defined &utf8::is_utf8 ) {
1279 *utf8::is_utf8 = *Encode::is_utf8;
1282 if ( $] >= 5.008 ) {
1283 *JSON::PP::JSON_PP_encode_ascii = \&_encode_ascii;
1284 *JSON::PP::JSON_PP_encode_latin1 = \&_encode_latin1;
1285 *JSON::PP::JSON_PP_decode_surrogates = \&_decode_surrogates;
1286 *JSON::PP::JSON_PP_decode_unicode = \&_decode_unicode;
1289 if ($] >= 5.008 and $] < 5.008003) { # join() in 5.8.0 - 5.8.2 is broken.
1290 package # hide from PAUSE
1293 subs->import('join');
1296 return '' if (@_ < 2);
1299 for (@_) { $str .= $j . $_; }
1306 sub JSON::PP::incr_parse {
1307 local $Carp::CarpLevel = 1;
1308 ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_parse( @_ );
1312 sub JSON::PP::incr_skip {
1313 ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_skip;
1317 sub JSON::PP::incr_reset {
1318 ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_reset;
1322 sub JSON::PP::incr_text : lvalue {
1323 $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new;
1325 if ( $_[0]->{_incr_parser}->{incr_parsing} ) {
1326 Carp::croak("incr_text can not be called when the incremental parser already started parsing");
1328 $_[0]->{_incr_parser}->{incr_text};
1330 } if ( $] >= 5.006 );
1332 } # Setup for various Perl versions (the code from JSON::PP58)
1335 ###############################
1340 eval 'require Scalar::Util';
1342 *JSON::PP::blessed = \&Scalar::Util::blessed;
1343 *JSON::PP::reftype = \&Scalar::Util::reftype;
1344 *JSON::PP::refaddr = \&Scalar::Util::refaddr;
1346 else{ # This code is from Scalar::Util.
1348 eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';
1349 *JSON::PP::blessed = sub {
1350 local($@, $SIG{__DIE__}, $SIG{__WARN__});
1351 ref($_[0]) ? eval { $_[0]->a_sub_not_likely_to_be_here } : undef;
1362 *JSON::PP::reftype = sub {
1365 return undef unless length(ref($r));
1367 my $t = ref(B::svref_2object($r));
1370 exists $tmap{$t} ? $tmap{$t}
1371 : length(ref($$r)) ? 'REF'
1374 *JSON::PP::refaddr = sub {
1375 return undef unless length(ref($_[0]));
1378 if(defined(my $pkg = blessed($_[0]))) {
1379 $addr .= bless $_[0], 'Scalar::Util::Fake';
1388 #no warnings 'portable';
1395 # shamelessly copied and modified from JSON::XS code.
1397 $JSON::PP::true = do { bless \(my $dummy = 1), "JSON::backportPP::Boolean" };
1398 $JSON::PP::false = do { bless \(my $dummy = 0), "JSON::backportPP::Boolean" };
1400 sub is_bool { defined $_[0] and UNIVERSAL::isa($_[0], "JSON::PP::Boolean"); }
1402 sub true { $JSON::PP::true }
1403 sub false { $JSON::PP::false }
1406 ###############################
1408 package JSON::backportPP::Boolean;
1410 @JSON::backportPP::Boolean::ISA = ('JSON::PP::Boolean');
1412 "0+" => sub { ${$_[0]} },
1413 "++" => sub { $_[0] = ${$_[0]} + 1 },
1414 "--" => sub { $_[0] = ${$_[0]} - 1 },
1419 ###############################
1421 package # hide from PAUSE
1422 JSON::PP::IncrParser;
1426 use constant INCR_M_WS => 0; # initial whitespace skipping
1427 use constant INCR_M_STR => 1; # inside string
1428 use constant INCR_M_BS => 2; # inside backslash
1429 use constant INCR_M_JSON => 3; # outside anything, count nesting
1430 use constant INCR_M_C0 => 4;
1431 use constant INCR_M_C1 => 5;
1433 use vars qw($VERSION);
1436 my $unpack_format = $] < 5.006 ? 'C*' : 'U*';
1451 my ( $self, $coder, $text ) = @_;
1453 $self->{incr_text} = '' unless ( defined $self->{incr_text} );
1455 if ( defined $text ) {
1456 if ( utf8::is_utf8( $text ) and !utf8::is_utf8( $self->{incr_text} ) ) {
1457 utf8::upgrade( $self->{incr_text} ) ;
1458 utf8::decode( $self->{incr_text} ) ;
1460 $self->{incr_text} .= $text;
1464 my $max_size = $coder->get_max_size;
1466 if ( defined wantarray ) {
1468 $self->{incr_mode} = INCR_M_WS unless defined $self->{incr_mode};
1473 $self->{incr_parsing} = 1;
1476 push @ret, $self->_incr_parse( $coder, $self->{incr_text} );
1478 unless ( !$self->{incr_nest} and $self->{incr_mode} == INCR_M_JSON ) {
1479 $self->{incr_mode} = INCR_M_WS if $self->{incr_mode} != INCR_M_STR;
1482 } until ( length $self->{incr_text} >= $self->{incr_p} );
1484 $self->{incr_parsing} = 0;
1488 else { # in scalar context
1489 $self->{incr_parsing} = 1;
1490 my $obj = $self->_incr_parse( $coder, $self->{incr_text} );
1491 $self->{incr_parsing} = 0 if defined $obj; # pointed by Martin J. Evans
1492 return $obj ? $obj : undef; # $obj is an empty string, parsing was completed.
1501 my ( $self, $coder, $text, $skip ) = @_;
1502 my $p = $self->{incr_p};
1506 my $len = length $text;
1508 if ( $self->{incr_mode} == INCR_M_WS ) {
1509 while ( $len > $p ) {
1510 my $s = substr( $text, $p, 1 );
1511 $p++ and next if ( 0x20 >= unpack($unpack_format, $s) );
1512 $self->{incr_mode} = INCR_M_JSON;
1517 while ( $len > $p ) {
1518 my $s = substr( $text, $p++, 1 );
1521 if (substr( $text, $p - 2, 1 ) eq '\\' ) {
1525 if ( $self->{incr_mode} != INCR_M_STR ) {
1526 $self->{incr_mode} = INCR_M_STR;
1529 $self->{incr_mode} = INCR_M_JSON;
1530 unless ( $self->{incr_nest} ) {
1536 if ( $self->{incr_mode} == INCR_M_JSON ) {
1538 if ( $s eq '[' or $s eq '{' ) {
1539 if ( ++$self->{incr_nest} > $coder->get_max_depth ) {
1540 Carp::croak('json text or perl structure exceeds maximum nesting level (max_depth set too low?)');
1543 elsif ( $s eq ']' or $s eq '}' ) {
1544 last if ( --$self->{incr_nest} <= 0 );
1546 elsif ( $s eq '#' ) {
1547 while ( $len > $p ) {
1548 last if substr( $text, $p++, 1 ) eq "\n";
1556 $self->{incr_p} = $p;
1558 return if ( $self->{incr_mode} == INCR_M_STR and not $self->{incr_nest} );
1559 return if ( $self->{incr_mode} == INCR_M_JSON and $self->{incr_nest} > 0 );
1561 return '' unless ( length substr( $self->{incr_text}, 0, $p ) );
1563 local $Carp::CarpLevel = 2;
1565 $self->{incr_p} = $restore;
1566 $self->{incr_c} = $p;
1568 my ( $obj, $tail ) = $coder->PP_decode_json( substr( $self->{incr_text}, 0, $p ), 0x10000001 );
1570 $self->{incr_text} = substr( $self->{incr_text}, $p );
1571 $self->{incr_p} = 0;
1578 if ( $_[0]->{incr_parsing} ) {
1579 Carp::croak("incr_text can not be called when the incremental parser already started parsing");
1587 $self->{incr_text} = substr( $self->{incr_text}, $self->{incr_c} );
1588 $self->{incr_p} = 0;
1594 $self->{incr_text} = undef;
1595 $self->{incr_p} = 0;
1596 $self->{incr_mode} = 0;
1597 $self->{incr_nest} = 0;
1598 $self->{incr_parsing} = 0;
1601 ###############################
1610 JSON::PP - JSON::XS compatible pure-Perl module.
1616 # exported functions, they croak on error
1617 # and expect/generate UTF-8
1619 $utf8_encoded_json_text = encode_json $perl_hash_or_arrayref;
1620 $perl_hash_or_arrayref = decode_json $utf8_encoded_json_text;
1624 $coder = JSON::PP->new->ascii->pretty->allow_nonref;
1626 $json_text = $json->encode( $perl_scalar );
1627 $perl_scalar = $json->decode( $json_text );
1629 $pretty_printed = $json->pretty->encode( $perl_scalar ); # pretty-printing
1631 # Note that JSON version 2.0 and above will automatically use
1632 # JSON::XS or JSON::PP, so you should be able to just:
1641 L<JSON::XS> 2.27 (~2.30) compatible.
1645 This module is L<JSON::XS> compatible pure Perl module.
1646 (Perl 5.8 or later is recommended)
1648 JSON::XS is the fastest and most proper JSON module on CPAN.
1649 It is written by Marc Lehmann in C, so must be compiled and
1650 installed in the used environment.
1652 JSON::PP is a pure-Perl module and has compatibility to JSON::XS.
1659 =item * correct unicode handling
1661 This module knows how to handle Unicode (depending on Perl version).
1663 See to L<JSON::XS/A FEW NOTES ON UNICODE AND PERL> and
1664 L<UNICODE HANDLING ON PERLS>.
1667 =item * round-trip integrity
1669 When you serialise a perl data structure using only data types
1670 supported by JSON and Perl, the deserialised data structure is
1671 identical on the Perl level. (e.g. the string "2.0" doesn't suddenly
1672 become "2" just because it looks like a number). There I<are> minor
1673 exceptions to this, read the MAPPING section below to learn about
1677 =item * strict checking of JSON correctness
1679 There is no guessing, no generating of illegal JSON texts by default,
1680 and only JSON is accepted as input by default (the latter is a
1681 security feature). But when some options are set, loose checking
1682 features are available.
1686 =head1 FUNCTIONAL INTERFACE
1688 Some documents are copied and modified from L<JSON::XS/FUNCTIONAL INTERFACE>.
1692 $json_text = encode_json $perl_scalar
1694 Converts the given Perl data structure to a UTF-8 encoded, binary string.
1696 This function call is functionally identical to:
1698 $json_text = JSON::PP->new->utf8->encode($perl_scalar)
1702 $perl_scalar = decode_json $json_text
1704 The opposite of C<encode_json>: expects an UTF-8 (binary) string and tries
1705 to parse that as an UTF-8 encoded JSON text, returning the resulting
1708 This function call is functionally identical to:
1710 $perl_scalar = JSON::PP->new->utf8->decode($json_text)
1712 =head2 JSON::PP::is_bool
1714 $is_boolean = JSON::PP::is_bool($scalar)
1716 Returns true if the passed scalar represents either JSON::PP::true or
1717 JSON::PP::false, two constants that act like C<1> and C<0> respectively
1718 and are also used to represent JSON C<true> and C<false> in Perl strings.
1720 =head2 JSON::PP::true
1722 Returns JSON true value which is blessed object.
1723 It C<isa> JSON::PP::Boolean object.
1725 =head2 JSON::PP::false
1727 Returns JSON false value which is blessed object.
1728 It C<isa> JSON::PP::Boolean object.
1730 =head2 JSON::PP::null
1734 See L<MAPPING>, below, for more information on how JSON values are mapped to
1738 =head1 HOW DO I DECODE A DATA FROM OUTER AND ENCODE TO OUTER
1740 This section supposes that your perl version is 5.8 or later.
1742 If you know a JSON text from an outer world - a network, a file content, and so on,
1743 is encoded in UTF-8, you should use C<decode_json> or C<JSON> module object
1744 with C<utf8> enable. And the decoded result will contain UNICODE characters.
1747 my $json = JSON::PP->new->utf8;
1748 my $json_text = CGI->new->param( 'json_data' );
1749 my $perl_scalar = $json->decode( $json_text );
1753 open( my $fh, '<', 'json.data' );
1755 $perl_scalar = decode_json( $json_text );
1757 If an outer data is not encoded in UTF-8, firstly you should C<decode> it.
1761 open( my $fh, '<', 'json.data' );
1762 my $encoding = 'cp932';
1763 my $unicode_json_text = decode( $encoding, <$fh> ); # UNICODE
1765 # or you can write the below code.
1767 # open( my $fh, "<:encoding($encoding)", 'json.data' );
1768 # $unicode_json_text = <$fh>;
1770 In this case, C<$unicode_json_text> is of course UNICODE string.
1771 So you B<cannot> use C<decode_json> nor C<JSON> module object with C<utf8> enable.
1772 Instead of them, you use C<JSON> module object with C<utf8> disable.
1774 $perl_scalar = $json->utf8(0)->decode( $unicode_json_text );
1776 Or C<encode 'utf8'> and C<decode_json>:
1778 $perl_scalar = decode_json( encode( 'utf8', $unicode_json_text ) );
1779 # this way is not efficient.
1781 And now, you want to convert your C<$perl_scalar> into JSON data and
1782 send it to an outer world - a network or a file content, and so on.
1784 Your data usually contains UNICODE strings and you want the converted data to be encoded
1785 in UTF-8, you should use C<encode_json> or C<JSON> module object with C<utf8> enable.
1787 print encode_json( $perl_scalar ); # to a network? file? or display?
1789 print $json->utf8->encode( $perl_scalar );
1791 If C<$perl_scalar> does not contain UNICODE but C<$encoding>-encoded strings
1792 for some reason, then its characters are regarded as B<latin1> for perl
1793 (because it does not concern with your $encoding).
1794 You B<cannot> use C<encode_json> nor C<JSON> module object with C<utf8> enable.
1795 Instead of them, you use C<JSON> module object with C<utf8> disable.
1796 Note that the resulted text is a UNICODE string but no problem to print it.
1798 # $perl_scalar contains $encoding encoded string values
1799 $unicode_json_text = $json->utf8(0)->encode( $perl_scalar );
1800 # $unicode_json_text consists of characters less than 0x100
1801 print $unicode_json_text;
1803 Or C<decode $encoding> all string values and C<encode_json>:
1805 $perl_scalar->{ foo } = decode( $encoding, $perl_scalar->{ foo } );
1806 # ... do it to each string values, then encode_json
1807 $json_text = encode_json( $perl_scalar );
1809 This method is a proper way but probably not efficient.
1811 See to L<Encode>, L<perluniintro>.
1816 Basically, check to L<JSON> or L<JSON::XS>.
1820 $json = JSON::PP->new
1822 Returns a new JSON::PP object that can be used to de/encode JSON
1825 All boolean flags described below are by default I<disabled>.
1827 The mutators for flags all return the JSON object again and thus calls can
1830 my $json = JSON::PP->new->utf8->space_after->encode({a => [1,2]})
1835 $json = $json->ascii([$enable])
1837 $enabled = $json->get_ascii
1839 If $enable is true (or missing), then the encode method will not generate characters outside
1840 the code range 0..127. Any Unicode characters outside that range will be escaped using either
1841 a single \uXXXX or a double \uHHHH\uLLLLL escape sequence, as per RFC4627.
1842 (See to L<JSON::XS/OBJECT-ORIENTED INTERFACE>).
1844 In Perl 5.005, there is no character having high value (more than 255).
1845 See to L<UNICODE HANDLING ON PERLS>.
1847 If $enable is false, then the encode method will not escape Unicode characters unless
1848 required by the JSON syntax or other flags. This results in a faster and more compact format.
1850 JSON::PP->new->ascii(1)->encode([chr 0x10401])
1855 $json = $json->latin1([$enable])
1857 $enabled = $json->get_latin1
1859 If $enable is true (or missing), then the encode method will encode the resulting JSON
1860 text as latin1 (or iso-8859-1), escaping any characters outside the code range 0..255.
1862 If $enable is false, then the encode method will not escape Unicode characters
1863 unless required by the JSON syntax or other flags.
1865 JSON::XS->new->latin1->encode (["\x{89}\x{abc}"]
1866 => ["\x{89}\\u0abc"] # (perl syntax, U+abc escaped, U+89 not)
1868 See to L<UNICODE HANDLING ON PERLS>.
1872 $json = $json->utf8([$enable])
1874 $enabled = $json->get_utf8
1876 If $enable is true (or missing), then the encode method will encode the JSON result
1877 into UTF-8, as required by many protocols, while the decode method expects to be handled
1878 an UTF-8-encoded string. Please note that UTF-8-encoded strings do not contain any
1879 characters outside the range 0..255, they are thus useful for bytewise/binary I/O.
1881 (In Perl 5.005, any character outside the range 0..255 does not exist.
1882 See to L<UNICODE HANDLING ON PERLS>.)
1884 In future versions, enabling this option might enable autodetection of the UTF-16 and UTF-32
1885 encoding families, as described in RFC4627.
1887 If $enable is false, then the encode method will return the JSON string as a (non-encoded)
1888 Unicode string, while decode expects thus a Unicode string. Any decoding or encoding
1889 (e.g. to UTF-8 or UTF-16) needs to be done yourself, e.g. using the Encode module.
1891 Example, output UTF-16BE-encoded JSON:
1894 $jsontext = encode "UTF-16BE", JSON::PP->new->encode ($object);
1896 Example, decode UTF-32LE-encoded JSON:
1899 $object = JSON::PP->new->decode (decode "UTF-32LE", $jsontext);
1904 $json = $json->pretty([$enable])
1906 This enables (or disables) all of the C<indent>, C<space_before> and
1907 C<space_after> flags in one call to generate the most readable
1908 (or most compact) form possible.
1912 $json->indent->space_before->space_after
1916 $json = $json->indent([$enable])
1918 $enabled = $json->get_indent
1920 The default indent space length is three.
1921 You can use C<indent_length> to change the length.
1925 $json = $json->space_before([$enable])
1927 $enabled = $json->get_space_before
1929 If C<$enable> is true (or missing), then the C<encode> method will add an extra
1930 optional space before the C<:> separating keys from values in JSON objects.
1932 If C<$enable> is false, then the C<encode> method will not add any extra
1933 space at those places.
1935 This setting has no effect when decoding JSON texts.
1937 Example, space_before enabled, space_after and indent disabled:
1943 $json = $json->space_after([$enable])
1945 $enabled = $json->get_space_after
1947 If C<$enable> is true (or missing), then the C<encode> method will add an extra
1948 optional space after the C<:> separating keys from values in JSON objects
1949 and extra whitespace after the C<,> separating key-value pairs and array
1952 If C<$enable> is false, then the C<encode> method will not add any extra
1953 space at those places.
1955 This setting has no effect when decoding JSON texts.
1957 Example, space_before and indent disabled, space_after enabled:
1963 $json = $json->relaxed([$enable])
1965 $enabled = $json->get_relaxed
1967 If C<$enable> is true (or missing), then C<decode> will accept some
1968 extensions to normal JSON syntax (see below). C<encode> will not be
1969 affected in anyway. I<Be aware that this option makes you accept invalid
1970 JSON texts as if they were valid!>. I suggest only to use this option to
1971 parse application-specific files written by humans (configuration files,
1972 resource files etc.)
1974 If C<$enable> is false (the default), then C<decode> will only accept
1977 Currently accepted extensions are:
1981 =item * list items can have an end-comma
1983 JSON I<separates> array elements and key-value pairs with commas. This
1984 can be annoying if you write JSON texts manually and want to be able to
1985 quickly append elements, so this extension accepts comma at the end of
1986 such items not just between them:
1990 2, <- this comma not normally allowed
1994 "k2": "v2", <- this comma not normally allowed
1997 =item * shell-style '#'-comments
1999 Whenever JSON allows whitespace, shell-style comments are additionally
2000 allowed. They are terminated by the first carriage-return or line-feed
2001 character, after which more white-space and comments are allowed.
2004 1, # this comment not allowed in JSON
2005 # neither this one...
2012 $json = $json->canonical([$enable])
2014 $enabled = $json->get_canonical
2016 If C<$enable> is true (or missing), then the C<encode> method will output JSON objects
2017 by sorting their keys. This is adding a comparatively high overhead.
2019 If C<$enable> is false, then the C<encode> method will output key-value
2020 pairs in the order Perl stores them (which will likely change between runs
2021 of the same script).
2023 This option is useful if you want the same data structure to be encoded as
2024 the same JSON text (given the same overall settings). If it is disabled,
2025 the same hash might be encoded differently even if contains the same data,
2026 as key-value pairs have no inherent ordering in Perl.
2028 This setting has no effect when decoding JSON texts.
2030 If you want your own sorting routine, you can give a code reference
2031 or a subroutine name to C<sort_by>. See to C<JSON::PP OWN METHODS>.
2035 $json = $json->allow_nonref([$enable])
2037 $enabled = $json->get_allow_nonref
2039 If C<$enable> is true (or missing), then the C<encode> method can convert a
2040 non-reference into its corresponding string, number or null JSON value,
2041 which is an extension to RFC4627. Likewise, C<decode> will accept those JSON
2042 values instead of croaking.
2044 If C<$enable> is false, then the C<encode> method will croak if it isn't
2045 passed an arrayref or hashref, as JSON texts must either be an object
2046 or array. Likewise, C<decode> will croak if given something that is not a
2047 JSON object or array.
2049 JSON::PP->new->allow_nonref->encode ("Hello, World!")
2052 =head2 allow_unknown
2054 $json = $json->allow_unknown ([$enable])
2056 $enabled = $json->get_allow_unknown
2058 If $enable is true (or missing), then "encode" will *not* throw an
2059 exception when it encounters values it cannot represent in JSON (for
2060 example, filehandles) but instead will encode a JSON "null" value.
2061 Note that blessed objects are not included here and are handled
2062 separately by c<allow_nonref>.
2064 If $enable is false (the default), then "encode" will throw an
2065 exception when it encounters anything it cannot encode as JSON.
2067 This option does not affect "decode" in any way, and it is
2068 recommended to leave it off unless you know your communications
2071 =head2 allow_blessed
2073 $json = $json->allow_blessed([$enable])
2075 $enabled = $json->get_allow_blessed
2077 If C<$enable> is true (or missing), then the C<encode> method will not
2078 barf when it encounters a blessed reference. Instead, the value of the
2079 B<convert_blessed> option will decide whether C<null> (C<convert_blessed>
2080 disabled or no C<TO_JSON> method found) or a representation of the
2081 object (C<convert_blessed> enabled and C<TO_JSON> method found) is being
2082 encoded. Has no effect on C<decode>.
2084 If C<$enable> is false (the default), then C<encode> will throw an
2085 exception when it encounters a blessed object.
2087 =head2 convert_blessed
2089 $json = $json->convert_blessed([$enable])
2091 $enabled = $json->get_convert_blessed
2093 If C<$enable> is true (or missing), then C<encode>, upon encountering a
2094 blessed object, will check for the availability of the C<TO_JSON> method
2095 on the object's class. If found, it will be called in scalar context
2096 and the resulting scalar will be encoded instead of the object. If no
2097 C<TO_JSON> method is found, the value of C<allow_blessed> will decide what
2100 The C<TO_JSON> method may safely call die if it wants. If C<TO_JSON>
2101 returns other blessed objects, those will be handled in the same
2102 way. C<TO_JSON> must take care of not causing an endless recursion cycle
2103 (== crash) in this case. The name of C<TO_JSON> was chosen because other
2104 methods called by the Perl core (== not by the user of the object) are
2105 usually in upper case letters and to avoid collisions with the C<to_json>
2108 This setting does not yet influence C<decode> in any way.
2110 If C<$enable> is false, then the C<allow_blessed> setting will decide what
2111 to do when a blessed object is found.
2113 =head2 filter_json_object
2115 $json = $json->filter_json_object([$coderef])
2117 When C<$coderef> is specified, it will be called from C<decode> each
2118 time it decodes a JSON object. The only argument passed to the coderef
2119 is a reference to the newly-created hash. If the code references returns
2120 a single scalar (which need not be a reference), this value
2121 (i.e. a copy of that scalar to avoid aliasing) is inserted into the
2122 deserialised data structure. If it returns an empty list
2123 (NOTE: I<not> C<undef>, which is a valid scalar), the original deserialised
2124 hash will be inserted. This setting can slow down decoding considerably.
2126 When C<$coderef> is omitted or undefined, any existing callback will
2127 be removed and C<decode> will not change the deserialised hash in any
2130 Example, convert all JSON objects into the integer 5:
2132 my $js = JSON::PP->new->filter_json_object (sub { 5 });
2134 $js->decode ('[{}]'); # the given subroutine takes a hash reference.
2135 # throw an exception because allow_nonref is not enabled
2136 # so a lone 5 is not allowed.
2137 $js->decode ('{"a":1, "b":2}');
2139 =head2 filter_json_single_key_object
2141 $json = $json->filter_json_single_key_object($key [=> $coderef])
2143 Works remotely similar to C<filter_json_object>, but is only called for
2144 JSON objects having a single key named C<$key>.
2146 This C<$coderef> is called before the one specified via
2147 C<filter_json_object>, if any. It gets passed the single value in the JSON
2148 object. If it returns a single value, it will be inserted into the data
2149 structure. If it returns nothing (not even C<undef> but the empty list),
2150 the callback from C<filter_json_object> will be called next, as if no
2151 single-key callback were specified.
2153 If C<$coderef> is omitted or undefined, the corresponding callback will be
2154 disabled. There can only ever be one callback for a given key.
2156 As this callback gets called less often then the C<filter_json_object>
2157 one, decoding speed will not usually suffer as much. Therefore, single-key
2158 objects make excellent targets to serialise Perl objects into, especially
2159 as single-key JSON objects are as close to the type-tagged value concept
2160 as JSON gets (it's basically an ID/VALUE tuple). Of course, JSON does not
2161 support this in any way, so you need to make sure your data never looks
2162 like a serialised Perl hash.
2164 Typical names for the single object key are C<__class_whatever__>, or
2165 C<$__dollars_are_rarely_used__$> or C<}ugly_brace_placement>, or even
2166 things like C<__class_md5sum(classname)__>, to reduce the risk of clashing
2169 Example, decode JSON objects of the form C<< { "__widget__" => <id> } >>
2170 into the corresponding C<< $WIDGET{<id>} >> object:
2172 # return whatever is in $WIDGET{5}:
2175 ->filter_json_single_key_object (__widget__ => sub {
2178 ->decode ('{"__widget__": 5')
2180 # this can be used with a TO_JSON method in some "widget" class
2181 # for serialisation to json:
2182 sub WidgetBase::TO_JSON {
2185 unless ($self->{id}) {
2186 $self->{id} = ..get..some..id..;
2187 $WIDGET{$self->{id}} = $self;
2190 { __widget__ => $self->{id} }
2195 $json = $json->shrink([$enable])
2197 $enabled = $json->get_shrink
2199 In JSON::XS, this flag resizes strings generated by either
2200 C<encode> or C<decode> to their minimum size possible.
2201 It will also try to downgrade any strings to octet-form if possible.
2203 In JSON::PP, it is noop about resizing strings but tries
2204 C<utf8::downgrade> to the returned string by C<encode>.
2207 See to L<JSON::XS/OBJECT-ORIENTED INTERFACE>
2211 $json = $json->max_depth([$maximum_nesting_depth])
2213 $max_depth = $json->get_max_depth
2215 Sets the maximum nesting level (default C<512>) accepted while encoding
2216 or decoding. If a higher nesting level is detected in JSON text or a Perl
2217 data structure, then the encoder and decoder will stop and croak at that
2220 Nesting level is defined by number of hash- or arrayrefs that the encoder
2221 needs to traverse to reach a given point or the number of C<{> or C<[>
2222 characters without their matching closing parenthesis crossed to reach a
2223 given character in a string.
2225 If no argument is given, the highest possible setting will be used, which
2228 See L<JSON::XS/SSECURITY CONSIDERATIONS> for more info on why this is useful.
2230 When a large value (100 or more) was set and it de/encodes a deep nested object/text,
2231 it may raise a warning 'Deep recursion on subroutine' at the perl runtime phase.
2235 $json = $json->max_size([$maximum_string_size])
2237 $max_size = $json->get_max_size
2239 Set the maximum length a JSON text may have (in bytes) where decoding is
2240 being attempted. The default is C<0>, meaning no limit. When C<decode>
2241 is called on a string that is longer then this many bytes, it will not
2242 attempt to decode the string but throw an exception. This setting has no
2243 effect on C<encode> (yet).
2245 If no argument is given, the limit check will be deactivated (same as when
2248 See L<JSON::XS/SECURITY CONSIDERATIONS> for more info on why this is useful.
2252 $json_text = $json->encode($perl_scalar)
2254 Converts the given Perl data structure (a simple scalar or a reference
2255 to a hash or array) to its JSON representation. Simple scalars will be
2256 converted into JSON string or number sequences, while references to arrays
2257 become JSON arrays and references to hashes become JSON objects. Undefined
2258 Perl values (e.g. C<undef>) become JSON C<null> values.
2259 References to the integers C<0> and C<1> are converted into C<true> and C<false>.
2263 $perl_scalar = $json->decode($json_text)
2265 The opposite of C<encode>: expects a JSON text and tries to parse it,
2266 returning the resulting simple scalar or reference. Croaks on error.
2268 JSON numbers and strings become simple Perl scalars. JSON arrays become
2269 Perl arrayrefs and JSON objects become Perl hashrefs. C<true> becomes
2270 C<1> (C<JSON::true>), C<false> becomes C<0> (C<JSON::false>) and
2271 C<null> becomes C<undef>.
2273 =head2 decode_prefix
2275 ($perl_scalar, $characters) = $json->decode_prefix($json_text)
2277 This works like the C<decode> method, but instead of raising an exception
2278 when there is trailing garbage after the first JSON object, it will
2279 silently stop parsing there and return the number of characters consumed
2282 JSON->new->decode_prefix ("[1] the tail")
2285 =head1 INCREMENTAL PARSING
2287 Most of this section are copied and modified from L<JSON::XS/INCREMENTAL PARSING>.
2289 In some cases, there is the need for incremental parsing of JSON texts.
2290 This module does allow you to parse a JSON stream incrementally.
2291 It does so by accumulating text until it has a full JSON object, which
2292 it then can decode. This process is similar to using C<decode_prefix>
2293 to see if a full JSON object is available, but is much more efficient
2294 (and can be implemented with a minimum of method calls).
2296 This module will only attempt to parse the JSON text once it is sure it
2297 has enough text to get a decisive result, using a very simple but
2298 truly incremental parser. This means that it sometimes won't stop as
2299 early as the full parser, for example, it doesn't detect parenthesis
2300 mismatches. The only thing it guarantees is that it starts decoding as
2301 soon as a syntactically valid JSON text has been seen. This means you need
2302 to set resource limits (e.g. C<max_size>) to ensure the parser will stop
2303 parsing in the presence if syntax errors.
2305 The following methods implement this incremental parser.
2309 $json->incr_parse( [$string] ) # void context
2311 $obj_or_undef = $json->incr_parse( [$string] ) # scalar context
2313 @obj_or_empty = $json->incr_parse( [$string] ) # list context
2315 This is the central parsing function. It can both append new text and
2316 extract objects from the stream accumulated so far (both of these
2317 functions are optional).
2319 If C<$string> is given, then this string is appended to the already
2320 existing JSON fragment stored in the C<$json> object.
2322 After that, if the function is called in void context, it will simply
2323 return without doing anything further. This can be used to add more text
2324 in as many chunks as you want.
2326 If the method is called in scalar context, then it will try to extract
2327 exactly I<one> JSON object. If that is successful, it will return this
2328 object, otherwise it will return C<undef>. If there is a parse error,
2329 this method will croak just as C<decode> would do (one can then use
2330 C<incr_skip> to skip the erroneous part). This is the most common way of
2333 And finally, in list context, it will try to extract as many objects
2334 from the stream as it can find and return them, or the empty list
2335 otherwise. For this to work, there must be no separators between the JSON
2336 objects or arrays, instead they must be concatenated back-to-back. If
2337 an error occurs, an exception will be raised as in the scalar context
2338 case. Note that in this case, any previously-parsed JSON texts will be
2341 Example: Parse some JSON arrays/objects in a given string and return them.
2343 my @objs = JSON->new->incr_parse ("[5][7][1,2]");
2347 $lvalue_string = $json->incr_text
2349 This method returns the currently stored JSON fragment as an lvalue, that
2350 is, you can manipulate it. This I<only> works when a preceding call to
2351 C<incr_parse> in I<scalar context> successfully returned an object. Under
2352 all other circumstances you must not call this function (I mean it.
2353 although in simple tests it might actually work, it I<will> fail under
2354 real world conditions). As a special exception, you can also call this
2355 method before having parsed anything.
2357 This function is useful in two cases: a) finding the trailing text after a
2358 JSON object or b) parsing multiple JSON objects separated by non-JSON text
2361 $json->incr_text =~ s/\s*,\s*//;
2363 In Perl 5.005, C<lvalue> attribute is not available.
2364 You must write codes like the below:
2366 $string = $json->incr_text;
2367 $string =~ s/\s*,\s*//;
2368 $json->incr_text( $string );
2374 This will reset the state of the incremental parser and will remove the
2375 parsed text from the input buffer. This is useful after C<incr_parse>
2376 died, in which case the input buffer and incremental parser state is left
2377 unchanged, to skip the text parsed so far and to reset the parse state.
2383 This completely resets the incremental parser, that is, after this call,
2384 it will be as if the parser had never parsed anything.
2386 This is useful if you want to repeatedly parse JSON objects and want to
2387 ignore any trailing data, which means you have to reset the parser after
2388 each successful decode.
2390 See to L<JSON::XS/INCREMENTAL PARSING> for examples.
2393 =head1 JSON::PP OWN METHODS
2395 =head2 allow_singlequote
2397 $json = $json->allow_singlequote([$enable])
2399 If C<$enable> is true (or missing), then C<decode> will accept
2400 JSON strings quoted by single quotations that are invalid JSON
2403 $json->allow_singlequote->decode({"foo":'bar'});
2404 $json->allow_singlequote->decode({'foo':"bar"});
2405 $json->allow_singlequote->decode({'foo':'bar'});
2407 As same as the C<relaxed> option, this option may be used to parse
2408 application-specific files written by humans.
2411 =head2 allow_barekey
2413 $json = $json->allow_barekey([$enable])
2415 If C<$enable> is true (or missing), then C<decode> will accept
2416 bare keys of JSON object that are invalid JSON format.
2418 As same as the C<relaxed> option, this option may be used to parse
2419 application-specific files written by humans.
2421 $json->allow_barekey->decode('{foo:"bar"}');
2425 $json = $json->allow_bignum([$enable])
2427 If C<$enable> is true (or missing), then C<decode> will convert
2428 the big integer Perl cannot handle as integer into a L<Math::BigInt>
2429 object and convert a floating number (any) into a L<Math::BigFloat>.
2431 On the contrary, C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
2432 objects into JSON numbers with C<allow_blessed> enable.
2434 $json->allow_nonref->allow_blessed->allow_bignum;
2435 $bigfloat = $json->decode('2.000000000000000000000000001');
2436 print $json->encode($bigfloat);
2437 # => 2.000000000000000000000000001
2439 See to L<JSON::XS/MAPPING> about the normal conversion of JSON number.
2443 $json = $json->loose([$enable])
2445 The unescaped [\x00-\x1f\x22\x2f\x5c] strings are invalid in JSON strings
2446 and the module doesn't allow to C<decode> to these (except for \x2f).
2447 If C<$enable> is true (or missing), then C<decode> will accept these
2450 $json->loose->decode(qq|["abc
2453 See L<JSON::XS/SSECURITY CONSIDERATIONS>.
2457 $json = $json->escape_slash([$enable])
2459 According to JSON Grammar, I<slash> (U+002F) is escaped. But default
2460 JSON::PP (as same as JSON::XS) encodes strings without escaping slash.
2462 If C<$enable> is true (or missing), then C<encode> will escape slashes.
2464 =head2 indent_length
2466 $json = $json->indent_length($length)
2468 JSON::XS indent space length is 3 and cannot be changed.
2469 JSON::PP set the indent space length with the given $length.
2470 The default is 3. The acceptable range is 0 to 15.
2474 $json = $json->sort_by($function_name)
2475 $json = $json->sort_by($subroutine_ref)
2477 If $function_name or $subroutine_ref are set, its sort routine are used
2478 in encoding JSON objects.
2480 $js = $pc->sort_by(sub { $JSON::PP::a cmp $JSON::PP::b })->encode($obj);
2481 # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
2483 $js = $pc->sort_by('own_sort')->encode($obj);
2484 # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
2486 sub JSON::PP::own_sort { $JSON::PP::a cmp $JSON::PP::b }
2488 As the sorting routine runs in the JSON::PP scope, the given
2489 subroutine name and the special variables C<$a>, C<$b> will begin
2492 If $integer is set, then the effect is same as C<canonical> on.
2506 indent_count => $indent_count,
2520 encoding => $encoding,
2521 is_valid_utf8 => $is_valid_utf8,
2528 This section is copied from JSON::XS and modified to C<JSON::PP>.
2529 JSON::XS and JSON::PP mapping mechanisms are almost equivalent.
2531 See to L<JSON::XS/MAPPING>.
2539 A JSON object becomes a reference to a hash in Perl. No ordering of object
2540 keys is preserved (JSON does not preserver object key ordering itself).
2544 A JSON array becomes a reference to an array in Perl.
2548 A JSON string becomes a string scalar in Perl - Unicode codepoints in JSON
2549 are represented by the same codepoints in the Perl string, so no manual
2550 decoding is necessary.
2554 A JSON number becomes either an integer, numeric (floating point) or
2555 string scalar in perl, depending on its range and any fractional parts. On
2556 the Perl level, there is no difference between those as Perl handles all
2557 the conversion details, but an integer may take slightly less memory and
2558 might represent more values exactly than floating point numbers.
2560 If the number consists of digits only, C<JSON> will try to represent
2561 it as an integer value. If that fails, it will try to represent it as
2562 a numeric (floating point) value if that is possible without loss of
2563 precision. Otherwise it will preserve the number as a string value (in
2564 which case you lose roundtripping ability, as the JSON number will be
2565 re-encoded to a JSON string).
2567 Numbers containing a fractional or exponential part will always be
2568 represented as numeric (floating point) values, possibly at a loss of
2569 precision (in which case you might lose perfect roundtripping ability, but
2570 the JSON number will still be re-encoded as a JSON number).
2572 Note that precision is not accuracy - binary floating point values cannot
2573 represent most decimal fractions exactly, and when converting from and to
2574 floating point, C<JSON> only guarantees precision up to but not including
2575 the least significant bit.
2577 When C<allow_bignum> is enable, the big integers
2578 and the numeric can be optionally converted into L<Math::BigInt> and
2579 L<Math::BigFloat> objects.
2583 These JSON atoms become C<JSON::PP::true> and C<JSON::PP::false>,
2584 respectively. They are overloaded to act almost exactly like the numbers
2585 C<1> and C<0>. You can check whether a scalar is a JSON boolean by using
2586 the C<JSON::is_bool> function.
2588 print JSON::PP::true . "\n";
2590 print JSON::PP::true + 1;
2593 ok(JSON::true eq '1');
2594 ok(JSON::true == 1);
2596 C<JSON> will install these missing overloading features to the backend modules.
2601 A JSON null atom becomes C<undef> in Perl.
2603 C<JSON::PP::null> returns C<undef>.
2610 The mapping from Perl to JSON is slightly more difficult, as Perl is a
2611 truly typeless language, so we can only guess which JSON type is meant by
2616 =item hash references
2618 Perl hash references become JSON objects. As there is no inherent ordering
2619 in hash keys (or JSON objects), they will usually be encoded in a
2620 pseudo-random order that can change between runs of the same program but
2621 stays generally the same within a single run of a program. C<JSON>
2622 optionally sort the hash keys (determined by the I<canonical> flag), so
2623 the same data structure will serialise to the same JSON text (given same
2624 settings and version of JSON::XS), but this incurs a runtime overhead
2625 and is only rarely useful, e.g. when you want to compare some JSON text
2626 against another for equality.
2629 =item array references
2631 Perl array references become JSON arrays.
2633 =item other references
2635 Other unblessed references are generally not allowed and will cause an
2636 exception to be thrown, except for references to the integers C<0> and
2637 C<1>, which get turned into C<false> and C<true> atoms in JSON. You can
2638 also use C<JSON::false> and C<JSON::true> to improve readability.
2640 to_json [\0,JSON::PP::true] # yields [false,true]
2642 =item JSON::PP::true, JSON::PP::false, JSON::PP::null
2644 These special values become JSON true and JSON false values,
2645 respectively. You can also use C<\1> and C<\0> directly if you want.
2647 JSON::PP::null returns C<undef>.
2649 =item blessed objects
2651 Blessed objects are not directly representable in JSON. See the
2652 C<allow_blessed> and C<convert_blessed> methods on various options on
2653 how to deal with this: basically, you can choose between throwing an
2654 exception, encoding the reference as if it weren't blessed, or provide
2655 your own serialiser method.
2657 See to L<convert_blessed>.
2659 =item simple scalars
2661 Simple Perl scalars (any scalar that is not a reference) are the most
2662 difficult objects to encode: JSON::XS and JSON::PP will encode undefined scalars as
2663 JSON C<null> values, scalars that have last been used in a string context
2664 before encoding as JSON strings, and anything else as number value:
2667 encode_json [2] # yields [2]
2668 encode_json [-3.0e17] # yields [-3e+17]
2669 my $value = 5; encode_json [$value] # yields [5]
2671 # used as string, so dump as string
2673 encode_json [$value] # yields ["5"]
2675 # undef becomes null
2676 encode_json [undef] # yields [null]
2678 You can force the type to be a string by stringifying it:
2680 my $x = 3.1; # some variable containing a number
2682 $x .= ""; # another, more awkward way to stringify
2683 print $x; # perl does it for you, too, quite often
2685 You can force the type to be a number by numifying it:
2687 my $x = "3"; # some variable containing a string
2688 $x += 0; # numify it, ensuring it will be dumped as a number
2689 $x *= 1; # same thing, the choice is yours.
2691 You can not currently force the type in other, less obscure, ways.
2693 Note that numerical precision has the same meaning as under Perl (so
2694 binary to decimal conversion follows the same rules as in Perl, which
2695 can differ to other languages). Also, your perl interpreter might expose
2696 extensions to the floating point numbers of your platform, such as
2697 infinities or NaN's - these cannot be represented in JSON, and it is an
2698 error to pass those in.
2702 When C<allow_bignum> is enable,
2703 C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
2704 objects into JSON numbers.
2709 =head1 UNICODE HANDLING ON PERLS
2711 If you do not know about Unicode on Perl well,
2712 please check L<JSON::XS/A FEW NOTES ON UNICODE AND PERL>.
2714 =head2 Perl 5.8 and later
2716 Perl can handle Unicode and the JSON::PP de/encode methods also work properly.
2718 $json->allow_nonref->encode(chr hex 3042);
2719 $json->allow_nonref->encode(chr hex 12345);
2721 Returns C<"\u3042"> and C<"\ud808\udf45"> respectively.
2723 $json->allow_nonref->decode('"\u3042"');
2724 $json->allow_nonref->decode('"\ud808\udf45"');
2726 Returns UTF-8 encoded strings with UTF8 flag, regarded as C<U+3042> and C<U+12345>.
2728 Note that the versions from Perl 5.8.0 to 5.8.2, Perl built-in C<join> was broken,
2729 so JSON::PP wraps the C<join> with a subroutine. Thus JSON::PP works slow in the versions.
2734 Perl can handle Unicode and the JSON::PP de/encode methods also work.
2738 Perl 5.005 is a byte semantics world -- all strings are sequences of bytes.
2739 That means the unicode handling is not available.
2743 $json->allow_nonref->encode(chr hex 3042); # hex 3042 is 12354.
2744 $json->allow_nonref->encode(chr hex 12345); # hex 12345 is 74565.
2746 Returns C<B> and C<E>, as C<chr> takes a value more than 255, it treats
2747 as C<$value % 256>, so the above codes are equivalent to :
2749 $json->allow_nonref->encode(chr 66);
2750 $json->allow_nonref->encode(chr 69);
2754 $json->decode('"\u00e3\u0081\u0082"');
2756 The returned is a byte sequence C<0xE3 0x81 0x82> for UTF-8 encoded
2757 japanese character (C<HIRAGANA LETTER A>).
2758 And if it is represented in Unicode code point, C<U+3042>.
2762 $json->decode('"\u3042"');
2764 We ordinary expect the returned value is a Unicode character C<U+3042>.
2765 But here is 5.005 world. This is C<0xE3 0x81 0x82>.
2767 $json->decode('"\ud808\udf45"');
2769 This is not a character C<U+12345> but bytes - C<0xf0 0x92 0x8d 0x85>.
2785 Most of the document are copied and modified from JSON::XS doc.
2789 RFC4627 (L<http://www.ietf.org/rfc/rfc4627.txt>)
2793 Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
2796 =head1 COPYRIGHT AND LICENSE
2798 Copyright 2007-2012 by Makamaka Hannyaharamitu
2800 This library is free software; you can redistribute it and/or modify
2801 it under the same terms as Perl itself.