The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/opt/bin/perl

# Usage: bench json-file

# which modules to test (JSON::PP usually excluded because its so slow)
my %tst = (
#   "JSON"          => ['JSON::encode_json $perl'  , 'JSON::decode_json $json'],
   "JSON::PP"      => ['$pp->encode ($perl)'      , '$pp->decode ($json)'],
   "JSON::DWIW/FJ" => ['$dwiw->to_json ($perl)'   , '$dwiw->from_json ($json)'],
   "JSON::DWIW/DS" => ['$dwiw->to_json ($perl)'   , 'JSON::DWIW::deserialize $json'],
#   "JSON::PC"      => ['$pc->convert ($perl)'     , '$pc->parse ($json)'],
   "JSON::Syck"    => ['JSON::Syck::Dump $perl'   , 'JSON::Syck::Load $json'],
   "JSON::XS"      => ['encode_json $perl'        , 'decode_json $json'],
   "JSON::XS/2"    => ['$xs2->encode ($perl)'     , '$xs2->decode ($json)'],
   "JSON::XS/3"    => ['$xs3->encode ($perl)'     , '$xs3->decode ($json)'],
   "Storable"      => ['Storable::nfreeze $perl'  , 'Storable::thaw $pst'],
);

use JSON ();
use JSON::DWIW;
use JSON::PC;
use JSON::PP ();
use JSON::XS qw(encode_json decode_json);
use JSON::Syck;
use Storable ();

use Time::HiRes;
use List::Util;

use utf8;

my $dwiw = new JSON::DWIW;
my $pc   = new JSON::PC;
my $pp   = JSON::PP->new->max_depth (512);
my $xs2  = JSON::XS->new->utf8->pretty->canonical;
my $xs3  = JSON::XS->new->utf8->shrink;

my $json; # the test string

local $/;
$json = <>;

# fix syck-brokenised stuff
#$json = JSON::XS->new->ascii(1)->encode (JSON::Syck::Load $json);

#srand 0; $json = JSON::XS->new->utf8(1)->ascii(0)->encode ([join "", map +(chr rand 255), 0..2047]);

#if (1) {
#   use Storable;
#   open my $fh, "<:unix", "/opt/crossfire/share/cfserver/faces" or die "$!";
#   my $faces = Storable::thaw do { <$fh> };
#   $json = objToJson $faces;
#   open my $fh2, ">:unix", "faces.json" or die "$!";
#   print $fh2 $json;
#   warn length $json;
#}

sub bench($) {
   my ($code) = @_;

   my $pst  = Storable::nfreeze JSON::XS::decode_json $json; # seperately decode as storable stringifies :/
   my $perl = JSON::XS::decode_json $json;

   my $count = 5;
   my $times = 200;

   my $cent = eval "sub { my \$t = Time::HiRes::time; " . (join ";", ($code) x $count) . "; Time::HiRes::time - \$t }";
   $cent->();

   my $min = 1e99;

   for (1..$times) {
      my $t = $cent->();

      $min = $t if $t < $min;
   }

   return $count / $min;
}

printf "%-13s | %10s | %10s |\n", "module", "encode", "decode";
printf "--------------|------------|------------|\n";
for my $module (sort keys %tst) {
   my $enc = bench $tst{$module}[0];
   my $dec = bench $tst{$module}[1];

   printf "%-13s | %10.3f | %10.3f |\n", $module, $enc, $dec;
}
printf "--------------+------------+------------+\n";