view release on metacpan or  search on metacpan

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

	    	    	'test1.3' => ['test1.1.1','test1.1.2','test1.1.3'],
	        		},
	        	},
    	    'help' 		=> 'test1.1.y is a test command',
        	'usage'		=> 'test 1.1.1',
        	'topic'		=> 'testing',
        	'call_style'=> 'session',
        	'command'	=> 'base',
	        'handler'	=> 'establish_context',
			'verbose'		=> \$verbose,
			'do_verbose'	=> sub { diag( @_ ) },
		),
		Agent::TCLI::Command->new(
	        'name'		=> 'test1.2.1',
	        'contexts'	=> {
	        	'test1'	=> {
		        	'test1.1' => 'test1.2.1',
		        	'test1.2' => 'test1.2.1',
	    	    	'test1.3' => 'test1.2.1',
	        		},
	        	},
    	    'help' 		=> 'test1.2.1 is a test command',
        	'usage'		=> 'test 1.2.1',
        	'topic'		=> 'testing',
        	'call_style'=> 'session',
        	'command'	=> 'base',
	        'handler'	=> 'establish_context',
			'verbose'		=> \$verbose,
			'do_verbose'	=> sub { diag( @_ ) },
		),

);

my $test_master = Agent::TCLI::Transport::Test->new({
    'control_options'	=> {
	     'packages' 	=> [ $test_base, ],
    },

	'verbose'		=> \$verbose,
	'do_verbose'	=> sub { diag( @_ ) },
	});

my $t = Agent::TCLI::Testee->new(
	'test_master'	=> $test_master,
	'addressee'		=> 'self',
);

# From here on out, verbose is either on or off because these are queued events.
#$verbose = 3;
is($test_base->name,'base', '$test_base->name ');

# 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');
is($t->get_param('auth','',1),'master', 'test auth check');
$t->ok('Control show local_address');
is($t->get_param('address','',1),'127.0.0.1', 'test local_address check');


$test_master->run;