view release on metacpan or  search on metacpan

t/1.t  view on Meta::CPAN

{ 
	package MyTestSubApp;
	use base qw[MyTestApp ];
	
	 sub mode2 : Runmode {
	 	'called mode2';
	 }
}

# Callback test package
{

	package MyCallBackTest;
	use base  'CGI::Application';
	use CGI::Application::Plugin::AutoRunmode;
		
	 sub mode2 : Runmode {
	 	'called mode2';
	 }
	 
	 sub cgiapp_prerun{
	 	my ($self, $rm) = @_;
		$self->prerun_mode('mode2')
			if $rm eq 'change_to_2';
		CGI::Application::Plugin::AutoRunmode::cgiapp_prerun($self);
	 }


}




{	
	my $testname = "runmode from a superclass";
	$q->param(rm => 'mode1');
	my $app = new MyTestSubApp(QUERY=>$q);
	my $t = $app->run;
	ok ($t =~ /called mode1/, $testname);
}

{	
	my $testname = "runmode from a subclass";
	$q->param(rm => 'mode2');
	my $app = new MyTestSubApp(QUERY=>$q);
	my $t = $app->run;
	ok ($t =~ /called mode2/, $testname);
}

{	
	my $testname = "security check - calling packaged runmode";
	$q->param(rm => 'MyTestSubApp::mode2');
	my $app = new MyTestApp(QUERY=>$q);
	eval{ my $t = $app->run; };
	ok ($@ =~ /^No such/, $testname);
}


# CGI::App::Callbacks tests (4.0 hooks)
 SKIP: {
 	my $has_callbacks = $CGI::Application::VERSION >= 4;
 	
 
	skip 'callback hooks require CGI::Application version 4', 2 
	     	unless $has_callbacks;



{	
	my $testname = "install via Callbacks";
	$q->param(rm => 'mode2');
	my $app = new MyCallBackTest(QUERY=>$q);
	my $t = $app->run;
	ok ($t =~ /called mode2/, $testname);
}

{	
	my $testname = "prerun changed mode";
	$q->param(rm => 'change_to_2');
	my $app = new MyCallBackTest(QUERY=>$q);
	my $t = $app->run;
	ok ($t =~ /called mode2/, $testname);
}

}; # end skip