| Server IP : 23.254.227.96 / Your IP : 216.73.216.183 Web Server : Apache/2.4.62 (Unix) OpenSSL/1.1.1k System : Linux hwsrv-1277026.hostwindsdns.com 4.18.0-477.13.1.el8_8.x86_64 #1 SMP Tue May 30 14:53:41 EDT 2023 x86_64 User : viralblo ( 1001) PHP Version : 8.1.31 Disable Function : NONE MySQL : OFF | cURL : ON | WGET : ON | Perl : ON | Python : OFF | Sudo : ON | Pkexec : ON Directory : /proc/self/root/usr/share/perl5/vendor_perl/Amavis/ |
Upload File : |
# 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;