9 BEGIN { @JSON::PP
::ISA
= ('Exporter') }
12 use JSON
::PP
::Boolean
;
17 $JSON::PP
::VERSION
= '4.02';
19 @JSON::PP
::EXPORT
= qw(encode_json decode_json from_json to_json);
21 # instead of hash-access, i tried index-access for speed.
22 # but this method is not faster than what i expected. so it will be changed.
24 use constant P_ASCII
=> 0;
25 use constant P_LATIN1
=> 1;
26 use constant P_UTF8
=> 2;
27 use constant P_INDENT
=> 3;
28 use constant P_CANONICAL
=> 4;
29 use constant P_SPACE_BEFORE
=> 5;
30 use constant P_SPACE_AFTER
=> 6;
31 use constant P_ALLOW_NONREF
=> 7;
32 use constant P_SHRINK
=> 8;
33 use constant P_ALLOW_BLESSED
=> 9;
34 use constant P_CONVERT_BLESSED
=> 10;
35 use constant P_RELAXED
=> 11;
37 use constant P_LOOSE
=> 12;
38 use constant P_ALLOW_BIGNUM
=> 13;
39 use constant P_ALLOW_BAREKEY
=> 14;
40 use constant P_ALLOW_SINGLEQUOTE
=> 15;
41 use constant P_ESCAPE_SLASH
=> 16;
42 use constant P_AS_NONBLESSED
=> 17;
44 use constant P_ALLOW_UNKNOWN
=> 18;
45 use constant P_ALLOW_TAGS
=> 19;
47 use constant OLD_PERL
=> $] < 5.008 ?
1 : 0;
48 use constant USE_B
=> $ENV{PERL_JSON_PP_USE_B
} || 0;
57 my @xs_compati_bit_properties = qw(
58 latin1 ascii utf8 indent canonical space_before space_after allow_nonref shrink
59 allow_blessed convert_blessed relaxed allow_unknown
62 my @pp_bit_properties = qw(
63 allow_singlequote allow_bignum loose
64 allow_barekey escape_slash as_nonblessed
67 # Perl version check, Unicode handling is enabled?
68 # Helper module sets @JSON::PP::_properties.
70 my $helper = $] >= 5.006 ?
'JSON::PP::Compat5006' : 'JSON::PP::Compat5005';
71 eval qq| require $helper |;
72 if ($@
) { Carp
::croak
$@
; }
75 for my $name (@xs_compati_bit_properties, @pp_bit_properties) {
76 my $property_id = 'P_' . uc($name);
80 my \
$enable = defined \
$_[1] ? \
$_[1] : 1;
83 \
$_[0]->{PROPS
}->[$property_id] = 1;
86 \
$_[0]->{PROPS
}->[$property_id] = 0;
93 \
$_[0]->{PROPS
}->[$property_id] ?
1 : '';
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.");
137 $self->{PROPS
}[P_ALLOW_NONREF
] = 1;
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)->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
}; }
201 my ($false, $true) = @_;
202 $self->{false
} = $false;
203 $self->{true
} = $true;
204 return ($false, $true);
206 delete $self->{false
};
207 delete $self->{true
};
212 sub get_boolean_values
{
214 if (exists $self->{true
} and exists $self->{false
}) {
215 return @
$self{qw
/false true/};
220 sub filter_json_object
{
221 if (defined $_[1] and ref $_[1] eq 'CODE') {
222 $_[0]->{cb_object
} = $_[1];
224 delete $_[0]->{cb_object
};
226 $_[0]->{F_HOOK
} = ($_[0]->{cb_object
} or $_[0]->{cb_sk_object
}) ?
1 : 0;
230 sub filter_json_single_key_object
{
231 if (@_ == 1 or @_ > 3) {
232 Carp
::croak
("Usage: JSON::PP::filter_json_single_key_object(self, key, callback = undef)");
234 if (defined $_[2] and ref $_[2] eq 'CODE') {
235 $_[0]->{cb_sk_object
}->{$_[1]} = $_[2];
237 delete $_[0]->{cb_sk_object
}->{$_[1]};
238 delete $_[0]->{cb_sk_object
} unless %{$_[0]->{cb_sk_object
} || {}};
240 $_[0]->{F_HOOK
} = ($_[0]->{cb_object
} or $_[0]->{cb_sk_object
}) ?
1 : 0;
245 if (!defined $_[1] or $_[1] > 15 or $_[1] < 0) {
246 Carp
::carp
"The acceptable range of indent_length() is 0 to 15.";
249 $_[0]->{indent_length
} = $_[1];
254 sub get_indent_length
{
255 $_[0]->{indent_length
};
259 $_[0]->{sort_by
} = defined $_[1] ?
$_[1] : 1;
264 Carp
::carp
("allow_bigint() is obsoleted. use allow_bignum() instead.");
268 ###############################
306 my $props = $self->{PROPS
};
308 ($ascii, $latin1, $utf8, $indent, $canonical, $space_before, $space_after, $allow_blessed,
309 $convert_blessed, $escape_slash, $bignum, $as_nonblessed, $allow_tags)
310 = @
{$props}[P_ASCII
.. P_SPACE_AFTER
, P_ALLOW_BLESSED
, P_CONVERT_BLESSED
,
311 P_ESCAPE_SLASH
, P_ALLOW_BIGNUM
, P_AS_NONBLESSED
, P_ALLOW_TAGS
];
313 ($max_depth, $indent_length) = @
{$self}{qw
/max_depth indent_length/};
315 $keysort = $canonical ?
sub { $a cmp $b } : undef;
317 if ($self->{sort_by
}) {
318 $keysort = ref($self->{sort_by
}) eq 'CODE' ?
$self->{sort_by
}
319 : $self->{sort_by
} =~ /\D+/ ?
$self->{sort_by
}
323 encode_error
("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)")
324 if(!ref $obj and !$props->[ P_ALLOW_NONREF
]);
326 my $str = $self->object_to_json($obj);
328 $str .= "\n" if ( $indent ); # JSON::XS 2.26 compatible
330 unless ($ascii or $latin1 or $utf8) {
334 if ($props->[ P_SHRINK
]) {
335 utf8
::downgrade
($str, 1);
343 my ($self, $obj) = @_;
344 my $type = ref($obj);
347 return $self->hash_to_json($obj);
349 elsif($type eq 'ARRAY'){
350 return $self->array_to_json($obj);
352 elsif ($type) { # blessed object?
355 return $self->value_to_json($obj) if ( $obj->isa('JSON::PP::Boolean') );
357 if ( $allow_tags and $obj->can('FREEZE') ) {
358 my $obj_class = ref $obj || $obj;
359 $obj = bless $obj, $obj_class;
360 my @results = $obj->FREEZE('JSON');
361 if ( @results and ref $results[0] ) {
362 if ( refaddr
( $obj ) eq refaddr
( $results[0] ) ) {
363 encode_error
( sprintf(
364 "%s::FREEZE method returned same object as was passed instead of a new one",
369 return '("'.$obj_class.'")['.join(',', @results).']';
372 if ( $convert_blessed and $obj->can('TO_JSON') ) {
373 my $result = $obj->TO_JSON();
374 if ( defined $result and ref( $result ) ) {
375 if ( refaddr
( $obj ) eq refaddr
( $result ) ) {
376 encode_error
( sprintf(
377 "%s::TO_JSON method returned same object as was passed instead of a new one",
383 return $self->object_to_json( $result );
386 return "$obj" if ( $bignum and _is_bignum
($obj) );
388 if ($allow_blessed) {
389 return $self->blessed_to_json($obj) if ($as_nonblessed); # will be removed.
392 encode_error
( sprintf("encountered object '%s', but neither allow_blessed, convert_blessed nor allow_tags settings are enabled (or TO_JSON/FREEZE method missing)", $obj)
396 return $self->value_to_json($obj);
400 return $self->value_to_json($obj);
406 my ($self, $obj) = @_;
409 encode_error
("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
410 if (++$depth > $max_depth);
412 my ($pre, $post) = $indent ?
$self->_up_indent() : ('', '');
413 my $del = ($space_before ?
' ' : '') . ':' . ($space_after ?
' ' : '');
415 for my $k ( _sort
( $obj ) ) {
416 if ( OLD_PERL
) { utf8
::decode
($k) } # key for Perl 5.6 / be optimized
417 push @res, $self->string_to_json( $k )
419 . ( ref $obj->{$k} ?
$self->object_to_json( $obj->{$k} ) : $self->value_to_json( $obj->{$k} ) );
423 $self->_down_indent() if ($indent);
425 return '{}' unless @res;
426 return '{' . $pre . join( ",$pre", @res ) . $post . '}';
431 my ($self, $obj) = @_;
434 encode_error
("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
435 if (++$depth > $max_depth);
437 my ($pre, $post) = $indent ?
$self->_up_indent() : ('', '');
440 push @res, ref($v) ?
$self->object_to_json($v) : $self->value_to_json($v);
444 $self->_down_indent() if ($indent);
446 return '[]' unless @res;
447 return '[' . $pre . join( ",$pre", @res ) . $post . ']';
450 sub _looks_like_number
{
453 my $b_obj = B
::svref_2object
(\
$value);
454 my $flags = $b_obj->FLAGS;
455 return 1 if $flags & ( B
::SVp_IOK
() | B
::SVp_NOK
() ) and !( $flags & B
::SVp_POK
() );
458 no warnings
'numeric';
459 # if the utf8 flag is on, it almost certainly started as a string
460 return if utf8
::is_utf8
($value);
463 # number & "" -> 0 (with warning)
464 # nan and inf can detect as numbers, so check with * 0
465 return unless length((my $dummy = "") & $value);
466 return unless 0 + $value eq $value;
467 return 1 if $value * 0 == 0;
473 my ($self, $value) = @_;
475 return 'null' if(!defined $value);
477 my $type = ref($value);
480 if (_looks_like_number
($value)) {
483 return $self->string_to_json($value);
485 elsif( blessed
($value) and $value->isa('JSON::PP::Boolean') ){
486 return $$value == 1 ?
'true' : 'false';
489 if ((overload
::StrVal
($value) =~ /=(\w+)/)[0]) {
490 return $self->value_to_json("$value");
493 if ($type eq 'SCALAR' and defined $$value) {
494 return $$value eq '1' ?
'true'
495 : $$value eq '0' ?
'false'
496 : $self->{PROPS
}->[ P_ALLOW_UNKNOWN
] ?
'null'
497 : encode_error
("cannot encode reference to scalar");
500 if ( $self->{PROPS
}->[ P_ALLOW_UNKNOWN
] ) {
504 if ( $type eq 'SCALAR' or $type eq 'REF' ) {
505 encode_error
("cannot encode reference to scalar");
508 encode_error
("encountered $value, but JSON can only represent references to arrays or hashes");
529 my ($self, $arg) = @_;
531 $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;
532 $arg =~ s/\//\\\
//g if ($escape_slash);
533 $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;
536 $arg = JSON_PP_encode_ascii
($arg);
540 $arg = JSON_PP_encode_latin1
($arg);
547 return '"' . $arg . '"';
551 sub blessed_to_json
{
552 my $reftype = reftype
($_[1]) || '';
553 if ($reftype eq 'HASH') {
554 return $_[0]->hash_to_json($_[1]);
556 elsif ($reftype eq 'ARRAY') {
557 return $_[0]->array_to_json($_[1]);
567 Carp
::croak
"$error";
572 defined $keysort ?
(sort $keysort (keys %{$_[0]})) : keys %{$_[0]};
578 my $space = ' ' x
$indent_length;
580 my ($pre,$post) = ('','');
582 $post = "\n" . $space x
$indent_count;
586 $pre = "\n" . $space x
$indent_count;
592 sub _down_indent
{ $indent_count--; }
598 indent_count
=> $indent_count,
611 sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates
($_));
612 } unpack('U*', $_[0])
623 sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates
($_));
624 } unpack('U*', $_[0])
629 sub _encode_surrogates
{ # from perlunicode
630 my $uni = $_[0] - 0x10000;
631 return ($uni / 0x400 + 0xD800, $uni % 0x400 + 0xDC00);
636 $_[0]->isa('Math::BigInt') or $_[0]->isa('Math::BigFloat');
651 my $int = eval qq| $checkint |;
652 if ($int =~ /[eE]/) {
653 $max_intsize = $d - 1;
661 my %escapes = ( # by Jeremy Muhlich <jmuhlich [at] bitflood.org>
672 my $text; # json data
674 my $ch; # first character
675 my $len; # text length (changed according to UTF8 or NON UTF8)
677 my $depth; # nest counter
678 my $encoding; # json text encoding
679 my $is_valid_utf8; # temp variable
680 my $utf8_len; # utf8 byte length
682 my $utf8; # must be utf8
683 my $max_depth; # max nest number of objects and arrays
691 my $allow_bignum; # using Math::BigInt/BigFloat
692 my $singlequote; # loosely quoting
694 my $allow_barekey; # bareKey
700 sub _detect_utf_encoding
{
702 my @octets = unpack('C4', $text);
703 return 'unknown' unless defined $octets[3];
704 return ( $octets[0] and $octets[1]) ?
'UTF-8'
705 : (!$octets[0] and $octets[1]) ?
'UTF-16BE'
706 : (!$octets[0] and !$octets[1]) ?
'UTF-32BE'
707 : ( $octets[2] ) ?
'UTF-16LE'
708 : (!$octets[2] ) ?
'UTF-32LE'
713 my ($self, $want_offset);
715 ($self, $text, $want_offset) = @_;
717 ($at, $ch, $depth) = (0, '', 0);
719 if ( !defined $text or ref $text ) {
720 decode_error
("malformed JSON string, neither array, object, number, string or atom");
723 my $props = $self->{PROPS
};
725 ($utf8, $relaxed, $loose, $allow_bignum, $allow_barekey, $singlequote, $allow_tags)
726 = @
{$props}[P_UTF8
, P_RELAXED
, P_LOOSE
.. P_ALLOW_SINGLEQUOTE
, P_ALLOW_TAGS
];
728 ($alt_true, $alt_false) = @
$self{qw
/true false/};
731 $encoding = _detect_utf_encoding
($text);
732 if ($encoding ne 'UTF-8' and $encoding ne 'unknown') {
734 Encode
::from_to
($text, $encoding, 'utf-8');
736 utf8
::downgrade
( $text, 1 ) or Carp
::croak
("Wide character in subroutine entry");
740 utf8
::upgrade
( $text );
741 utf8
::encode
( $text );
746 ($max_depth, $max_size, $cb_object, $cb_sk_object, $F_HOOK)
747 = @
{$self}{qw
/max_depth max_size cb_object cb_sk_object F_HOOK/};
751 my $bytes = length $text;
753 sprintf("attempted decode of JSON text of %s bytes size, but max_size is set to %s"
754 , $bytes, $max_size), 1
755 ) if ($bytes > $max_size);
758 white
(); # remove head white space
760 decode_error
("malformed JSON string, neither array, object, number, string or atom") unless defined $ch; # Is there a first character for JSON structure?
762 my $result = value
();
764 if ( !$props->[ P_ALLOW_NONREF
] and !ref $result ) {
766 'JSON text must be an object or array (but found number, string, true, false or null,'
767 . ' use allow_nonref to allow this)', 1);
770 Carp
::croak
('something wrong.') if $len < $at; # we won't arrive here.
772 my $consumed = defined $ch ?
$at - 1 : $at; # consumed JSON text length
774 white
(); # remove tail white space
776 return ( $result, $consumed ) if $want_offset; # all right if decode_prefix
778 decode_error
("garbage after JSON object") if defined $ch;
785 return $ch = undef if($at >= $len);
786 $ch = substr($text, $at++, 1);
792 return if(!defined $ch);
793 return object
() if($ch eq '{');
794 return array
() if($ch eq '[');
795 return tag
() if($ch eq '(');
796 return string
() if($ch eq '"' or ($singlequote and $ch eq "'"));
797 return number
() if($ch =~ /[0-9]/ or $ch eq '-');
805 ($is_valid_utf8, $utf8_len) = ('', 0);
807 my $s = ''; # basically UTF8 flag on
809 if($ch eq '"' or ($singlequote and $ch eq "'")){
812 OUTER
: while( defined(next_chr
()) ){
814 if($ch eq $boundChar){
818 decode_error
("missing low surrogate character in surrogate pair");
821 utf8
::decode
($s) if($is_utf8);
827 if(exists $escapes{$ch}){
830 elsif($ch eq 'u'){ # UNICODE handling
835 last OUTER
if($ch !~ /[0-9a-fA-F]/);
840 if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/) { # UTF-16 high surrogate?
844 elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/) { # UTF-16 low surrogate?
845 unless (defined $utf16) {
846 decode_error
("missing high surrogate character in surrogate pair");
849 $s .= JSON_PP_decode_surrogates
($utf16, $u) || next;
853 if (defined $utf16) {
854 decode_error
("surrogate pair expected");
857 if ( ( my $hex = hex( $u ) ) > 127 ) {
859 $s .= JSON_PP_decode_unicode
($u) || next;
870 decode_error
('illegal backslash escape sequence in string');
877 if ( ord $ch > 127 ) {
878 unless( $ch = is_valid_utf8
($ch) ) {
880 decode_error
("malformed UTF-8 character in JSON string");
883 $at += $utf8_len - 1;
890 if ($ch =~ /[\x00-\x1f\x22\x5c]/) { # '/' ok
891 if (!$relaxed or $ch ne "\t") {
893 decode_error
('invalid character encountered while parsing JSON string');
903 decode_error
("unexpected end of string while parsing JSON string");
908 while( defined $ch ){
909 if($ch eq '' or $ch =~ /\A[ \t\r\n]\z/){
912 elsif($relaxed and $ch eq '/'){
914 if(defined $ch and $ch eq '/'){
915 1 while(defined(next_chr
()) and $ch ne "\n" and $ch ne "\r");
917 elsif(defined $ch and $ch eq '*'){
922 if(defined(next_chr
()) and $ch eq '/'){
932 decode_error
("Unterminated comment");
939 decode_error
("malformed JSON string, neither array, object, number, string or atom");
943 if ($relaxed and $ch eq '#') { # correctly?
945 $text =~ /\G([^\n]*(?:\r\n|\r|\n|$))/g;
958 my $a = $_[0] || []; # you can use this code to use another array ref object.
960 decode_error
('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
961 if (++$depth > $max_depth);
966 if(defined $ch and $ch eq ']'){
994 if ($relaxed and $ch eq ']') {
1003 $at-- if defined $ch and $ch ne '';
1004 decode_error
(", or ] expected while parsing array");
1008 decode_error
('malformed JSON string, neither array, object, number, string or atom') unless $allow_tags;
1014 return unless defined $tag;
1015 decode_error
('malformed JSON string, (tag) must be a string') if ref $tag;
1019 if (!defined $ch or $ch ne ')') {
1020 decode_error
(') expected after tag');
1027 return unless defined $val;
1028 decode_error
('malformed JSON string, tag value must be an array') unless ref $val eq 'ARRAY';
1030 if (!eval { $tag->can('THAW') }) {
1031 decode_error
('cannot decode perl-object (package does not exist)') if $@
;
1032 decode_error
('cannot decode perl-object (package does not have a THAW method)');
1034 $tag->THAW('JSON', @
$val);
1038 my $o = $_[0] || {}; # you can use this code to use another hash ref object.
1041 decode_error
('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
1042 if (++$depth > $max_depth);
1046 if(defined $ch and $ch eq '}'){
1050 return _json_object_hook
($o);
1055 while (defined $ch) {
1056 $k = ($allow_barekey and $ch ne '"' and $ch ne "'") ? bareKey
() : string
();
1059 if(!defined $ch or $ch ne ':'){
1061 decode_error
("':' expected");
1068 last if (!defined $ch);
1074 return _json_object_hook
($o);
1086 if ($relaxed and $ch eq '}') {
1090 return _json_object_hook
($o);
1099 $at-- if defined $ch and $ch ne '';
1100 decode_error
(", or } expected while parsing object/hash");
1104 sub bareKey
{ # doesn't strictly follow Standard ECMA-262 3rd Edition
1106 while($ch =~ /[^\x00-\x23\x25-\x2F\x3A-\x40\x5B-\x5E\x60\x7B-\x7F]/){
1115 my $word = substr($text,$at-1,4);
1117 if($word eq 'true'){
1120 return defined $alt_true ?
$alt_true : $JSON::PP
::true
;
1122 elsif($word eq 'null'){
1127 elsif($word eq 'fals'){
1129 if(substr($text,$at,1) eq 'e'){
1132 return defined $alt_false ?
$alt_false : $JSON::PP
::false
;
1136 $at--; # for decode_error report
1138 decode_error
("'null' expected") if ($word =~ /^n/);
1139 decode_error
("'true' expected") if ($word =~ /^t/);
1140 decode_error
("'false' expected") if ($word =~ /^f/);
1141 decode_error
("malformed JSON string, neither array, object, number, string or atom");
1154 if (!defined $ch or $ch !~ /\d/) {
1155 decode_error
("malformed number (no digits after initial minus)");
1159 # According to RFC4627, hex or oct digits are invalid.
1161 my $peek = substr($text,$at,1);
1162 if($peek =~ /^[0-9a-dfA-DF]/){ # e may be valid (exponential)
1163 decode_error
("malformed number (leading zero must not be followed by another digit)");
1169 while(defined $ch and $ch =~ /\d/){
1174 if(defined $ch and $ch eq '.'){
1179 if (!defined $ch or $ch !~ /\d/) {
1180 decode_error
("malformed number (no digits after decimal point)");
1186 while(defined(next_chr
) and $ch =~ /\d/){
1191 if(defined $ch and ($ch eq 'e' or $ch eq 'E')){
1196 if(defined($ch) and ($ch eq '+' or $ch eq '-')){
1199 if (!defined $ch or $ch =~ /\D/) {
1200 decode_error
("malformed number (no digits after exp sign)");
1204 elsif(defined($ch) and $ch =~ /\d/){
1208 decode_error
("malformed number (no digits after exp sign)");
1211 while(defined(next_chr
) and $ch =~ /\d/){
1219 if ($is_dec or $is_exp) {
1220 if ($allow_bignum) {
1221 require Math
::BigFloat
;
1222 return Math
::BigFloat
->new($v);
1225 if (length $v > $max_intsize) {
1226 if ($allow_bignum) { # from Adam Sussman
1227 require Math
::BigInt
;
1228 return Math
::BigInt
->new($v);
1236 return $is_dec ?
$v/1.0 : 0+$v;
1242 $utf8_len = $_[0] =~ /[\x00-\x7F]/ ?
1
1243 : $_[0] =~ /[\xC2-\xDF]/ ?
2
1244 : $_[0] =~ /[\xE0-\xEF]/ ?
3
1245 : $_[0] =~ /[\xF0-\xF4]/ ?
4
1249 return unless $utf8_len;
1251 my $is_valid_utf8 = substr($text, $at - 1, $utf8_len);
1253 return ( $is_valid_utf8 =~ /^(?
:
1255 |[\xC2-\xDF][\x80-\xBF]
1256 |[\xE0][\xA0-\xBF][\x80-\xBF]
1257 |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
1258 |[\xED][\x80-\x9F][\x80-\xBF]
1259 |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
1260 |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
1261 |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
1262 |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
1263 )$/x
) ?
$is_valid_utf8 : '';
1270 my $str = defined $text ?
substr($text, $at) : '';
1275 my $type = $] < 5.006 ?
'C*'
1276 : utf8
::is_utf8
( $str ) ?
'U*' # 5.6
1281 for my $c ( unpack( $type, $str ) ) { # emulate pv_uni_display() ?
1282 $mess .= $c == 0x07 ?
'\a'
1287 : $c < 0x20 ?
sprintf('\x{%x}', $c)
1288 : $c == 0x5c ?
'\\\\'
1289 : $c < 0x80 ?
chr($c)
1290 : sprintf('\x{%x}', $c)
1292 if ( length $mess >= 20 ) {
1298 unless ( length $mess ) {
1299 $mess = '(end of string)';
1303 $no_rep ?
"$error" : "$error, at character offset $at (before \"$mess\")"
1309 sub _json_object_hook
{
1311 my @ks = keys %{$o};
1313 if ( $cb_sk_object and @ks == 1 and exists $cb_sk_object->{ $ks[0] } and ref $cb_sk_object->{ $ks[0] } ) {
1314 my @val = $cb_sk_object->{ $ks[0] }->( $o->{$ks[0]} );
1322 Carp
::croak
("filter_json_single_key_object callbacks must not return more than one scalar");
1326 my @val = $cb_object->($o) if ($cb_object);
1334 Carp
::croak
("filter_json_object callbacks must not return more than one scalar");
1346 encoding
=> $encoding,
1347 is_valid_utf8
=> $is_valid_utf8,
1354 sub _decode_surrogates
{ # from perlunicode
1355 my $uni = 0x10000 + (hex($_[0]) - 0xD800) * 0x400 + (hex($_[1]) - 0xDC00);
1356 my $un = pack('U*', $uni);
1357 utf8
::encode
( $un );
1362 sub _decode_unicode
{
1363 my $un = pack('U', hex shift);
1364 utf8
::encode
( $un );
1369 # Setup for various Perl versions (the code from JSON::PP58)
1374 unless ( defined &utf8
::is_utf8
) {
1376 *utf8
::is_utf8
= *Encode
::is_utf8
;
1380 *JSON
::PP
::JSON_PP_encode_ascii
= \
&_encode_ascii
;
1381 *JSON
::PP
::JSON_PP_encode_latin1
= \
&_encode_latin1
;
1382 *JSON
::PP
::JSON_PP_decode_surrogates
= \
&_decode_surrogates
;
1383 *JSON
::PP
::JSON_PP_decode_unicode
= \
&_decode_unicode
;
1385 if ($] < 5.008003) { # join() in 5.8.0 - 5.8.2 is broken.
1388 subs
->import('join');
1391 return '' if (@_ < 2);
1394 for (@_) { $str .= $j . $_; }
1402 sub JSON
::PP
::incr_parse
{
1403 local $Carp::CarpLevel
= 1;
1404 ( $_[0]->{_incr_parser
} ||= JSON
::PP
::IncrParser
->new )->incr_parse( @_ );
1408 sub JSON
::PP
::incr_skip
{
1409 ( $_[0]->{_incr_parser
} ||= JSON
::PP
::IncrParser
->new )->incr_skip;
1413 sub JSON
::PP
::incr_reset
{
1414 ( $_[0]->{_incr_parser
} ||= JSON
::PP
::IncrParser
->new )->incr_reset;
1418 sub JSON::PP::incr_text : lvalue {
1419 $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new;
1421 if ( $_[0]->{_incr_parser}->{incr_pos} ) {
1422 Carp::croak("incr_text cannot be called when the incremental parser already started parsing");
1424 $_[0]->{_incr_parser}->{incr_text};
1426 } if ( $] >= 5.006 );
1428 } # Setup for various Perl versions (the code from JSON::PP58)
1431 ###############################
1436 eval 'require Scalar::Util';
1438 *JSON::PP::blessed = \&Scalar::Util::blessed;
1439 *JSON::PP::reftype = \&Scalar::Util::reftype;
1440 *JSON::PP::refaddr = \&Scalar::Util::refaddr;
1442 else{ # This code is from Scalar::Util.
1444 eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';
1445 *JSON::PP::blessed = sub {
1446 local($@, $SIG{__DIE__}, $SIG{__WARN__});
1447 ref($_[0]) ? eval { $_[0]->a_sub_not_likely_to_be_here } : undef;
1459 *JSON
::PP
::reftype
= sub {
1462 return undef unless length(ref($r));
1464 my $t = ref(B
::svref_2object
($r));
1467 exists $tmap{$t} ?
$tmap{$t}
1468 : length(ref($$r)) ?
'REF'
1471 *JSON
::PP
::refaddr
= sub {
1472 return undef unless length(ref($_[0]));
1475 if(defined(my $pkg = blessed
($_[0]))) {
1476 $addr .= bless $_[0], 'Scalar::Util::Fake';
1485 #no warnings 'portable';
1492 # shamelessly copied and modified from JSON::XS code.
1494 $JSON::PP
::true
= do { bless \
(my $dummy = 1), "JSON::PP::Boolean" };
1495 $JSON::PP
::false
= do { bless \
(my $dummy = 0), "JSON::PP::Boolean" };
1497 sub is_bool
{ blessed
$_[0] and ( $_[0]->isa("JSON::PP::Boolean") or $_[0]->isa("Types::Serialiser::BooleanBase") or $_[0]->isa("JSON::XS::Boolean") ); }
1499 sub true
{ $JSON::PP
::true
}
1500 sub false
{ $JSON::PP
::false
}
1503 ###############################
1505 package JSON
::PP
::IncrParser
;
1509 use constant INCR_M_WS
=> 0; # initial whitespace skipping
1510 use constant INCR_M_STR
=> 1; # inside string
1511 use constant INCR_M_BS
=> 2; # inside backslash
1512 use constant INCR_M_JSON
=> 3; # outside anything, count nesting
1513 use constant INCR_M_C0
=> 4;
1514 use constant INCR_M_C1
=> 5;
1515 use constant INCR_M_TFN
=> 6;
1516 use constant INCR_M_NUM
=> 7;
1518 $JSON::PP
::IncrParser
::VERSION
= '1.01';
1533 my ( $self, $coder, $text ) = @_;
1535 $self->{incr_text
} = '' unless ( defined $self->{incr_text
} );
1537 if ( defined $text ) {
1538 if ( utf8
::is_utf8
( $text ) and !utf8
::is_utf8
( $self->{incr_text
} ) ) {
1539 utf8
::upgrade
( $self->{incr_text
} ) ;
1540 utf8
::decode
( $self->{incr_text
} ) ;
1542 $self->{incr_text
} .= $text;
1545 if ( defined wantarray ) {
1546 my $max_size = $coder->get_max_size;
1547 my $p = $self->{incr_pos
};
1551 unless ( $self->{incr_nest
} <= 0 and $self->{incr_mode
} == INCR_M_JSON
) {
1552 $self->_incr_parse( $coder );
1554 if ( $max_size and $self->{incr_pos
} > $max_size ) {
1555 Carp
::croak
("attempted decode of JSON text of $self->{incr_pos} bytes size, but max_size is set to $max_size");
1557 unless ( $self->{incr_nest
} <= 0 and $self->{incr_mode
} == INCR_M_JSON
) {
1558 # as an optimisation, do not accumulate white space in the incr buffer
1559 if ( $self->{incr_mode
} == INCR_M_WS
and $self->{incr_pos
} ) {
1560 $self->{incr_pos
} = 0;
1561 $self->{incr_text
} = '';
1567 my ($obj, $offset) = $coder->PP_decode_json( $self->{incr_text
}, 0x00000001 );
1570 $self->{incr_text
} = substr( $self->{incr_text
}, $offset || 0 );
1571 $self->{incr_pos
} = 0;
1572 $self->{incr_nest
} = 0;
1573 $self->{incr_mode
} = 0;
1574 last unless wantarray;
1575 } while ( wantarray );
1581 else { # in scalar context
1582 return defined $ret[0] ?
$ret[0] : undef;
1589 my ($self, $coder) = @_;
1590 my $text = $self->{incr_text
};
1591 my $len = length $text;
1592 my $p = $self->{incr_pos
};
1595 while ( $len > $p ) {
1596 my $s = substr( $text, $p, 1 );
1597 last INCR_PARSE
unless defined $s;
1598 my $mode = $self->{incr_mode
};
1600 if ( $mode == INCR_M_WS
) {
1601 while ( $len > $p ) {
1602 $s = substr( $text, $p, 1 );
1603 last INCR_PARSE
unless defined $s;
1604 if ( ord($s) > 0x20 ) {
1606 $self->{incr_mode
} = INCR_M_C0
;
1609 $self->{incr_mode
} = INCR_M_JSON
;
1615 } elsif ( $mode == INCR_M_BS
) {
1617 $self->{incr_mode
} = INCR_M_STR
;
1619 } elsif ( $mode == INCR_M_C0
or $mode == INCR_M_C1
) {
1620 while ( $len > $p ) {
1621 $s = substr( $text, $p, 1 );
1622 last INCR_PARSE
unless defined $s;
1624 $self->{incr_mode
} = $self->{incr_mode
} == INCR_M_C0 ? INCR_M_WS
: INCR_M_JSON
;
1630 } elsif ( $mode == INCR_M_TFN
) {
1631 while ( $len > $p ) {
1632 $s = substr( $text, $p++, 1 );
1633 next if defined $s and $s =~ /[rueals]/;
1637 $self->{incr_mode
} = INCR_M_JSON
;
1639 last INCR_PARSE
unless $self->{incr_nest
};
1641 } elsif ( $mode == INCR_M_NUM
) {
1642 while ( $len > $p ) {
1643 $s = substr( $text, $p++, 1 );
1644 next if defined $s and $s =~ /[0-9eE.+\-]/;
1648 $self->{incr_mode
} = INCR_M_JSON
;
1650 last INCR_PARSE
unless $self->{incr_nest
};
1652 } elsif ( $mode == INCR_M_STR
) {
1653 while ( $len > $p ) {
1654 $s = substr( $text, $p, 1 );
1655 last INCR_PARSE
unless defined $s;
1658 $self->{incr_mode
} = INCR_M_JSON
;
1660 last INCR_PARSE
unless $self->{incr_nest
};
1663 elsif ( $s eq '\\' ) {
1665 if ( !defined substr($text, $p, 1) ) {
1666 $self->{incr_mode
} = INCR_M_BS
;
1672 } elsif ( $mode == INCR_M_JSON
) {
1673 while ( $len > $p ) {
1674 $s = substr( $text, $p++, 1 );
1675 if ( $s eq "\x00" ) {
1678 } elsif ( $s eq "\x09" or $s eq "\x0a" or $s eq "\x0d" or $s eq "\x20" ) {
1679 if ( !$self->{incr_nest
} ) {
1680 $p--; # do not eat the whitespace, let the next round do it
1684 } elsif ( $s eq 't' or $s eq 'f' or $s eq 'n' ) {
1685 $self->{incr_mode
} = INCR_M_TFN
;
1687 } elsif ( $s =~ /^[0-9\-]$/ ) {
1688 $self->{incr_mode
} = INCR_M_NUM
;
1690 } elsif ( $s eq '"' ) {
1691 $self->{incr_mode
} = INCR_M_STR
;
1693 } elsif ( $s eq '[' or $s eq '{' ) {
1694 if ( ++$self->{incr_nest
} > $coder->get_max_depth ) {
1695 Carp
::croak
('json text or perl structure exceeds maximum nesting level (max_depth set too low?)');
1698 } elsif ( $s eq ']' or $s eq '}' ) {
1699 if ( --$self->{incr_nest
} <= 0 ) {
1702 } elsif ( $s eq '#' ) {
1703 $self->{incr_mode
} = INCR_M_C1
;
1710 $self->{incr_pos
} = $p;
1711 $self->{incr_parsing
} = $p ?
1 : 0; # for backward compatibility
1716 if ( $_[0]->{incr_pos
} ) {
1717 Carp
::croak
("incr_text cannot be called when the incremental parser already started parsing");
1725 $self->{incr_text
} = substr( $self->{incr_text
}, $self->{incr_pos
} );
1726 $self->{incr_pos
} = 0;
1727 $self->{incr_mode
} = 0;
1728 $self->{incr_nest
} = 0;
1734 $self->{incr_text
} = undef;
1735 $self->{incr_pos
} = 0;
1736 $self->{incr_mode
} = 0;
1737 $self->{incr_nest
} = 0;
1740 ###############################
1749 JSON::PP - JSON::XS compatible pure-Perl module.
1755 # exported functions, they croak on error
1756 # and expect/generate UTF-8
1758 $utf8_encoded_json_text = encode_json $perl_hash_or_arrayref;
1759 $perl_hash_or_arrayref = decode_json $utf8_encoded_json_text;
1763 $json = JSON::PP->new->ascii->pretty->allow_nonref;
1765 $pretty_printed_json_text = $json->encode( $perl_scalar );
1766 $perl_scalar = $json->decode( $json_text );
1768 # Note that JSON version 2.0 and above will automatically use
1769 # JSON::XS or JSON::PP, so you should be able to just:
1780 JSON::PP is a pure perl JSON decoder/encoder, and (almost) compatible to much
1781 faster L<JSON::XS> written by Marc Lehmann in C. JSON::PP works as
1782 a fallback module when you use L<JSON> module without having
1785 Because of this fallback feature of JSON.pm, JSON::PP tries not to
1786 be more JavaScript-friendly than JSON::XS (i.e. not to escape extra
1787 characters such as U+2028 and U+2029, etc),
1788 in order for you not to lose such JavaScript-friendliness silently
1789 when you use JSON.pm and install JSON::XS for speed or by accident.
1790 If you need JavaScript-friendly RFC7159-compliant pure perl module,
1791 try L<JSON::Tiny>, which is derived from L<Mojolicious> web
1792 framework and is also smaller and faster than JSON::PP.
1794 JSON::PP has been in the Perl core since Perl 5.14, mainly for
1795 CPAN toolchain modules to parse META.json.
1797 =head1 FUNCTIONAL INTERFACE
1799 This section is taken from JSON::XS almost verbatim. C<encode_json>
1800 and C<decode_json> are exported by default.
1804 $json_text = encode_json $perl_scalar
1806 Converts the given Perl data structure to a UTF-8 encoded, binary string
1807 (that is, the string contains octets only). Croaks on error.
1809 This function call is functionally identical to:
1811 $json_text = JSON::PP->new->utf8->encode($perl_scalar)
1813 Except being faster.
1817 $perl_scalar = decode_json $json_text
1819 The opposite of C<encode_json>: expects an UTF-8 (binary) string and tries
1820 to parse that as an UTF-8 encoded JSON text, returning the resulting
1821 reference. Croaks on error.
1823 This function call is functionally identical to:
1825 $perl_scalar = JSON::PP->new->utf8->decode($json_text)
1827 Except being faster.
1829 =head2 JSON::PP::is_bool
1831 $is_boolean = JSON::PP::is_bool($scalar)
1833 Returns true if the passed scalar represents either JSON::PP::true or
1834 JSON::PP::false, two constants that act like C<1> and C<0> respectively
1835 and are also used to represent JSON C<true> and C<false> in Perl strings.
1837 See L<MAPPING>, below, for more information on how JSON values are mapped to
1840 =head1 OBJECT-ORIENTED INTERFACE
1842 This section is also taken from JSON::XS.
1844 The object oriented interface lets you configure your own encoding or
1845 decoding style, within the limits of supported formats.
1849 $json = JSON::PP->new
1851 Creates a new JSON::PP object that can be used to de/encode JSON
1852 strings. All boolean flags described below are by default I<disabled>
1853 (with the exception of C<allow_nonref>, which defaults to I<enabled> since
1856 The mutators for flags all return the JSON::PP object again and thus calls can
1859 my $json = JSON::PP->new->utf8->space_after->encode({a => [1,2]})
1864 $json = $json->ascii([$enable])
1866 $enabled = $json->get_ascii
1868 If C<$enable> is true (or missing), then the C<encode> method will not
1869 generate characters outside the code range C<0..127> (which is ASCII). Any
1870 Unicode characters outside that range will be escaped using either a
1871 single \uXXXX (BMP characters) or a double \uHHHH\uLLLLL escape sequence,
1872 as per RFC4627. The resulting encoded JSON text can be treated as a native
1873 Unicode string, an ascii-encoded, latin1-encoded or UTF-8 encoded string,
1874 or any other superset of ASCII.
1876 If C<$enable> is false, then the C<encode> method will not escape Unicode
1877 characters unless required by the JSON syntax or other flags. This results
1878 in a faster and more compact format.
1880 See also the section I<ENCODING/CODESET FLAG NOTES> later in this document.
1882 The main use for this flag is to produce JSON texts that can be
1883 transmitted over a 7-bit channel, as the encoded JSON texts will not
1884 contain any 8 bit characters.
1886 JSON::PP->new->ascii(1)->encode([chr 0x10401])
1891 $json = $json->latin1([$enable])
1893 $enabled = $json->get_latin1
1895 If C<$enable> is true (or missing), then the C<encode> method will encode
1896 the resulting JSON text as latin1 (or iso-8859-1), escaping any characters
1897 outside the code range C<0..255>. The resulting string can be treated as a
1898 latin1-encoded JSON text or a native Unicode string. The C<decode> method
1899 will not be affected in any way by this flag, as C<decode> by default
1900 expects Unicode, which is a strict superset of latin1.
1902 If C<$enable> is false, then the C<encode> method will not escape Unicode
1903 characters unless required by the JSON syntax or other flags.
1905 See also the section I<ENCODING/CODESET FLAG NOTES> later in this document.
1907 The main use for this flag is efficiently encoding binary data as JSON
1908 text, as most octets will not be escaped, resulting in a smaller encoded
1909 size. The disadvantage is that the resulting JSON text is encoded
1910 in latin1 (and must correctly be treated as such when storing and
1911 transferring), a rare encoding for JSON. It is therefore most useful when
1912 you want to store data structures known to contain binary data efficiently
1913 in files or databases, not when talking to other JSON encoders/decoders.
1915 JSON::PP->new->latin1->encode (["\x{89}\x{abc}"]
1916 => ["\x{89}\\u0abc"] # (perl syntax, U+abc escaped, U+89 not)
1920 $json = $json->utf8([$enable])
1922 $enabled = $json->get_utf8
1924 If C<$enable> is true (or missing), then the C<encode> method will encode
1925 the JSON result into UTF-8, as required by many protocols, while the
1926 C<decode> method expects to be handled an UTF-8-encoded string. Please
1927 note that UTF-8-encoded strings do not contain any characters outside the
1928 range C<0..255>, they are thus useful for bytewise/binary I/O. In future
1929 versions, enabling this option might enable autodetection of the UTF-16
1930 and UTF-32 encoding families, as described in RFC4627.
1932 If C<$enable> is false, then the C<encode> method will return the JSON
1933 string as a (non-encoded) Unicode string, while C<decode> expects thus a
1934 Unicode string. Any decoding or encoding (e.g. to UTF-8 or UTF-16) needs
1935 to be done yourself, e.g. using the Encode module.
1937 See also the section I<ENCODING/CODESET FLAG NOTES> later in this document.
1939 Example, output UTF-16BE-encoded JSON:
1942 $jsontext = encode "UTF-16BE", JSON::PP->new->encode ($object);
1944 Example, decode UTF-32LE-encoded JSON:
1947 $object = JSON::PP->new->decode (decode "UTF-32LE", $jsontext);
1951 $json = $json->pretty([$enable])
1953 This enables (or disables) all of the C<indent>, C<space_before> and
1954 C<space_after> (and in the future possibly more) flags in one call to
1955 generate the most readable (or most compact) form possible.
1959 $json = $json->indent([$enable])
1961 $enabled = $json->get_indent
1963 If C<$enable> is true (or missing), then the C<encode> method will use a multiline
1964 format as output, putting every array member or object/hash key-value pair
1965 into its own line, indenting them properly.
1967 If C<$enable> is false, no newlines or indenting will be produced, and the
1968 resulting JSON text is guaranteed not to contain any C<newlines>.
1970 This setting has no effect when decoding JSON texts.
1972 The default indent space length is three.
1973 You can use C<indent_length> to change the length.
1977 $json = $json->space_before([$enable])
1979 $enabled = $json->get_space_before
1981 If C<$enable> is true (or missing), then the C<encode> method will add an extra
1982 optional space before the C<:> separating keys from values in JSON objects.
1984 If C<$enable> is false, then the C<encode> method will not add any extra
1985 space at those places.
1987 This setting has no effect when decoding JSON texts. You will also
1988 most likely combine this setting with C<space_after>.
1990 Example, space_before enabled, space_after and indent disabled:
1996 $json = $json->space_after([$enable])
1998 $enabled = $json->get_space_after
2000 If C<$enable> is true (or missing), then the C<encode> method will add an extra
2001 optional space after the C<:> separating keys from values in JSON objects
2002 and extra whitespace after the C<,> separating key-value pairs and array
2005 If C<$enable> is false, then the C<encode> method will not add any extra
2006 space at those places.
2008 This setting has no effect when decoding JSON texts.
2010 Example, space_before and indent disabled, space_after enabled:
2016 $json = $json->relaxed([$enable])
2018 $enabled = $json->get_relaxed
2020 If C<$enable> is true (or missing), then C<decode> will accept some
2021 extensions to normal JSON syntax (see below). C<encode> will not be
2022 affected in anyway. I<Be aware that this option makes you accept invalid
2023 JSON texts as if they were valid!>. I suggest only to use this option to
2024 parse application-specific files written by humans (configuration files,
2025 resource files etc.)
2027 If C<$enable> is false (the default), then C<decode> will only accept
2030 Currently accepted extensions are:
2034 =item * list items can have an end-comma
2036 JSON I<separates> array elements and key-value pairs with commas. This
2037 can be annoying if you write JSON texts manually and want to be able to
2038 quickly append elements, so this extension accepts comma at the end of
2039 such items not just between them:
2043 2, <- this comma not normally allowed
2047 "k2": "v2", <- this comma not normally allowed
2050 =item * shell-style '#'-comments
2052 Whenever JSON allows whitespace, shell-style comments are additionally
2053 allowed. They are terminated by the first carriage-return or line-feed
2054 character, after which more white-space and comments are allowed.
2057 1, # this comment not allowed in JSON
2058 # neither this one...
2061 =item * C-style multiple-line '/* */'-comments (JSON::PP only)
2063 Whenever JSON allows whitespace, C-style multiple-line comments are additionally
2064 allowed. Everything between C</*> and C<*/> is a comment, after which
2065 more white-space and comments are allowed.
2068 1, /* this comment not allowed in JSON */
2069 /* neither this one... */
2072 =item * C++-style one-line '//'-comments (JSON::PP only)
2074 Whenever JSON allows whitespace, C++-style one-line comments are additionally
2075 allowed. They are terminated by the first carriage-return or line-feed
2076 character, after which more white-space and comments are allowed.
2079 1, // this comment not allowed in JSON
2080 // neither this one...
2083 =item * literal ASCII TAB characters in strings
2085 Literal ASCII TAB characters are now allowed in strings (and treated as
2090 "Hello<TAB>World", # literal <TAB> would not normally be allowed
2097 $json = $json->canonical([$enable])
2099 $enabled = $json->get_canonical
2101 If C<$enable> is true (or missing), then the C<encode> method will output JSON objects
2102 by sorting their keys. This is adding a comparatively high overhead.
2104 If C<$enable> is false, then the C<encode> method will output key-value
2105 pairs in the order Perl stores them (which will likely change between runs
2106 of the same script, and can change even within the same run from 5.18
2109 This option is useful if you want the same data structure to be encoded as
2110 the same JSON text (given the same overall settings). If it is disabled,
2111 the same hash might be encoded differently even if contains the same data,
2112 as key-value pairs have no inherent ordering in Perl.
2114 This setting has no effect when decoding JSON texts.
2116 This setting has currently no effect on tied hashes.
2120 $json = $json->allow_nonref([$enable])
2122 $enabled = $json->get_allow_nonref
2124 Unlike other boolean options, this opotion is enabled by default beginning
2125 with version C<4.0>.
2127 If C<$enable> is true (or missing), then the C<encode> method can convert a
2128 non-reference into its corresponding string, number or null JSON value,
2129 which is an extension to RFC4627. Likewise, C<decode> will accept those JSON
2130 values instead of croaking.
2132 If C<$enable> is false, then the C<encode> method will croak if it isn't
2133 passed an arrayref or hashref, as JSON texts must either be an object
2134 or array. Likewise, C<decode> will croak if given something that is not a
2135 JSON object or array.
2137 Example, encode a Perl scalar as JSON value without enabled C<allow_nonref>,
2138 resulting in an error:
2140 JSON::PP->new->allow_nonref(0)->encode ("Hello, World!")
2141 => hash- or arrayref expected...
2143 =head2 allow_unknown
2145 $json = $json->allow_unknown([$enable])
2147 $enabled = $json->get_allow_unknown
2149 If C<$enable> is true (or missing), then C<encode> will I<not> throw an
2150 exception when it encounters values it cannot represent in JSON (for
2151 example, filehandles) but instead will encode a JSON C<null> value. Note
2152 that blessed objects are not included here and are handled separately by
2155 If C<$enable> is false (the default), then C<encode> will throw an
2156 exception when it encounters anything it cannot encode as JSON.
2158 This option does not affect C<decode> in any way, and it is recommended to
2159 leave it off unless you know your communications partner.
2161 =head2 allow_blessed
2163 $json = $json->allow_blessed([$enable])
2165 $enabled = $json->get_allow_blessed
2167 See L<OBJECT SERIALISATION> for details.
2169 If C<$enable> is true (or missing), then the C<encode> method will not
2170 barf when it encounters a blessed reference that it cannot convert
2171 otherwise. Instead, a JSON C<null> value is encoded instead of the object.
2173 If C<$enable> is false (the default), then C<encode> will throw an
2174 exception when it encounters a blessed object that it cannot convert
2177 This setting has no effect on C<decode>.
2179 =head2 convert_blessed
2181 $json = $json->convert_blessed([$enable])
2183 $enabled = $json->get_convert_blessed
2185 See L<OBJECT SERIALISATION> for details.
2187 If C<$enable> is true (or missing), then C<encode>, upon encountering a
2188 blessed object, will check for the availability of the C<TO_JSON> method
2189 on the object's class. If found, it will be called in scalar context and
2190 the resulting scalar will be encoded instead of the object.
2192 The C<TO_JSON> method may safely call die if it wants. If C<TO_JSON>
2193 returns other blessed objects, those will be handled in the same
2194 way. C<TO_JSON> must take care of not causing an endless recursion cycle
2195 (== crash) in this case. The name of C<TO_JSON> was chosen because other
2196 methods called by the Perl core (== not by the user of the object) are
2197 usually in upper case letters and to avoid collisions with any C<to_json>
2200 If C<$enable> is false (the default), then C<encode> will not consider
2201 this type of conversion.
2203 This setting has no effect on C<decode>.
2207 $json = $json->allow_tags([$enable])
2209 $enabled = $json->get_allow_tags
2211 See L<OBJECT SERIALISATION> for details.
2213 If C<$enable> is true (or missing), then C<encode>, upon encountering a
2214 blessed object, will check for the availability of the C<FREEZE> method on
2215 the object's class. If found, it will be used to serialise the object into
2216 a nonstandard tagged JSON value (that JSON decoders cannot decode).
2218 It also causes C<decode> to parse such tagged JSON values and deserialise
2219 them via a call to the C<THAW> method.
2221 If C<$enable> is false (the default), then C<encode> will not consider
2222 this type of conversion, and tagged JSON values will cause a parse error
2223 in C<decode>, as if tags were not part of the grammar.
2225 =head2 boolean_values
2227 $json->boolean_values([$false, $true])
2229 ($false, $true) = $json->get_boolean_values
2231 By default, JSON booleans will be decoded as overloaded
2232 C<$JSON::PP::false> and C<$JSON::PP::true> objects.
2234 With this method you can specify your own boolean values for decoding -
2235 on decode, JSON C<false> will be decoded as a copy of C<$false>, and JSON
2236 C<true> will be decoded as C<$true> ("copy" here is the same thing as
2237 assigning a value to another variable, i.e. C<$copy = $false>).
2239 This is useful when you want to pass a decoded data structure directly
2240 to other serialisers like YAML, Data::MessagePack and so on.
2242 Note that this works only when you C<decode>. You can set incompatible
2243 boolean objects (like L<boolean>), but when you C<encode> a data structure
2244 with such boolean objects, you still need to enable C<convert_blessed>
2245 (and add a C<TO_JSON> method if necessary).
2247 Calling this method without any arguments will reset the booleans
2248 to their default values.
2250 C<get_boolean_values> will return both C<$false> and C<$true> values, or
2251 the empty list when they are set to the default.
2253 =head2 filter_json_object
2255 $json = $json->filter_json_object([$coderef])
2257 When C<$coderef> is specified, it will be called from C<decode> each
2258 time it decodes a JSON object. The only argument is a reference to
2259 the newly-created hash. If the code references returns a single scalar
2260 (which need not be a reference), this value (or rather a copy of it) is
2261 inserted into the deserialised data structure. If it returns an empty
2262 list (NOTE: I<not> C<undef>, which is a valid scalar), the original
2263 deserialised hash will be inserted. This setting can slow down decoding
2266 When C<$coderef> is omitted or undefined, any existing callback will
2267 be removed and C<decode> will not change the deserialised hash in any
2270 Example, convert all JSON objects into the integer 5:
2272 my $js = JSON::PP->new->filter_json_object(sub { 5 });
2274 $js->decode('[{}]');
2276 $js->decode('{"a":1, "b":2}');
2278 =head2 filter_json_single_key_object
2280 $json = $json->filter_json_single_key_object($key [=> $coderef])
2282 Works remotely similar to C<filter_json_object>, but is only called for
2283 JSON objects having a single key named C<$key>.
2285 This C<$coderef> is called before the one specified via
2286 C<filter_json_object>, if any. It gets passed the single value in the JSON
2287 object. If it returns a single value, it will be inserted into the data
2288 structure. If it returns nothing (not even C<undef> but the empty list),
2289 the callback from C<filter_json_object> will be called next, as if no
2290 single-key callback were specified.
2292 If C<$coderef> is omitted or undefined, the corresponding callback will be
2293 disabled. There can only ever be one callback for a given key.
2295 As this callback gets called less often then the C<filter_json_object>
2296 one, decoding speed will not usually suffer as much. Therefore, single-key
2297 objects make excellent targets to serialise Perl objects into, especially
2298 as single-key JSON objects are as close to the type-tagged value concept
2299 as JSON gets (it's basically an ID/VALUE tuple). Of course, JSON does not
2300 support this in any way, so you need to make sure your data never looks
2301 like a serialised Perl hash.
2303 Typical names for the single object key are C<__class_whatever__>, or
2304 C<$__dollars_are_rarely_used__$> or C<}ugly_brace_placement>, or even
2305 things like C<__class_md5sum(classname)__>, to reduce the risk of clashing
2308 Example, decode JSON objects of the form C<< { "__widget__" => <id> } >>
2309 into the corresponding C<< $WIDGET{<id>} >> object:
2311 # return whatever is in $WIDGET{5}:
2314 ->filter_json_single_key_object (__widget__ => sub {
2317 ->decode ('{"__widget__": 5')
2319 # this can be used with a TO_JSON method in some "widget" class
2320 # for serialisation to json:
2321 sub WidgetBase::TO_JSON {
2324 unless ($self->{id}) {
2325 $self->{id} = ..get..some..id..;
2326 $WIDGET{$self->{id}} = $self;
2329 { __widget__ => $self->{id} }
2334 $json = $json->shrink([$enable])
2336 $enabled = $json->get_shrink
2338 If C<$enable> is true (or missing), the string returned by C<encode> will
2339 be shrunk (i.e. downgraded if possible).
2341 The actual definition of what shrink does might change in future versions,
2342 but it will always try to save space at the expense of time.
2344 If C<$enable> is false, then JSON::PP does nothing.
2348 $json = $json->max_depth([$maximum_nesting_depth])
2350 $max_depth = $json->get_max_depth
2352 Sets the maximum nesting level (default C<512>) accepted while encoding
2353 or decoding. If a higher nesting level is detected in JSON text or a Perl
2354 data structure, then the encoder and decoder will stop and croak at that
2357 Nesting level is defined by number of hash- or arrayrefs that the encoder
2358 needs to traverse to reach a given point or the number of C<{> or C<[>
2359 characters without their matching closing parenthesis crossed to reach a
2360 given character in a string.
2362 Setting the maximum depth to one disallows any nesting, so that ensures
2363 that the object is only a single hash/object or array.
2365 If no argument is given, the highest possible setting will be used, which
2368 See L<JSON::XS/SECURITY CONSIDERATIONS> for more info on why this is useful.
2372 $json = $json->max_size([$maximum_string_size])
2374 $max_size = $json->get_max_size
2376 Set the maximum length a JSON text may have (in bytes) where decoding is
2377 being attempted. The default is C<0>, meaning no limit. When C<decode>
2378 is called on a string that is longer then this many bytes, it will not
2379 attempt to decode the string but throw an exception. This setting has no
2380 effect on C<encode> (yet).
2382 If no argument is given, the limit check will be deactivated (same as when
2385 See L<JSON::XS/SECURITY CONSIDERATIONS> for more info on why this is useful.
2389 $json_text = $json->encode($perl_scalar)
2391 Converts the given Perl value or data structure to its JSON
2392 representation. Croaks on error.
2396 $perl_scalar = $json->decode($json_text)
2398 The opposite of C<encode>: expects a JSON text and tries to parse it,
2399 returning the resulting simple scalar or reference. Croaks on error.
2401 =head2 decode_prefix
2403 ($perl_scalar, $characters) = $json->decode_prefix($json_text)
2405 This works like the C<decode> method, but instead of raising an exception
2406 when there is trailing garbage after the first JSON object, it will
2407 silently stop parsing there and return the number of characters consumed
2410 This is useful if your JSON texts are not delimited by an outer protocol
2411 and you need to know where the JSON text ends.
2413 JSON::PP->new->decode_prefix ("[1] the tail")
2416 =head1 FLAGS FOR JSON::PP ONLY
2418 The following flags and properties are for JSON::PP only. If you use
2419 any of these, you can't make your application run faster by replacing
2420 JSON::PP with JSON::XS. If you need these and also speed boost,
2421 you might want to try L<Cpanel::JSON::XS>, a fork of JSON::XS by
2422 Reini Urban, which supports some of these (with a different set of
2423 incompatibilities). Most of these historical flags are only kept
2424 for backward compatibility, and should not be used in a new application.
2426 =head2 allow_singlequote
2428 $json = $json->allow_singlequote([$enable])
2429 $enabled = $json->get_allow_singlequote
2431 If C<$enable> is true (or missing), then C<decode> will accept
2432 invalid JSON texts that contain strings that begin and end with
2433 single quotation marks. C<encode> will not be affected in any way.
2434 I<Be aware that this option makes you accept invalid JSON texts
2435 as if they were valid!>. I suggest only to use this option to
2436 parse application-specific files written by humans (configuration
2437 files, resource files etc.)
2439 If C<$enable> is false (the default), then C<decode> will only accept
2442 $json->allow_singlequote->decode(qq|{"foo":'bar'}|);
2443 $json->allow_singlequote->decode(qq|{'foo':"bar"}|);
2444 $json->allow_singlequote->decode(qq|{'foo':'bar'}|);
2446 =head2 allow_barekey
2448 $json = $json->allow_barekey([$enable])
2449 $enabled = $json->get_allow_barekey
2451 If C<$enable> is true (or missing), then C<decode> will accept
2452 invalid JSON texts that contain JSON objects whose names don't
2453 begin and end with quotation marks. C<encode> will not be affected
2454 in any way. I<Be aware that this option makes you accept invalid JSON
2455 texts as if they were valid!>. I suggest only to use this option to
2456 parse application-specific files written by humans (configuration
2457 files, resource files etc.)
2459 If C<$enable> is false (the default), then C<decode> will only accept
2462 $json->allow_barekey->decode(qq|{foo:"bar"}|);
2466 $json = $json->allow_bignum([$enable])
2467 $enabled = $json->get_allow_bignum
2469 If C<$enable> is true (or missing), then C<decode> will convert
2470 big integers Perl cannot handle as integer into L<Math::BigInt>
2471 objects and convert floating numbers into L<Math::BigFloat>
2472 objects. C<encode> will convert C<Math::BigInt> and C<Math::BigFloat>
2473 objects into JSON numbers.
2475 $json->allow_nonref->allow_bignum;
2476 $bigfloat = $json->decode('2.000000000000000000000000001');
2477 print $json->encode($bigfloat);
2478 # => 2.000000000000000000000000001
2480 See also L<MAPPING>.
2484 $json = $json->loose([$enable])
2485 $enabled = $json->get_loose
2487 If C<$enable> is true (or missing), then C<decode> will accept
2488 invalid JSON texts that contain unescaped [\x00-\x1f\x22\x5c]
2489 characters. C<encode> will not be affected in any way.
2490 I<Be aware that this option makes you accept invalid JSON texts
2491 as if they were valid!>. I suggest only to use this option to
2492 parse application-specific files written by humans (configuration
2493 files, resource files etc.)
2495 If C<$enable> is false (the default), then C<decode> will only accept
2498 $json->loose->decode(qq|["abc
2503 $json = $json->escape_slash([$enable])
2504 $enabled = $json->get_escape_slash
2506 If C<$enable> is true (or missing), then C<encode> will explicitly
2507 escape I<slash> (solidus; C<U+002F>) characters to reduce the risk of
2508 XSS (cross site scripting) that may be caused by C<< </script> >>
2509 in a JSON text, with the cost of bloating the size of JSON texts.
2511 This option may be useful when you embed JSON in HTML, but embedding
2512 arbitrary JSON in HTML (by some HTML template toolkit or by string
2513 interpolation) is risky in general. You must escape necessary
2514 characters in correct order, depending on the context.
2516 C<decode> will not be affected in any way.
2518 =head2 indent_length
2520 $json = $json->indent_length($number_of_spaces)
2521 $length = $json->get_indent_length
2523 This option is only useful when you also enable C<indent> or C<pretty>.
2525 JSON::XS indents with three spaces when you C<encode> (if requested
2526 by C<indent> or C<pretty>), and the number cannot be changed.
2527 JSON::PP allows you to change/get the number of indent spaces with these
2528 mutator/accessor. The default number of spaces is three (the same as
2529 JSON::XS), and the acceptable range is from C<0> (no indentation;
2530 it'd be better to disable indentation by C<indent(0)>) to C<15>.
2534 $json = $json->sort_by($code_ref)
2535 $json = $json->sort_by($subroutine_name)
2537 If you just want to sort keys (names) in JSON objects when you
2538 C<encode>, enable C<canonical> option (see above) that allows you to
2539 sort object keys alphabetically.
2541 If you do need to sort non-alphabetically for whatever reasons,
2542 you can give a code reference (or a subroutine name) to C<sort_by>,
2543 then the argument will be passed to Perl's C<sort> built-in function.
2545 As the sorting is done in the JSON::PP scope, you usually need to
2546 prepend C<JSON::PP::> to the subroutine name, and the special variables
2547 C<$a> and C<$b> used in the subrontine used by C<sort> function.
2551 my %ORDER = (id => 1, class => 2, name => 3);
2552 $json->sort_by(sub {
2553 ($ORDER{$JSON::PP::a} // 999) <=> ($ORDER{$JSON::PP::b} // 999)
2554 or $JSON::PP::a cmp $JSON::PP::b
2556 print $json->encode([
2557 {name => 'CPAN', id => 1, href => 'http://cpan.org'}
2559 # [{"id":1,"name":"CPAN","href":"http://cpan.org"}]
2561 Note that C<sort_by> affects all the plain hashes in the data structure.
2562 If you need finer control, C<tie> necessary hashes with a module that
2563 implements ordered hash (such as L<Hash::Ordered> and L<Tie::IxHash>).
2564 C<canonical> and C<sort_by> don't affect the key order in C<tie>d
2568 tie my %hash, 'Hash::Ordered',
2569 (name => 'CPAN', id => 1, href => 'http://cpan.org');
2570 print $json->encode([\%hash]);
2571 # [{"name":"CPAN","id":1,"href":"http://cpan.org"}] # order is kept
2573 =head1 INCREMENTAL PARSING
2575 This section is also taken from JSON::XS.
2577 In some cases, there is the need for incremental parsing of JSON
2578 texts. While this module always has to keep both JSON text and resulting
2579 Perl data structure in memory at one time, it does allow you to parse a
2580 JSON stream incrementally. It does so by accumulating text until it has
2581 a full JSON object, which it then can decode. This process is similar to
2582 using C<decode_prefix> to see if a full JSON object is available, but
2583 is much more efficient (and can be implemented with a minimum of method
2586 JSON::PP will only attempt to parse the JSON text once it is sure it
2587 has enough text to get a decisive result, using a very simple but
2588 truly incremental parser. This means that it sometimes won't stop as
2589 early as the full parser, for example, it doesn't detect mismatched
2590 parentheses. The only thing it guarantees is that it starts decoding as
2591 soon as a syntactically valid JSON text has been seen. This means you need
2592 to set resource limits (e.g. C<max_size>) to ensure the parser will stop
2593 parsing in the presence if syntax errors.
2595 The following methods implement this incremental parser.
2599 $json->incr_parse( [$string] ) # void context
2601 $obj_or_undef = $json->incr_parse( [$string] ) # scalar context
2603 @obj_or_empty = $json->incr_parse( [$string] ) # list context
2605 This is the central parsing function. It can both append new text and
2606 extract objects from the stream accumulated so far (both of these
2607 functions are optional).
2609 If C<$string> is given, then this string is appended to the already
2610 existing JSON fragment stored in the C<$json> object.
2612 After that, if the function is called in void context, it will simply
2613 return without doing anything further. This can be used to add more text
2614 in as many chunks as you want.
2616 If the method is called in scalar context, then it will try to extract
2617 exactly I<one> JSON object. If that is successful, it will return this
2618 object, otherwise it will return C<undef>. If there is a parse error,
2619 this method will croak just as C<decode> would do (one can then use
2620 C<incr_skip> to skip the erroneous part). This is the most common way of
2623 And finally, in list context, it will try to extract as many objects
2624 from the stream as it can find and return them, or the empty list
2625 otherwise. For this to work, there must be no separators (other than
2626 whitespace) between the JSON objects or arrays, instead they must be
2627 concatenated back-to-back. If an error occurs, an exception will be
2628 raised as in the scalar context case. Note that in this case, any
2629 previously-parsed JSON texts will be lost.
2631 Example: Parse some JSON arrays/objects in a given string and return
2634 my @objs = JSON::PP->new->incr_parse ("[5][7][1,2]");
2638 $lvalue_string = $json->incr_text
2640 This method returns the currently stored JSON fragment as an lvalue, that
2641 is, you can manipulate it. This I<only> works when a preceding call to
2642 C<incr_parse> in I<scalar context> successfully returned an object. Under
2643 all other circumstances you must not call this function (I mean it.
2644 although in simple tests it might actually work, it I<will> fail under
2645 real world conditions). As a special exception, you can also call this
2646 method before having parsed anything.
2648 That means you can only use this function to look at or manipulate text
2649 before or after complete JSON objects, not while the parser is in the
2650 middle of parsing a JSON object.
2652 This function is useful in two cases: a) finding the trailing text after a
2653 JSON object or b) parsing multiple JSON objects separated by non-JSON text
2660 This will reset the state of the incremental parser and will remove
2661 the parsed text from the input buffer so far. This is useful after
2662 C<incr_parse> died, in which case the input buffer and incremental parser
2663 state is left unchanged, to skip the text parsed so far and to reset the
2666 The difference to C<incr_reset> is that only text until the parse error
2667 occurred is removed.
2673 This completely resets the incremental parser, that is, after this call,
2674 it will be as if the parser had never parsed anything.
2676 This is useful if you want to repeatedly parse JSON objects and want to
2677 ignore any trailing data, which means you have to reset the parser after
2678 each successful decode.
2682 Most of this section is also taken from JSON::XS.
2684 This section describes how JSON::PP maps Perl values to JSON values and
2685 vice versa. These mappings are designed to "do the right thing" in most
2686 circumstances automatically, preserving round-tripping characteristics
2687 (what you put in comes out as something equivalent).
2689 For the more enlightened: note that in the following descriptions,
2690 lowercase I<perl> refers to the Perl interpreter, while uppercase I<Perl>
2691 refers to the abstract Perl language itself.
2699 A JSON object becomes a reference to a hash in Perl. No ordering of object
2700 keys is preserved (JSON does not preserve object key ordering itself).
2704 A JSON array becomes a reference to an array in Perl.
2708 A JSON string becomes a string scalar in Perl - Unicode codepoints in JSON
2709 are represented by the same codepoints in the Perl string, so no manual
2710 decoding is necessary.
2714 A JSON number becomes either an integer, numeric (floating point) or
2715 string scalar in perl, depending on its range and any fractional parts. On
2716 the Perl level, there is no difference between those as Perl handles all
2717 the conversion details, but an integer may take slightly less memory and
2718 might represent more values exactly than floating point numbers.
2720 If the number consists of digits only, JSON::PP will try to represent
2721 it as an integer value. If that fails, it will try to represent it as
2722 a numeric (floating point) value if that is possible without loss of
2723 precision. Otherwise it will preserve the number as a string value (in
2724 which case you lose roundtripping ability, as the JSON number will be
2725 re-encoded to a JSON string).
2727 Numbers containing a fractional or exponential part will always be
2728 represented as numeric (floating point) values, possibly at a loss of
2729 precision (in which case you might lose perfect roundtripping ability, but
2730 the JSON number will still be re-encoded as a JSON number).
2732 Note that precision is not accuracy - binary floating point values cannot
2733 represent most decimal fractions exactly, and when converting from and to
2734 floating point, JSON::PP only guarantees precision up to but not including
2735 the least significant bit.
2737 When C<allow_bignum> is enabled, big integer values and any numeric
2738 values will be converted into L<Math::BigInt> and L<Math::BigFloat>
2739 objects respectively, without becoming string scalars or losing
2744 These JSON atoms become C<JSON::PP::true> and C<JSON::PP::false>,
2745 respectively. They are overloaded to act almost exactly like the numbers
2746 C<1> and C<0>. You can check whether a scalar is a JSON boolean by using
2747 the C<JSON::PP::is_bool> function.
2751 A JSON null atom becomes C<undef> in Perl.
2753 =item shell-style comments (C<< # I<text> >>)
2755 As a nonstandard extension to the JSON syntax that is enabled by the
2756 C<relaxed> setting, shell-style comments are allowed. They can start
2757 anywhere outside strings and go till the end of the line.
2759 =item tagged values (C<< (I<tag>)I<value> >>).
2761 Another nonstandard extension to the JSON syntax, enabled with the
2762 C<allow_tags> setting, are tagged values. In this implementation, the
2763 I<tag> must be a perl package/class name encoded as a JSON string, and the
2764 I<value> must be a JSON array encoding optional constructor arguments.
2766 See L<OBJECT SERIALISATION>, below, for details.
2773 The mapping from Perl to JSON is slightly more difficult, as Perl is a
2774 truly typeless language, so we can only guess which JSON type is meant by
2779 =item hash references
2781 Perl hash references become JSON objects. As there is no inherent
2782 ordering in hash keys (or JSON objects), they will usually be encoded
2783 in a pseudo-random order. JSON::PP can optionally sort the hash keys
2784 (determined by the I<canonical> flag and/or I<sort_by> property), so
2785 the same data structure will serialise to the same JSON text (given
2786 same settings and version of JSON::PP), but this incurs a runtime
2787 overhead and is only rarely useful, e.g. when you want to compare some
2788 JSON text against another for equality.
2790 =item array references
2792 Perl array references become JSON arrays.
2794 =item other references
2796 Other unblessed references are generally not allowed and will cause an
2797 exception to be thrown, except for references to the integers C<0> and
2798 C<1>, which get turned into C<false> and C<true> atoms in JSON. You can
2799 also use C<JSON::PP::false> and C<JSON::PP::true> to improve
2802 to_json [\0, JSON::PP::true] # yields [false,true]
2804 =item JSON::PP::true, JSON::PP::false
2806 These special values become JSON true and JSON false values,
2807 respectively. You can also use C<\1> and C<\0> directly if you want.
2809 =item JSON::PP::null
2811 This special value becomes JSON null.
2813 =item blessed objects
2815 Blessed objects are not directly representable in JSON, but C<JSON::PP>
2816 allows various ways of handling objects. See L<OBJECT SERIALISATION>,
2819 =item simple scalars
2821 Simple Perl scalars (any scalar that is not a reference) are the most
2822 difficult objects to encode: JSON::PP will encode undefined scalars as
2823 JSON C<null> values, scalars that have last been used in a string context
2824 before encoding as JSON strings, and anything else as number value:
2827 encode_json [2] # yields [2]
2828 encode_json [-3.0e17] # yields [-3e+17]
2829 my $value = 5; encode_json [$value] # yields [5]
2831 # used as string, so dump as string
2833 encode_json [$value] # yields ["5"]
2835 # undef becomes null
2836 encode_json [undef] # yields [null]
2838 You can force the type to be a JSON string by stringifying it:
2840 my $x = 3.1; # some variable containing a number
2842 $x .= ""; # another, more awkward way to stringify
2843 print $x; # perl does it for you, too, quite often
2844 # (but for older perls)
2846 You can force the type to be a JSON number by numifying it:
2848 my $x = "3"; # some variable containing a string
2849 $x += 0; # numify it, ensuring it will be dumped as a number
2850 $x *= 1; # same thing, the choice is yours.
2852 You can not currently force the type in other, less obscure, ways.
2854 Since version 2.91_01, JSON::PP uses a different number detection logic
2855 that converts a scalar that is possible to turn into a number safely.
2856 The new logic is slightly faster, and tends to help people who use older
2857 perl or who want to encode complicated data structure. However, this may
2858 results in a different JSON text from the one JSON::XS encodes (and
2859 thus may break tests that compare entire JSON texts). If you do
2860 need the previous behavior for compatibility or for finer control,
2861 set PERL_JSON_PP_USE_B environmental variable to true before you
2862 C<use> JSON::PP (or JSON.pm).
2864 Note that numerical precision has the same meaning as under Perl (so
2865 binary to decimal conversion follows the same rules as in Perl, which
2866 can differ to other languages). Also, your perl interpreter might expose
2867 extensions to the floating point numbers of your platform, such as
2868 infinities or NaN's - these cannot be represented in JSON, and it is an
2869 error to pass those in.
2871 JSON::PP (and JSON::XS) trusts what you pass to C<encode> method
2872 (or C<encode_json> function) is a clean, validated data structure with
2873 values that can be represented as valid JSON values only, because it's
2874 not from an external data source (as opposed to JSON texts you pass to
2875 C<decode> or C<decode_json>, which JSON::PP considers tainted and
2876 doesn't trust). As JSON::PP doesn't know exactly what you and consumers
2877 of your JSON texts want the unexpected values to be (you may want to
2878 convert them into null, or to stringify them with or without
2879 normalisation (string representation of infinities/NaN may vary
2880 depending on platforms), or to croak without conversion), you're advised
2881 to do what you and your consumers need before you encode, and also not
2882 to numify values that may start with values that look like a number
2883 (including infinities/NaN), without validating.
2887 =head2 OBJECT SERIALISATION
2889 As JSON cannot directly represent Perl objects, you have to choose between
2890 a pure JSON representation (without the ability to deserialise the object
2891 automatically again), and a nonstandard extension to the JSON syntax,
2894 =head3 SERIALISATION
2896 What happens when C<JSON::PP> encounters a Perl object depends on the
2897 C<allow_blessed>, C<convert_blessed>, C<allow_tags> and C<allow_bignum>
2898 settings, which are used in this order:
2902 =item 1. C<allow_tags> is enabled and the object has a C<FREEZE> method.
2904 In this case, C<JSON::PP> creates a tagged JSON value, using a nonstandard
2905 extension to the JSON syntax.
2907 This works by invoking the C<FREEZE> method on the object, with the first
2908 argument being the object to serialise, and the second argument being the
2909 constant string C<JSON> to distinguish it from other serialisers.
2911 The C<FREEZE> method can return any number of values (i.e. zero or
2912 more). These values and the paclkage/classname of the object will then be
2913 encoded as a tagged JSON value in the following format:
2915 ("classname")[FREEZE return values...]
2919 ("URI")["http://www.google.com/"]
2920 ("MyDate")[2013,10,29]
2921 ("ImageData::JPEG")["Z3...VlCg=="]
2923 For example, the hypothetical C<My::Object> C<FREEZE> method might use the
2924 objects C<type> and C<id> members to encode the object:
2926 sub My::Object::FREEZE {
2927 my ($self, $serialiser) = @_;
2929 ($self->{type}, $self->{id})
2932 =item 2. C<convert_blessed> is enabled and the object has a C<TO_JSON> method.
2934 In this case, the C<TO_JSON> method of the object is invoked in scalar
2935 context. It must return a single scalar that can be directly encoded into
2936 JSON. This scalar replaces the object in the JSON text.
2938 For example, the following C<TO_JSON> method will convert all L<URI>
2939 objects to JSON strings when serialised. The fact that these values
2940 originally were L<URI> objects is lost.
2947 =item 3. C<allow_bignum> is enabled and the object is a C<Math::BigInt> or C<Math::BigFloat>.
2949 The object will be serialised as a JSON number value.
2951 =item 4. C<allow_blessed> is enabled.
2953 The object will be serialised as a JSON null value.
2955 =item 5. none of the above
2957 If none of the settings are enabled or the respective methods are missing,
2958 C<JSON::PP> throws an exception.
2962 =head3 DESERIALISATION
2964 For deserialisation there are only two cases to consider: either
2965 nonstandard tagging was used, in which case C<allow_tags> decides,
2966 or objects cannot be automatically be deserialised, in which
2967 case you can use postprocessing or the C<filter_json_object> or
2968 C<filter_json_single_key_object> callbacks to get some real objects our of
2971 This section only considers the tagged value case: a tagged JSON object
2972 is encountered during decoding and C<allow_tags> is disabled, a parse
2973 error will result (as if tagged values were not part of the grammar).
2975 If C<allow_tags> is enabled, C<JSON::PP> will look up the C<THAW> method
2976 of the package/classname used during serialisation (it will not attempt
2977 to load the package as a Perl module). If there is no such method, the
2978 decoding will fail with an error.
2980 Otherwise, the C<THAW> method is invoked with the classname as first
2981 argument, the constant string C<JSON> as second argument, and all the
2982 values from the JSON array (the values originally returned by the
2983 C<FREEZE> method) as remaining arguments.
2985 The method must then return the object. While technically you can return
2986 any Perl scalar, you might have to enable the C<allow_nonref> setting to
2987 make that work in all cases, so better return an actual blessed reference.
2989 As an example, let's implement a C<THAW> function that regenerates the
2990 C<My::Object> from the C<FREEZE> example earlier:
2992 sub My::Object::THAW {
2993 my ($class, $serialiser, $type, $id) = @_;
2995 $class->new (type => $type, id => $id)
2999 =head1 ENCODING/CODESET FLAG NOTES
3001 This section is taken from JSON::XS.
3003 The interested reader might have seen a number of flags that signify
3004 encodings or codesets - C<utf8>, C<latin1> and C<ascii>. There seems to be
3005 some confusion on what these do, so here is a short comparison:
3007 C<utf8> controls whether the JSON text created by C<encode> (and expected
3008 by C<decode>) is UTF-8 encoded or not, while C<latin1> and C<ascii> only
3009 control whether C<encode> escapes character values outside their respective
3010 codeset range. Neither of these flags conflict with each other, although
3011 some combinations make less sense than others.
3013 Care has been taken to make all flags symmetrical with respect to
3014 C<encode> and C<decode>, that is, texts encoded with any combination of
3015 these flag values will be correctly decoded when the same flags are used
3016 - in general, if you use different flag settings while encoding vs. when
3017 decoding you likely have a bug somewhere.
3019 Below comes a verbose discussion of these flags. Note that a "codeset" is
3020 simply an abstract set of character-codepoint pairs, while an encoding
3021 takes those codepoint numbers and I<encodes> them, in our case into
3022 octets. Unicode is (among other things) a codeset, UTF-8 is an encoding,
3023 and ISO-8859-1 (= latin 1) and ASCII are both codesets I<and> encodings at
3024 the same time, which can be confusing.
3028 =item C<utf8> flag disabled
3030 When C<utf8> is disabled (the default), then C<encode>/C<decode> generate
3031 and expect Unicode strings, that is, characters with high ordinal Unicode
3032 values (> 255) will be encoded as such characters, and likewise such
3033 characters are decoded as-is, no changes to them will be done, except
3034 "(re-)interpreting" them as Unicode codepoints or Unicode characters,
3035 respectively (to Perl, these are the same thing in strings unless you do
3036 funny/weird/dumb stuff).
3038 This is useful when you want to do the encoding yourself (e.g. when you
3039 want to have UTF-16 encoded JSON texts) or when some other layer does
3040 the encoding for you (for example, when printing to a terminal using a
3041 filehandle that transparently encodes to UTF-8 you certainly do NOT want
3042 to UTF-8 encode your data first and have Perl encode it another time).
3044 =item C<utf8> flag enabled
3046 If the C<utf8>-flag is enabled, C<encode>/C<decode> will encode all
3047 characters using the corresponding UTF-8 multi-byte sequence, and will
3048 expect your input strings to be encoded as UTF-8, that is, no "character"
3049 of the input string must have any value > 255, as UTF-8 does not allow
3052 The C<utf8> flag therefore switches between two modes: disabled means you
3053 will get a Unicode string in Perl, enabled means you get an UTF-8 encoded
3054 octet/binary string in Perl.
3056 =item C<latin1> or C<ascii> flags enabled
3058 With C<latin1> (or C<ascii>) enabled, C<encode> will escape characters
3059 with ordinal values > 255 (> 127 with C<ascii>) and encode the remaining
3060 characters as specified by the C<utf8> flag.
3062 If C<utf8> is disabled, then the result is also correctly encoded in those
3063 character sets (as both are proper subsets of Unicode, meaning that a
3064 Unicode string with all character values < 256 is the same thing as a
3065 ISO-8859-1 string, and a Unicode string with all character values < 128 is
3066 the same thing as an ASCII string in Perl).
3068 If C<utf8> is enabled, you still get a correct UTF-8-encoded string,
3069 regardless of these flags, just some more characters will be escaped using
3070 C<\uXXXX> then before.
3072 Note that ISO-8859-1-I<encoded> strings are not compatible with UTF-8
3073 encoding, while ASCII-encoded strings are. That is because the ISO-8859-1
3074 encoding is NOT a subset of UTF-8 (despite the ISO-8859-1 I<codeset> being
3075 a subset of Unicode), while ASCII is.
3077 Surprisingly, C<decode> will ignore these flags and so treat all input
3078 values as governed by the C<utf8> flag. If it is disabled, this allows you
3079 to decode ISO-8859-1- and ASCII-encoded strings, as both strict subsets of
3080 Unicode. If it is enabled, you can correctly decode UTF-8 encoded strings.
3082 So neither C<latin1> nor C<ascii> are incompatible with the C<utf8> flag -
3083 they only govern when the JSON output engine escapes a character or not.
3085 The main use for C<latin1> is to relatively efficiently store binary data
3086 as JSON, at the expense of breaking compatibility with most JSON decoders.
3088 The main use for C<ascii> is to force the output to not contain characters
3089 with values > 127, which means you can interpret the resulting string
3090 as UTF-8, ISO-8859-1, ASCII, KOI8-R or most about any character set and
3091 8-bit-encoding, and still get the same data structure back. This is useful
3092 when your channel for JSON transfer is not 8-bit clean or the encoding
3093 might be mangled in between (e.g. in mail), and works because ASCII is a
3094 proper subset of most 8-bit and multibyte encodings in use in the world.
3100 Please report bugs on a specific behavior of this module to RT or GitHub
3103 L<https://github.com/makamaka/JSON-PP/issues>
3105 L<https://rt.cpan.org/Public/Dist/Display.html?Queue=JSON-PP>
3107 As for new features and requests to change common behaviors, please
3108 ask the author of JSON::XS (Marc Lehmann, E<lt>schmorp[at]schmorp.deE<gt>)
3109 first, by email (important!), to keep compatibility among JSON.pm backends.
3111 Generally speaking, if you need something special for you, you are advised
3112 to create a new module, maybe based on L<JSON::Tiny>, which is smaller and
3113 written in a much cleaner way than this module.
3117 The F<json_pp> command line utility for quick experiments.
3119 L<JSON::XS>, L<Cpanel::JSON::XS>, and L<JSON::Tiny> for faster alternatives.
3120 L<JSON> and L<JSON::MaybeXS> for easy migration.
3122 L<JSON::PP::Compat5005> and L<JSON::PP::Compat5006> for older perl users.
3124 RFC4627 (L<http://www.ietf.org/rfc/rfc4627.txt>)
3126 RFC7159 (L<http://www.ietf.org/rfc/rfc7159.txt>)
3128 RFC8259 (L<http://www.ietf.org/rfc/rfc8259.txt>)
3132 Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
3134 =head1 CURRENT MAINTAINER
3136 Kenichi Ishigaki, E<lt>ishigaki[at]cpan.orgE<gt>
3138 =head1 COPYRIGHT AND LICENSE
3140 Copyright 2007-2016 by Makamaka Hannyaharamitu
3142 Most of the documentation is taken from JSON::XS by Marc Lehmann
3144 This library is free software; you can redistribute it and/or modify
3145 it under the same terms as Perl itself.