Commit | Line | Data |
d10b9732 |
1 | #!/usr/bin/perl |
2 | |
3 | BEGIN { |
4 | require FindBin; |
5 | } |
6 | |
7 | use strict; |
8 | use warnings; |
9 | use lib "$FindBin::Bin/../lib"; |
10 | |
11 | use Benchmark qw[cmpthese timethese]; |
12 | use CGI qw[]; |
13 | use CGI::Simple qw[]; |
14 | use HTTP::Body qw[]; |
15 | use IO::Handle qw[]; |
16 | use IO::File qw[O_RDONLY SEEK_SET]; |
17 | use YAML qw[LoadFile]; |
18 | |
19 | my ( $headers, $content, $message ); |
20 | |
21 | my $benchmarks = { |
22 | 'CGI' => sub { |
23 | |
24 | $content->seek( 0, SEEK_SET ) |
25 | or die $!; |
26 | |
27 | STDIN->fdopen( $content->fileno, 'r' ); |
28 | |
29 | CGI::_reset_globals(); |
30 | |
31 | my $cgi = CGI->new; |
32 | }, |
33 | 'HTTP::Body' => sub { |
34 | |
35 | $content->seek( 0, SEEK_SET ) |
36 | or die $!; |
37 | |
38 | my $body = HTTP::Body->new( $headers->{'Content-Type'}, |
39 | $headers->{'Content-Length'} ); |
40 | |
41 | while ( $content->read( my $buffer, 4096 ) ) { |
42 | $body->add($buffer); |
43 | } |
44 | |
45 | unless ( $body->state eq 'done' ) { |
46 | die 'baaaaaaaaad'; |
47 | } |
7428d118 |
48 | } |
d10b9732 |
49 | }; |
50 | |
51 | if ( eval 'require CGI::Simple' ) { |
52 | $benchmarks->{'CGI::Simple'} = sub { |
53 | |
54 | $content->seek( 0, SEEK_SET ) |
55 | or die $!; |
56 | |
57 | STDIN->fdopen( $content->fileno, 'r' ); |
58 | |
59 | CGI::Simple::_reset_globals(); |
60 | |
61 | my $cgi = CGI::Simple->new; |
62 | }; |
63 | } |
64 | |
7428d118 |
65 | if ( eval 'require APR::Request' ) { |
66 | |
67 | require APR; |
68 | require APR::Pool; |
69 | require APR::Request; |
70 | require APR::Request::CGI; |
71 | require APR::Request::Param; |
72 | |
73 | $benchmarks->{'APR::Request'} = sub { |
74 | |
75 | $content->seek( 0, SEEK_SET ) |
76 | or die $!; |
77 | |
78 | STDIN->fdopen( $content->fileno, 'r' ); |
79 | |
80 | my $pool = APR::Pool->new; |
81 | my $apr = APR::Request::CGI->handle($pool); |
82 | |
83 | if ( my $table = $apr->param ) { |
84 | $table->do( sub { 1 } ); |
85 | } |
86 | |
87 | if ( my $body = $apr->body ) { |
88 | $body->param_class('APR::Request::Param'); |
89 | $body->uploads($pool)->do( sub { 1 } ); |
90 | } |
91 | }; |
92 | } |
93 | |
d10b9732 |
94 | my @benchmarks = @ARGV ? @ARGV : qw[ t/data/benchmark/001 |
95 | t/data/benchmark/002 |
96 | t/data/benchmark/003 ]; |
97 | |
98 | foreach my $benchmark ( @benchmarks ) { |
99 | |
100 | $headers = LoadFile("$FindBin::Bin/../$benchmark-headers.yml"); |
101 | $content = IO::File->new( "$FindBin::Bin/../$benchmark-content.dat", O_RDONLY ) |
102 | or die $!; |
103 | |
104 | binmode($content); |
105 | |
d10b9732 |
106 | local %ENV = ( |
107 | CONTENT_LENGTH => $headers->{'Content-Length'}, |
108 | CONTENT_TYPE => $headers->{'Content-Type'}, |
109 | QUERY_STRING => '', |
110 | REQUEST_METHOD => 'POST' |
111 | ); |
112 | |
113 | printf( "Content-Type : %s\n", $headers->{'Content-Type'} =~ m/^([^;]+)/ ); |
114 | printf( "Content-Length : %s\n", $headers->{'Content-Length'} ); |
115 | printf( "Benchmark : %s\n", $headers->{'Benchmark'} ) if $headers->{'Benchmark'}; |
116 | print "\n"; |
117 | |
71806b5a |
118 | timethese( -1, $benchmarks ); |
d10b9732 |
119 | |
120 | printf( "%s\n", "-" x 80 ) if @benchmarks > 1; |
121 | } |