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
  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         }
  48     },
  49     'HTTP::Body Complete' => sub {
  50
  51         my $body = HTTP::Body->new( $headers->{'Content-Type'},
  52                                     $headers->{'Content-Length'} );
  53
  54         $body->add($message);
  55
  56         unless ( $body->state eq 'done' ) {
  57             die 'baaaaaaaaad';
  58         }
  59     },
  60 };
  61
  62 if ( eval 'require CGI::Simple' ) {
  63     $benchmarks->{'CGI::Simple'} = sub {
  64
  65         $content->seek( 0, SEEK_SET )
  66           or die $!;
  67
  68         STDIN->fdopen( $content->fileno, 'r' );
  69
  70         CGI::Simple::_reset_globals();
  71
  72         my $cgi = CGI::Simple->new;
  73     };
  74 }
  75
  76 my @benchmarks =  @ARGV ? @ARGV : qw[ t/data/benchmark/001
  77                                       t/data/benchmark/002
  78                                       t/data/benchmark/003 ];
  79
  80 foreach my $benchmark ( @benchmarks ) {
  81
  82     $headers  = LoadFile("$FindBin::Bin/../$benchmark-headers.yml");
  83     $content  = IO::File->new( "$FindBin::Bin/../$benchmark-content.dat", O_RDONLY )
  84       or die $!;
  85
  86     binmode($content);
  87
  88     $message = do{ local $/; <$content> };
  89
  90     local %ENV = (
  91         CONTENT_LENGTH => $headers->{'Content-Length'},
  92         CONTENT_TYPE   => $headers->{'Content-Type'},
  93         QUERY_STRING   => '',
  94         REQUEST_METHOD => 'POST'
  95     );
  96
  97     printf( "Content-Type   : %s\n", $headers->{'Content-Type'} =~ m/^([^;]+)/ );
  98     printf( "Content-Length : %s\n", $headers->{'Content-Length'} );
  99     printf( "Benchmark      : %s\n", $headers->{'Benchmark'} ) if $headers->{'Benchmark'};
 100     print "\n";
 101
 102     cmpthese( -1, $benchmarks );
 103
 104     printf( "%s\n", "-" x 80 ) if @benchmarks > 1;
 105 }