#!/usr/local/bin/perl5
# =========================
# CGI Script - redirect.cgi
# =========================

%in = &webread;

foreach $case (sort keys %in)
{
	next if ($case =~ /^\s*$/);
	next if ($case =~ /^submit$/i);

	if ($case =~ /^baseurl$/i)
	{
		if ($in{$case} !~ /^\s*$/)
		{
			$usebaseurl = 1;
			$baseurl = $in{$case} . "/";
			$baseurl =~ s/\/\/$/\//;
			if ($baseurl !~ /^http\:\/\//i)
			{
				$baseurl = "http://" . $baseurl;
			}
		}

		next;
	}
	
	$htmldoc = $in{$case};
}

if ($usebaseurl == 1)
{
	$htmldoc = substr($htmldoc, 1) if (substr($htmldoc, 0, 1) eq "/");
	if ($htmldoc !~ /^\s*$/)
	{
		$target = $baseurl . $htmldoc;
	}
	else
	{
		$target = $baseurl;
		chop($target);
	}
}
else
{
	($http, $null, $domain, $directory) = split(/\//, $ENV{'HTTP_REFERER'}, 4);

	$directory = reverse($directory);
	($oldhtmldoc, $directory) = split(/\//, $directory, 2);
	$directory = reverse($directory);

	if (substr($htmldoc, 0, 1) eq "/")
	{
		$target = $http . "/" . $null . "/" . $domain . $htmldoc;
	}
	else
	{
		$domain = $domain . "/" . $directory if ($directory ne "");
		$target = join("/", $http, $null, $domain, $htmldoc);
	}
}

open(LOG, ">> mylog.log");
print LOG ($target . "\n");
close(LOG);

# print "Content-type: text/html\n\n";
print "location: $target\n\n";



sub webread
{
	my($readin, %input, $key, $val, $case, @pairs);

	if ($ENV{'REQUEST_METHOD'} eq "POST")
	{
		read(STDIN, $readin, $ENV{'CONTENT_LENGTH'});
	}
	else
	{
		$readin = $ENV{'QUERY_STRING'};
	}

	@pairs = split(/&/, $readin);

	if ($readin ne "")
	{
		foreach $case (0 .. $#pairs)
		{
			$pairs[$case] =~ s/\+/ /g;
			$pairs[$case] =~ s/%(..)/pack("c", hex($1))/ge;

			($key, $val) = split(/=/, $pairs[$case], 2);
			next if ($key eq "");

			$input{$key} .= "\|" if (defined($input{$key}));
			$input{$key} .= $val;
		}
	}

	%input;
}