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 <kazeb...@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

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits

Reply via email to