[libhttp-entity-parser-perl] 01/02: cache loaded parser and tune a bit
gregor herrmann
gregoa at debian.org
Sun Oct 23 00:23:39 UTC 2016
This is an automated email from the git hooks/post-receive script.
gregoa pushed a commit to tag 0.11
in repository libhttp-entity-parser-perl.
commit d233fd6376dc34c82aaa058f4572abe351b20501
Author: Masahiro Nagano <kazeburo at gmail.com>
Date: Thu Feb 20 00:31:14 2014 +0900
cache loaded parser and tune a bit
---
eg/bench.pl | 28 +++++++++----------
lib/HTTP/Entity/Parser.pm | 52 +++++++++++++++++++++--------------
lib/HTTP/Entity/Parser/JSON.pm | 9 +++---
lib/HTTP/Entity/Parser/OctetStream.pm | 3 +-
lib/HTTP/Entity/Parser/UrlEncoded.pm | 2 +-
5 files changed, 52 insertions(+), 42 deletions(-)
diff --git a/eg/bench.pl b/eg/bench.pl
index 1e7ab05..3ad586c 100644
--- a/eg/bench.pl
+++ b/eg/bench.pl
@@ -12,8 +12,8 @@ my $content2 = 'xxx=hogehoge&yyy=aaaaaaaaaaaaaaaaaaaaa&%E6%97%A5%E6%9C%AC%E8%AA%
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';
- my $parser = HTTP::Entity::Parser->new;
- $parser->register('application/x-www-form-urlencoded','HTTP::Entity::Parser::UrlEncoded');
+my $parser = HTTP::Entity::Parser->new;
+$parser->register('application/x-www-form-urlencoded','HTTP::Entity::Parser::UrlEncoded');
for my $content ($content1, $content2, $content3) {
print "\n## content length => ", length($content) . "\n\n";
@@ -43,26 +43,26 @@ __END__
## content length => 38
Benchmark: running http_body, http_entity for at least 1 CPU seconds...
- http_body: 1 wallclock secs ( 1.08 usr + 0.00 sys = 1.08 CPU) @ 36201.85/s (n=39098)
-http_entity: 1 wallclock secs ( 1.12 usr + 0.00 sys = 1.12 CPU) @ 76799.11/s (n=86015)
+ http_body: 1 wallclock secs ( 1.02 usr + 0.00 sys = 1.02 CPU) @ 34132.35/s (n=34815)
+http_entity: 1 wallclock secs ( 1.08 usr + 0.00 sys = 1.08 CPU) @ 79643.52/s (n=86015)
Rate http_body http_entity
-http_body 36202/s -- -53%
-http_entity 76799/s 112% --
+http_body 34132/s -- -57%
+http_entity 79644/s 133% --
## content length => 177
Benchmark: running http_body, http_entity for at least 1 CPU seconds...
- http_body: 1 wallclock secs ( 1.11 usr + 0.00 sys = 1.11 CPU) @ 14901.80/s (n=16541)
-http_entity: 1 wallclock secs ( 1.08 usr + 0.00 sys = 1.08 CPU) @ 64474.07/s (n=69632)
+ http_body: 2 wallclock secs ( 1.17 usr + 0.00 sys = 1.17 CPU) @ 14137.61/s (n=16541)
+http_entity: 1 wallclock secs ( 1.06 usr + 0.00 sys = 1.06 CPU) @ 67621.70/s (n=71679)
Rate http_body http_entity
-http_body 14902/s -- -77%
-http_entity 64474/s 333% --
+http_body 14138/s -- -79%
+http_entity 67622/s 378% --
## content length => 1997
Benchmark: running http_body, http_entity for at least 1 CPU seconds...
- http_body: 1 wallclock secs ( 1.16 usr + 0.00 sys = 1.16 CPU) @ 1930.17/s (n=2239)
-http_entity: 1 wallclock secs ( 1.11 usr + 0.00 sys = 1.11 CPU) @ 29519.82/s (n=32767)
+ http_body: 1 wallclock secs ( 1.09 usr + 0.00 sys = 1.09 CPU) @ 2054.13/s (n=2239)
+http_entity: 2 wallclock secs ( 1.13 usr + 0.00 sys = 1.13 CPU) @ 29276.99/s (n=33083)
Rate http_body http_entity
-http_body 1930/s -- -93%
-http_entity 29520/s 1429% --
+http_body 2054/s -- -93%
+http_entity 29277/s 1325% --
diff --git a/lib/HTTP/Entity/Parser.pm b/lib/HTTP/Entity/Parser.pm
index 1128366..c8d3801 100644
--- a/lib/HTTP/Entity/Parser.pm
+++ b/lib/HTTP/Entity/Parser.pm
@@ -4,47 +4,57 @@ use 5.008005;
use strict;
use warnings;
use Stream::Buffered;
-use HTTP::Entity::Parser::OctetStream;
use Module::Load;
our $VERSION = "0.10";
-sub new {
- my $class = shift;
- bless { handlers => [] }, $class;
+our %LOADED;
+our @DEFAULT_PARSER = qw/
+ OctetStream
+ UrlEncoded
+ MultiPart
+ JSON
+/;
+for my $parser ( @DEFAULT_PARSER ) {
+ load "HTTP::Entity::Parser::".$parser;
+ $LOADED{"HTTP::Entity::Parser::".$parser} = 1;
}
-sub register {
- my ($self, $content_type, $klass, $opts) = @_;
- load $klass;
- push @{$self->{handlers}}, [$content_type, $klass, $opts];
+sub new {
+ bless [ [] ], $_[0];
}
-sub get_parser {
- my ($self, $env) = @_;
-
- if (defined $env->{CONTENT_TYPE}) {
- for my $handler (@{$self->{handlers}}) {
- if ( $env->{CONTENT_TYPE} eq $handler->[0]
- || index($env->{CONTENT_TYPE}, $handler->[0]) == 0) {
- return $handler->[1]->new($env, $handler->[2]);
- }
- }
+sub register {
+ my ($self,$content_type, $klass, $opts) = @_;
+ if ( !$LOADED{$klass} ) {
+ load $klass;
+ $LOADED{$klass} = 1;
}
- return HTTP::Entity::Parser::OctetStream->new();
+ push @{$self->[0]}, [$content_type, $klass, $opts];
}
sub parse {
my ($self, $env) = @_;
- my $parser = $self->get_parser($env);
-
my $ct = $env->{CONTENT_TYPE};
if (!$ct) {
# No Content-Type
return ([], []);
}
+ my $parser;
+ for my $handler (@{$self->[0]}) {
+ if ( $ct eq $handler->[0] || index($ct, $handler->[0]) == 0) {
+ $parser = $handler->[1]->new($env, $handler->[2]);
+ last;
+ }
+ }
+
+ if ( !$parser ) {
+ $parser = HTTP::Entity::Parser::OctetStream->new();
+ }
+
+
my $input = $env->{'psgi.input'};
my $buffer;
diff --git a/lib/HTTP/Entity/Parser/JSON.pm b/lib/HTTP/Entity/Parser/JSON.pm
index 665a9c8..5b17774 100644
--- a/lib/HTTP/Entity/Parser/JSON.pm
+++ b/lib/HTTP/Entity/Parser/JSON.pm
@@ -6,19 +6,20 @@ use JSON qw//;
use Encode qw/encode_utf8/;
sub new {
- my $class = shift;
- bless {buffer => ''}, $class;
+ bless [''], $_[0];
}
sub add {
my $self = shift;
- $self->{buffer} .= $_[0] if defined $_[0];
+ if (defined $_[0]) {
+ $self->[0] .= $_[0];
+ }
}
sub finalize {
my $self = shift;
- my $p = JSON::decode_json($self->{buffer});
+ my $p = JSON::decode_json($self->[0]);
my @params;
if (ref $p eq 'HASH') {
while (my ($k, $v) = each %$p) {
diff --git a/lib/HTTP/Entity/Parser/OctetStream.pm b/lib/HTTP/Entity/Parser/OctetStream.pm
index 770067f..628d8e2 100644
--- a/lib/HTTP/Entity/Parser/OctetStream.pm
+++ b/lib/HTTP/Entity/Parser/OctetStream.pm
@@ -4,8 +4,7 @@ use strict;
use warnings;
sub new {
- my $class = shift;
- bless {}, $class;
+ bless [], $_[0];
}
sub add { }
diff --git a/lib/HTTP/Entity/Parser/UrlEncoded.pm b/lib/HTTP/Entity/Parser/UrlEncoded.pm
index 938ca60..d66b087 100644
--- a/lib/HTTP/Entity/Parser/UrlEncoded.pm
+++ b/lib/HTTP/Entity/Parser/UrlEncoded.pm
@@ -5,7 +5,7 @@ use warnings;
use WWW::Form::UrlEncoded qw/parse_urlencoded/;
sub new {
- bless [''], shift;
+ bless [''], $_[0];
}
sub add {
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libhttp-entity-parser-perl.git
More information about the Pkg-perl-cvs-commits
mailing list