The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl

use lib 't/lib';
use strict;
use warnings;

use CGI;

use CGI::Snapp::RedirectTest;

use Log::Handler;

use Test::More;

# -----------------------------------------------

sub test_a
{
	# Test 1. Don't redirect.

	my($logger) = Log::Handler -> new;

	$logger -> add
		(
		 screen =>
		 {
			 maxlevel       => 'debug',
			 message_layout => '%m',
			 minlevel       => 'error',
			 newline        => 1, # When running from the command line.
		 }
		);

	my($app)         = CGI::Snapp::RedirectTest -> new(logger => $logger, send_output => 0);
	my($mode_source) = 'rm';
	my($run_mode)    = 'first_rm';

	$app -> mode_param($mode_source);
	$app -> query(CGI -> new({$mode_source => $run_mode}) );
	$app -> run_modes({$run_mode => 'first_sub'});
	$app -> start_mode($run_mode);

	my($output) = $app -> run;

	ok($output =~ /first_sub/, 'Run mode first_sub returned its name');

	return 1;

} # End of test_a.

# -----------------------------------------------

sub test_b
{
	# Test 2. Redirect during prerun phase.

	my($logger) = Log::Handler -> new;

	$logger -> add
		(
		 screen =>
		 {
			 maxlevel       => 'debug',
			 message_layout => '%m',
			 minlevel       => 'error',
			 newline        => 1, # When running from the command line.
		 }
		);

	my($test_name)   = 'test.prerun.mode';
	my($app)         = CGI::Snapp::RedirectTest -> new(logger => $logger, PARAMS => {$test_name => 1}, send_output => 0);
	my($mode_source) = 'rm';
	my($run_mode)    = 'first_rm';

	$app -> mode_param($mode_source);
	$app -> query(CGI -> new({$mode_source => $run_mode}) );
	$app -> run_modes({$run_mode => 'first_sub'});
	$app -> start_mode($run_mode);

	ok($app -> param($test_name) == 1, "PARAMS => {$test_name => 1} worked");

	my($output) = $app -> run;

	ok($output =~ /first.net.au/, 'redirect(http://first.net.au/) during cgiapp_prerun() worked');

	return 2;

} # End of test_b.

# -----------------------------------------------

sub test_c
{
	# Test 3. Redirect but don't set a status.

	my($logger) = Log::Handler -> new;

	$logger -> add
		(
		 screen =>
		 {
			 maxlevel       => 'debug',
			 message_layout => '%m',
			 minlevel       => 'error',
			 newline        => 1, # When running from the command line.
		 }
		);

	my($test_name)   = 'test.without.status';
	my($app)         = CGI::Snapp::RedirectTest -> new(logger => $logger, PARAMS => {$test_name => 1}, send_output => 0);
	my($mode_source) = 'rm';
	my($run_mode)    = 'first_rm';

	$app -> mode_param($mode_source);
	$app -> query(CGI -> new({$mode_source => $run_mode}) );
	$app -> run_modes({$run_mode => 'first_sub'});
	$app -> start_mode($run_mode);

	ok($app -> param($test_name) == 1, "PARAMS => {$test_name => 1} worked");

	my($output) = $app -> run;

	ok($output =~ /second.net.au/, 'Check url: redirect(http://second.net.au/) without a status worked');
	ok($output =~ /302 (?:Found|Moved)/, "Check default status: redirect('http://second.net.au/') without a status worked");

	return 3;

} # End of test_c.

# -----------------------------------------------

sub test_d
{
	# Test 4. Redirect and set a status.

	my($logger) = Log::Handler -> new;

	$logger -> add
		(
		 screen =>
		 {
			 maxlevel       => 'debug',
			 message_layout => '%m',
			 minlevel       => 'error',
			 newline        => 1, # When running from the command line.
		 }
		);

	my($test_name)   = 'test.with.status';
	my($app)         = CGI::Snapp::RedirectTest -> new(logger => $logger, PARAMS => {$test_name => 1}, send_output => 0);
	my($mode_source) = 'rm';
	my($run_mode)    = 'first_rm';

	$app -> mode_param($mode_source);
	$app -> query(CGI -> new({$mode_source => $run_mode}) );
	$app -> run_modes({$run_mode => 'first_sub'});
	$app -> start_mode($run_mode);

	ok($app -> param($test_name) == 1, "PARAMS => {$test_name => 1} worked");

	my($output) = $app -> run;

	ok($output =~ /third.net.au/, 'Check url: redirect(http://third.net.au/) with a status worked');
	ok($output =~ /301 Moved Permanently/, "Check explicit status: redirect('http://third.net.au/', '301 Moved Permanently') with a status worked");

	return 3;

} # End of test_d.

# -----------------------------------------------

sub test_e
{
	# Test 5. Redirect to another URL on the same server.

	my($logger) = Log::Handler -> new;

	$logger -> add
		(
		 screen =>
		 {
			 maxlevel       => 'debug',
			 message_layout => '%m',
			 minlevel       => 'error',
			 newline        => 1, # When running from the command line.
		 }
		);

	my($test_name)   = 'test.local.url';
	my($app)         = CGI::Snapp::RedirectTest -> new(logger => $logger, PARAMS => {$test_name => 1}, send_output => 0);
	my($mode_source) = 'rm';
	my($run_mode)    = 'first_rm';

	$app -> mode_param($mode_source);
	$app -> query(CGI -> new({$mode_source => $run_mode}) );
	$app -> run_modes({$run_mode => 'first_sub'});
	$app -> start_mode($run_mode);

	ok($app -> param($test_name) == 1, "PARAMS => {$test_name => 1} worked");

	my($output) = $app -> run;

	ok($output =~ /login.html/, 'Check url: redirect(login.html) without a status worked');
	ok($output =~ /302 Found/, "Check default status: redirect(login.html) without a status worked");

	return 3;

} # End of test_e.

# -----------------------------------------------

my($count) = 0;

$count += test_a;
$count += test_b;
$count += test_c;
$count += test_d;
$count += test_e;

done_testing($count);