前段时间看到一个老外对perl网络传输持久化做了个对比，原文地址http://blog.celogeek.com/201401/519/perl-benchmark-jsonxs-vs-sereal-vs-datamessagepack/，需要自己翻墙。
本人在自己的机器上也做了下测试。硬件配置Intel(R) Xeon(R) CPU X3430 @ 2.40GHz, 8G内存，Centos6.4 64位 perl 5.10 64位。
原文中作者测试了Data::MessagePack，Sereal，JSON，CBOR，这里我也加了一个Storable，毕竟从取材来说这个模块是自带的。注意CBOR目前只支持64位的操作系统。以下是测试结果
测试小数据的结果
{
CBOR {
decode 809562,
encode 1720319,
size 30
},
JSON {
decode 669260,
encode 860160,
size 42
},
MP {
decode 573439,
encode 491519,
size 30
},
Sereal {
decode 595284,
encode 600178,
size 38
},
'Sereal OO' {
decode 764586,
encode 1181633,
size 38
},
storable {
decode 312785,
encode 46109
}
}
#!perluse 5.010;use DDP;use Data::MessagePack;use Sereal;use JSON;#use JSON::XS;use CBOR::XS;use Storable qw(nstore store_fd nstore_fd freeze thaw dclone);use Benchmark qw/countit :hireswallclock/;my $dt = Data::MessagePack->new;my $se = Sereal::Encoder->new({no_shared_hashkeys => 1}); # may lead to high size, but 100% faster at encoding !my $sd = Sereal::Decoder->new;my $cb = CBOR::XS->new;sub count_this {my ($label, $meth, $storage) = @_;$|=1;print $label, " ";$$storage = countit(1, $meth)->iters;print ".";$$storage += countit(1, $meth)->iters;print ".";$$storage += countit(1, $meth)->iters;say ".";$$storage = int($$storage / 3);}sub run_bench {my ($label, $struct) = @_;my $ser_sereal = Sereal::encode_sereal($struct);my $ser_sereal_oo = $se->encode($struct);my $ser_mp = $dt->pack($struct);my $ser_json = JSON::encode_json($struct);my $ser_cb = $cb->encode($struct);my $ser_storable = freeze $struct;my %result = ('Sereal' => { size => length($ser_sereal) },'Sereal OO' => { size => length($ser_sereal_oo) },'MP' => { size => length($ser_mp) },'JSON' => { size => length($ser_json) },'CBOR' => { size => length($ser_cb) },'Storable' => { size => length($ser_storable) },);say "Start benchmark for $label ...";count_this('Sereal Decode' , sub {Sereal::decode_sereal($ser_sereal)}, \$result{Sereal}{decode});count_this('Sereal Encode' , sub {Sereal::encode_sereal($struct)} , \$result{Sereal}{encode});count_this('Sereal OO Decode', sub {$sd->decode($ser_sereal_oo)} , \$result{'Sereal OO'}{decode});count_this('Sereal OO Encode', sub {$se->encode($struct)} , \$result{'Sereal OO'}{encode});count_this('MP Decode' , sub {$dt->unpack($ser_mp)} , \$result{'MP'}{decode});count_this('MP Encode' , sub {$dt->pack($struct)} , \$result{'MP'}{encode});count_this('JSON Decode' , sub {JSON::decode_json($ser_json)} , \$result{'JSON'}{decode});count_this('JSON Encode' , sub {JSON::encode_json($struct)} , \$result{'JSON'}{encode});count_this('CBOR Decode' , sub {$cb->decode($ser_cb)} , \$result{'CBOR'}{decode});count_this('CBOR Encode' , sub {$cb->encode($struct)} , \$result{'CBOR'}{encode});count_this('storable Encode' , sub {freeze $struct} , \$result{'storable'}{encode});count_this('storable Decode' , sub {thaw $ser_storable} , \$result{'storable'}{decode});say "Finish benchmark for $label ...";say "Result : ";say p(%result);}run_bench( 'small', { a => 1, b => 2, c => 3, d => 'string', e => 5.018 } );run_bench( 'large', { a => 1, b => 2, c => 3, d => 'string', e => 5.018, f => [map{$_} 1..1000] } );
