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


use Test::More "no_plan";
use Test::Warn;

use lib ("blib/lib", "t/lib");
use CGI::FileManager;

use CGI::FileManager::Test;

my $t = CGI::FileManager::Test->new({
	module => "CGI::FileManager",
	cookie => "cgi-filemanager",
});

my $cookie;
my $parent = "\Q..\E";   # the regex for matching the text shown on parent directory

# access main page and login screen
{
	my $result = $t->cgiapp("/");
	like ($result, qr{\QLocation: http://test-host/?rm=login}, "Redirected");
	my $cookie = $t->extract_cookie($result);
	is($cookie, "", "no cookie, when redirecting");
}

# get a new cookie
{
	my $result = $t->cgiapp("/", "", {rm => "login"});  # try also  /?rm=login
	like($result, qr{Login form});
	$cookie = $t->extract_cookie($result);
	like($cookie, qr{^\w+$}, "nice cookie, eh ?");
	unlike($result, qr{gabor});
	unlike($result, qr{Login failed});
	unlike($result, qr{badpw});
	like($result,  qr{text/css});
}

# failed logins:
{
	my $result = $t->cgiapp("/", $cookie, {rm => "login_process"});
	my $newcookie = $t->extract_cookie($result);
	is($newcookie, $cookie, "Cookie did not change");
	like($result, qr{Login form});
	unlike($result, qr{gabor});
	like($result, qr{Login failed});
	unlike($result, qr{badpw});
}

{
	my $result = $t->cgiapp("/", $cookie, {rm => "login_process", username => "gabor", password=> "badpw"});
	like($result, qr{Login form});
	like($result, qr{gabor});
	like($result, qr{Login failed});
	unlike($result, qr{badpw});
	like($result,  qr{text/css});
}

# successful login:
{
	my $result = $t->cgiapp("/", $cookie, {rm => "login_process", username => "gabor", password=> "nincs"});
	like ($result, qr{\QLocation: http://test-host/}, "Redirected to home page");
}

# accessing home page after login
{
	my $result = $t->cgiapp("/", $cookie);
	unlike($result, qr{Login form});
	like($result, qr{gabor\@pti.co.il});
	unlike($result, qr{Login failed});
	unlike($result, qr{badpw});
	like($result, qr{Directory Listing});
	like($result,  qr{text/css});

	like($result,  qr{data\.txt});
	unlike($result,  qr{<a href="\?rm=change_dir;workdir=;dir=\.\.">\s*$parent\s*</a>});
	like($result,  qr{<a href="\?rm=change_dir;workdir=;dir=subdir">\s*subdir\s*</a>});
}

# changing to a subdir
{
	my $result = $t->cgiapp("/", $cookie, {rm => "change_dir", dir => "subdir"});
	like($result, qr{Location: http://test-host/\?rm=list_dir;workdir=/subdir});
}
{
	my $result = $t->cgiapp("/", $cookie, {rm => "list_dir", workdir => "/subdir"});
	like($result, qr{Directory Listing});
	unlike($result,  qr{data\.txt});
	unlike($result,  qr{<a href="\?rm=change_dir;workdir=/subdir;dir=subdir">\s*subdir\s*</a>});
	like($result,  qr{<a href="\?rm=change_dir;workdir=/subdir;dir=\.\.">\s*$parent\s*</a>});
	like($result,  qr{somefile\.txt});
}	

# listing the home directory again
{
	my $result = $t->cgiapp("/", $cookie, {rm => "list_dir", workdir => "" });
	like($result, qr{Directory Listing});
	like($result,  qr{data\.txt});
	like($result,  qr{<a href="\?rm=change_dir;workdir=;dir=subdir">\s*subdir\s*</a>});
	unlike($result,  qr{<a href="\?rm=change_dir;workdir=;dir=\.\.">\s*$parent\s*</a>});
	unlike($result,  qr{somefile\.txt});
}	

# changing back to the parent
{
	my $result = $t->cgiapp("/", $cookie, {rm => "change_dir", workdir => "/subdir", dir => ".."});
	like($result, qr{Location: http://test-host/\?rm=list_dir;workdir=/});

}
{
	my $result = $t->cgiapp("/", $cookie, {rm => "list_dir", workdir => "/"});
	like($result, qr{Directory Listing});
	like($result,  qr{data\.txt});
	like($result,  qr{<a href="\?rm=change_dir;workdir=/;dir=subdir">\s*subdir\s*</a>});
	unlike($result,  qr{<a href="\?rm=change_dir;workdir=/;dir=\.\.">\s*$parent\s*</a>});
	unlike($result,  qr{somefile\.txt});
}	

# trying to change back (..) from the root
{
	my $result = $t->cgiapp("/", $cookie, {rm => "change_dir", workdir => "/", dir => ".."});
	like($result, qr{Location: http://test-host/\?rm=list_dir;workdir=/});
}

{
	my $result = $t->cgiapp("/", $cookie, {rm => "list_dir", workdir => ""});
	like($result, qr{Directory Listing});
	like($result,  qr{data\.txt});
	like($result,  qr{<a href="\?rm=change_dir;workdir=;dir=subdir">\s*subdir\s*</a>});
	unlike($result,  qr{<a href="\?rm=change_dir;workdir=;dir=\.\.">\s*$parent\s*</a>});
	unlike($result,  qr{somefile\.txt});
}	

# trying to change back (..) from the root
{
	my $result = $t->cgiapp("/", $cookie, {rm => "change_dir", dir => ".."});
	like($result, qr{Directory Listing});
	like($result,  qr{data\.txt});
	like($result,  qr{<a href="\?rm=change_dir;workdir=;dir=subdir">\s*subdir\s*</a>});
	unlike($result,  qr{<a href="\?rm=change_dir;workdir=;dir=\.\.">\s*$parent\s*</a>});
	unlike($result,  qr{somefile\.txt});
}	


# trying to change to a non existant subdir
{

	# this gives a warning but we use __WARN__ so we cannot use Test::Warn here
	my $result;
	warning_like 
		{$result = $t->cgiapp("/", $cookie, {rm => "change_dir", dir => "nosuch"})}
		qr{Trying to change to invalid directory},
		"invalid directory change warning";
	like($result,  qr{It does not seem to be a correct directory. Please contact the administrator});
}




# logout
{
	my $result = $t->cgiapp("/", $cookie, {rm => "logout"});
	like($result, qr{Good bye});

	# after logut cannot access the internal pages
	$result = $t->cgiapp("/", $cookie);
	like ($result, qr{\QLocation: http://test-host/?rm=login}, "Redirected");
}