File Coverage

blib/lib/HTTP/LoadGen/ScoreBoard.pm

Criterion	Covered	Total	%
statement	55	92	59.7
branch	5	10	50.0
condition			n/a
subroutine	20	20	100.0
pod	2	2	100.0
total	82	124	66.1

package HTTP::LoadGen::ScoreBoard;

use strict;
use IPC::ScoreBoard;
no warnings 'uninitialized';

our $VERSION = '0.04';

use Exporter qw/import/;
our @EXPORT_OK=qw/scoreboard sb slot thread_start thread_done req_start
		  req_done thread_count req_started req_success req_failed
		  header_bytes header_count body_bytes sbinit/;

use constant {
  SC_THREADCOUNT=>0,		# scoreboard items
  SC_REQ_STARTED=>1,
  SC_REQ_SUCCESS=>2,
  SC_REQ_FAILED=>3,
  SC_BODY_BYTES=>4,
  SC_HEADER_BYTES=>5,
  SC_HEADER_COUNT=>6,
  SC_SLOTSIZE=>7,
};

my ($scoreboard, $slotsz, $extra, $myslot);

sub scoreboard () : lvalue {$scoreboard;}
sub slot () : lvalue {$myslot;}

BEGIN {
  if( SB::have_atomics ) {
    *init=sub {
      (my ($name, $nslots), $slotsz, $extra)=@_;
      if( defined $name ) {
	$scoreboard=SB::named $name, 0+$nslots, 0+$slotsz, $extra+SC_SLOTSIZE;
      } else {
	$scoreboard=SB::anon 0+$nslots, 0+$slotsz, $extra+SC_SLOTSIZE;
      }
      return $scoreboard;
    };

    *thread_start=sub () {
      SB::incr_extra $scoreboard, $extra+SC_THREADCOUNT;
    };

    *thread_done=sub () {
      SB::decr_extra $scoreboard, $extra+SC_THREADCOUNT;
    };

    *req_start=sub () {
      SB::incr_extra $scoreboard, $extra+SC_REQ_STARTED;
    };

    *req_done=sub ($$$) {
      my ($success, $hdr, $body)=@_;
      SB::incr_extra $scoreboard,
	  $extra+($success ? SC_REQ_SUCCESS : SC_REQ_FAILED);
      SB::incr_extra $scoreboard, $extra+SC_BODY_BYTES, length $body;
      SB::incr_extra $scoreboard, $extra+SC_HEADER_COUNT, 0+keys %$hdr;
      my $sum=0;
      while( my ($k, $v)=each %$hdr ) {
	$sum+=length $k;
	for my $s (@$v) {
	  $sum+=length $s;
	}
      }
      SB::incr_extra $scoreboard, $extra+SC_HEADER_BYTES, $sum;
    };

    *thread_count=sub () {
      SB::get_extra $scoreboard, $extra+SC_THREADCOUNT;
    };

    *req_started=sub () {
      SB::get_extra $scoreboard, $extra+SC_REQ_STARTED;
    };

    *req_success=sub () {
      SB::get_extra $scoreboard, $extra+SC_REQ_SUCCESS;
    };

    *req_failed=sub () {
      SB::get_extra $scoreboard, $extra+SC_REQ_FAILED;
    };

    *header_bytes=sub () {
      SB::get_extra $scoreboard, $extra+SC_HEADER_BYTES;
    };

    *header_count=sub () {
      SB::get_extra $scoreboard, $extra+SC_HEADER_COUNT;
    };

    *body_bytes=sub () {
      SB::get_extra $scoreboard, $extra+SC_BODY_BYTES;
    };
  } else {			# no atomics
    *init=sub {
      (my ($name, $nslots), $slotsz, $extra)=@_;
      if( defined $name ) {
	$scoreboard=SB::named $name, 0+$nslots, 0+$slotsz+SC_SLOTSIZE, 0+$extra;
      } else {
	$scoreboard=SB::anon 0+$nslots, 0+$slotsz+SC_SLOTSIZE, 0+$extra;
      }
      return $scoreboard;
    };

    *thread_start=sub () {
      SB::incr $scoreboard, $myslot, $slotsz+SC_THREADCOUNT;
    };

    *thread_done=sub () {
      SB::decr $scoreboard, $myslot, $slotsz+SC_THREADCOUNT;
    };

    *req_start=sub () {
      SB::incr $scoreboard, $myslot, $slotsz+SC_REQ_STARTED;
    };

    *req_done=sub ($$$) {
      my ($success, $hdr, $body)=@_;
      SB::incr $scoreboard, $myslot,
	  $slotsz+($success ? SC_REQ_SUCCESS : SC_REQ_FAILED);
      SB::incr $scoreboard, $myslot, $slotsz+SC_BODY_BYTES, length $body;
      SB::incr $scoreboard, $myslot, $slotsz+SC_HEADER_COUNT, 0+keys %$hdr;
      my $sum=0;
      while( my ($k, $v)=each %$hdr ) {
	$sum+=length $k;
	for my $s (@$v) {
	  $sum+=length $s;
	}
      }
      SB::incr $scoreboard, $myslot, $slotsz+SC_HEADER_BYTES, $sum;
    };

    *thread_count=sub () {
      SB::sum $scoreboard, $slotsz+SC_THREADCOUNT;
    };

    *req_started=sub () {
      SB::sum $scoreboard, $slotsz+SC_REQ_STARTED;
    };

    *req_success=sub () {
      SB::sum $scoreboard, $slotsz+SC_REQ_SUCCESS;
    };

    *req_failed=sub () {
      SB::sum $scoreboard, $slotsz+SC_REQ_FAILED;
    };

    *header_bytes=sub () {
      SB::sum $scoreboard, $slotsz+SC_HEADER_BYTES;
    };

    *header_count=sub () {
      SB::sum $scoreboard, $slotsz+SC_HEADER_COUNT;
    };

    *body_bytes=sub () {
      SB::sum $scoreboard, $slotsz+SC_BODY_BYTES;
    };
  }
}

*sbinit=\&init;

1;
__END__