Agent-TCLI
view release on metacpan or search on metacpan
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
$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);
}
=item PostRequest
B<PostReuqest> is a required POE event handler for all Transports. Well, all
transports except this one. It currently does nothing.
=cut
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.
}
=item PostResponse
B<PostResponse> is a required POE event handler for all Transports.
It takes a TCLI Response as an argument. Typically
it is called by another Transport to deliver the Response.
It will queue the Reponses in an array in the
responses hash keyed by response->id. It will call B<do_test> to complete
the tests as appropriate.
=cut
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 )
{
( run in 2.902 seconds using v1.01-cache-2.11-cpan-99c4e6809bf )