view release on metacpan or  search on metacpan

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

		'auth'		=> 'master',
	})] unless defined($args->{'peers'});

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

}

=item _init

This private OIO method is used for object initialization.

=cut

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

=item build_test

This object method is used to build the test, as a Agent::TCLI::Request, and put it
on the queue. It is called by the Testee. Some of this functionality may be
pushed to the Testee soon, so expect this API to change.

=cut

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