The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -Tw

use strict;
use warnings;
use Test::Most tests => 61;
use File::Spec;
use Cwd;
use Test::NoWarnings;
use Tie::Filehandle::Preempt::Stdin;

BEGIN {
	use_ok('CGI::Info');
}

PATHS: {
        delete $ENV{'SCRIPT_NAME'};
	delete $ENV{'DOCUMENT_ROOT'};
        delete $ENV{'SCRIPT_FILENAME'};

	my $i = new_ok('CGI::Info');
	ok(File::Spec->file_name_is_absolute($i->script_path()));
	ok($i->script_path() =~ /.+script\.t$/);
	ok($i->script_name() eq 'script.t');
	ok($i->script_path() eq File::Spec->catfile($i->script_dir(), $i->script_name()));
	# Check calling twice return path
	ok($i->script_name() eq 'script.t');

	ok(-f $i->script_path());
	my @statb = stat($i->script_path());
	ok(defined($statb[9]));

	# Test full path given as the name of the script
	$ENV{'SCRIPT_NAME'} = $i->script_path();
	$i = new_ok('CGI::Info');
	ok(File::Spec->file_name_is_absolute($i->script_path()));
	ok($i->script_path() =~ /.+script\.t$/);
	if($^O eq 'MSWin32') {
		TODO: {
			local $TODO = 'Absolute path test needs to be done on Windows';
			ok($i->script_name() eq 'script.t');
		}
	} else {
		ok($i->script_name() eq 'script.t');
	}

	$ENV{'SCRIPT_NAME'} = '/cgi-bin/foo.pl';
	if($^O eq 'MSWin32') {
		$ENV{'DOCUMENT_ROOT'} = '\var\www\bandsman';
		$ENV{'SCRIPT_FILENAME'} = '\var\www\bandsman\cgi-bin\foo.pl';
	} else {
		$ENV{'DOCUMENT_ROOT'} = '/var/www/bandsman';
		$ENV{'SCRIPT_FILENAME'} = '/var/www/bandsman/cgi-bin/foo.pl';
	}
	$i = new_ok('CGI::Info');
	if($^O eq 'MSWin32') {
		ok($i->script_dir() eq '\var\www\bandsman\cgi-bin');
		ok($i->script_path() eq '\var\www\bandsman\cgi-bin\foo.pl');
	} else {
		ok($i->script_dir() eq '/var/www/bandsman/cgi-bin');
		ok($i->script_path() eq '/var/www/bandsman/cgi-bin/foo.pl');
	}
	ok($i->script_name() eq 'foo.pl');

	# The name is cached - check reading it twice returns the same value
	ok($i->script_name() eq 'foo.pl');
	if($^O eq 'MSWin32') {
		ok($i->script_path() eq '\var\www\bandsman\cgi-bin\foo.pl');
		ok($i->script_dir() eq '\var\www\bandsman\cgi-bin');
	} else {
		ok($i->script_path() eq '/var/www/bandsman/cgi-bin/foo.pl');
		ok($i->script_dir() eq '/var/www/bandsman/cgi-bin');
	}

	$ENV{'DOCUMENT_ROOT'} = '/path/to';
	$ENV{'SCRIPT_NAME'} = '/cgi-bin/bar.pl';
        delete $ENV{'SCRIPT_FILENAME'};

	$i = new_ok('CGI::Info');
	ok($i->script_name() eq 'bar.pl');
	if($^O eq 'MSWin32') {
		TODO: {
			local $TODO = 'Absolute path test needs to be done on Windows';
			ok($i->script_path() eq '/path/to/cgi-bin/bar.pl');
		}
	} else {
		ok($i->script_path() eq '/path/to/cgi-bin/bar.pl');
	}

        delete $ENV{'DOCUMENT_ROOT'};
	$ENV{'SCRIPT_NAME'} = '/cgi-bin/bar.pl';
        delete $ENV{'SCRIPT_FILENAME'};

	$i = new_ok('CGI::Info');
	ok($i->script_name() eq 'bar.pl');
	ok($i->script_path() eq File::Spec->catfile(Cwd::abs_path(), 'cgi-bin/bar.pl'));
	if($^O eq 'MSWin32') {
		TODO: {
			local $TODO = 'Script_dir test needs to be done on Windows';
			ok($i->script_dir() eq Cwd::abs_path());
		}
	} else {
		ok($i->script_dir() eq File::Spec->catfile(Cwd::abs_path(), 'cgi-bin'));
	}

	$ENV{'SCRIPT_NAME'} = 'cgi-bin/bar.pl';
	$ENV{'DOCUMENT_ROOT'} = '/tmp';
	$i = new_ok('CGI::Info');
	ok($i->script_name() eq 'bar.pl');
	ok($i->script_path() eq File::Spec->catfile('/tmp', 'cgi-bin/bar.pl'));
	if($^O eq 'MSWin32') {
		TODO: {
			local $TODO = 'Script_dir test needs to be done on Windows';
			ok($i->script_dir() eq File::Spec->catfile('/tmp', 'cgi-bin'));
		}
	} else {
		ok($i->script_dir() eq File::Spec->catfile('/tmp', 'cgi-bin'));
	}

	$ENV{'SCRIPT_NAME'} = '/cgi-bin/bar.pl';
	$i = new_ok('CGI::Info');
	ok($i->script_name() eq 'bar.pl');
	ok($i->script_path() eq File::Spec->catfile('/tmp', 'cgi-bin/bar.pl'));
	if($^O eq 'MSWin32') {
		TODO: {
			local $TODO = 'Script_dir test needs to be done on Windows';
			ok($i->script_dir() eq File::Spec->catfile('/tmp', 'cgi-bin'));
		}
	} else {
		ok($i->script_dir() eq File::Spec->catfile('/tmp', 'cgi-bin'));
	}

	$ENV{'SCRIPT_NAME'} = '/tmp/cgi-bin/bar.pl';
	delete $ENV{'DOCUMENT_ROOT'};
	$i = new_ok('CGI::Info');
	ok($i->script_name() eq 'bar.pl');
	if($^O eq 'MSWin32') {
		TODO: {
			local $TODO = 'Script_dir test needs to be done on Windows';
			ok($i->script_dir() =~ /\/tmp\/cgi-bin$/);
			ok($i->script_path() =~ /\/tmp\/cgi-bin\/bar.pl$/);
		}
	} else {
		ok($i->script_dir() =~ /\/tmp\/cgi-bin$/);
		ok($i->script_path() =~ /\/tmp\/cgi-bin\/bar.pl$/);
	}

	# No leading /
	$ENV{'SCRIPT_NAME'} = 'tmp/cgi-bin/bar.pl';
	$i = new_ok('CGI::Info');
	ok($i->script_name() eq 'bar.pl');
	if($^O eq 'MSWin32') {
		TODO: {
			local $TODO = 'Script_dir test needs to be done on Windows';
			ok($i->script_dir() =~ /\/tmp\/cgi-bin$/);
			ok($i->script_path() =~ /\/tmp\/cgi-bin\/bar.pl$/);
		}
	} else {
		ok($i->script_dir() =~ /\/tmp\/cgi-bin$/);
		ok($i->script_path() =~ /\/tmp\/cgi-bin\/bar.pl$/);
	}

	$ENV{'SCRIPT_NAME'} = '/cgi-bin/bar.pl';
	$ENV{'DOCUMENT_ROOT'} = '/tmp';
	$i = new_ok('CGI::Info');
	ok($i->script_name() eq 'bar.pl');
	if($^O eq 'MSWin32') {
		TODO: {
			local $TODO = 'Script_dir test needs to be done on Windows';
			ok($i->script_dir() =~ /\/tmp\/cgi-bin$/);
			ok($i->script_path() =~ /\/tmp\/cgi-bin\/bar.pl$/);
		}
	} else {
		ok($i->script_dir() =~ /\/tmp\/cgi-bin$/);
		ok($i->script_path() =~ /\/tmp\/cgi-bin\/bar.pl$/);
	}

	$ENV{'SCRIPT_NAME'} = 'bar.pl';
	$ENV{'DOCUMENT_ROOT'} = '/tmp';
	$i = new_ok('CGI::Info');
	ok($i->script_name() eq 'bar.pl');
	if($^O eq 'MSWin32') {
		TODO: {
			local $TODO = 'Script_dir test needs to be done on Windows';
			ok($i->script_dir() eq '\\tmp');
			ok($i->script_path() eq '\\tmp\\bar.pl');
		}
	} else {
		ok($i->script_dir() eq '/tmp');
		ok($i->script_path() eq '/tmp/bar.pl');
	}

	delete $ENV{'DOCUMENT_ROOT'};
	$i = new_ok('CGI::Info');
	ok($i->script_name() eq 'bar.pl');
	if($^O eq 'MSWin32') {
		TODO: {
			local $TODO = 'Script_dir test needs to be done on Windows';
			ok($i->script_dir() =~ /\\CGI-Info$/);
			ok($i->script_path() =~ /\\.+bar\.pl$/);
		}
	} else {
		ok($i->script_dir() =~ /\/CGI-Info/);
		ok($i->script_path() =~ /\/.+bar\.pl$/);
	}

	my $object = tie *STDIN,
		'Tie::Filehandle::Preempt::Stdin',
		("fred=wilma\n", "quit\n");
	$i = new_ok('CGI::Info');
	my %p = %{$i->params()};
	ok($p{fred} eq 'wilma');
	ok(!defined($p{barney}));
	ok($i->fred() eq 'wilma');
	ok(!defined($i->barney()));
}