Current File : //usr/share/perl5/vendor_perl/Amavis/JSON.pm |
# SPDX-License-Identifier: GPL-2.0-or-later
package Amavis::JSON;
use strict;
use re 'taint';
# serialize a data structure to JSON, RFC 7159
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&boolean &numeric);
}
use subs @EXPORT_OK;
our %jesc = ( # JSON escaping
"\x22" => '\\"', "\x5C" => '\\\\',
"\x08" => '\\b', "\x09" => '\\t',
"\x0A" => '\\n', "\x0C" => '\\f', "\x0D" => '\\r',
"\x{2028}" => '\\u2028', "\x{2029}" => '\\u2029' );
# escape also the Line Separator (U+2028) and Paragraph Separator (U+2029)
# http://timelessrepo.com/json-isnt-a-javascript-subset
our($FALSE, $TRUE) = ('false', 'true');
sub boolean { bless($_[0] ? \$TRUE : \$FALSE) }
sub numeric { my $value = $_[0]; bless(\$value) }
# serialize a data structure to JSON, RFC 7159
# expects logical characters in scalars, returns a string of logical chars
#
sub encode($); # prototype
sub encode($) {
my $val = $_[0];
my $ref = ref $val;
local $1;
if ($ref) {
if ($ref eq 'ARRAY') {
return '[' . join(',', map(encode($_), @$val)) . ']';
} elsif ($ref eq 'HASH') {
return '{' .
join(',',
map {
my $k = $_;
$k =~ s{ ([\x00-\x1F\x7F\x{2028}\x{2029}"\\]) }
{ $jesc{$1} || sprintf('\\u%04X',ord($1)) }xgse;
'"' . $k . '":' . encode($val->{$_});
} sort keys %$val
) . '}';
} elsif ($ref->isa('Amavis::JSON')) { # numeric or boolean type
return defined $$val ? $$val : 'null';
}
# fall through, encode other refs as strings, helps debugging
}
return 'null' if !defined $val;
{ # concession on a perl 5.20.0 bug [perl #122148] (fixed in 5.20.1)
# - just warn, do not abort
use warnings NONFATAL => qw(utf8);
$val =~ s{ ([\x00-\x1F\x7F\x{2028}\x{2029}"\\]) }
{ $jesc{$1} || sprintf('\\u%04X',ord($1)) }xgse;
};
'"' . $val . '"';
}
1;