File Coverage

blib/lib/HTTPD/Bench/ApacheBench.pm

Criterion	Covered	Total	%
statement	57	115	49.5
branch	15	54	27.7
condition	11	34	32.3
subroutine	14	22	63.6
pod	15	17	88.2
total	112	242	46.2

package HTTPD::Bench::ApacheBench;

use strict;
use vars qw($VERSION @ISA);

use base qw(DynaLoader HTTPD::Bench::ApacheBench::Regression);

use HTTPD::Bench::ApacheBench::Run;
use Scalar::Util qw/blessed/;

$HTTPD::Bench::ApacheBench::VERSION = '0.73';

bootstrap HTTPD::Bench::ApacheBench $VERSION;

##################################################
## the constructor                              ##
##################################################
sub new {
    my ($this, $self) = @_;
    my $class = ref($this) || $this;
    if (ref($self) ne 'HASH') { $self = {} }
    bless $self, $class;
    $self->initialize;
    return $self;
}

##################################################
## initialize defaults                          ##
##################################################
sub initialize {
    my ($self) = @_;
    $self->{runs} = [] if ref $self->{runs} ne 'ARRAY';
    $self->{concurrency} ||= 1;
    $self->{repeat} ||= 1;
    $self->{priority} ||= "equal_opportunity";
    $self->{buffersize} ||= 262144;
    $self->{request_buffersize} ||= 8192;
    $self->{timelimit} = undef if ! defined $self->{timelimit};
    $self->{keepalive} = 0 if ! defined $self->{keepalive};
    $self->{memory} = 1 if ! defined $self->{memory};
}


##################################################
## configure the global parameters              ##
##################################################
sub config {
    my ($self, $opt) = @_;
    foreach (qw(concurrency priority buffersize repeat memory)) {
	$self->{$_} = $opt->{$_} if defined $opt->{$_};
    }
}

sub concurrency {
    my ($self, $arg) = @_;
    $self->{concurrency} = $arg if $arg;
    return $self->{concurrency};
}

sub priority {
    my ($self, $arg) = @_;
    $self->{priority} = $arg if $arg;
    return $self->{priority};
}

sub memory {
    my ($self, $arg) = @_;
    $self->{memory} = $arg if defined $arg;
    return $self->{memory};
}

sub repeat {
    my ($self, $arg) = @_;
    $self->{repeat} = $arg if $arg;
    return $self->{repeat};
}

sub keepalive {
    my ($self, $arg) = @_;
    $self->{keepalive} = $arg if $arg;
    return $self->{keepalive};
}

sub timelimit {
    my ($self, $arg) = @_;
    $self->{timelimit} = $arg if $arg;
    return $self->{timelimit};
}

sub buffersize {
    my ($self, $arg) = @_;
    $self->{buffersize} = $arg if $arg;
    return $self->{buffersize};
}

sub request_buffersize {
    my ($self, $arg) = @_;
    $self->{request_buffersize} = $arg if $arg;
    return $self->{request_buffersize};
}

sub total_requests {
    my ($self) = @_;
    return 0 if ref $self->{runs} ne 'ARRAY';
    my $total = 0;
    foreach my $run (@{$self->{runs}}) {
	my $repeat = $run->repeat ? $run->repeat : $self->{repeat};
	$total += ($#{$run->urls} + 1) * $repeat
	  if ref $run->urls eq 'ARRAY';
    }
    return $total;
}


##################################################
## verify configuration of runs and execute     ##
##################################################
sub execute {
    my ($self) = @_;
    # keep track of temporarily altered run object variables
    my %altered;

    # fail if they have not added any runs
    return undef if ref $self->{runs} ne 'ARRAY';

    # pre execute initialization of each run
    foreach my $run_no (0..$#{$self->{runs}}) {
	my $runobj = $self->{runs}->[$run_no];

	$runobj->ready_to_execute or $runobj->prepare_for_execute or
	  return undef;

	# default to base ApacheBench object variables if not specified in run
	if (! $runobj->repeat) {
	    $runobj->repeat($self->{repeat});
	    $altered{$run_no}->{repeat} = 1;
	}
	if (! defined $runobj->memory) {
	    $runobj->memory($self->{memory});
	    $altered{$run_no}->{memory} = 1;
	}

        $runobj->pre_execute_warnings;
    }

    # call the XS code and store regression data
    $self->{'regression'} = $self->ab;

    # post execute polishing of each run
    foreach my $run_no (0..$#{$self->{runs}}) {
	my $runobj = $self->{runs}->[$run_no];
	$runobj->{'run_no'} = $run_no;
	$runobj->{'regression'} = $self->{'regression'};
	foreach my $param (qw(repeat memory)) {
	    delete $runobj->{$param}
	      if (ref $altered{$run_no} and $altered{$run_no}->{$param});
	}
    }
    return HTTPD::Bench::ApacheBench::Regression->new
      ({ 'regression' => $self->{'regression'} });
}


##################################################
## run accessors                                ##
##################################################
sub run {
    my ($self, $run_no, $run) = @_;
    return undef if ! (ref $self->{runs} eq 'ARRAY' && blessed $self->{runs}->[$run_no]
                         && $self->{runs}->[$run_no]->isa('HTTPD::Bench::ApacheBench::Run'));
    if (blessed $run && $run->isa('HTTPD::Bench::ApacheBench::Run')) {
	my $replaced_run = $self->{runs}->[$run_no];
	$self->{runs}->[$run_no] = $run;
	return $replaced_run;
    }
    return $self->{runs}->[$run_no];
}

sub add_run {
    my ($self, $newrun) = @_;
    return undef if ! (ref $self->{runs} eq 'ARRAY' && blessed $newrun
                         && $newrun->isa('HTTPD::Bench::ApacheBench::Run'));
    push(@{$self->{runs}}, $newrun);
    return $#{$self->{runs}};
}

sub delete_run {
    my ($self, $run_no) = @_;
    return undef if ref $self->{runs} ne 'ARRAY';
    my $deleted_run = $self->{runs}->[$run_no];
    $self->{runs} = [ @{$self->{runs}}[0..$run_no-1],
		      @{$self->{runs}}[$run_no+1..$#{$self->{runs}}] ];
    return $deleted_run;
}

sub num_runs {
    my ($self) = @_;
    return scalar(@{$self->{runs} || []});
}


1;

__END__