#!NETQUOTEVAR:PERLPATH --
#################################################################
######## 
######## Added Referrer script support 
######## Bounce page to a specified item
########
######## Use at you your own risk - I take NO responsibility for
######## broken catalogs etc. I've tested this and am using it
######## Back up your referrer.pl file before use
########
######## all changes noted by comments above
######## and below change, named Start legendgames change
######## and End legendgames change
########
######## All new variables etc are appended by 'LG'
######## For example $sLGProductCode
########
######## How it works:
######## Simply sets a meta refresh to the page specified by the 
######## &DESTINATION value in the standard referrer link
######## with an anchor added to the end to the specific product.
######## The cookie info should still be set as normal
########
######## How to use:
######## Simply add a new name pair to the end of the referrer
######## after the &DESTINATION pair
######## &LGPRODUCTCODE=product reference number
######## where Product reference number is an item number 
######## from your catalogue
######## leave it off completely if you want it to default to the section
######## (a bad anchor will also default to section top)
########
######## Andy Warner, andy@legendgames.co.uk
######## Oct 16 2004
########
#################################################################

require NETQUOTEVAR:ACTINICPACKAGE;
require NETQUOTEVAR:ACTINICORDERPACKAGE;
require NETQUOTEVAR:SESSIONPACKAGE;

use strict;

$::prog_name = "REFERRER";							# Program Name
$::prog_ver = '$Revision: 19 $ ';				# program version
$::prog_ver = substr($::prog_ver, 11);			# strip the revision information
$::prog_ver =~ s/ \$//;								# and the trailers


my $sPathToCatalog = 'NETQUOTEVAR:PATH';

$sPathToCatalog =~ s/\/?$/\//;

my ($status, $sMessage, $sInput, $sIgnore, %InputHash) = ACTINIC::ReadAndParseInput();

if ($status != $::SUCCESS)
	{
	ACTINIC::TerminalError($sMessage);
	}

#################################################################
########
######## Start legendgames change
########
######## original code line
######## my ($sSource, $sDestination, $sCatalogUrl) = ($InputHash{SOURCE}, $InputHash{DESTINATION}, $InputHash{BASEURL});
######## changed to line shown below
######## set input name pair to LGProductCode LGPRODUCTCODE which will be the product number to jump to
########
#################################################################

my ($sSource, $sDestination, $sCatalogUrl, $sLGProductCode) = ($InputHash{SOURCE}, $InputHash{DESTINATION},$InputHash{BASEURL}, $InputHash{LGPRODUCTCODE});

#################################################################
########
######## End legendgames change
########
#################################################################


$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.");
	}
#
# We need some tricky way here to make fool the XML parser.
# The BASE HREF determination is based on the refpage which can be
# absolute different then the real catalog URL. So we need ACTINIC_REFERRER
# defined to have correct URLs.
#
$::g_InputHash{'ACTINIC_REFERRER'} = $sCatalogUrl;
#
# Initialize the script
#
Init();
#
# load the file.  Correct the links to refer to the static version of the page
#
my $sURL = $sCatalogUrl . $sDestination;

#################################################################
########
######## Start legendgames change
########
######## Insert code lines to make the bounce link
######## 
######## 
######## 
########
#################################################################

my $sLGAnchor = "#a";
my $sLGFlag = "true";
my $sLGProductCodeLength = length $sLGProductCode;
if ($sLGProductCodeLength < 1)
{
my $sLGFlag = "false";
} 
my $sLGAppendItem = $sLGAnchor . $sLGProductCode;
my $sLGPageBounce = $sURL . $sLGAppendItem;

#################################################################
########
######## End legendgames change
########
#################################################################

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]);
	}
#
# adjust the links
#
@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;
$sHTML = ACTINIC::MakeExtendedInfoLinksAbsolute($sHTML, $sCatalogUrl);

PrintPage($sHTML, $sSource);

exit;

#######################################################
#
# Init - initialize the script
#
#######################################################

sub Init
	{
	#
	# read the prompts
	#
	($status, $sMessage) = ACTINIC::ReadPromptFile($sPathToCatalog);
	if ($status != $::SUCCESS)
		{
		ACTINIC::TerminalError($sMessage);
		}
	#
	# The setup info is required by the session management
	#
	($status, $sMessage) = ACTINIC::ReadSetupFile($sPathToCatalog);	# read the setup
	if ($status != $::SUCCESS)
		{
		ACTINIC::TerminalError($sMessage);
		}
	#
	# Initialise session
	#
	my ($sCartID, $sContactDetails) = ACTINIC::GetCookies();
	$::Session = new Session($sCartID, $sContactDetails, ACTINIC::GetPath(), $::TRUE);
	}

#######################################################
#
# PrintPage - print the HTML page
#
#	Params: 	0 - HTML to print
#				1 - source reference cookie
#
#######################################################

sub PrintPage
	{
	my ($nLength, $sHTML, $sCookie);
	($sHTML, $sCookie) = @_;

	$::bCookieCheckRequired = $::FALSE;
	$sHTML = ACTINIC::ParseXML($sHTML);				# fix up BASEHREF stuff


#################################################################
########
######## Start legendgames change
########
######## If the item code is present, change the html output from 
######## the contents of the page to a meta - refresh
######## directing the browser to the real page
######## You can change the body markup to match your site 
########
######## if it isn't then keep original code
########
#################################################################
if ($sLGProductCodeLength > 0)
{
$sHTML = " 
<html>
<head>
<title>Untitled Document</title>
<meta http-equiv=\"Content-Type\" content=\"text/html charset=iso-8859-1\">
<meta http-equiv=\"refresh\" content=\"0\;URL=" . $sLGPageBounce ."\">
</head>
<body>
<p><center>
Going to the product number\: " . $sLGProductCode . " now.....<p>
If your page does not change, <a href=\"" . $sLGPageBounce . "\">CLICK HERE</a> to go there now.<p>
<p>
</center>
Referrer Link Debug Information\:
<ul>
<li>Source\: " . $sSource . "</li>
<li>Destination page\: " . $sDestination . "</li>
<li>base url\: " . $sCatalogUrl . "</li>
<li>Product code\: " . $sLGProductCode . "</li>
<li>Bounce Page\: " . $sLGPageBounce . "</li>
<li>Flag setting\: " . $sLGFlag . "</li>
<li>Length of item code\: " . $sLGProductCodeLength . "</li>
</ul>
</body>
</html>"
;
}
#################################################################
########
######## End legendgames change
########
#################################################################

	$nLength = length $sHTML;

	binmode STDOUT;										# dump in binary mode so the line breaks are correct and the data is not corrupted

	PrintHeader('text/html', $nLength, $sCookie);

	print $sHTML;											# the body
	}

#######################################################
#
# PrintHeader - print the HTTP header
#
#	Params: 	0 - content type
#				1 - content length
#				2 - cookie
#
#######################################################

sub PrintHeader
	{
	my ($sType, $nLength, $sCookie) = @_;
	#
	# Build a date for the expiry
	#
	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=" .			# set the cookie
	   $sCookie . "; PATH=/;\r\n";

	print "Date: $sNow\r\n";							# print the date to allow the browser to compensate between server and client differences

	print "Content-type: $sType\r\n";
	print "Content-length: $nLength\r\n\r\n";
	}