The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!perl -Tw

use strict;
use warnings;
use Test::More tests => 44;
use File::Spec;
use Cwd;
use Test::NoWarnings;

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($i->script_name() eq 'script.t');
	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()));

	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$/);
	}
}