root/lang/perl/App-Benchmark-WAF/trunk/lib/App/Benchmark/WAF.pm @ 23681

package App::Benchmark::WAF;
use strict;
use warnings;
use base qw(Exporter);
use Apache::TestConfig;
use Apache::TestUtil qw(t_debug);
use File::Spec;
use IPC::Open3;
use Test::More;
use URI;
our $VERSION = '0.00001';

our @EXPORT = qw(waf_benchmark_diag);
our $AB;
BEGIN {
    require File::Spec->catfile('t', 'conf', 'apache_test_config.pm');
    my $config = apache_test_config->new();
    $AB = $ENV{APACHE_BENCH} ||
        File::Spec->catfile($config->{vars}->{bindir}, "ab");

    if (! -x $AB) {
        plan(skip_all => "could not find a working $AB");
    } else {
        plan('no_plan');
    }
}

sub waf_benchmark_diag {
    my %args   = @_;

    my $mode = $args{mode};
    my $type = $args{type};

    my $config = apache_test_config->new();
    my $uri = URI->new();
    $uri->scheme('http');
    $uri->host( $config->our_remote_addr() );
    $uri->port( $config->port );
    $uri->path( $args{path} || join('/', $mode, $type, 'index.cgi' ) );

    my $post = $args{post} 
        ? "-p $args{post} -T \"application/x-www-form-urlencoded\"" : ''; 
    my @cmd = ($AB, "-c", $args{concurrency} || 100, "-n", $args{requests} || 1000, $post, '-v 2', $uri);
   
    t_debug("running $type in $mode ($uri)");
    t_debug("command: @cmd");

    # capture output...
    {
        my ($stdout, $stdin, $stderr);
        open3( $stdin, $stdout, $stderr, "@cmd" );
        while (<$stdout>) {
            t_debug($_);
            warn $_;
            next unless /Requests per second:\s*(.*)$/;
            diag("[$type ($mode)]: $1");
        }
    }
    ok(1);
}

1;