Skip to content

Instantly share code, notes, and snippets.

@ap

ap/faster-header-utils-bench.pl

Last active August 29, 2015 14:14
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save ap/e179bb0072c708b7704c to your computer and use it in GitHub Desktop.
Save ap/e179bb0072c708b7704c to your computer and use it in GitHub Desktop.
Download ZIP
Pull request benchmarks for Plack#495
Raw
faster-header-utils-bench.pl
#!/usr/bin/env perl
use 5.012;
use warnings;
use Benchmark 'cmpthese';
use lib 'lib';
use Plack::Util ();
BEGIN { *header_iter = \&Plack::Util::header_iter }
my $h_null = [];
my $h_foo_none = [qw(X-Hdr-Bar 1 X-Hdr-Baz 2 X-Hdr-Quux 3 X-Hdr-Quux 4 X-Hdr-Quux 5 X-Hdr-Quux 6 X-Hdr-Quux 7 X-Hdr-Quux 8 X-Hdr-Quux 9 X-Hdr-Quux 10)];
my $h_foo_near = [qw(X-Hdr-Foo 1 X-Hdr-Bar 2 X-Hdr-Baz 3 X-Hdr-Quux 4 X-Hdr-Quux 5 X-Hdr-Quux 6 X-Hdr-Quux 7 X-Hdr-Quux 8 X-Hdr-Quux 9 X-Hdr-Quux 10)];
my $h_foo_last = [qw(X-Hdr-Bar 1 X-Hdr-Baz 2 X-Hdr-Quux 3 X-Hdr-Quux 4 X-Hdr-Quux 5 X-Hdr-Quux 6 X-Hdr-Quux 7 X-Hdr-Quux 8 X-Hdr-Quux 9 X-Hdr-Foo 10)];
my $h_foo_many = [qw(X-Hdr-Bar 1 X-Hdr-Baz 2 X-Hdr-Foo 3 X-Hdr-Quux 4 X-Hdr-Foo 5 X-Hdr-Quux 6 X-Hdr-Quux 7 X-Hdr-Quux 8 X-Hdr-Quux 9 X-Hdr-Quux 10 X-Hdr-Quux 11 X-Hdr-Foo 12)];
#######################################################################
sub header_exists {
my($headers, $key) = (shift, lc shift);
my $exists;
header_iter $headers, sub {
$exists = 1 if lc $_[0] eq $key;
};
return $exists;
}
say for header_exists => '-' x 35;
cmpthese -1, {
old_null => sub { header_exists $h_null, "X-Hdr-Foo" for 1..2000 },
new_null => sub { Plack::Util::header_exists $h_null, "X-Hdr-Foo" for 1..2000 },
};
cmpthese -1, {
old_none => sub { header_exists $h_foo_none, "X-Hdr-Foo" for 1..2000 },
new_none => sub { Plack::Util::header_exists $h_foo_none, "X-Hdr-Foo" for 1..2000 },
};
cmpthese -1, {
old_near => sub { header_exists $h_foo_near, "X-Hdr-Foo" for 1..2000 },
new_near => sub { Plack::Util::header_exists $h_foo_near, "X-Hdr-Foo" for 1..2000 },
};
cmpthese -1, {
old_last => sub { header_exists $h_foo_last, "X-Hdr-Foo" for 1..2000 },
new_last => sub { Plack::Util::header_exists $h_foo_last, "X-Hdr-Foo" for 1..2000 },
};
cmpthese -1, {
old_many => sub { header_exists $h_foo_many, "X-Hdr-Foo" for 1..2000 },
new_many => sub { Plack::Util::header_exists $h_foo_many, "X-Hdr-Foo" for 1..2000 },
};
say '';
#######################################################################
sub header_get {
my($headers, $key) = (shift, lc shift);
my @val;
header_iter $headers, sub {
push @val, $_[1] if lc $_[0] eq $key;
};
return wantarray ? @val : $val[0];
}
say for header_get => '-' x 35;
{ my @r; cmpthese -1, {
old_arrray_null => sub { @r = header_get $h_null, "X-Hdr-Foo" for 1..2000 },
new_arrray_null => sub { @r = Plack::Util::header_get $h_null, "X-Hdr-Foo" for 1..2000 },
} }
{ my $r; cmpthese -1, {
old_scalar_null => sub { $r = header_get $h_null, "X-Hdr-Foo" for 1..2000 },
new_scalar_null => sub { $r = Plack::Util::header_get $h_null, "X-Hdr-Foo" for 1..2000 },
} }
{ my @r; cmpthese -1, {
old_arrray_none => sub { @r = header_get $h_foo_none, "X-Hdr-Foo" for 1..2000 },
new_arrray_none => sub { @r = Plack::Util::header_get $h_foo_none, "X-Hdr-Foo" for 1..2000 },
} }
{ my $r; cmpthese -1, {
old_scalar_none => sub { $r = header_get $h_foo_none, "X-Hdr-Foo" for 1..2000 },
new_scalar_none => sub { $r = Plack::Util::header_get $h_foo_none, "X-Hdr-Foo" for 1..2000 },
} }
{ my @r; cmpthese -1, {
old_arrray_near => sub { @r = header_get $h_foo_near, "X-Hdr-Foo" for 1..2000 },
new_arrray_near => sub { @r = Plack::Util::header_get $h_foo_near, "X-Hdr-Foo" for 1..2000 },
} }
{ my $r; cmpthese -1, {
old_scalar_near => sub { $r = header_get $h_foo_near, "X-Hdr-Foo" for 1..2000 },
new_scalar_near => sub { $r = Plack::Util::header_get $h_foo_near, "X-Hdr-Foo" for 1..2000 },
} }
{ my @r; cmpthese -1, {
old_arrray_last => sub { @r = header_get $h_foo_last, "X-Hdr-Foo" for 1..2000 },
new_arrray_last => sub { @r = Plack::Util::header_get $h_foo_last, "X-Hdr-Foo" for 1..2000 },
} }
{ my $r; cmpthese -1, {
old_scalar_last => sub { $r = header_get $h_foo_last, "X-Hdr-Foo" for 1..2000 },
new_scalar_last => sub { $r = Plack::Util::header_get $h_foo_last, "X-Hdr-Foo" for 1..2000 },
} }
{ my @r; cmpthese -1, {
old_arrray_many => sub { @r = header_get $h_foo_many, "X-Hdr-Foo" for 1..2000 },
new_arrray_many => sub { @r = Plack::Util::header_get $h_foo_many, "X-Hdr-Foo" for 1..2000 },
} }
{ my $r; cmpthese -1, {
old_scalar_many => sub { $r = header_get $h_foo_many, "X-Hdr-Foo" for 1..2000 },
new_scalar_many => sub { $r = Plack::Util::header_get $h_foo_many, "X-Hdr-Foo" for 1..2000 },
} }
say '';
#######################################################################
sub header_remove {
my($headers, $key) = (shift, lc shift);
my @new_headers;
header_iter $headers, sub {
push @new_headers, $_[0], $_[1]
unless lc $_[0] eq $key;
};
@$headers = @new_headers;
}
say for header_remove => '-' x 35;
{ my $num = 1000; my @h = map [@$h_null], 1..(2000*$num*2); my $i = -1; cmpthese $num, {
old_null => sub { header_remove $h[++$i], "X-Hdr-Foo" for 1..2000 },
new_null => sub { Plack::Util::header_remove $h[++$i], "X-Hdr-Foo" for 1..2000 },
} }
{ my $num = 100; my @h = map [@$h_foo_none], 1..(2000*$num*2); my $i = -1; cmpthese $num, {
old_none => sub { header_remove $h[++$i], "X-Hdr-Foo" for 1..2000 },
new_none => sub { Plack::Util::header_remove $h[++$i], "X-Hdr-Foo" for 1..2000 },
} }
{ my $num = 100; my @h = map [@$h_foo_near], 1..(2000*$num*2); my $i = -1; cmpthese $num, {
old_near => sub { header_remove $h[++$i], "X-Hdr-Foo" for 1..2000 },
new_near => sub { Plack::Util::header_remove $h[++$i], "X-Hdr-Foo" for 1..2000 },
} }
{ my $num = 100; my @h = map [@$h_foo_last], 1..(2000*$num*2); my $i = -1; cmpthese $num, {
old_last => sub { header_remove $h[++$i], "X-Hdr-Foo" for 1..2000 },
new_last => sub { Plack::Util::header_remove $h[++$i], "X-Hdr-Foo" for 1..2000 },
} }
{ my $num = 100; my @h = map [@$h_foo_many], 1..(2000*$num*2); my $i = -1; cmpthese $num, {
old_many => sub { header_remove $h[++$i], "X-Hdr-Foo" for 1..2000 },
new_many => sub { Plack::Util::header_remove $h[++$i], "X-Hdr-Foo" for 1..2000 },
} }
say '';
#######################################################################
sub header_set {
my($headers, $key, $val) = @_;
my($set, @new_headers);
header_iter $headers, sub {
if (lc $key eq lc $_[0]) {
return if $set;
$_[1] = $val;
$set++;
}
push @new_headers, $_[0], $_[1];
};
push @new_headers, $key, $val unless $set;
@$headers = @new_headers;
}
say for header_set => '-' x 35;
{ my $num = 700; my @h = map [@$h_null], 1..(2000*$num*2); my $i = -1; cmpthese $num, {
old_null => sub { header_set $h[++$i], "X-Hdr-Foo", 1 for 1..2000 },
new_null => sub { Plack::Util::header_set $h[++$i], "X-Hdr-Foo", 1 for 1..2000 },
} }
{ my $num = 100; my @h = map [@$h_foo_none], 1..(2000*$num*2); my $i = -1; cmpthese $num, {
old_none => sub { header_set $h[++$i], "X-Hdr-Foo", 1 for 1..2000 },
new_none => sub { Plack::Util::header_set $h[++$i], "X-Hdr-Foo", 1 for 1..2000 },
} }
{ my $num = 100; my @h = map [@$h_foo_near], 1..(2000*$num*2); my $i = -1; cmpthese $num, {
old_near => sub { header_set $h[++$i], "X-Hdr-Foo", 1 for 1..2000 },
new_near => sub { Plack::Util::header_set $h[++$i], "X-Hdr-Foo", 1 for 1..2000 },
} }
{ my $num = 100; my @h = map [@$h_foo_last], 1..(2000*$num*2); my $i = -1; cmpthese $num, {
old_last => sub { header_set $h[++$i], "X-Hdr-Foo", 1 for 1..2000 },
new_last => sub { Plack::Util::header_set $h[++$i], "X-Hdr-Foo", 1 for 1..2000 },
} }
{ my $num = 100; my @h = map [@$h_foo_many], 1..(2000*$num*2); my $i = -1; cmpthese $num, {
old_many => sub { header_set $h[++$i], "X-Hdr-Foo", 1 for 1..2000 },
new_many => sub { Plack::Util::header_set $h[++$i], "X-Hdr-Foo", 1 for 1..2000 },
} }
say '';
Raw
output.txt
header_exists
-----------------------------------
Rate old_null new_null
old_null 189/s -- -79%
new_null 889/s 370% --
Rate old_none new_none
old_none 44.5/s -- -73%
new_none 163/s 266% --
Rate old_near new_near
old_near 43.8/s -- -93%
new_near 651/s 1386% --
Rate old_last new_last
old_last 43.4/s -- -77%
new_last 189/s 336% --
Rate old_many new_many
old_many 37.3/s -- -91%
new_many 399/s 971% --
header_get
-----------------------------------
Rate old_arrray_null new_arrray_null
old_arrray_null 157/s -- -83%
new_arrray_null 939/s 498% --
Rate old_scalar_null new_scalar_null
old_scalar_null 164/s -- -84%
new_scalar_null 1046/s 539% --
Rate old_arrray_none new_arrray_none
old_arrray_none 42.3/s -- -68%
new_arrray_none 131/s 210% --
Rate old_scalar_none new_scalar_none
old_scalar_none 42.6/s -- -76%
new_scalar_none 179/s 320% --
Rate old_arrray_near new_arrray_near
old_arrray_near 39.3/s -- -61%
new_arrray_near 102/s 159% --
Rate old_scalar_near new_scalar_near
old_scalar_near 40.9/s -- -90%
new_scalar_near 410/s 903% --
Rate old_arrray_last new_arrray_last
old_arrray_last 39.0/s -- -61%
new_arrray_last 101/s 158% --
Rate old_scalar_last new_scalar_last
old_scalar_last 40.2/s -- -75%
new_scalar_last 163/s 305% --
Rate old_arrray_many new_arrray_many
old_arrray_many 31.3/s -- -57%
new_arrray_many 72.2/s 131% --
Rate old_scalar_many new_scalar_many
old_scalar_many 33.7/s -- -89%
new_scalar_many 298/s 786% --
header_remove
-----------------------------------
Rate old_null new_null
old_null 153/s -- -86%
new_null 1064/s 594% --
Rate old_none new_none
old_none 22.0/s -- -71%
new_none 75.2/s 242% --
Rate old_near new_near
old_near 21.6/s -- -45%
new_near 39.4/s 82% --
Rate old_last new_last
old_last 22.0/s -- -44%
new_last 39.5/s 80% --
Rate old_many new_many
old_many 19.5/s -- -46%
new_many 36.1/s 85% --
header_set
-----------------------------------
Rate old_null new_null
old_null 115/s -- -78%
new_null 511/s 345% --
Rate old_none new_none
old_none 19.1/s -- -82%
new_none 109/s 470% --
Rate old_near new_near
old_near 19.3/s -- -51%
new_near 39.4/s 104% --
Rate old_last new_last
old_last 19.1/s -- -84%
new_last 118/s 515% --
Rate old_many new_many
old_many 16.4/s -- -58%
new_many 38.6/s 136% --
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment