view release on metacpan or  search on metacpan

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

	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;

t/TCLI.Control.Interactive.t  view on Meta::CPAN

# are we in the right place?
$t->like_body('show name',qr(base));

#$verbose = 0;
# general tests
$t->ok('status');
$t->ok('hi');
$t->like_body('echo this',qr(this) );
$t->like_body('echo that is not this',qr(that is not this) );
$t->is_body( 'context','Context: ROOT','verify root context');
$t->ok('debug_request');
$t->ok('exit');
$t->ok('root');
$t->ok('Verbose');

#help tests
$t->is_code( 'help',200, 'help');
$t->is_code( '/',200, 'root context');
$t->is_body( 'context','Context: ROOT','verify root context');
$t->is_code( 'test1',200, 'test1 context');
$t->is_body( 'context','Context: test1','verify test1 context');
$t->like_body( 'help',qr(test1.1.*?test1.2.*?test1.3)s, "help");
$t->like_body( 'help test1.1',qr(test1.x is a test command)s, "help test1.1");
$t->is_code( 'test1.1',200, 'test1.1 context');
$t->is_body( 'context','Context: test1 test1.1','verify test1.1 context');
$t->like_body( 'help',qr(show.*?test1.1.1.*?test1.2.1)s, "help");
$t->like_body( 'help',qr(global.*?exit.*?help)s, "help with globals");
$t->like_body( 'help globals',qr(global.*?exit.*?help)s, "help globals in context");
$t->like_body( 'exit',qr(Context now: test1),"exit ok" );
$t->is_body( 'exit','Context now: ROOT', 'exit Context now: root');
$t->like_body( 'help globals',qr(global.*?exit.*?help)s, "help globals at root");

#manual tests

#$verbose = 2;
#
$t->is_code( 'manual manual',200, 'manual');
$t->is_code( '/',200, 'root context');
$t->is_body( 'context','Context: ROOT','verify root context');
$t->is_code( 'test1',200, 'test1 context');
$t->is_body( 'context','Context: test1','verify test1 context');
$t->like_body( 'manual test1.1',qr(testing TLCI)s, "manual test1.1");
$t->is_code( 'test1.1',200, 'test1.1 context');
$t->is_body( 'context','Context: test1 test1.1','verify test1.1 context');
$t->like_body( 'manual test1.1.1',qr(help for command)s, "manual gives help when not defined");
$t->like_body( 'manual manual',qr(manual command provides detailed)s, "manual for global in context");
$t->like_body( 'exit',qr(Context now: test1),"exit ok" );
$t->is_body( 'exit','Context now: ROOT', 'exit Context now: root');
$test_master->done;

# Control tests
$t->ok('Control show user');
is($t->get_param('id','',1),'test-master@localhost', 'test user check');
$t->ok('Control show auth');