Agent::TCLI::Transport::Test - transport for testing commands

	use Test::More qw(no_plan);
	ues Agent::TCLI::Transport::Test;
	use Agent::TCLI::Package::Tail;

	# set the list of packages
	my @packages = (
		Agent::TCLI::Package::Tail->new({
			'verbose'		=> \$verbose,
			'do_verbose'	=> sub { diag( @_ ) },
		}),
	);




	my $test_master = Agent::TCLI::Transport::Test->new({
	    'verbose'   	=> \$verbose,        # Verbose sets level

	    # change verbose output to Test::More::diag
		'do_verbose'	=> sub { diag( @_ ) },

		# load up the packages to support testing
	    'control_options'	=> {
		    'packages' 		=> \@packages,
	    },
	});

	# need at least one testee

	# Set up the local test
	my $target = Agent::TCLI::Testee->new(
		'test_master'	=> $test_master,
		'addressee'		=> 'self',
	);

# $Id: Test.pm 62 2007-05-03 15:55:17Z hacker $
package Agent::TCLI::Transport::Test;

use warnings;
use strict;

use vars qw($VERSION @EXPORT %EXPORT_TAGS );

use Carp;
#use Time::HiRes qw(time);

use POE;
use Agent::TCLI::Control;
use Agent::TCLI::Request;
use Agent::TCLI::User;
require Agent::TCLI::Transport::Base;

use Test::Builder::Module;

use Object::InsideOut qw( Agent::TCLI::Transport::Base Test::Builder::Module);

our $VERSION = '0.031.'.sprintf "%04d", (qw($Id: Test.pm 62 2007-05-03 15:55:17Z hacker $))[2];

#func#our $TCLI_TEST = Agent::TCLI::Transport::Test->new;

#func#BEGIN {
#func#	@EXPORT = qw( load_packages
#func#		is_body like_body
#func#		is_code like_code
#func#		);
#func#}

my @testees			:Field
					:All('testees')
					:Type('Array');

my @requests		:Field
					:All('requests')
					:Type('Array');

my @test_count		:Field
					:Type('numeric')
					:All('test_count');

my @request_count	:Field
					:Type('numeric')
					:All('request_count');

my @default_request	:Field
					:All('default_request')
					:Type('Agent::TCLI::Request' );

my @requests_sent	:Field
					:All('requests_sent')
					:Type('Numeric');

my @requests_complete	:Field
						:All('requests_complete')
						:Type('Numeric');

my @request_tests	:Field
					:Type('hash')
					:Arg('name'=>'request_tests', 'default'=> { } )
					:Acc('request_tests');

my @responses		:Field
					:Type('hash')
					:Arg('name'=>'responses', 'default'=> { } )
					:Acc('responses');

my @responses_max_contiguous	:Field
					:Type('numeric')
					:Arg('name'=>'responses_max_contiguous', 'default'=> 1)
					:Acc('responses_max_contiguous');

my @dispatch_counter			:Field
					:Type('numeric')
					:All('dispatch_counter');

my @dispatch_retries			:Field
					:Type('numeric')
					:Arg('name'=>'dispatch_retries','default'=>6)
					:Acc('dispatch_retries');

my @timeout_counter			:Field
					:Type('numeric')
					:All('timeout_counter');

my @timeout_retries	:Field
					:Type('numeric')
					:Arg('name'=>'timeout_retries','default'=>6)
					:Acc('timeout_retries');

my @timeout_id		:Field
#					:Type('type')
					:All('timeout_id');

my @running			:Field
#					:Type('boolean')
					:Arg('name'=>'running','default'=>0)
					:Acc('running');

my @last_testee		:Field
#					:Type('scalar')
					:Arg('name'=>'last_testee','default'=>'')
					:Acc('last_testee');

my @dispatch_id			:Field
#					:Type('scalar')
					:All('dispatch_id');

# Standard class utils are inherited

sub done {
	my ($self, $wait, $name) = @_;

	$wait = 31 unless defined $wait;
	my $start = time();
	my $ready = 0;
	$self->Verbose($self->alias.":done: start($start) wait($wait)");

	# Clean out anything in kernel queue
#	$poe_kernel->run_one_timeslice unless ($self->running || $wait == 0 );

	# Try to finish up anything left out there.
	while ( $start + $wait > time() )
	{
		$self->Verbose($self->alias.":done: end(".($start + $wait).")time(".time().")  ",3);
		# make sure there is nothing in request queue
		$self->dispatch;
		$ready = $self->post_it('done');
		# Clean out anything in kernel queue
		$poe_kernel->run_one_timeslice;
		last if $ready;
		next;
	}

	$ready = $self->post_it('done') if ($wait == 0);

	if  ( (not $ready && $wait == 0 )  ||
		($ready && $wait > 0 ) )
	{
		$self->Verbose($self->alias.":done: ".
			" run(".$self->running.")  dc(".$dispatch_counter[$$self].") dr(".
			$dispatch_retries[$$self].") tc(".$timeout_counter[$$self].") tr(".
			$timeout_retries[$$self].") requests(".$self->depth_requests.") ");
		$self->Verbose($self->alias.":done: count(".$request_count[$$self].
			") contiguous(".$self->responses_max_contiguous.")");
	}

	# there may be tests left in request_tests.
	# Some will be all type tests (ares...), which do not matter.
	# but some will need to be failed.

	my $test;

	ID: foreach my $id ( sort keys %{$self->request_tests} )
	{
		# are there more tests left for this request?
		next ID unless ( scalar(@{$self->request_tests->{ $id } } ) > 0);

		TEST: while ( @{ $self->request_tests->{ $id } } )
		{
			$test = shift @{ $self->request_tests->{ $id } };
			# if this is an multi response test, then skip it
			if ( $test->[0] =~ qr(are) )
			{
				next TEST;
			}

			# any other test must fail if there is no response

			$self->builder->ok( 0, $test->[3] );
			$self->builder->diag("Response not recieved for this test's request.");

		}

	}

	if ( defined($name) && $name ne '' )
	{
		$test_count[$$self]++;
		$self->builder->ok( $ready, $name );
	}
	$self->Verbose($self->alias.":done: ready($ready) ");

	return ($ready);
}

sub done_id {
	my ($self, $id, $wait, $name) = @_;

	$wait = 31 unless defined $wait;
	my $start = time();
	my $ready = 0;

	# validate id
	unless ( defined($id) && $id )
	{
		# Use last id if not supplied
		$id = $self->make_id( $request_count[$$self] );
	}

	$self->Verbose($self->alias.":done_id: id($id) start($start) wait($wait)",1);

	# Clean out anything in kernel queue
#	$poe_kernel->run_one_timeslice unless ($self->running || $wait == 0 );

	# Try to finish up anything left out there.
	while ( $start + $wait > time() )
	{
		$self->Verbose($self->alias.":done_id: end(".($start + $wait).") time(".time().")  ",3);
		# make sure there is nothing in request queue
		$self->dispatch;
		$ready = $self->post_it('done');
		# Clean out anything in kernel queue
		$poe_kernel->run_one_timeslice;
		last if $ready;
		next;
	}

	$ready = $self->post_it('done') if ($wait == 0);

	if  ( (not $ready && $wait == 0 )  ||
		($ready && $wait > 0 ) )
	{
		$self->Verbose($self->alias.":done: ".
			" run(".$self->running.")  dc(".$dispatch_counter[$$self].") dr(".
			$dispatch_retries[$$self].") tc(".$timeout_counter[$$self].") tr(".
			$timeout_retries[$$self].") requests(".$self->depth_requests.") ");
		$self->Verbose($self->alias.":done: count(".$request_count[$$self].
			") contiguous(".$self->responses_max_contiguous.")");
	}

	# there may be tests left in request_tests.
	# Some will be all type tests (ares...), which do not matter.
	# but some will need to be failed.

	my $test;

	TEST: while ( @{ $self->request_tests->{ $id } } )
	{
		$test = shift @{ $self->request_tests->{ $id } };
		# if this is an multi response test, then skip it
		if ( $test->[0] =~ qr(are) )
		{
			next TEST;
		}

		# any other test must fail if there is no response

		$self->builder->ok( 0, $test->[3] );
		$self->builder->diag("Response not recieved for this test's request.");

	}

	if ( defined($name) && $name ne '' )
	{
		$test_count[$$self]++;
		$self->builder->ok( $ready, $name );
	}
	$self->Verbose($self->alias.":done: ready($ready) ");

	return ($ready);
}

sub load_testee {
	my ($self, $testee) = @_;
#func#	my $self = ( ref $_[0] && (ref $_[0]) =~ /Agent::TCLI::.*TEST/ )
#func#		? shift : $TCLI_TEST;
	$self->Verbose($self->alias.":load_testee: dump ".$testee->dump(1),3);

	$self->push_testees($testee);
}

sub run {
	my $self = shift;
	$self->Verbose($self->alias.":run: running (".$self->depth_requests.") requests " );

	# requests still left in queue (How could there not be?)
	if ( $self->depth_requests > 0 )
	{
		# Whatever's left in the queue is bigger than us little synchronous
		# calls. Send it over to the big Dispatch.
		$poe_kernel->post($self->alias, 'Dispatch', 1 );
	}

	# set running state for Timeout.
	$self->running(1);

	$poe_kernel->run;
}

sub _preinit :PreInit {
	my ($self,$args) = @_;

	$args->{'alias'} = 'transport_test' unless defined( $args->{'alias'} ) ;

  	$args->{'session'} = POE::Session->create(
        object_states => [
        	$self => [ qw(
	            _start
            	_stop
        	    _shutdown
        	    _child
        	    _default

				Dispatch
        	    SendChangeContext
        	    SendRequest

				PostResponse
        	    Timeout
        	)],
        ],
  	);

	$args->{'peers'} = [ Agent::TCLI::User->new({
		'id'		=> 'test-master@localhost',
		'protocol'	=> 'test',
		'auth'		=> 'master',
	})] unless defined($args->{'peers'});

	$args->{'do_verbose'} = sub { diag( @_ ) } unless defined($args->{'do_verbose'});

}

sub _init :Init {
	my ($self, $args) = @_;

	$self->set(\@default_request, Agent::TCLI::Request->new({
		'id'		=> 1,
#		'args'		=> ,
#		'command'	=> ,
		'sender'	=> [$self->alias],
		'postback'	=> ['PostResponse'],
		'input'		=> '',

		'response_verbose' 	=> 1,  # Must be set to get test back with response
		'verbose'			=> $self->verbose,
		'do_verbose'		=> $self->do_verbose,
	})) unless defined( $self->default_request );

	$self->control_options->{'local_address'} = '127.0.0.1'
		unless defined($self->control_options->{'local_address'});

	# Load up control now, before requests come in, since we must be local
	# if loading packages.
	# Get a Control for the test-master user loaded into peers.
	$self->GetControl(	$self->peers->[0]->id, $self->peers->[0] );

	# Get the packages and control going but come back for the requests.
	$poe_kernel->run_one_timeslice;
}

sub build_test {
	my ($self, $testee, $test, $input, $exp1, $exp2, $name) = @_;
	$self->Verbose($self->alias.":build_test: testee(".$testee->addressee.
		")\n\t test($test) input($input)\n\t exp($exp1)",1);
	my ($request, $id);

	if ( ( defined($input) && $input ne '') )
	{
		# check if input is a request object.
		if ( ref($input) =~ /Request/ )
		{
			# verify sender/postback
			if ( ( $request->postback->[0] eq 'PostRseponse' &&
				   $testee->addressee ne 'self' ) ||
				 ( defined($request->postback->[1] ) &&
				   $request->postback->[1] ne $testee->addressee )
			)
			{
				croak("Testee $testee->addressee does not match request" );
			}
			$request = $input;
			$id = $request->id;
		}
		else # put into default request if not
		{
			# clone the default_request
			$request = $self->default_request->clone(1);
			$request->input($input);

			# Insert the proper testee
			if ($testee->addressee ne 'self')
			{
				$request->sender([
					$testee->transport,
					$testee->protocol,
					]);
				$request->postback([
					'PostRequest',
					$testee->addressee,
				])
			}

			# using make_id to faciltate changing ID style in olny one place later
			$request_count[$$self]++;
			$id = $self->make_id( $request_count[$$self]);
			$request->id( $id );

			# Put request onto stack.
			$self->push_requests($request);

			$last_testee[$$self] = $testee->addressee;

		}
	}
	else
	{
		croak("Input required. Nothing in queue") unless defined($request_count[$$self]);
		# Get last request id if none provided
		$id = $self->make_id( $request_count[$$self] );
	}

	unless ( defined $name )
	{
		$name = ( $test =~ qr(not|error) )
			? 'failed '.$input
			: $input;
	}

	$test_count[$$self]++;

	# add test, values, name and number to request_tests.
	# Not doing any checking, so allowing stupidity like repeating tests
	# or putting in conflicting tests....
	push( @{$self->request_tests->{ $id } },
		[ $test, $exp1, $exp2, $name, $test_count[$$self] ] );

	$self->dispatch;

	# return request for future reference.
	return($request);
}

sub dispatch {
	my ($self, $style) = @_;

	# Clean out anything in kernel queue
	$poe_kernel->run_one_timeslice;

	my $post_it = $self->post_it($style);

	if ( ( $post_it == 1 ) && ( my $next_request = $self->shift_requests ) )
	{
		$self->Verbose($self->alias.":dispatch: sending request id(".$next_request->id.") " );
		$poe_kernel->post($self->alias, 'SendRequest', $next_request );

		# There are problems with OIO Lvalues on some windows systems....
		$requests_sent[$$self]++;

		# Go ahead and send that out
		$poe_kernel->run_one_timeslice;

		# But wait, are there more?
		$self->dispatch if ( $self->depth_requests );
	}

	# returning $post_it so that it can be checked to see if it is safe to proceed.
	# This could be used by done() to loop until timed out.
	$self->Verbose($self->alias.":dispatch: post_it($post_it)",2);

	return($post_it);
}

sub do_test {
	my ($self, $t, $response) = @_;

	# Split out test name and test class.
	my ($test, $class) = split('-',$t->[0]);

	my $value;
	my $another = 0;
	my $again = 0;
	# Test classes currently, body, code, time

	if ($class eq 'time')
	{
		# Should time be checked on the first test or on the last?
		# Time will get checked wherever it is placed in the queue
		# before a body/code and is tested agaisnt that response time.
		$value = int( time() ) - $response->get_time();
		# time does not use up a response.
		$another = 1;
	}
	elsif ($class eq 'fail')
	{
		# Got nothing, test nothing.
		$value = '';
	}
	else
	{
		$value = $response->$class();
	}
	# $t is [ test-class , expected, expected2, name ]

    # special case for code 100 / class code
    # Preserves and skips all tests if a 100 is received and not looking
    # for it.
    if ( $class eq 'code' && $value == 100 && $t->[1] != 100 )
    {
    	# skip the test unless testing for 100
		$self->Verbose($self->alias.":do_test: $class value($value) != $t->[1] skipping ");
		# Preserve this test
		$again = 1;
		# skip the rest of the tests for this response too.
    	return ($another, $again);
    }

	my $res;
	# Let's do it.
	$self->Verbose($self->alias.
		":do_test: $test $class value($value) expected(".$t->[1].") ");

	if ($test =~ qr(eq|num|like) )
	{
		$res = $self->builder->$test( $value, $t->[1], $t->[3] );
		$self->builder->diag($response->body) if (!$res && $class eq 'code');
	}
	elsif ($test =~ qr(error) )
	{
		$res = $self->builder->ok( ( $value >= 400 && $value <= 499 ) , $t->[3] );
		$self->builder->diag($response->body) if (!$res);
	}
	elsif ($test =~ qr(success) )
	{
		$res = $self->builder->ok( ( $value >= 200 && $value <= 299 ) , $t->[3] );
		$self->builder->diag($response->body) if (!$res);
	}
	elsif ($test =~ qr(trying) )
	{
		$res = $self->builder->ok( ( $value >= 100 && $value <= 199 ) , $t->[3] );
		$self->builder->diag($response->body) if (!$res);
	}

	if ($test =~ qr(^are) )
	{
		# set again not to use up this test on this resonse
		$again = 1;
	}

	$self->Verbose($self->alias.
		":do_test: $test res($res) another($another) again($again)");

	return ($another, $again);
}

sub get_param {
	my ($self, $param, $id, $timeout) = @_;

	# valid formats to receive the parameter are:
	# param=something
	# param something
	# param="a quoted string with something"
	# param "a quoted string with something"
	# param: a string yaml-ish style, no comments, to the end of the line
	# param: "a quoted string, just what's in quotes"

	my $value;

	# validate id
	unless ( defined($id) && $id )
	{
		# Use last id if not supplied
		$id = $self->make_id( $request_count[$$self]);
	}

	$self->Verbose("get_param: param($param) id($id) timeout($timeout)  ",1);

	$self->done_id( $id, $timeout) if ( defined($timeout) );

	return(undef) unless (exists($self->responses->{$id}));

	$self->Verbose("get_param: id($id) timeout($timeout) count(".
		@{ $self->responses->{$id} }.") ",2);

	# loop through responses, last first
	RESPONSE: foreach my $response ( reverse @{$self->responses->{$id}} )
	{
		$self->Verbose('get_param: body('.$response->body.') ',3);

		# any valid format in double quotes
		if (  $response->body =~ qr($param(?:=|\s|:\s)"(.*?)") )
		{
			$value = $1;
			last RESPONSE
		}
		# = or space followed by a word
		elsif ( $response->body =~ qr($param(?:=|\s)(\S*))  )
		{
			$value = $1;
			last RESPONSE
		}
		# yaml to the end of the line
		elsif ( $response->body =~ qr($param(?::\s)(.*?)\s*$)m )
		{
			$value = $1;
			last RESPONSE
		}

	}
	$self->Verbose("get_param: returning $value");
	return ($value);
}

sub get_responses {
	my ($self, $id, $timeout) = @_;

	my $value;

	# validate id
	unless ( defined($id) && $id )
	{
		# Use last id if not supplied
		$id = $self->make_id( $request_count[$$self] );
	}
	$self->Verbose("get_responses: id($id)",3);

	$self->done_id( $id, $timeout) if ( defined($timeout) );

	return(undef) unless (exists( $self->responses->{$id} ) );

	$self->Verbose("get_responses: id($id) count(".@{ $self->responses->{$id} }.") ",1);
	# loop through responses
	RESPONSE: foreach my $response ( reverse @{ $self->responses->{$id} } )
	{
		$value .= $response->body."\n\n";
	}
	$self->Verbose("get_responses: returning $value");
	return ($value);
}

sub make_id {
	my ($self, $num) = @_;

	my $id = defined ($num) ? $num : $self->request_count;

	# Maybe put in hostname and PID or some other unique ID prefix someday?
	# or maybe not

	$self->Verbose($self->alias.":make_id: num($num) id($id)",2);
	return ( $id );
}

sub post_it{
	my ($self, $style) = @_;
	my $post_it = 0;

	# Currently running partially synchronous by default.
	$style = 'default' unless defined( $style );

	# TODO Option to set default for all runs.
	if ( $dispatch_counter[$$self] == $dispatch_retries[$$self] )
	{
		# if we stalled on something, then skip it
		$post_it = 1;
	}
	elsif ( !defined($style) || $style =~ /default|syncsend/ )  # partially synchronous / ordered
		# make sure we got some response to the previously sent request before sending
	{
		# Have we seen a response yet for the last request?
		$self->Verbose($self->alias.":post_it:$style: sent(".$requests_sent[$$self].") ",1);
		if ( $requests_sent[$$self] == 0 ||
			exists( $responses[$$self]{ $self->make_id($requests_sent[$$self]) } )
		)
		{
			$post_it = 1;
		}
	}
	elsif ( $style =~ /syncresp|done|ordered/ )  # completely synchronous / ordered
		#make sure all created requests have responses before sending another
	{
		my $rmc = $self->responses_contiguous;
		if ( $request_count[$$self] == $rmc )
		{
			$post_it = 1;
		}
		$self->Verbose($self->alias.":post_it:$style: count(".
			$request_count[$$self].") contiguous(".$rmc.")",);
	}
	elsif ( $style =~ /async/  )  # asynchrounous, no other checks necessary
		# who cares, send it now.
	{
			$post_it = 1;
	}
	$self->Verbose($self->alias.":post_it: ($post_it)");
	return($post_it);
}

sub responses_contiguous {
	my ($self, $id) = @_;

	while  ( defined($self->responses->{
		$self->make_id( $self->responses_max_contiguous + 1) } ) )
	{
		$responses_max_contiguous[$$self]++;
	}
	return ( $self->responses_max_contiguous );
} # End responses_contiguous

sub Dispatch {
	my ($kernel,  $self, $session, $delay) =
  	  @_[KERNEL, OBJECT,  SESSION, 	   ARG0];
	$self->Verbose($self->alias.":Dispatch: {".$delay.
		"} dc(".$dispatch_counter[$$self].") requests(".$self->depth_requests.") ");

	my $next_request;

	if ( ! $self->depth_requests )
	{
		# Whohoo. we're done, let timeout know bu setting counter.
		$dispatch_counter[$$self] = $dispatch_retries[$$self];
	}
	elsif ( ( $self->post_it ) && ( $next_request = $self->shift_requests ) )
	{
		$self->Verbose($self->alias.":Dispatch: sending request id(".$next_request->id.") " ,1,);
		$kernel->yield( 'SendRequest', $next_request );

		# There are problems with OIO Lvalues on some windows systems....
		$requests_sent[$$self]++;

		# But wait, are there more?
		$kernel->delay('Dispatch', $delay, $delay);

		# We did something, clear out counter.
		$dispatch_counter[$$self] = 0;
	}
	elsif ( $dispatch_counter[$$self] >= $dispatch_retries[$$self] &&
		( $next_request = $self->shift_requests ) )
	{
		$self->Verbose($self->alias.":Dispatch: STALLED sending request id(".
			$next_request->id.") overriding post_it" ,1,);
		$kernel->yield( 'SendRequest', $next_request );

		$requests_sent[$$self]++;

		# But wait, are there more?
		$kernel->delay('Dispatch', $delay, $delay);

		# We did something, clear out counter.
		$dispatch_counter[$$self] = 0;
	}
#	elsif ( $dispatch_counter[$$self] == $dispatch_retries[$$self] )
#	{
#		$self->Verbose($self->alias.":Dispatch: STALLED requests(".$self->depth_requests.") ",0 );
#		# Stalled out
#		foreach my $test ( @{$self->requests} )
#		{
#			$self->Verbose($self->alias.":Dispatch: test dump(".$test->dump(1).") ");
#		}
#		return;
#	}
	else
	{
		#start counting to doom...
		$dispatch_counter[$$self]++;
		$kernel->delay('Dispatch', $delay, $delay );
	}

	return('Dispatch_'.$self->alias);
}

sub PostRequest {

	# assign request ID, if input is blank, then use last request ID.

	# Post request will look a lot like build test?

	# if input is blank, the send to PostResponse otherwise send to
	# whomever is doing the request. Does it matter what order the requests
	# are checked in PostResponse? It shouldn't, I think.
}

sub PostResponse {
	my ($kernel,  $self, $sender, $response) =
  	  @_[KERNEL, OBJECT,  SENDER,      ARG0];
	$self->Verbose($self->alias.":PostResponse: sender(".$sender->ID.") Code(".$response->code.") \n");

	# Test always terminates a response transmission. The buck stops here,
	# unlike other transports

	# TODO Need to figure out how to decide it is time to start checking the tests!

	# Hmm. I donn't want to optimize this better with another object right now.
	# Push response into a responses array in a hash keyed on id.
	push( @{ $responses[$$self]->{$response->id} }, $response  );

	$self->Verbose($self->alias.":PostResponse: responses(".@{ $responses[$$self]->{$response->id} }.
		") ",3,$responses[$$self]->{$response->id} );

	# Work off of the first response for tracking.

#	my $response_prime = $responses[$$self]->{$response->id}[0];

	# we chould only check one body/code test per response? Or one of each type.
	# Hmmm. Not very intuitive either way.
	# Gotta be that body/code always use up a response,  or vice/versa....
	# but have to deal with 100s

	my $test;
	my $again = 0;
	my $index = 0;
	my $another = 1;
	# some tests are greedy and use up the response, others are not
	# $another is used to track that.
	# some tests get used up with a response (is) some don't (are)
	# $again is used for that
	while ( $another )
	{

		$test = $self->request_tests->{ $response->id }->[$index];
#		$test = $response_prime->shift_test_array;

		$self->Verbose($self->alias.":PostResponse: test dump ",3,$test);
		if (defined ($test))
		{
			($another, $again) = $self->do_test($test, $response);

			# allow tests to apply to more than one response by setting again
			unless ( $again )
			{
				shift(@{$self->request_tests->{ $response->id } });
			}

			# adjust index only if again, otherwise we just shifted the array
			$index += $again;
		}
		else
		{
			# There are not any more to do. :)
			$another = 0;
			$self->Verbose("PostResponse: response ".$response->id." received but no more tests");
		}
		next;
	}

	$self->responses_contiguous;

#	if ( $response_prime->depth_test_array == 0 )

	if ( scalar(@{$self->request_tests->{ $response->id } }) == 0 )
	{
		# TODO the way to do this is to have a test type that counts

#		if ( defined( $response->get_responses_wanted) &&
#			$response->get_responses_wanted == $response->response_count )
#		{
#			$self->builder->ok( 1, " Request ".$response->id." got wanted responses " );
#		}

		$requests_complete[$$self]++;
	}
	elsif ( scalar(@{$self->request_tests->{ $response->id } }) >= 0 )
	{
		my $complete = 1;
		# if all we have left is are tests, then we can be complete.
		foreach $test ( @{$self->request_tests->{ $response->id } } )
		{
			$complete = ($complete && $test->[0] =~ /^are/);
		}
		$requests_complete[$$self] += $complete;
	}
}

sub SendChangeContext {
	my ($kernel,  $self, $control ) =
	  @_[KERNEL, OBJECT,    ARG0 ];
	# for jabber, we announce context with presence.
	# for a terminal, it might be a prompt...
	$self->Verbose($self->alias.":SendChangeContext: for control".$control->id());

}

sub SendRequest {
	my ($kernel,  $self, $sender, $request) =
  	  @_[KERNEL, OBJECT,  SENDER, 	ARG0  ];
	$self->Verbose($self->alias.":SendRequest: sender(".$sender->ID.") request(".$request->id.") \n");
	$self->Verbose($self->alias.":SendRequest: request dump \n",3,$request);

	# send request
		# Need to think about sender stack...

		# if there is nothing on the stack, it get's populated with
		# test and posted to control.

		# if another transport is on the stack, it puts itself on the bottom?
		# Then sends it to the local transport for handling.

		# The local transport will send it to the remote transport, putting
		# itself (the local) on the stack as well. No, it needs to take off the remote when it sends it there.

		# we're not via headers here. We just need to know where to go
		# Transport should take themselves out and put in where they got the request
		# so it can go back.


	# Put time in request for tracking
	$request->set_time(time());

	if ( $request->sender->[0] eq $self->alias )
	{
		$self->Verbose($self->alias.":SendRequest: local request \n");
		$self->Verbose($self->alias.":SendRequest: request dump ".$request->dump(1),3 );
		# Get a Control for the test-master user loaded into peers.
		my $control = $self->GetControl(	$self->peers->[0]->id, $self->peers->[0] );
		# Post to our Control
		# Sometimes, control has not started, so we wiat if we have to.
		if ( defined($control->start_time) )
		{
			$kernel->post( $control->id => 'Execute' => $request );
		}
		else
		{
			$kernel->delay('ControlExecute' => 1 => $control, $request );
		}
	}
	else
	{
		$self->Verbose($self->alias.":SendRequest: punting the request \n");
		# Take off Sender and postback and put us at the end.
		# assuming here that wherever this is going, we don't have to
		# worry about setting up the Control....
		my $sender = $request->shift_sender;
		my $postback = $request->shift_postback;
		$request->push_sender($self->alias);
		$request->push_postback('PostResponse');

		$kernel->call( $sender => $postback => $request );
	}

	return(  );
}

sub Timeout {
	my ($kernel,  $self, $session, $delay, ) =
	  @_[KERNEL, OBJECT,  SESSION,     ARG0,  ];
	$self->Verbose($self->alias.":Timeout: {".$delay.
		"} run(".$self->running.")  dc(".$dispatch_counter[$$self].") dr(".
		$dispatch_retries[$$self].") tc(".$timeout_counter[$$self].") tr".
		$timeout_retries[$$self].") requests(".$self->depth_requests.") ");

	# Is Dispatch done with the queue?
	# We wait until running before using an empty queue as goood enough.
	if ( ( $self->running && $self->depth_requests == 0 ) ||
		$dispatch_counter[$$self] == $dispatch_retries[$$self] )
	{
		if ( $request_count[$$self] == $requests_complete[$$self] ||
			 $timeout_counter[$$self] == $timeout_retries[$$self] )
		{
			$kernel->yield('_shutdown');
			return;
		}
		else
		{
			$kernel->delay( 'Timeout', $delay, $delay, );
			$timeout_counter[$$self]++;
		}
	}
	# Dispatch now taking care of requests still in queue and we'll just wait until
	# it is done.
	else
	{
		$kernel->delay( 'Timeout', $delay, $delay, );
	}
}

sub _shutdown :Cumulative {
    my ($kernel,  $self, $session) =
    @_[KERNEL, OBJECT,  SESSION];
	$self->Verbose($self->alias.':_shutdown:');

	foreach my $package ( @{$self->control_options->{'packages'} })
	{
		$kernel->post( $package->name => '_shutdown'  );
	}

#    $kernel->alias_remove( $self->alias );
	return ('_shutdown '.$self->alias )
}

sub _start {
	my ($kernel, $session, $self) = @_[KERNEL, SESSION, OBJECT];

	# Trying to run this as cumulative is not working. Not sure why.
	# Just being inefficient instead of debugging.

	# are we up before OIO has finished initializing object?
	if (!defined( $self->alias ))
	{
    $self->Verbose($session->ID.":_start: OIO not started delaying ");
		$kernel->yield('_start');
		return;
	}

    $kernel->alias_set($self->alias);

    $self->Verbose($self->alias.":_start: Starting alias(".$self->alias.")");

	# Set up recording.
	$self->requests_sent(0) ;
	$self->requests_complete(0);

	# initialize counters
	$self->dispatch_counter(0);
	$self->timeout_counter(0);

	# This will call timeout in 5 seconds
	# So there is a 30 seconds delay from the sending of the last test
	# before we stop by default.
	$timeout_id[$$self] = $kernel->delay_set( 'Timeout', 5, 5 );

	# well, tha above would be true if the kernel was running gung ho. But we're
	# calling timeslices willy nilly until all requests are queued, so it turns out
	# that Timeout gets called in every timeslice regardless of delay, but
	# this is good because it is the one queud event that keeps everything
	# from stopping.

	# When debugging POE Event streams, this might help.
	return('_start'.$self->alias);
}

sub _stop {
	my ($kernel, $session, $self) = @_[KERNEL, SESSION, OBJECT];
	$self->Verbose($self->alias.":".":stop session stopped...\n" );

	# did we send all requests?
	$self->builder->is_num( $self->depth_requests, 0,
		$self->alias." test queue empty" );


	$self->done(0,"Run finished, all tests completed");

	# Sometime timeout is sneaking itself back onto stack during shutdown.
	$self->Verbose($self->alias.":_stop: removing alarms",1,$kernel->alarm_remove_all() );

	# TODO maybe hold on on all response count tests until done for overages?

	# When debugging POE Event streams, this might help.
	return('_stop '.$self->alias);
}

1;

#__END__