percona/percona-toolkit
1
0
Fork 0
mirror of https://github.com/percona/percona-toolkit.git synced 2025-10-24 11:11:14 +00:00
Code Issues Packages Projects Releases Wiki Activity

Add an encode_json function to Transformers.pm

Browse Source
This commit is contained in:
Brian Fraser
2012-02-07 11:07:41 -03:00
parent 4d5d4da4b7
commit cf347793be
2 changed files with 199 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

94
lib/Transformers.pm
View File

@@ -29,6 +29,7 @@ use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Time::Local qw(timegm timelocal);
use Digest::MD5 qw(md5_hex);
use B qw();
require Exporter;
our @ISA = qw(Exporter);
@@ -46,6 +47,7 @@ our @EXPORT_OK = qw(
any_unix_timestamp
make_checksum
crc32
encode_json
);
our $mysql_ts = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/;
@@ -285,6 +287,98 @@ sub crc32 {
return $crc ^ 0xFFFFFFFF;
}
my $got_json = eval { require JSON };
sub encode_json {
return JSON::encode_json(@_) if $got_json;
my ( $data ) = @_;
return (object_to_json($data) || '');
}
# The following is a stripped down version of JSON::PP by Makamaka Hannyaharamitu
# https://metacpan.org/module/JSON::PP
sub object_to_json {
my ($obj) = @_;
my $type = ref($obj);
if($type eq 'HASH'){
return hash_to_json($obj);
}
elsif($type eq 'ARRAY'){
return array_to_json($obj);
}
else {
return value_to_json($obj);
}
}
sub hash_to_json {
my ($obj) = @_;
my @res;
for my $k ( sort { $a cmp $b } keys %$obj ) {
push @res, string_to_json( $k )
. ":"
. ( object_to_json( $obj->{$k} ) || value_to_json( $obj->{$k} ) );
}
return '{' . ( @res ? join( ",", @res ) : '' ) . '}';
}
sub array_to_json {
my ($obj) = @_;
my @res;
for my $v (@$obj) {
push @res, object_to_json($v) || value_to_json($v);
}
return '[' . ( @res ? join( ",", @res ) : '' ) . ']';
}
sub value_to_json {
my ($value) = @_;
return 'null' if(!defined $value);
my $b_obj = B::svref_2object(\$value); # for round trip problem
my $flags = $b_obj->FLAGS;
return $value # as is
if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV?
my $type = ref($value);
if( !$type ) {
return string_to_json($value);
}
else {
return 'null';
}
}
my %esc = (
"\n" => '\n',
"\r" => '\r',
"\t" => '\t',
"\f" => '\f',
"\b" => '\b',
"\"" => '\"',
"\\" => '\\\\',
"\'" => '\\\'',
);
sub string_to_json {
my ($arg) = @_;
$arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;
$arg =~ s/\//\\\//g;
$arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;
utf8::upgrade($arg);
utf8::encode($arg);
return '"' . $arg . '"';
}
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }

107
t/lib/Transformers.t
View File

@@ -1,5 +1,7 @@
#!/usr/bin/perl
# This file is encoded in UTF-8.
BEGIN {
die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
@@ -12,14 +14,14 @@ BEGIN {
use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use Test::More tests => 49;
use Test::More tests => 74;
use Transformers;
use PerconaTest;
Transformers->import( qw(parse_timestamp micro_t shorten secs_to_time
time_to_secs percentage_of unix_timestamp make_checksum any_unix_timestamp
ts crc32) );
ts crc32 encode_json) );
# #############################################################################
# micro_t() tests.
@@ -195,6 +197,107 @@ is(
'any_unix_timestamp MySQL expression that looks like another type'
);
{
# Tests borrowed from http://api.metacpan.org/source/MAKAMAKA/JSON-2.53/t/08_pc_base.t
my $obj = {};
my $js = encode_json($obj);
is($js,'{}', '{}');
$obj = [];
$js = encode_json($obj);
is($js,'[]', '[]');
$obj = {"foo" => "bar"};
$js = encode_json($obj);
is($js,'{"foo":"bar"}', '{"foo":"bar"}');
$js = encode_json({"foo" => ""});
is($js,'{"foo":""}', '{"foo":""}');
$js = encode_json({"foo" => " "});
is($js,'{"foo":" "}' ,'{"foo":" "}');
$js = encode_json({"foo" => "0"});
is($js,'{"foo":"0"}',q|{"foo":"0"} - autoencode (default)|);
$js = encode_json({"foo" => "0 0"});
is($js,'{"foo":"0 0"}','{"foo":"0 0"}');
$js = encode_json([1,2,3]);
is($js,'[1,2,3]');
$js = encode_json({"foo"=>{"bar"=>"hoge"}});
is($js,q|{"foo":{"bar":"hoge"}}|);
$obj = [{"foo"=>[1,2,3]},-0.12,{"a"=>"b"}];
$js = encode_json($obj);
is($js,q|[{"foo":[1,2,3]},-0.12,{"a":"b"}]|);
$obj = ["\x01"];
is(encode_json($obj),'["\\u0001"]');
$obj = ["\e"];
is(encode_json($obj),'["\\u001b"]');
{
# http://api.metacpan.org/source/MAKAMAKA/JSON-2.53/t/07_pc_esc.t
use utf8;
$obj = {test => qq|abc"def|};
my $str = encode_json($obj);
is($str,q|{"test":"abc\"def"}|);
$obj = {qq|te"st| => qq|abc"def|};
$str = encode_json($obj);
is($str,q|{"te\"st":"abc\"def"}|);
$obj = {test => q|abc\def|};
$str = encode_json($obj);
is($str,q|{"test":"abc\\\\def"}|);
$obj = {test => "abc\bdef"};
$str = encode_json($obj);
is($str,q|{"test":"abc\bdef"}|);
$obj = {test => "abc\fdef"};
$str = encode_json($obj);
is($str,q|{"test":"abc\fdef"}|);
$obj = {test => "abc\ndef"};
$str = encode_json($obj);
is($str,q|{"test":"abc\ndef"}|);
$obj = {test => "abc\rdef"};
$str = encode_json($obj);
is($str,q|{"test":"abc\rdef"}|);
$obj = {test => "abc-def"};
$str = encode_json($obj);
is($str,q|{"test":"abc-def"}|);
$obj = {test => "abc(def"};
$str = encode_json($obj);
is($str,q|{"test":"abc(def"}|);
$obj = {test => "abc\\def"};
$str = encode_json($obj);
is($str,q|{"test":"abc\\\\def"}|);
$obj = {test => "あいうえお"};
$str = encode_json($obj);
my $expect = q|{"test":"あいうえお"}|;
utf8::encode($expect);
is($str,$expect);
$obj = {"あいうえお" => "かきくけこ"};
$str = encode_json($obj);
$expect = q|{"あいうえお":"かきくけこ"}|;
utf8::encode($expect);
is($str,$expect);
}
}
# #############################################################################
# Done.