#!/usr/bin/perl
require al000001;			
require ao000001;	
require sm000001;			
use strict;
$::prog_name = "REFERRER";
$::prog_ver = '$Revision: 16 $ ';
$::prog_ver = substr($::prog_ver, 11);
$::prog_ver =~ s/ \$//;
my $sPathToCatalog = '../estore/acatalog/';
$sPathToCatalog =~ s/\/?$/\//;
my ($status, $sMessage, $sInput, $sIgnore, %InputHash) = ACTINIC::ReadAndParseInput();
if ($status != $::SUCCESS)
{
ACTINIC::TerminalError($sMessage);
}
my ($sSource, $sDestination, $sCatalogUrl) = ($InputHash{SOURCE}, $InputHash{DESTINATION}, $InputHash{BASEURL});
$sCatalogUrl =~ s#/?$#/#;
if (!$sSource)
{
ACTINIC::TerminalError("The referring source is not defined.");
}
if (!$sDestination)
{
ACTINIC::TerminalError("The destination page is not defined.");
}
if (length $sCatalogUrl < 2)
{
ACTINIC::TerminalError("The BASEURL is not defined.");
}
$::g_InputHash{'ACTINIC_REFERRER'} = $sCatalogUrl;
Init();
my $sURL = $sCatalogUrl . $sDestination;
my @Response = ACTINIC::EncodeText($sURL);
$sURL = $Response[1];
my %vartable;
$vartable{'</FORM>'} = "<INPUT TYPE=HIDDEN NAME=ACTINIC_REFERRER VALUE=$sURL></FORM>";
@Response = ACTINIC::TemplateFile($sPathToCatalog . $sDestination, \%vartable);
if ($Response[0] != $::SUCCESS)
{
ACTINIC::TerminalError($Response[1]);
}
@Response = ACTINIC::MakeLinksAbsolute($Response[2], $sCatalogUrl, $sCatalogUrl);
if ($Response[0] != $::SUCCESS)
{
ACTINIC::TerminalError($Response[1]);
}
my $sHTML = $Response[2];
$sHTML =~ s/(\<\s*A\s*HREF[^>?]+\?)/$1ACTINIC_REFERRER=$sURL&/gi;
PrintPage($sHTML, $sSource);
exit;
sub Init
{
($status, $sMessage) = ACTINIC::ReadPromptFile($sPathToCatalog);
if ($status != $::SUCCESS)
{
ACTINIC::TerminalError($sMessage);
}
my ($sCartID, $sContactDetails) = ACTINIC::GetCookies();
$::Session = new Session($sCartID, $sContactDetails, ACTINIC::GetPath(), $::TRUE);	
}
sub PrintPage
{
my ($nLength, $sHTML, $sCookie);
($sHTML, $sCookie) = @_;
$sHTML = ACTINIC::ParseXML($sHTML);
$nLength = length $sHTML;
binmode STDOUT;
PrintHeader('text/html', $nLength, $sCookie);
print $sHTML;
}
sub PrintHeader
{
my ($sType, $nLength, $sCookie) = @_;
my (@expires, $day, $month, $now, $later, @now, $sNow);
my (@days) = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
my (@months) = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
$now = time;
@now = gmtime($now);
$day = $days[$now[6]];
$month = $months[$now[4]];
$sNow = sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT", $day, $now[3],
$month, $now[5]+1900, $now[2], $now[1], $now[0]);
print "Set-Cookie: ACTINIC_SOURCE=" .
$sCookie . "; PATH=/;\r\n";
print "Date: $sNow\r\n";
print "Content-type: $sType\r\n";
print "Content-length: $nLength\r\n\r\n";
}