Skip to content

Instantly share code, notes, and snippets.

@xaicron
Created March 4, 2014 07:42
Show Gist options
  • Save xaicron/9341932 to your computer and use it in GitHub Desktop.
Save xaicron/9341932 to your computer and use it in GitHub Desktop.
use strict;
use warnings;
use Plack::Request;
use Benchmark qw(cmpthese :hireswallclock);
package Plack::Request::Fast {
use parent 'Plack::Request';
use HTTP::Headers::Fast;
use URI::Escape::XS;
use WWW::Form::UrlEncoded::XS;
use HTTP::Entity::Parser;
my $parser = HTTP::Entity::Parser->new;
$parser->register('application/x-www-form-urlencoded', 'HTTP::Entity::Parser::UrlEncoded');
$parser->register('multipart/form-data', 'HTTP::Entity::Parser::MultiPart');
# $parser->register('application/json', 'HTTP::Entity::Parser::JSON');
sub _parse_query {
my $self = shift;
my @query;
my $query_string = $self->env->{QUERY_STRING};
if (defined $query_string) {
if ($query_string =~ /=/) {
# Handle ?foo=bar&bar=foo type of query
@query =
map { s/\+/ /g; URI::Escape::XS::uri_unescape($_) }
map { /=/ ? split(/=/, $_, 2) : ($_ => '')}
split(/[&;]/, $query_string);
} else {
# Handle ...?dog+bones type of query
@query =
map { (URI::Escape::XS::uri_unescape($_), '') }
split(/\+/, $query_string, -1);
}
}
Hash::MultiValue->new(@query);
}
sub _parse_request_body {
my $self = shift;
my $ct = $self->env->{CONTENT_TYPE};
my $cl = $self->env->{CONTENT_LENGTH};
if (!$ct && !$cl) {
# No Content-Type nor Content-Length -> GET/HEAD
$self->env->{'plack.request.body'} = Hash::MultiValue->new;
$self->env->{'plack.request.upload'} = Hash::MultiValue->new;
return;
}
my ($params, $uploads) = $parser->parse($self->env);
$self->env->{'plack.request.body'} = Hash::MultiValue->new(@$params);
$self->{_uploads} = $uploads,
return 1;
}
sub uploads {
my $self = shift;
if ($self->env->{'plack.request.upload'}) {
return $self->env->{'plack.request.upload'};
}
$self->_parse_request_body unless $self->{_uploads};
my $uploads = delete $self->{_uploads};
my $upload_hmv = Hash::MultiValue->new();
while (my ($k,$v) = splice @$uploads, 0, 2) {
my %copy = %$v;
$copy{headers} = HTTP::Headers::Fast->new(@{$v->{headers}});
$upload_hmv->add($k, Plack::Request::Upload->new(%copy));
}
return $self->env->{'plack.request.upload'} = $upload_hmv;
}
sub DESTROY {
my $self = shift;
if (my $upload_hmv = $self->env->{'plack.request.upload'}) {
my @temps = ();
for my $upload (values %{ $upload_hmv }) {
push @temps, map { $_->{tempname} // () }
ref $upload eq 'ARRAY' ? @$upload : $upload;
}
unlink map { $_ } grep { -e $_ } @temps;
}
}
};
package main {
my $content1 = 'xxx=hogehoge&yyy=aaaaaaaaaaaaaaaaaaaaa';
my $content2 = 'xxx=hogehoge&yyy=aaaaaaaaaaaaaaaaaaaaa&%E6%97%A5%E6%9C%AC%E8%AA%9E=%E3%81%AB%E3%81%BB%E3%82%93%E3%81%94&%E3%81%BB%E3%81%92%E3%81%BB%E3%81%92=%E3%81%B5%E3%81%8C%E3%81%B5%E3%81%8C';
my $content3 = join '&', map { "$_=%E3%81%B5%E3%81%8C%E3%81%B5%E3%81%8C%E3%81%B5%E3%81%8C%E3%81%B5%E3%81%8C%E3%81%B5%E3%81%8C%E3%81%B5%E3%81%8C" } 'A'..'R';
for my $content ($content1, $content2, $content3) {
print "\n## body_parameters (content length => ", length($content) . ")\n\n";
cmpthese -1, {
'fast' => sub {
open my $input, '<', \$content;
my $env = {
'psgi.input' => $input,
'psgix.input.buffered' => 1,
CONTENT_LENGTH => length($content),
CONTENT_TYPE => 'application/x-www-form-urlencoded',
};
my $req = Plack::Request::Fast->new($env);
my $params = $req->body_parameters;
},
'original' => sub {
open my $input, '<', \$content;
my $env = {
'psgi.input' => $input,
'psgix.input.buffered' => 1,
CONTENT_LENGTH => length($content),
CONTENT_TYPE => 'application/x-www-form-urlencoded',
};
my $req = Plack::Request->new($env);
my $params = $req->body_parameters;
}
}, 'all';
}
print "-" x 80, "\n";
for my $content ($content1, $content2, $content3) {
print "\n## query_parameters (content length => ", length($content) . ")\n\n";
cmpthese -1, {
'fast' => sub {
my $env = {
'QUERY_STRING' => $content,
};
my $req = Plack::Request::Fast->new($env);
my $params = $req->query_parameters;
},
'original' => sub {
my $env = {
'QUERY_STRING' => $content,
};
my $req = Plack::Request->new($env);
my $params = $req->query_parameters;
}
}, 'all';
}
};
__DATA__
## body_parameters (content length => 38)
Benchmark: running fast, original for at least 1 CPU seconds...
fast: 1.11663 wallclock secs ( 1.07 usr 0.01 sys + 0.00 cusr 0.00 csys = 1.08 CPU) @ 18100.93/s (n=19549)
original: 1.14458 wallclock secs ( 1.10 usr 0.01 sys + 0.00 cusr 0.00 csys = 1.11 CPU) @ 7840.54/s (n=8703)
Rate original fast
original 7841/s -- -57%
fast 18101/s 131% --
## body_parameters (content length => 177)
Benchmark: running fast, original for at least 1 CPU seconds...
fast: 1.10127 wallclock secs ( 1.09 usr 0.00 sys + 0.00 cusr 0.00 csys = 1.09 CPU) @ 16440.37/s (n=17920)
original: 1.20091 wallclock secs ( 1.18 usr 0.00 sys + 0.00 cusr 0.00 csys = 1.18 CPU) @ 5009.32/s (n=5911)
Rate original fast
original 5009/s -- -70%
fast 16440/s 228% --
## body_parameters (content length => 1997)
Benchmark: running fast, original for at least 1 CPU seconds...
fast: 1.06687 wallclock secs ( 1.02 usr 0.00 sys + 0.00 cusr 0.00 csys = 1.02 CPU) @ 9582.35/s (n=9774)
original: 1.11147 wallclock secs ( 1.09 usr 0.00 sys + 0.00 cusr 0.00 csys = 1.09 CPU) @ 997.25/s (n=1087)
Rate original fast
original 997/s -- -90%
fast 9582/s 861% --
--------------------------------------------------------------------------------
## query_parameters (content length => 38)
Benchmark: running fast, original for at least 1 CPU seconds...
fast: 1.14357 wallclock secs ( 1.13 usr 0.00 sys + 0.00 cusr 0.00 csys = 1.13 CPU) @ 25372.57/s (n=28671)
original: 1.18189 wallclock secs ( 1.16 usr 0.00 sys + 0.00 cusr 0.00 csys = 1.16 CPU) @ 28519.83/s (n=33083)
Rate fast original
fast 25373/s -- -11%
original 28520/s 12% --
## query_parameters (content length => 177)
Benchmark: running fast, original for at least 1 CPU seconds...
fast: 1.18275 wallclock secs ( 1.14 usr 0.00 sys + 0.00 cusr 0.00 csys = 1.14 CPU) @ 17148.25/s (n=19549)
original: 1.15653 wallclock secs ( 1.09 usr 0.00 sys + 0.00 cusr 0.00 csys = 1.09 CPU) @ 9158.72/s (n=9983)
Rate original fast
original 9159/s -- -47%
fast 17148/s 87% --
## query_parameters (content length => 1997)
Benchmark: running fast, original for at least 1 CPU seconds...
fast: 1.12652 wallclock secs ( 1.11 usr 0.00 sys + 0.00 cusr 0.00 csys = 1.11 CPU) @ 5097.30/s (n=5658)
original: 1.1952 wallclock secs ( 1.16 usr 0.00 sys + 0.00 cusr 0.00 csys = 1.16 CPU) @ 1157.76/s (n=1343)
Rate original fast
original 1158/s -- -77%
fast 5097/s 340% --
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment