view release on metacpan or  search on metacpan

ab  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use Getopt::Std;
use HTTPD::Bench::ApacheBench;

my %options;
getopt('nctpCHT', \%options);
getopts('Vki', \%options);

if ($options{'V'}) {
    &show_version;
    exit;
}
if (!@ARGV) {
    &show_usage;
    exit;
}

my $postdata;
if ($options{'p'}) {
    open(FILE, $options{'p'});
    $postdata = join('', <FILE>);
    close FILE;
}

my $c = $options{'c'} || 1;
my $n = $options{'n'} || 1;


my $b = HTTPD::Bench::ApacheBench->new;
$b->concurrency($c);
$b->keepalive( $options{'k'} );
$b->timelimit( $options{'t'} );
my $run = HTTPD::Bench::ApacheBench::Run->new
  ({
    urls      => [ $ARGV[0] ],
    repeat    => $n,
    memory    => 3,
   });
$run->cookies([ $options{'C'} ]);
$run->postdata([ $postdata ]);
$run->head_requests([ $options{'i'} ]);
$run->content_types([ $options{'T'} ]);
# need to kludge H option because of weaknesses in Getopt::Std
#  (can't handle multiple identical options)
$options{'H'} =~ s/\\r\\n/\r\n/g;
$run->request_headers([ $options{'H'} ]);
$b->add_run($run);

$b->execute;

&show_results();
print "Response headers:\n";
print $run->response_headers(0)."\n";

sub min { my $min = shift; foreach (@_) {$min = $_ if $_ < $min} $min; }
sub max { my $max = shift; foreach (@_) {$max = $_ if $_ > $max} $max; }
sub avg { my $tot = 0; foreach (@_) {$tot += $_} $tot / ($#_+1); }

sub show_results {
    my $time_in_sec = $b->total_time / 1000;

    my $sent_requests = $b->total_requests_sent;
    my $completed_requests = $b->total_responses_received;
    my $failed_requests = $b->total_responses_failed;

    my $hps = $completed_requests / $time_in_sec;
    my $kps = $b->bytes_received / 1024 / $time_in_sec;

    my $doc_length = $run->response_body_lengths()->[0];
    my $html_size = $n * $doc_length;
    my $total_bytes_read = $n * $run->sum_bytes_read();

    my ($software) = ( $run->response_headers()->[0] =~ m/Server: (.*)/ );
    my ($hostname) = ( $run->urls()->[0] =~ m,(?:http://)?([^/:]+), );
    my ($port) = ( $run->urls()->[0] =~ m,(?:http://)?[^/:]+:(\d+), );
    $port = 80 unless $port;
    my ($path) = ( $run->urls()->[0] =~ m,(?:http://)?[^/]+(.*), );

    &show_version;
    print qq`Server Software:        $software
Server Hostname:        $hostname
Server Port:            $port

Document Path:          $path
Document Length:        $doc_length bytes

Concurrency Level:      $c
Time taken for tests:   $time_in_sec seconds
Sent requests:          $sent_requests
Completed requests:     $completed_requests
Failed requests:        $failed_requests