1 package # This is JSON::backportPP
15 $JSON::PP
::VERSION
= '2.27200';
17 @JSON::PP
::EXPORT
= qw(encode_json decode_json from_json to_json);
19 # instead of hash-access, i tried index-access for speed.
20 # but this method is not faster than what i expected. so it will be changed.
22 use constant P_ASCII
=> 0;
23 use constant P_LATIN1
=> 1;
24 use constant P_UTF8
=> 2;
25 use constant P_INDENT
=> 3;
26 use constant P_CANONICAL
=> 4;
27 use constant P_SPACE_BEFORE
=> 5;
28 use constant P_SPACE_AFTER
=> 6;
29 use constant P_ALLOW_NONREF
=> 7;
30 use constant P_SHRINK
=> 8;
31 use constant P_ALLOW_BLESSED
=> 9;
32 use constant P_CONVERT_BLESSED
=> 10;
33 use constant P_RELAXED
=> 11;
35 use constant P_LOOSE
=> 12;
36 use constant P_ALLOW_BIGNUM
=> 13;
37 use constant P_ALLOW_BAREKEY
=> 14;
38 use constant P_ALLOW_SINGLEQUOTE
=> 15;
39 use constant P_ESCAPE_SLASH
=> 16;
40 use constant P_AS_NONBLESSED
=> 17;
42 use constant P_ALLOW_UNKNOWN
=> 18;
44 use constant OLD_PERL
=> $] < 5.008 ?
1 : 0;
47 my @xs_compati_bit_properties = qw(
48 latin1 ascii utf8 indent canonical space_before space_after allow_nonref shrink
49 allow_blessed convert_blessed relaxed allow_unknown
51 my @pp_bit_properties = qw(
52 allow_singlequote allow_bignum loose
53 allow_barekey escape_slash as_nonblessed
56 # Perl version check, Unicode handling is enable?
57 # Helper module sets @JSON::PP::_properties.
59 my $helper = $] >= 5.006 ?
'JSON::backportPP::Compat5006' : 'JSON::backportPP::Compat5005';
60 eval qq| require $helper |;
61 if ($@
) { Carp
::croak
$@
; }
64 for my $name (@xs_compati_bit_properties, @pp_bit_properties) {
65 my $flag_name = 'P_' . uc($name);
69 my \
$enable = defined \
$_[1] ? \
$_[1] : 1;
72 \
$_[0]->{PROPS
}->[$flag_name] = 1;
75 \
$_[0]->{PROPS
}->[$flag_name] = 0;
82 \
$_[0]->{PROPS
}->[$flag_name] ?
1 : '';
93 my %encode_allow_method
94 = map {($_ => 1)} qw
/utf8 pretty allow_nonref latin1 self_encode escape_slash
95 allow_blessed convert_blessed indent indent_length allow_bignum
98 my %decode_allow_method
99 = map {($_ => 1)} qw
/utf8 allow_nonref loose allow_singlequote allow_bignum
100 allow_barekey max_size relaxed
/;
105 sub encode_json
($) { # encode
106 ($JSON ||= __PACKAGE__
->new->utf8)->encode(@_);
110 sub decode_json
{ # decode
111 ($JSON ||= __PACKAGE__
->new->utf8)->decode(@_);
117 Carp
::croak
("JSON::PP::to_json has been renamed to encode_json.");
122 Carp
::croak
("JSON::PP::from_json has been renamed to decode_json.");
135 fallback
=> sub { encode_error
('Invalid value. JSON can only reference.') },
144 return $_[0]->PP_encode_json($_[1]);
149 return $_[0]->PP_decode_json($_[1], 0x00000000);
154 return $_[0]->PP_decode_json($_[1], 0x00000001);
165 my $enable = defined $v ?
$v : 1;
167 if ($enable) { # indent_length(3) for JSON::XS compatibility
168 $self->indent(1)->indent_length(3)->space_before(1)->space_after(1);
171 $self->indent(0)->space_before(0)->space_after(0);
180 my $max = defined $_[1] ?
$_[1] : 0x80000000;
181 $_[0]->{max_depth
} = $max;
186 sub get_max_depth
{ $_[0]->{max_depth
}; }
190 my $max = defined $_[1] ?
$_[1] : 0;
191 $_[0]->{max_size
} = $max;
196 sub get_max_size
{ $_[0]->{max_size
}; }
199 sub filter_json_object
{
200 $_[0]->{cb_object
} = defined $_[1] ?
$_[1] : 0;
201 $_[0]->{F_HOOK
} = ($_[0]->{cb_object
} or $_[0]->{cb_sk_object
}) ?
1 : 0;
205 sub filter_json_single_key_object
{
207 $_[0]->{cb_sk_object
}->{$_[1]} = $_[2];
209 $_[0]->{F_HOOK
} = ($_[0]->{cb_object
} or $_[0]->{cb_sk_object
}) ?
1 : 0;
214 if (!defined $_[1] or $_[1] > 15 or $_[1] < 0) {
215 Carp
::carp
"The acceptable range of indent_length() is 0 to 15.";
218 $_[0]->{indent_length
} = $_[1];
223 sub get_indent_length
{
224 $_[0]->{indent_length
};
228 $_[0]->{sort_by
} = defined $_[1] ?
$_[1] : 1;
233 Carp
::carp
("allow_bigint() is obsoleted. use allow_bignum() insted.");
236 ###############################
273 my $idx = $self->{PROPS
};
275 ($ascii, $latin1, $utf8, $indent, $canonical, $space_before, $space_after, $allow_blessed,
276 $convert_blessed, $escape_slash, $bignum, $as_nonblessed)
277 = @
{$idx}[P_ASCII
.. P_SPACE_AFTER
, P_ALLOW_BLESSED
, P_CONVERT_BLESSED
,
278 P_ESCAPE_SLASH
, P_ALLOW_BIGNUM
, P_AS_NONBLESSED
];
280 ($max_depth, $indent_length) = @
{$self}{qw
/max_depth indent_length/};
282 $keysort = $canonical ?
sub { $a cmp $b } : undef;
284 if ($self->{sort_by
}) {
285 $keysort = ref($self->{sort_by
}) eq 'CODE' ?
$self->{sort_by
}
286 : $self->{sort_by
} =~ /\D+/ ?
$self->{sort_by
}
290 encode_error
("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)")
291 if(!ref $obj and !$idx->[ P_ALLOW_NONREF
]);
293 my $str = $self->object_to_json($obj);
295 $str .= "\n" if ( $indent ); # JSON::XS 2.26 compatible
297 unless ($ascii or $latin1 or $utf8) {
301 if ($idx->[ P_SHRINK
]) {
302 utf8
::downgrade
($str, 1);
310 my ($self, $obj) = @_;
311 my $type = ref($obj);
314 return $self->hash_to_json($obj);
316 elsif($type eq 'ARRAY'){
317 return $self->array_to_json($obj);
319 elsif ($type) { # blessed object?
322 return $self->value_to_json($obj) if ( $obj->isa('JSON::PP::Boolean') );
324 if ( $convert_blessed and $obj->can('TO_JSON') ) {
325 my $result = $obj->TO_JSON();
326 if ( defined $result and ref( $result ) ) {
327 if ( refaddr
( $obj ) eq refaddr
( $result ) ) {
328 encode_error
( sprintf(
329 "%s::TO_JSON method returned same object as was passed instead of a new one",
335 return $self->object_to_json( $result );
338 return "$obj" if ( $bignum and _is_bignum
($obj) );
339 return $self->blessed_to_json($obj) if ($allow_blessed and $as_nonblessed); # will be removed.
341 encode_error
( sprintf("encountered object '%s', but neither allow_blessed "
342 . "nor convert_blessed settings are enabled", $obj)
343 ) unless ($allow_blessed);
348 return $self->value_to_json($obj);
352 return $self->value_to_json($obj);
358 my ($self, $obj) = @_;
361 encode_error
("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
362 if (++$depth > $max_depth);
364 my ($pre, $post) = $indent ?
$self->_up_indent() : ('', '');
365 my $del = ($space_before ?
' ' : '') . ':' . ($space_after ?
' ' : '');
367 for my $k ( _sort
( $obj ) ) {
368 if ( OLD_PERL
) { utf8
::decode
($k) } # key for Perl 5.6 / be optimized
369 push @res, string_to_json
( $self, $k )
371 . ( $self->object_to_json( $obj->{$k} ) || $self->value_to_json( $obj->{$k} ) );
375 $self->_down_indent() if ($indent);
377 return '{' . ( @res ?
$pre : '' ) . ( @res ?
join( ",$pre", @res ) . $post : '' ) . '}';
382 my ($self, $obj) = @_;
385 encode_error
("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
386 if (++$depth > $max_depth);
388 my ($pre, $post) = $indent ?
$self->_up_indent() : ('', '');
391 push @res, $self->object_to_json($v) || $self->value_to_json($v);
395 $self->_down_indent() if ($indent);
397 return '[' . ( @res ?
$pre : '' ) . ( @res ?
join( ",$pre", @res ) . $post : '' ) . ']';
402 my ($self, $value) = @_;
404 return 'null' if(!defined $value);
406 my $b_obj = B
::svref_2object
(\
$value); # for round trip problem
407 my $flags = $b_obj->FLAGS;
409 return $value # as is
410 if $flags & ( B
::SVp_IOK
| B
::SVp_NOK
) and !( $flags & B
::SVp_POK
); # SvTYPE is IV or NV?
412 my $type = ref($value);
415 return string_to_json
($self, $value);
417 elsif( blessed
($value) and $value->isa('JSON::PP::Boolean') ){
418 return $$value == 1 ?
'true' : 'false';
421 if ((overload
::StrVal
($value) =~ /=(\w+)/)[0]) {
422 return $self->value_to_json("$value");
425 if ($type eq 'SCALAR' and defined $$value) {
426 return $$value eq '1' ?
'true'
427 : $$value eq '0' ?
'false'
428 : $self->{PROPS
}->[ P_ALLOW_UNKNOWN
] ?
'null'
429 : encode_error
("cannot encode reference to scalar");
432 if ( $self->{PROPS
}->[ P_ALLOW_UNKNOWN
] ) {
436 if ( $type eq 'SCALAR' or $type eq 'REF' ) {
437 encode_error
("cannot encode reference to scalar");
440 encode_error
("encountered $value, but JSON can only represent references to arrays or hashes");
446 return $self->{fallback
}->($value)
447 if ($self->{fallback
} and ref($self->{fallback
}) eq 'CODE');
467 my ($self, $arg) = @_;
469 $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;
470 $arg =~ s/\//\\\
//g if ($escape_slash);
471 $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;
474 $arg = JSON_PP_encode_ascii
($arg);
478 $arg = JSON_PP_encode_latin1
($arg);
485 return '"' . $arg . '"';
489 sub blessed_to_json
{
490 my $reftype = reftype
($_[1]) || '';
491 if ($reftype eq 'HASH') {
492 return $_[0]->hash_to_json($_[1]);
494 elsif ($reftype eq 'ARRAY') {
495 return $_[0]->array_to_json($_[1]);
505 Carp
::croak
"$error";
510 defined $keysort ?
(sort $keysort (keys %{$_[0]})) : keys %{$_[0]};
516 my $space = ' ' x
$indent_length;
518 my ($pre,$post) = ('','');
520 $post = "\n" . $space x
$indent_count;
524 $pre = "\n" . $space x
$indent_count;
530 sub _down_indent
{ $indent_count--; }
536 indent_count
=> $indent_count,
549 sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates
($_));
550 } unpack('U*', $_[0])
561 sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates
($_));
562 } unpack('U*', $_[0])
567 sub _encode_surrogates
{ # from perlunicode
568 my $uni = $_[0] - 0x10000;
569 return ($uni / 0x400 + 0xD800, $uni % 0x400 + 0xDC00);
574 $_[0]->isa('Math::BigInt') or $_[0]->isa('Math::BigFloat');
589 my $int = eval qq| $checkint |;
590 if ($int =~ /[eE]/) {
591 $max_intsize = $d - 1;
599 my %escapes = ( # by Jeremy Muhlich <jmuhlich [at] bitflood.org>
610 my $text; # json data
613 my $len; # text length (changed according to UTF8 or NON UTF8)
615 my $depth; # nest counter
616 my $encoding; # json text encoding
617 my $is_valid_utf8; # temp variable
618 my $utf8_len; # utf8 byte length
620 my $utf8; # must be utf8
621 my $max_depth; # max nest nubmer of objects and arrays
629 my $allow_bigint; # using Math::BigInt
630 my $singlequote; # loosely quoting
632 my $allow_barekey; # bareKey
635 # 0x00000001 .... decode_prefix
636 # 0x10000000 .... incr_parse
639 my ($self, $opt); # $opt is an effective flag during this decode_json.
641 ($self, $text, $opt) = @_;
643 ($at, $ch, $depth) = (0, '', 0);
645 if ( !defined $text or ref $text ) {
646 decode_error
("malformed JSON string, neither array, object, number, string or atom");
649 my $idx = $self->{PROPS
};
651 ($utf8, $relaxed, $loose, $allow_bigint, $allow_barekey, $singlequote)
652 = @
{$idx}[P_UTF8
, P_RELAXED
, P_LOOSE
.. P_ALLOW_SINGLEQUOTE
];
655 utf8
::downgrade
( $text, 1 ) or Carp
::croak
("Wide character in subroutine entry");
658 utf8
::upgrade
( $text );
663 ($max_depth, $max_size, $cb_object, $cb_sk_object, $F_HOOK)
664 = @
{$self}{qw
/max_depth max_size cb_object cb_sk_object F_HOOK/};
668 my $bytes = length $text;
670 sprintf("attempted decode of JSON text of %s bytes size, but max_size is set to %s"
671 , $bytes, $max_size), 1
672 ) if ($bytes > $max_size);
675 # Currently no effect
677 my @octets = unpack('C4', $text);
678 $encoding = ( $octets[0] and $octets[1]) ?
'UTF-8'
679 : (!$octets[0] and $octets[1]) ?
'UTF-16BE'
680 : (!$octets[0] and !$octets[1]) ?
'UTF-32BE'
681 : ( $octets[2] ) ?
'UTF-16LE'
682 : (!$octets[2] ) ?
'UTF-32LE'
685 white
(); # remove head white space
687 my $valid_start = defined $ch; # Is there a first character for JSON structure?
689 my $result = value
();
691 return undef if ( !$result && ( $opt & 0x10000000 ) ); # for incr_parse
693 decode_error
("malformed JSON string, neither array, object, number, string or atom") unless $valid_start;
695 if ( !$idx->[ P_ALLOW_NONREF
] and !ref $result ) {
697 'JSON text must be an object or array (but found number, string, true, false or null,'
698 . ' use allow_nonref to allow this)', 1);
701 Carp
::croak
('something wrong.') if $len < $at; # we won't arrive here.
703 my $consumed = defined $ch ?
$at - 1 : $at; # consumed JSON text length
705 white
(); # remove tail white space
708 return ( $result, $consumed ) if ($opt & 0x00000001); # all right if decode_prefix
709 decode_error
("garbage after JSON object");
712 ( $opt & 0x00000001 ) ?
( $result, $consumed ) : $result;
717 return $ch = undef if($at >= $len);
718 $ch = substr($text, $at++, 1);
724 return if(!defined $ch);
725 return object
() if($ch eq '{');
726 return array
() if($ch eq '[');
727 return string
() if($ch eq '"' or ($singlequote and $ch eq "'"));
728 return number
() if($ch =~ /[0-9]/ or $ch eq '-');
737 ($is_valid_utf8, $utf8_len) = ('', 0);
739 $s = ''; # basically UTF8 flag on
741 if($ch eq '"' or ($singlequote and $ch eq "'")){
744 OUTER
: while( defined(next_chr
()) ){
746 if($ch eq $boundChar){
750 decode_error
("missing low surrogate character in surrogate pair");
753 utf8
::decode
($s) if($is_utf8);
759 if(exists $escapes{$ch}){
762 elsif($ch eq 'u'){ # UNICODE handling
767 last OUTER
if($ch !~ /[0-9a-fA-F]/);
772 if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/) { # UTF-16 high surrogate?
776 elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/) { # UTF-16 low surrogate?
777 unless (defined $utf16) {
778 decode_error
("missing high surrogate character in surrogate pair");
781 $s .= JSON_PP_decode_surrogates
($utf16, $u) || next;
785 if (defined $utf16) {
786 decode_error
("surrogate pair expected");
789 if ( ( my $hex = hex( $u ) ) > 127 ) {
791 $s .= JSON_PP_decode_unicode
($u) || next;
802 decode_error
('illegal backslash escape sequence in string');
809 if ( ord $ch > 127 ) {
811 unless( $ch = is_valid_utf8
($ch) ) {
813 decode_error
("malformed UTF-8 character in JSON string");
816 $at += $utf8_len - 1;
827 if ($ch =~ /[\x00-\x1f\x22\x5c]/) { # '/' ok
829 decode_error
('invalid character encountered while parsing JSON string');
838 decode_error
("unexpected end of string while parsing JSON string");
843 while( defined $ch ){
849 if(defined $ch and $ch eq '/'){
850 1 while(defined(next_chr
()) and $ch ne "\n" and $ch ne "\r");
852 elsif(defined $ch and $ch eq '*'){
857 if(defined(next_chr
()) and $ch eq '/'){
867 decode_error
("Unterminated comment");
874 decode_error
("malformed JSON string, neither array, object, number, string or atom");
878 if ($relaxed and $ch eq '#') { # correctly?
880 $text =~ /\G([^\n]*(?:\r\n|\r|\n|$))/g;
893 my $a = $_[0] || []; # you can use this code to use another array ref object.
895 decode_error
('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
896 if (++$depth > $max_depth);
901 if(defined $ch and $ch eq ']'){
929 if ($relaxed and $ch eq ']') {
938 decode_error
(", or ] expected while parsing array");
943 my $o = $_[0] || {}; # you can use this code to use another hash ref object.
946 decode_error
('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
947 if (++$depth > $max_depth);
951 if(defined $ch and $ch eq '}'){
955 return _json_object_hook
($o);
960 while (defined $ch) {
961 $k = ($allow_barekey and $ch ne '"' and $ch ne "'") ? bareKey
() : string
();
964 if(!defined $ch or $ch ne ':'){
966 decode_error
("':' expected");
973 last if (!defined $ch);
979 return _json_object_hook
($o);
991 if ($relaxed and $ch eq '}') {
995 return _json_object_hook
($o);
1005 decode_error
(", or } expected while parsing object/hash");
1009 sub bareKey
{ # doesn't strictly follow Standard ECMA-262 3rd Edition
1011 while($ch =~ /[^\x00-\x23\x25-\x2F\x3A-\x40\x5B-\x5E\x60\x7B-\x7F]/){
1020 my $word = substr($text,$at-1,4);
1022 if($word eq 'true'){
1025 return $JSON::PP
::true
;
1027 elsif($word eq 'null'){
1032 elsif($word eq 'fals'){
1034 if(substr($text,$at,1) eq 'e'){
1037 return $JSON::PP
::false
;
1041 $at--; # for decode_error report
1043 decode_error
("'null' expected") if ($word =~ /^n/);
1044 decode_error
("'true' expected") if ($word =~ /^t/);
1045 decode_error
("'false' expected") if ($word =~ /^f/);
1046 decode_error
("malformed JSON string, neither array, object, number, string or atom");
1054 # According to RFC4627, hex or oct digts are invalid.
1056 my $peek = substr($text,$at,1);
1057 my $hex = $peek =~ /[xX]/; # 0 or 1
1060 decode_error
("malformed number (leading zero must not be followed by another digit)");
1061 ($n) = ( substr($text, $at+1) =~ /^([0-9a-fA-F]+)/);
1064 ($n) = ( substr($text, $at) =~ /^([0-7]+)/);
1065 if (defined $n and length $n > 1) {
1066 decode_error
("malformed number (leading zero must not be followed by another digit)");
1070 if(defined $n and length($n)){
1071 if (!$hex and length($n) == 1) {
1072 decode_error
("malformed number (leading zero must not be followed by another digit)");
1074 $at += length($n) + $hex;
1076 return $hex ?
hex($n) : oct($n);
1083 if (!defined $ch or $ch !~ /\d/) {
1084 decode_error
("malformed number (no digits after initial minus)");
1088 while(defined $ch and $ch =~ /\d/){
1093 if(defined $ch and $ch eq '.'){
1097 if (!defined $ch or $ch !~ /\d/) {
1098 decode_error
("malformed number (no digits after decimal point)");
1104 while(defined(next_chr
) and $ch =~ /\d/){
1109 if(defined $ch and ($ch eq 'e' or $ch eq 'E')){
1113 if(defined($ch) and ($ch eq '+' or $ch eq '-')){
1116 if (!defined $ch or $ch =~ /\D/) {
1117 decode_error
("malformed number (no digits after exp sign)");
1121 elsif(defined($ch) and $ch =~ /\d/){
1125 decode_error
("malformed number (no digits after exp sign)");
1128 while(defined(next_chr
) and $ch =~ /\d/){
1136 if ($v !~ /[.eE]/ and length $v > $max_intsize) {
1137 if ($allow_bigint) { # from Adam Sussman
1138 require Math
::BigInt
;
1139 return Math
::BigInt
->new($v);
1145 elsif ($allow_bigint) {
1146 require Math
::BigFloat
;
1147 return Math
::BigFloat
->new($v);
1156 $utf8_len = $_[0] =~ /[\x00-\x7F]/ ?
1
1157 : $_[0] =~ /[\xC2-\xDF]/ ?
2
1158 : $_[0] =~ /[\xE0-\xEF]/ ?
3
1159 : $_[0] =~ /[\xF0-\xF4]/ ?
4
1163 return unless $utf8_len;
1165 my $is_valid_utf8 = substr($text, $at - 1, $utf8_len);
1167 return ( $is_valid_utf8 =~ /^(?
:
1169 |[\xC2-\xDF][\x80-\xBF]
1170 |[\xE0][\xA0-\xBF][\x80-\xBF]
1171 |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
1172 |[\xED][\x80-\x9F][\x80-\xBF]
1173 |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
1174 |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
1175 |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
1176 |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
1177 )$/x
) ?
$is_valid_utf8 : '';
1184 my $str = defined $text ?
substr($text, $at) : '';
1186 my $type = $] >= 5.008 ?
'U*'
1188 : utf8
::is_utf8
( $str ) ?
'U*' # 5.6
1192 for my $c ( unpack( $type, $str ) ) { # emulate pv_uni_display() ?
1193 $mess .= $c == 0x07 ?
'\a'
1198 : $c < 0x20 ?
sprintf('\x{%x}', $c)
1199 : $c == 0x5c ?
'\\\\'
1200 : $c < 0x80 ?
chr($c)
1201 : sprintf('\x{%x}', $c)
1203 if ( length $mess >= 20 ) {
1209 unless ( length $mess ) {
1210 $mess = '(end of string)';
1214 $no_rep ?
"$error" : "$error, at character offset $at (before \"$mess\")"
1220 sub _json_object_hook
{
1222 my @ks = keys %{$o};
1224 if ( $cb_sk_object and @ks == 1 and exists $cb_sk_object->{ $ks[0] } and ref $cb_sk_object->{ $ks[0] } ) {
1225 my @val = $cb_sk_object->{ $ks[0] }->( $o->{$ks[0]} );
1231 my @val = $cb_object->($o) if ($cb_object);
1232 if (@val == 0 or @val > 1) {
1248 encoding
=> $encoding,
1249 is_valid_utf8
=> $is_valid_utf8,
1256 sub _decode_surrogates
{ # from perlunicode
1257 my $uni = 0x10000 + (hex($_[0]) - 0xD800) * 0x400 + (hex($_[1]) - 0xDC00);
1258 my $un = pack('U*', $uni);
1259 utf8
::encode
( $un );
1264 sub _decode_unicode
{
1265 my $un = pack('U', hex shift);
1266 utf8
::encode
( $un );
1271 # Setup for various Perl versions (the code from JSON::PP58)
1276 unless ( defined &utf8
::is_utf8
) {
1278 *utf8
::is_utf8
= *Encode
::is_utf8
;
1281 if ( $] >= 5.008 ) {
1282 *JSON
::PP
::JSON_PP_encode_ascii
= \
&_encode_ascii
;
1283 *JSON
::PP
::JSON_PP_encode_latin1
= \
&_encode_latin1
;
1284 *JSON
::PP
::JSON_PP_decode_surrogates
= \
&_decode_surrogates
;
1285 *JSON
::PP
::JSON_PP_decode_unicode
= \
&_decode_unicode
;
1288 if ($] >= 5.008 and $] < 5.008003) { # join() in 5.8.0 - 5.8.2 is broken.
1291 subs
->import('join');
1294 return '' if (@_ < 2);
1297 for (@_) { $str .= $j . $_; }
1304 sub JSON
::PP
::incr_parse
{
1305 local $Carp::CarpLevel
= 1;
1306 ( $_[0]->{_incr_parser
} ||= JSON
::PP
::IncrParser
->new )->incr_parse( @_ );
1310 sub JSON
::PP
::incr_skip
{
1311 ( $_[0]->{_incr_parser
} ||= JSON
::PP
::IncrParser
->new )->incr_skip;
1315 sub JSON
::PP
::incr_reset
{
1316 ( $_[0]->{_incr_parser
} ||= JSON
::PP
::IncrParser
->new )->incr_reset;
1320 sub JSON::PP::incr_text : lvalue {
1321 $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new;
1323 if ( $_[0]->{_incr_parser}->{incr_parsing} ) {
1324 Carp::croak("incr_text can not be called when the incremental parser already started parsing");
1326 $_[0]->{_incr_parser}->{incr_text};
1328 } if ( $] >= 5.006 );
1330 } # Setup for various Perl versions (the code from JSON::PP58)
1333 ###############################
1338 eval 'require Scalar::Util';
1340 *JSON::PP::blessed = \&Scalar::Util::blessed;
1341 *JSON::PP::reftype = \&Scalar::Util::reftype;
1342 *JSON::PP::refaddr = \&Scalar::Util::refaddr;
1344 else{ # This code is from Sclar::Util.
1346 eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';
1347 *JSON::PP::blessed = sub {
1348 local($@, $SIG{__DIE__}, $SIG{__WARN__});
1349 ref($_[0]) ? eval { $_[0]->a_sub_not_likely_to_be_here } : undef;
1360 *JSON
::PP
::reftype
= sub {
1363 return undef unless length(ref($r));
1365 my $t = ref(B
::svref_2object
($r));
1368 exists $tmap{$t} ?
$tmap{$t}
1369 : length(ref($$r)) ?
'REF'
1372 *JSON
::PP
::refaddr
= sub {
1373 return undef unless length(ref($_[0]));
1376 if(defined(my $pkg = blessed
($_[0]))) {
1377 $addr .= bless $_[0], 'Scalar::Util::Fake';
1386 #no warnings 'portable';
1393 # shamely copied and modified from JSON::XS code.
1395 $JSON::PP
::true
= do { bless \
(my $dummy = 1), "JSON::backportPP::Boolean" };
1396 $JSON::PP
::false
= do { bless \
(my $dummy = 0), "JSON::backportPP::Boolean" };
1398 sub is_bool
{ defined $_[0] and UNIVERSAL
::isa
($_[0], "JSON::PP::Boolean"); }
1400 sub true
{ $JSON::PP
::true
}
1401 sub false
{ $JSON::PP
::false
}
1404 ###############################
1406 package JSON
::backportPP
::Boolean
;
1408 @JSON::backportPP
::Boolean
::ISA
= ('JSON::PP::Boolean');
1410 "0+" => sub { ${$_[0]} },
1411 "++" => sub { $_[0] = ${$_[0]} + 1 },
1412 "--" => sub { $_[0] = ${$_[0]} - 1 },
1417 ###############################
1420 JSON
::PP
::IncrParser
;
1424 use constant INCR_M_WS
=> 0; # initial whitespace skipping
1425 use constant INCR_M_STR
=> 1; # inside string
1426 use constant INCR_M_BS
=> 2; # inside backslash
1427 use constant INCR_M_JSON
=> 3; # outside anything, count nesting
1428 use constant INCR_M_C0
=> 4;
1429 use constant INCR_M_C1
=> 5;
1431 $JSON::PP
::IncrParser
::VERSION
= '1.01';
1433 my $unpack_format = $] < 5.006 ?
'C*' : 'U*';
1448 my ( $self, $coder, $text ) = @_;
1450 $self->{incr_text
} = '' unless ( defined $self->{incr_text
} );
1452 if ( defined $text ) {
1453 if ( utf8
::is_utf8
( $text ) and !utf8
::is_utf8
( $self->{incr_text
} ) ) {
1454 utf8
::upgrade
( $self->{incr_text
} ) ;
1455 utf8
::decode
( $self->{incr_text
} ) ;
1457 $self->{incr_text
} .= $text;
1461 my $max_size = $coder->get_max_size;
1463 if ( defined wantarray ) {
1465 $self->{incr_mode
} = INCR_M_WS
unless defined $self->{incr_mode
};
1470 $self->{incr_parsing
} = 1;
1473 push @ret, $self->_incr_parse( $coder, $self->{incr_text
} );
1475 unless ( !$self->{incr_nest
} and $self->{incr_mode
} == INCR_M_JSON
) {
1476 $self->{incr_mode
} = INCR_M_WS
if $self->{incr_mode
} != INCR_M_STR
;
1479 } until ( length $self->{incr_text
} >= $self->{incr_p
} );
1481 $self->{incr_parsing
} = 0;
1485 else { # in scalar context
1486 $self->{incr_parsing
} = 1;
1487 my $obj = $self->_incr_parse( $coder, $self->{incr_text
} );
1488 $self->{incr_parsing
} = 0 if defined $obj; # pointed by Martin J. Evans
1489 return $obj ?
$obj : undef; # $obj is an empty string, parsing was completed.
1498 my ( $self, $coder, $text, $skip ) = @_;
1499 my $p = $self->{incr_p
};
1503 my $len = length $text;
1505 if ( $self->{incr_mode
} == INCR_M_WS
) {
1506 while ( $len > $p ) {
1507 my $s = substr( $text, $p, 1 );
1508 $p++ and next if ( 0x20 >= unpack($unpack_format, $s) );
1509 $self->{incr_mode
} = INCR_M_JSON
;
1514 while ( $len > $p ) {
1515 my $s = substr( $text, $p++, 1 );
1518 if (substr( $text, $p - 2, 1 ) eq '\\' ) {
1522 if ( $self->{incr_mode
} != INCR_M_STR
) {
1523 $self->{incr_mode
} = INCR_M_STR
;
1526 $self->{incr_mode
} = INCR_M_JSON
;
1527 unless ( $self->{incr_nest
} ) {
1533 if ( $self->{incr_mode
} == INCR_M_JSON
) {
1535 if ( $s eq '[' or $s eq '{' ) {
1536 if ( ++$self->{incr_nest
} > $coder->get_max_depth ) {
1537 Carp
::croak
('json text or perl structure exceeds maximum nesting level (max_depth set too low?)');
1540 elsif ( $s eq ']' or $s eq '}' ) {
1541 last if ( --$self->{incr_nest
} <= 0 );
1543 elsif ( $s eq '#' ) {
1544 while ( $len > $p ) {
1545 last if substr( $text, $p++, 1 ) eq "\n";
1553 $self->{incr_p
} = $p;
1555 return if ( $self->{incr_mode
} == INCR_M_STR
and not $self->{incr_nest
} );
1556 return if ( $self->{incr_mode
} == INCR_M_JSON
and $self->{incr_nest
} > 0 );
1558 return '' unless ( length substr( $self->{incr_text
}, 0, $p ) );
1560 local $Carp::CarpLevel
= 2;
1562 $self->{incr_p
} = $restore;
1563 $self->{incr_c
} = $p;
1565 my ( $obj, $tail ) = $coder->PP_decode_json( substr( $self->{incr_text
}, 0, $p ), 0x10000001 );
1567 $self->{incr_text
} = substr( $self->{incr_text
}, $p );
1568 $self->{incr_p
} = 0;
1575 if ( $_[0]->{incr_parsing
} ) {
1576 Carp
::croak
("incr_text can not be called when the incremental parser already started parsing");
1584 $self->{incr_text
} = substr( $self->{incr_text
}, $self->{incr_c
} );
1585 $self->{incr_p
} = 0;
1591 $self->{incr_text
} = undef;
1592 $self->{incr_p
} = 0;
1593 $self->{incr_mode
} = 0;
1594 $self->{incr_nest
} = 0;
1595 $self->{incr_parsing
} = 0;
1598 ###############################
1607 JSON::PP - JSON::XS compatible pure-Perl module.
1613 # exported functions, they croak on error
1614 # and expect/generate UTF-8
1616 $utf8_encoded_json_text = encode_json $perl_hash_or_arrayref;
1617 $perl_hash_or_arrayref = decode_json $utf8_encoded_json_text;
1621 $coder = JSON::PP->new->ascii->pretty->allow_nonref;
1623 $json_text = $json->encode( $perl_scalar );
1624 $perl_scalar = $json->decode( $json_text );
1626 $pretty_printed = $json->pretty->encode( $perl_scalar ); # pretty-printing
1628 # Note that JSON version 2.0 and above will automatically use
1629 # JSON::XS or JSON::PP, so you should be able to just:
1638 L<JSON::XS> 2.27 (~2.30) compatible.
1642 This module is L<JSON::XS> compatible pure Perl module.
1643 (Perl 5.8 or later is recommended)
1645 JSON::XS is the fastest and most proper JSON module on CPAN.
1646 It is written by Marc Lehmann in C, so must be compiled and
1647 installed in the used environment.
1649 JSON::PP is a pure-Perl module and has compatibility to JSON::XS.
1656 =item * correct unicode handling
1658 This module knows how to handle Unicode (depending on Perl version).
1660 See to L<JSON::XS/A FEW NOTES ON UNICODE AND PERL> and L<UNICODE HANDLING ON PERLS>.
1663 =item * round-trip integrity
1665 When you serialise a perl data structure using only data types supported
1666 by JSON and Perl, the deserialised data structure is identical on the Perl
1667 level. (e.g. the string "2.0" doesn't suddenly become "2" just because
1668 it looks like a number). There I<are> minor exceptions to this, read the
1669 MAPPING section below to learn about those.
1672 =item * strict checking of JSON correctness
1674 There is no guessing, no generating of illegal JSON texts by default,
1675 and only JSON is accepted as input by default (the latter is a security feature).
1676 But when some options are set, loose chcking features are available.
1680 =head1 FUNCTIONAL INTERFACE
1682 Some documents are copied and modified from L<JSON::XS/FUNCTIONAL INTERFACE>.
1686 $json_text = encode_json $perl_scalar
1688 Converts the given Perl data structure to a UTF-8 encoded, binary string.
1690 This function call is functionally identical to:
1692 $json_text = JSON::PP->new->utf8->encode($perl_scalar)
1696 $perl_scalar = decode_json $json_text
1698 The opposite of C<encode_json>: expects an UTF-8 (binary) string and tries
1699 to parse that as an UTF-8 encoded JSON text, returning the resulting
1702 This function call is functionally identical to:
1704 $perl_scalar = JSON::PP->new->utf8->decode($json_text)
1706 =head2 JSON::PP::is_bool
1708 $is_boolean = JSON::PP::is_bool($scalar)
1710 Returns true if the passed scalar represents either JSON::PP::true or
1711 JSON::PP::false, two constants that act like C<1> and C<0> respectively
1712 and are also used to represent JSON C<true> and C<false> in Perl strings.
1714 =head2 JSON::PP::true
1716 Returns JSON true value which is blessed object.
1717 It C<isa> JSON::PP::Boolean object.
1719 =head2 JSON::PP::false
1721 Returns JSON false value which is blessed object.
1722 It C<isa> JSON::PP::Boolean object.
1724 =head2 JSON::PP::null
1728 See L<MAPPING>, below, for more information on how JSON values are mapped to
1732 =head1 HOW DO I DECODE A DATA FROM OUTER AND ENCODE TO OUTER
1734 This section supposes that your perl vresion is 5.8 or later.
1736 If you know a JSON text from an outer world - a network, a file content, and so on,
1737 is encoded in UTF-8, you should use C<decode_json> or C<JSON> module object
1738 with C<utf8> enable. And the decoded result will contain UNICODE characters.
1741 my $json = JSON::PP->new->utf8;
1742 my $json_text = CGI->new->param( 'json_data' );
1743 my $perl_scalar = $json->decode( $json_text );
1747 open( my $fh, '<', 'json.data' );
1749 $perl_scalar = decode_json( $json_text );
1751 If an outer data is not encoded in UTF-8, firstly you should C<decode> it.
1755 open( my $fh, '<', 'json.data' );
1756 my $encoding = 'cp932';
1757 my $unicode_json_text = decode( $encoding, <$fh> ); # UNICODE
1759 # or you can write the below code.
1761 # open( my $fh, "<:encoding($encoding)", 'json.data' );
1762 # $unicode_json_text = <$fh>;
1764 In this case, C<$unicode_json_text> is of course UNICODE string.
1765 So you B<cannot> use C<decode_json> nor C<JSON> module object with C<utf8> enable.
1766 Instead of them, you use C<JSON> module object with C<utf8> disable.
1768 $perl_scalar = $json->utf8(0)->decode( $unicode_json_text );
1770 Or C<encode 'utf8'> and C<decode_json>:
1772 $perl_scalar = decode_json( encode( 'utf8', $unicode_json_text ) );
1773 # this way is not efficient.
1775 And now, you want to convert your C<$perl_scalar> into JSON data and
1776 send it to an outer world - a network or a file content, and so on.
1778 Your data usually contains UNICODE strings and you want the converted data to be encoded
1779 in UTF-8, you should use C<encode_json> or C<JSON> module object with C<utf8> enable.
1781 print encode_json( $perl_scalar ); # to a network? file? or display?
1783 print $json->utf8->encode( $perl_scalar );
1785 If C<$perl_scalar> does not contain UNICODE but C<$encoding>-encoded strings
1786 for some reason, then its characters are regarded as B<latin1> for perl
1787 (because it does not concern with your $encoding).
1788 You B<cannot> use C<encode_json> nor C<JSON> module object with C<utf8> enable.
1789 Instead of them, you use C<JSON> module object with C<utf8> disable.
1790 Note that the resulted text is a UNICODE string but no problem to print it.
1792 # $perl_scalar contains $encoding encoded string values
1793 $unicode_json_text = $json->utf8(0)->encode( $perl_scalar );
1794 # $unicode_json_text consists of characters less than 0x100
1795 print $unicode_json_text;
1797 Or C<decode $encoding> all string values and C<encode_json>:
1799 $perl_scalar->{ foo } = decode( $encoding, $perl_scalar->{ foo } );
1800 # ... do it to each string values, then encode_json
1801 $json_text = encode_json( $perl_scalar );
1803 This method is a proper way but probably not efficient.
1805 See to L<Encode>, L<perluniintro>.
1810 Basically, check to L<JSON> or L<JSON::XS>.
1814 $json = JSON::PP->new
1816 Rturns a new JSON::PP object that can be used to de/encode JSON
1819 All boolean flags described below are by default I<disabled>.
1821 The mutators for flags all return the JSON object again and thus calls can
1824 my $json = JSON::PP->new->utf8->space_after->encode({a => [1,2]})
1829 $json = $json->ascii([$enable])
1831 $enabled = $json->get_ascii
1833 If $enable is true (or missing), then the encode method will not generate characters outside
1834 the code range 0..127. Any Unicode characters outside that range will be escaped using either
1835 a single \uXXXX or a double \uHHHH\uLLLLL escape sequence, as per RFC4627.
1836 (See to L<JSON::XS/OBJECT-ORIENTED INTERFACE>).
1838 In Perl 5.005, there is no character having high value (more than 255).
1839 See to L<UNICODE HANDLING ON PERLS>.
1841 If $enable is false, then the encode method will not escape Unicode characters unless
1842 required by the JSON syntax or other flags. This results in a faster and more compact format.
1844 JSON::PP->new->ascii(1)->encode([chr 0x10401])
1849 $json = $json->latin1([$enable])
1851 $enabled = $json->get_latin1
1853 If $enable is true (or missing), then the encode method will encode the resulting JSON
1854 text as latin1 (or iso-8859-1), escaping any characters outside the code range 0..255.
1856 If $enable is false, then the encode method will not escape Unicode characters
1857 unless required by the JSON syntax or other flags.
1859 JSON::XS->new->latin1->encode (["\x{89}\x{abc}"]
1860 => ["\x{89}\\u0abc"] # (perl syntax, U+abc escaped, U+89 not)
1862 See to L<UNICODE HANDLING ON PERLS>.
1866 $json = $json->utf8([$enable])
1868 $enabled = $json->get_utf8
1870 If $enable is true (or missing), then the encode method will encode the JSON result
1871 into UTF-8, as required by many protocols, while the decode method expects to be handled
1872 an UTF-8-encoded string. Please note that UTF-8-encoded strings do not contain any
1873 characters outside the range 0..255, they are thus useful for bytewise/binary I/O.
1875 (In Perl 5.005, any character outside the range 0..255 does not exist.
1876 See to L<UNICODE HANDLING ON PERLS>.)
1878 In future versions, enabling this option might enable autodetection of the UTF-16 and UTF-32
1879 encoding families, as described in RFC4627.
1881 If $enable is false, then the encode method will return the JSON string as a (non-encoded)
1882 Unicode string, while decode expects thus a Unicode string. Any decoding or encoding
1883 (e.g. to UTF-8 or UTF-16) needs to be done yourself, e.g. using the Encode module.
1885 Example, output UTF-16BE-encoded JSON:
1888 $jsontext = encode "UTF-16BE", JSON::PP->new->encode ($object);
1890 Example, decode UTF-32LE-encoded JSON:
1893 $object = JSON::PP->new->decode (decode "UTF-32LE", $jsontext);
1898 $json = $json->pretty([$enable])
1900 This enables (or disables) all of the C<indent>, C<space_before> and
1901 C<space_after> flags in one call to generate the most readable
1902 (or most compact) form possible.
1906 $json->indent->space_before->space_after
1910 $json = $json->indent([$enable])
1912 $enabled = $json->get_indent
1914 The default indent space length is three.
1915 You can use C<indent_length> to change the length.
1919 $json = $json->space_before([$enable])
1921 $enabled = $json->get_space_before
1923 If C<$enable> is true (or missing), then the C<encode> method will add an extra
1924 optional space before the C<:> separating keys from values in JSON objects.
1926 If C<$enable> is false, then the C<encode> method will not add any extra
1927 space at those places.
1929 This setting has no effect when decoding JSON texts.
1931 Example, space_before enabled, space_after and indent disabled:
1937 $json = $json->space_after([$enable])
1939 $enabled = $json->get_space_after
1941 If C<$enable> is true (or missing), then the C<encode> method will add an extra
1942 optional space after the C<:> separating keys from values in JSON objects
1943 and extra whitespace after the C<,> separating key-value pairs and array
1946 If C<$enable> is false, then the C<encode> method will not add any extra
1947 space at those places.
1949 This setting has no effect when decoding JSON texts.
1951 Example, space_before and indent disabled, space_after enabled:
1957 $json = $json->relaxed([$enable])
1959 $enabled = $json->get_relaxed
1961 If C<$enable> is true (or missing), then C<decode> will accept some
1962 extensions to normal JSON syntax (see below). C<encode> will not be
1963 affected in anyway. I<Be aware that this option makes you accept invalid
1964 JSON texts as if they were valid!>. I suggest only to use this option to
1965 parse application-specific files written by humans (configuration files,
1966 resource files etc.)
1968 If C<$enable> is false (the default), then C<decode> will only accept
1971 Currently accepted extensions are:
1975 =item * list items can have an end-comma
1977 JSON I<separates> array elements and key-value pairs with commas. This
1978 can be annoying if you write JSON texts manually and want to be able to
1979 quickly append elements, so this extension accepts comma at the end of
1980 such items not just between them:
1984 2, <- this comma not normally allowed
1988 "k2": "v2", <- this comma not normally allowed
1991 =item * shell-style '#'-comments
1993 Whenever JSON allows whitespace, shell-style comments are additionally
1994 allowed. They are terminated by the first carriage-return or line-feed
1995 character, after which more white-space and comments are allowed.
1998 1, # this comment not allowed in JSON
1999 # neither this one...
2006 $json = $json->canonical([$enable])
2008 $enabled = $json->get_canonical
2010 If C<$enable> is true (or missing), then the C<encode> method will output JSON objects
2011 by sorting their keys. This is adding a comparatively high overhead.
2013 If C<$enable> is false, then the C<encode> method will output key-value
2014 pairs in the order Perl stores them (which will likely change between runs
2015 of the same script).
2017 This option is useful if you want the same data structure to be encoded as
2018 the same JSON text (given the same overall settings). If it is disabled,
2019 the same hash might be encoded differently even if contains the same data,
2020 as key-value pairs have no inherent ordering in Perl.
2022 This setting has no effect when decoding JSON texts.
2024 If you want your own sorting routine, you can give a code referece
2025 or a subroutine name to C<sort_by>. See to C<JSON::PP OWN METHODS>.
2029 $json = $json->allow_nonref([$enable])
2031 $enabled = $json->get_allow_nonref
2033 If C<$enable> is true (or missing), then the C<encode> method can convert a
2034 non-reference into its corresponding string, number or null JSON value,
2035 which is an extension to RFC4627. Likewise, C<decode> will accept those JSON
2036 values instead of croaking.
2038 If C<$enable> is false, then the C<encode> method will croak if it isn't
2039 passed an arrayref or hashref, as JSON texts must either be an object
2040 or array. Likewise, C<decode> will croak if given something that is not a
2041 JSON object or array.
2043 JSON::PP->new->allow_nonref->encode ("Hello, World!")
2046 =head2 allow_unknown
2048 $json = $json->allow_unknown ([$enable])
2050 $enabled = $json->get_allow_unknown
2052 If $enable is true (or missing), then "encode" will *not* throw an
2053 exception when it encounters values it cannot represent in JSON (for
2054 example, filehandles) but instead will encode a JSON "null" value.
2055 Note that blessed objects are not included here and are handled
2056 separately by c<allow_nonref>.
2058 If $enable is false (the default), then "encode" will throw an
2059 exception when it encounters anything it cannot encode as JSON.
2061 This option does not affect "decode" in any way, and it is
2062 recommended to leave it off unless you know your communications
2065 =head2 allow_blessed
2067 $json = $json->allow_blessed([$enable])
2069 $enabled = $json->get_allow_blessed
2071 If C<$enable> is true (or missing), then the C<encode> method will not
2072 barf when it encounters a blessed reference. Instead, the value of the
2073 B<convert_blessed> option will decide whether C<null> (C<convert_blessed>
2074 disabled or no C<TO_JSON> method found) or a representation of the
2075 object (C<convert_blessed> enabled and C<TO_JSON> method found) is being
2076 encoded. Has no effect on C<decode>.
2078 If C<$enable> is false (the default), then C<encode> will throw an
2079 exception when it encounters a blessed object.
2081 =head2 convert_blessed
2083 $json = $json->convert_blessed([$enable])
2085 $enabled = $json->get_convert_blessed
2087 If C<$enable> is true (or missing), then C<encode>, upon encountering a
2088 blessed object, will check for the availability of the C<TO_JSON> method
2089 on the object's class. If found, it will be called in scalar context
2090 and the resulting scalar will be encoded instead of the object. If no
2091 C<TO_JSON> method is found, the value of C<allow_blessed> will decide what
2094 The C<TO_JSON> method may safely call die if it wants. If C<TO_JSON>
2095 returns other blessed objects, those will be handled in the same
2096 way. C<TO_JSON> must take care of not causing an endless recursion cycle
2097 (== crash) in this case. The name of C<TO_JSON> was chosen because other
2098 methods called by the Perl core (== not by the user of the object) are
2099 usually in upper case letters and to avoid collisions with the C<to_json>
2102 This setting does not yet influence C<decode> in any way.
2104 If C<$enable> is false, then the C<allow_blessed> setting will decide what
2105 to do when a blessed object is found.
2107 =head2 filter_json_object
2109 $json = $json->filter_json_object([$coderef])
2111 When C<$coderef> is specified, it will be called from C<decode> each
2112 time it decodes a JSON object. The only argument passed to the coderef
2113 is a reference to the newly-created hash. If the code references returns
2114 a single scalar (which need not be a reference), this value
2115 (i.e. a copy of that scalar to avoid aliasing) is inserted into the
2116 deserialised data structure. If it returns an empty list
2117 (NOTE: I<not> C<undef>, which is a valid scalar), the original deserialised
2118 hash will be inserted. This setting can slow down decoding considerably.
2120 When C<$coderef> is omitted or undefined, any existing callback will
2121 be removed and C<decode> will not change the deserialised hash in any
2124 Example, convert all JSON objects into the integer 5:
2126 my $js = JSON::PP->new->filter_json_object (sub { 5 });
2128 $js->decode ('[{}]'); # the given subroutine takes a hash reference.
2129 # throw an exception because allow_nonref is not enabled
2130 # so a lone 5 is not allowed.
2131 $js->decode ('{"a":1, "b":2}');
2133 =head2 filter_json_single_key_object
2135 $json = $json->filter_json_single_key_object($key [=> $coderef])
2137 Works remotely similar to C<filter_json_object>, but is only called for
2138 JSON objects having a single key named C<$key>.
2140 This C<$coderef> is called before the one specified via
2141 C<filter_json_object>, if any. It gets passed the single value in the JSON
2142 object. If it returns a single value, it will be inserted into the data
2143 structure. If it returns nothing (not even C<undef> but the empty list),
2144 the callback from C<filter_json_object> will be called next, as if no
2145 single-key callback were specified.
2147 If C<$coderef> is omitted or undefined, the corresponding callback will be
2148 disabled. There can only ever be one callback for a given key.
2150 As this callback gets called less often then the C<filter_json_object>
2151 one, decoding speed will not usually suffer as much. Therefore, single-key
2152 objects make excellent targets to serialise Perl objects into, especially
2153 as single-key JSON objects are as close to the type-tagged value concept
2154 as JSON gets (it's basically an ID/VALUE tuple). Of course, JSON does not
2155 support this in any way, so you need to make sure your data never looks
2156 like a serialised Perl hash.
2158 Typical names for the single object key are C<__class_whatever__>, or
2159 C<$__dollars_are_rarely_used__$> or C<}ugly_brace_placement>, or even
2160 things like C<__class_md5sum(classname)__>, to reduce the risk of clashing
2163 Example, decode JSON objects of the form C<< { "__widget__" => <id> } >>
2164 into the corresponding C<< $WIDGET{<id>} >> object:
2166 # return whatever is in $WIDGET{5}:
2169 ->filter_json_single_key_object (__widget__ => sub {
2172 ->decode ('{"__widget__": 5')
2174 # this can be used with a TO_JSON method in some "widget" class
2175 # for serialisation to json:
2176 sub WidgetBase::TO_JSON {
2179 unless ($self->{id}) {
2180 $self->{id} = ..get..some..id..;
2181 $WIDGET{$self->{id}} = $self;
2184 { __widget__ => $self->{id} }
2189 $json = $json->shrink([$enable])
2191 $enabled = $json->get_shrink
2193 In JSON::XS, this flag resizes strings generated by either
2194 C<encode> or C<decode> to their minimum size possible.
2195 It will also try to downgrade any strings to octet-form if possible.
2197 In JSON::PP, it is noop about resizing strings but tries
2198 C<utf8::downgrade> to the returned string by C<encode>.
2201 See to L<JSON::XS/OBJECT-ORIENTED INTERFACE>
2205 $json = $json->max_depth([$maximum_nesting_depth])
2207 $max_depth = $json->get_max_depth
2209 Sets the maximum nesting level (default C<512>) accepted while encoding
2210 or decoding. If a higher nesting level is detected in JSON text or a Perl
2211 data structure, then the encoder and decoder will stop and croak at that
2214 Nesting level is defined by number of hash- or arrayrefs that the encoder
2215 needs to traverse to reach a given point or the number of C<{> or C<[>
2216 characters without their matching closing parenthesis crossed to reach a
2217 given character in a string.
2219 If no argument is given, the highest possible setting will be used, which
2222 See L<JSON::XS/SSECURITY CONSIDERATIONS> for more info on why this is useful.
2224 When a large value (100 or more) was set and it de/encodes a deep nested object/text,
2225 it may raise a warning 'Deep recursion on subroutin' at the perl runtime phase.
2229 $json = $json->max_size([$maximum_string_size])
2231 $max_size = $json->get_max_size
2233 Set the maximum length a JSON text may have (in bytes) where decoding is
2234 being attempted. The default is C<0>, meaning no limit. When C<decode>
2235 is called on a string that is longer then this many bytes, it will not
2236 attempt to decode the string but throw an exception. This setting has no
2237 effect on C<encode> (yet).
2239 If no argument is given, the limit check will be deactivated (same as when
2242 See L<JSON::XS/SSECURITY CONSIDERATIONS> for more info on why this is useful.
2246 $json_text = $json->encode($perl_scalar)
2248 Converts the given Perl data structure (a simple scalar or a reference
2249 to a hash or array) to its JSON representation. Simple scalars will be
2250 converted into JSON string or number sequences, while references to arrays
2251 become JSON arrays and references to hashes become JSON objects. Undefined
2252 Perl values (e.g. C<undef>) become JSON C<null> values.
2253 References to the integers C<0> and C<1> are converted into C<true> and C<false>.
2257 $perl_scalar = $json->decode($json_text)
2259 The opposite of C<encode>: expects a JSON text and tries to parse it,
2260 returning the resulting simple scalar or reference. Croaks on error.
2262 JSON numbers and strings become simple Perl scalars. JSON arrays become
2263 Perl arrayrefs and JSON objects become Perl hashrefs. C<true> becomes
2264 C<1> (C<JSON::true>), C<false> becomes C<0> (C<JSON::false>) and
2265 C<null> becomes C<undef>.
2267 =head2 decode_prefix
2269 ($perl_scalar, $characters) = $json->decode_prefix($json_text)
2271 This works like the C<decode> method, but instead of raising an exception
2272 when there is trailing garbage after the first JSON object, it will
2273 silently stop parsing there and return the number of characters consumed
2276 JSON->new->decode_prefix ("[1] the tail")
2279 =head1 INCREMENTAL PARSING
2281 Most of this section are copied and modified from L<JSON::XS/INCREMENTAL PARSING>.
2283 In some cases, there is the need for incremental parsing of JSON texts.
2284 This module does allow you to parse a JSON stream incrementally.
2285 It does so by accumulating text until it has a full JSON object, which
2286 it then can decode. This process is similar to using C<decode_prefix>
2287 to see if a full JSON object is available, but is much more efficient
2288 (and can be implemented with a minimum of method calls).
2290 This module will only attempt to parse the JSON text once it is sure it
2291 has enough text to get a decisive result, using a very simple but
2292 truly incremental parser. This means that it sometimes won't stop as
2293 early as the full parser, for example, it doesn't detect parenthese
2294 mismatches. The only thing it guarantees is that it starts decoding as
2295 soon as a syntactically valid JSON text has been seen. This means you need
2296 to set resource limits (e.g. C<max_size>) to ensure the parser will stop
2297 parsing in the presence if syntax errors.
2299 The following methods implement this incremental parser.
2303 $json->incr_parse( [$string] ) # void context
2305 $obj_or_undef = $json->incr_parse( [$string] ) # scalar context
2307 @obj_or_empty = $json->incr_parse( [$string] ) # list context
2309 This is the central parsing function. It can both append new text and
2310 extract objects from the stream accumulated so far (both of these
2311 functions are optional).
2313 If C<$string> is given, then this string is appended to the already
2314 existing JSON fragment stored in the C<$json> object.
2316 After that, if the function is called in void context, it will simply
2317 return without doing anything further. This can be used to add more text
2318 in as many chunks as you want.
2320 If the method is called in scalar context, then it will try to extract
2321 exactly I<one> JSON object. If that is successful, it will return this
2322 object, otherwise it will return C<undef>. If there is a parse error,
2323 this method will croak just as C<decode> would do (one can then use
2324 C<incr_skip> to skip the errornous part). This is the most common way of
2327 And finally, in list context, it will try to extract as many objects
2328 from the stream as it can find and return them, or the empty list
2329 otherwise. For this to work, there must be no separators between the JSON
2330 objects or arrays, instead they must be concatenated back-to-back. If
2331 an error occurs, an exception will be raised as in the scalar context
2332 case. Note that in this case, any previously-parsed JSON texts will be
2335 Example: Parse some JSON arrays/objects in a given string and return them.
2337 my @objs = JSON->new->incr_parse ("[5][7][1,2]");
2341 $lvalue_string = $json->incr_text
2343 This method returns the currently stored JSON fragment as an lvalue, that
2344 is, you can manipulate it. This I<only> works when a preceding call to
2345 C<incr_parse> in I<scalar context> successfully returned an object. Under
2346 all other circumstances you must not call this function (I mean it.
2347 although in simple tests it might actually work, it I<will> fail under
2348 real world conditions). As a special exception, you can also call this
2349 method before having parsed anything.
2351 This function is useful in two cases: a) finding the trailing text after a
2352 JSON object or b) parsing multiple JSON objects separated by non-JSON text
2355 $json->incr_text =~ s/\s*,\s*//;
2357 In Perl 5.005, C<lvalue> attribute is not available.
2358 You must write codes like the below:
2360 $string = $json->incr_text;
2361 $string =~ s/\s*,\s*//;
2362 $json->incr_text( $string );
2368 This will reset the state of the incremental parser and will remove the
2369 parsed text from the input buffer. This is useful after C<incr_parse>
2370 died, in which case the input buffer and incremental parser state is left
2371 unchanged, to skip the text parsed so far and to reset the parse state.
2377 This completely resets the incremental parser, that is, after this call,
2378 it will be as if the parser had never parsed anything.
2380 This is useful if you want ot repeatedly parse JSON objects and want to
2381 ignore any trailing data, which means you have to reset the parser after
2382 each successful decode.
2384 See to L<JSON::XS/INCREMENTAL PARSING> for examples.
2387 =head1 JSON::PP OWN METHODS
2389 =head2 allow_singlequote
2391 $json = $json->allow_singlequote([$enable])
2393 If C<$enable> is true (or missing), then C<decode> will accept
2394 JSON strings quoted by single quotations that are invalid JSON
2397 $json->allow_singlequote->decode({"foo":'bar'});
2398 $json->allow_singlequote->decode({'foo':"bar"});
2399 $json->allow_singlequote->decode({'foo':'bar'});
2401 As same as the C<relaxed> option, this option may be used to parse
2402 application-specific files written by humans.
2405 =head2 allow_barekey
2407 $json = $json->allow_barekey([$enable])
2409 If C<$enable> is true (or missing), then C<decode> will accept
2410 bare keys of JSON object that are invalid JSON format.
2412 As same as the C<relaxed> option, this option may be used to parse
2413 application-specific files written by humans.
2415 $json->allow_barekey->decode('{foo:"bar"}');
2419 $json = $json->allow_bignum([$enable])
2421 If C<$enable> is true (or missing), then C<decode> will convert
2422 the big integer Perl cannot handle as integer into a L<Math::BigInt>
2423 object and convert a floating number (any) into a L<Math::BigFloat>.
2425 On the contary, C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
2426 objects into JSON numbers with C<allow_blessed> enable.
2428 $json->allow_nonref->allow_blessed->allow_bignum;
2429 $bigfloat = $json->decode('2.000000000000000000000000001');
2430 print $json->encode($bigfloat);
2431 # => 2.000000000000000000000000001
2433 See to L<JSON::XS/MAPPING> aboout the normal conversion of JSON number.
2437 $json = $json->loose([$enable])
2439 The unescaped [\x00-\x1f\x22\x2f\x5c] strings are invalid in JSON strings
2440 and the module doesn't allow to C<decode> to these (except for \x2f).
2441 If C<$enable> is true (or missing), then C<decode> will accept these
2444 $json->loose->decode(qq|["abc
2447 See L<JSON::XS/SSECURITY CONSIDERATIONS>.
2451 $json = $json->escape_slash([$enable])
2453 According to JSON Grammar, I<slash> (U+002F) is escaped. But default
2454 JSON::PP (as same as JSON::XS) encodes strings without escaping slash.
2456 If C<$enable> is true (or missing), then C<encode> will escape slashes.
2458 =head2 indent_length
2460 $json = $json->indent_length($length)
2462 JSON::XS indent space length is 3 and cannot be changed.
2463 JSON::PP set the indent space length with the given $length.
2464 The default is 3. The acceptable range is 0 to 15.
2468 $json = $json->sort_by($function_name)
2469 $json = $json->sort_by($subroutine_ref)
2471 If $function_name or $subroutine_ref are set, its sort routine are used
2472 in encoding JSON objects.
2474 $js = $pc->sort_by(sub { $JSON::PP::a cmp $JSON::PP::b })->encode($obj);
2475 # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
2477 $js = $pc->sort_by('own_sort')->encode($obj);
2478 # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
2480 sub JSON::PP::own_sort { $JSON::PP::a cmp $JSON::PP::b }
2482 As the sorting routine runs in the JSON::PP scope, the given
2483 subroutine name and the special variables C<$a>, C<$b> will begin
2486 If $integer is set, then the effect is same as C<canonical> on.
2500 indent_count => $indent_count,
2514 encoding => $encoding,
2515 is_valid_utf8 => $is_valid_utf8,
2522 This section is copied from JSON::XS and modified to C<JSON::PP>.
2523 JSON::XS and JSON::PP mapping mechanisms are almost equivalent.
2525 See to L<JSON::XS/MAPPING>.
2533 A JSON object becomes a reference to a hash in Perl. No ordering of object
2534 keys is preserved (JSON does not preserver object key ordering itself).
2538 A JSON array becomes a reference to an array in Perl.
2542 A JSON string becomes a string scalar in Perl - Unicode codepoints in JSON
2543 are represented by the same codepoints in the Perl string, so no manual
2544 decoding is necessary.
2548 A JSON number becomes either an integer, numeric (floating point) or
2549 string scalar in perl, depending on its range and any fractional parts. On
2550 the Perl level, there is no difference between those as Perl handles all
2551 the conversion details, but an integer may take slightly less memory and
2552 might represent more values exactly than floating point numbers.
2554 If the number consists of digits only, C<JSON> will try to represent
2555 it as an integer value. If that fails, it will try to represent it as
2556 a numeric (floating point) value if that is possible without loss of
2557 precision. Otherwise it will preserve the number as a string value (in
2558 which case you lose roundtripping ability, as the JSON number will be
2559 re-encoded toa JSON string).
2561 Numbers containing a fractional or exponential part will always be
2562 represented as numeric (floating point) values, possibly at a loss of
2563 precision (in which case you might lose perfect roundtripping ability, but
2564 the JSON number will still be re-encoded as a JSON number).
2566 Note that precision is not accuracy - binary floating point values cannot
2567 represent most decimal fractions exactly, and when converting from and to
2568 floating point, C<JSON> only guarantees precision up to but not including
2569 the leats significant bit.
2571 When C<allow_bignum> is enable, the big integers
2572 and the numeric can be optionally converted into L<Math::BigInt> and
2573 L<Math::BigFloat> objects.
2577 These JSON atoms become C<JSON::PP::true> and C<JSON::PP::false>,
2578 respectively. They are overloaded to act almost exactly like the numbers
2579 C<1> and C<0>. You can check wether a scalar is a JSON boolean by using
2580 the C<JSON::is_bool> function.
2582 print JSON::PP::true . "\n";
2584 print JSON::PP::true + 1;
2587 ok(JSON::true eq '1');
2588 ok(JSON::true == 1);
2590 C<JSON> will install these missing overloading features to the backend modules.
2595 A JSON null atom becomes C<undef> in Perl.
2597 C<JSON::PP::null> returns C<unddef>.
2604 The mapping from Perl to JSON is slightly more difficult, as Perl is a
2605 truly typeless language, so we can only guess which JSON type is meant by
2610 =item hash references
2612 Perl hash references become JSON objects. As there is no inherent ordering
2613 in hash keys (or JSON objects), they will usually be encoded in a
2614 pseudo-random order that can change between runs of the same program but
2615 stays generally the same within a single run of a program. C<JSON>
2616 optionally sort the hash keys (determined by the I<canonical> flag), so
2617 the same datastructure will serialise to the same JSON text (given same
2618 settings and version of JSON::XS), but this incurs a runtime overhead
2619 and is only rarely useful, e.g. when you want to compare some JSON text
2620 against another for equality.
2623 =item array references
2625 Perl array references become JSON arrays.
2627 =item other references
2629 Other unblessed references are generally not allowed and will cause an
2630 exception to be thrown, except for references to the integers C<0> and
2631 C<1>, which get turned into C<false> and C<true> atoms in JSON. You can
2632 also use C<JSON::false> and C<JSON::true> to improve readability.
2634 to_json [\0,JSON::PP::true] # yields [false,true]
2636 =item JSON::PP::true, JSON::PP::false, JSON::PP::null
2638 These special values become JSON true and JSON false values,
2639 respectively. You can also use C<\1> and C<\0> directly if you want.
2641 JSON::PP::null returns C<undef>.
2643 =item blessed objects
2645 Blessed objects are not directly representable in JSON. See the
2646 C<allow_blessed> and C<convert_blessed> methods on various options on
2647 how to deal with this: basically, you can choose between throwing an
2648 exception, encoding the reference as if it weren't blessed, or provide
2649 your own serialiser method.
2651 See to L<convert_blessed>.
2653 =item simple scalars
2655 Simple Perl scalars (any scalar that is not a reference) are the most
2656 difficult objects to encode: JSON::XS and JSON::PP will encode undefined scalars as
2657 JSON C<null> values, scalars that have last been used in a string context
2658 before encoding as JSON strings, and anything else as number value:
2661 encode_json [2] # yields [2]
2662 encode_json [-3.0e17] # yields [-3e+17]
2663 my $value = 5; encode_json [$value] # yields [5]
2665 # used as string, so dump as string
2667 encode_json [$value] # yields ["5"]
2669 # undef becomes null
2670 encode_json [undef] # yields [null]
2672 You can force the type to be a string by stringifying it:
2674 my $x = 3.1; # some variable containing a number
2676 $x .= ""; # another, more awkward way to stringify
2677 print $x; # perl does it for you, too, quite often
2679 You can force the type to be a number by numifying it:
2681 my $x = "3"; # some variable containing a string
2682 $x += 0; # numify it, ensuring it will be dumped as a number
2683 $x *= 1; # same thing, the choise is yours.
2685 You can not currently force the type in other, less obscure, ways.
2687 Note that numerical precision has the same meaning as under Perl (so
2688 binary to decimal conversion follows the same rules as in Perl, which
2689 can differ to other languages). Also, your perl interpreter might expose
2690 extensions to the floating point numbers of your platform, such as
2691 infinities or NaN's - these cannot be represented in JSON, and it is an
2692 error to pass those in.
2696 When C<allow_bignum> is enable,
2697 C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
2698 objects into JSON numbers.
2703 =head1 UNICODE HANDLING ON PERLS
2705 If you do not know about Unicode on Perl well,
2706 please check L<JSON::XS/A FEW NOTES ON UNICODE AND PERL>.
2708 =head2 Perl 5.8 and later
2710 Perl can handle Unicode and the JSON::PP de/encode methods also work properly.
2712 $json->allow_nonref->encode(chr hex 3042);
2713 $json->allow_nonref->encode(chr hex 12345);
2715 Reuturns C<"\u3042"> and C<"\ud808\udf45"> respectively.
2717 $json->allow_nonref->decode('"\u3042"');
2718 $json->allow_nonref->decode('"\ud808\udf45"');
2720 Returns UTF-8 encoded strings with UTF8 flag, regarded as C<U+3042> and C<U+12345>.
2722 Note that the versions from Perl 5.8.0 to 5.8.2, Perl built-in C<join> was broken,
2723 so JSON::PP wraps the C<join> with a subroutine. Thus JSON::PP works slow in the versions.
2728 Perl can handle Unicode and the JSON::PP de/encode methods also work.
2732 Perl 5.005 is a byte sementics world -- all strings are sequences of bytes.
2733 That means the unicode handling is not available.
2737 $json->allow_nonref->encode(chr hex 3042); # hex 3042 is 12354.
2738 $json->allow_nonref->encode(chr hex 12345); # hex 12345 is 74565.
2740 Returns C<B> and C<E>, as C<chr> takes a value more than 255, it treats
2741 as C<$value % 256>, so the above codes are equivalent to :
2743 $json->allow_nonref->encode(chr 66);
2744 $json->allow_nonref->encode(chr 69);
2748 $json->decode('"\u00e3\u0081\u0082"');
2750 The returned is a byte sequence C<0xE3 0x81 0x82> for UTF-8 encoded
2751 japanese character (C<HIRAGANA LETTER A>).
2752 And if it is represented in Unicode code point, C<U+3042>.
2756 $json->decode('"\u3042"');
2758 We ordinary expect the returned value is a Unicode character C<U+3042>.
2759 But here is 5.005 world. This is C<0xE3 0x81 0x82>.
2761 $json->decode('"\ud808\udf45"');
2763 This is not a character C<U+12345> but bytes - C<0xf0 0x92 0x8d 0x85>.
2779 Most of the document are copied and modified from JSON::XS doc.
2783 RFC4627 (L<http://www.ietf.org/rfc/rfc4627.txt>)
2787 Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
2790 =head1 COPYRIGHT AND LICENSE
2792 Copyright 2007-2011 by Makamaka Hannyaharamitu
2794 This library is free software; you can redistribute it and/or modify
2795 it under the same terms as Perl itself.