scripts/benchmark.pl

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