view release on metacpan or  search on metacpan

lib/Agent/TCLI/Transport/Test.pm  view on Meta::CPAN

	# 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);
}

=item done_id(<id>, <timeout>, <name> )

B<done_id> works similarly to B<done> except that it waits only for the
results from one request, as specified by the id. If a request id is not
supplied, it will default to the last request made.

It takes an optional timeout parameter, an integer in seconds. The default timeout
is 31 seconds if none is supplied.

It takes an option parameter of a test name.

=cut

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 '' )

lib/Agent/TCLI/Transport/Test.pm  view on Meta::CPAN

	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);
}

=item get_param ( <param>, [ <id>, <timeout> ] )

B<get_param> is an internal method that supports the Testee get_param command.
It requires a param argument that is the parameter to try and obtain a value
for. It takes an optional request id from a prior request. If not
supplied, it will use the last request made. It also takes an optional
timeout value, which will be passed to B<done_id>
to wait for all responses to that request to come in.

B<get_param> attempts to parse the text in the responses to find the value
for the parameter being requested. It expects that the response is
formatted appropriately to extract the parameter.
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"
It returns the value of the parameter requested, or undefined if it
cannot be found.

=cut

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);
}

=item get_responses ( [ <id>, <timeout> ] )

B<get_responses> is an internal method that supports the Testee get_responses
command. It takes an optional request id from a prior request. If not
supplied, it will use the last request made. It also takes an optional
timeout value, which will be passed to B<done> to wait for all responses
to come in.
It returns the text from all available responses, separated by a pair
of newlines.

=cut


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);
}

=item make_id

B<make_id> is used to create a request ID for new requests. It is a separate
method to ease mainenance in case it needs to change in the future. It
takes an optional integer as a parameter, or will default to the current
request_count.

=cut

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 );
}

=item post_it

This internal method controls whether to dispatch the next test. It supports
different styles of running tests, though currently the style is not
user configurable and manipulation of the style is not tested.

For future reference and to encourage assistance in creating a user interface to style, they are:

B<default> or B<syncsend> - This allows a test to be dispacthed when the
acknoledgement is received that the previous test has been received OK. This
does not wait for the previous test to complete.

B<syncresp> or B<done> - This will not dispatch any test until the previous test
has completed. There are many testing scenarios where this makes no sense.
There may be scenarios where it does make sense, and htat is why it is here.
A similar effect can be had with the B<done> test.

B<asynch> - This dispatches a test as soon as it is ready to go. Sometimes