#!<Actinic:Variable Name="PerlPath"/>
#######################################################
#                                                     #
# The above is the Path to Perl on the ISP's server   #
#                                                     #
# Requires Perl version 5.0 or later                  #
# Requires Perl MD5 module                            #
#                                                     #
#######################################################


#######################################################
#                                                     #
# PROBLEM SOLVING                                     #
#                                                     #
# Listed below are the most common reasons why this   #
# script may fail to operate correctly:               #
#                                                     #
# This cgi script MUST be installed in the 'CGI-BIN'  #
# directory allocated to the user on server of the    #
# Internet Service Provider.                          #
#                                                     #
# The script MUST be uploaded to this directory as    #
# an ASCII file. Do NOT use the 'AUTO' option in your #
# FTP program for the type of file upload . We have   #
# found that some of these FTP programs default to an #
# incorrect upload format.                            #
#                                                     #
# If you receive any error messages from the server,  #
# usually with an error code of 500 or 501, then the  #
# cause will usually be that this file has been sent  #
# to the server using the wrong transfer mode. To     #
# this please re-upload this file as an ASCII file.   #
#                                                     #
# The file permissions need to be correctly set on    #
# this file when it is installed on UNIX servers.     #
# These permissions need to be set as 'rwx r-x r-x'   #
# which equates to a file mask of '755'. These can    #
# usually be easily set via your FTP program.         #
#                                                     #
# Perl MD5 module must be installed at the ISP site   #
# and must be accessible by this script.              #
#                                                     #
#######################################################

#?use CGI::Carp qw(fatalsToBrowser);

#
# Make sure "." is included in the @INC directory list so we can find our packages
#
my $bFound = 0;
my $sDir;
foreach $sDir (@INC)
	{
	if ($sDir eq ".")
		{
		$bFound = 1;
		last;
		}
	}
if (!$bFound)
	{
	push (@INC, ".");
	}
#
# NT systems rarely execute the CGI scripts in the cgi-bin, so attempt to locate
# the packages in that case.  This may still fail if the cgi-bin folder is named
# something else, but at least we will catch 80% of the cases.  The INCLUDEPATHADJUSMENT
# covers the remaining cases.
#
push (@INC, "cgi-bin");
<Actinic:Variable Name="IncludePathAdjustment"/>

require <Actinic:Variable Name="ActinicPackage"/>;
require <Actinic:Variable Name="ActinicSafer"/>;
require <Actinic:Variable Name="ActinicDiffie"/>;
require <Actinic:Variable Name="ActinicEncrypt"/>;
require <Actinic:Variable Name="ActinicOrder"/>;
require <Actinic:Variable Name="SessionPackage"/>;
use strict;

#######################################################
#                                                     #
# CATALOG CUSTOMER ACCOUNTS CGI/PERL SCRIPT           #
#                                                     #
# Copyright (c) 1999 ACTINIC SOFTWARE LIMITED         #
#                                                     #
# written by Richard Zybert                           #
#                                                     #
#######################################################

$::prog_name = "CATACACC";								# Program Name (8 characters)
$::prog_ver = '$Revision: 21697 $';						# program version (6 characters)'
$::prog_ver = substr($::prog_ver, 11);				# strip the revision information
$::prog_ver =~ s/ \$//;									# and the trailers

Init();
CAccDispatch();
exit;

sub CAccDispatch
	{
	#
	# Store productref parameter if exists
	#
	my $sProdRef = $::g_InputHash{'PRODUCTREF'};
	#
	# Is it a logout query?
	#
	if ($::g_InputHash{ACTION} eq 'LOGOUT')
		{
		CaccLogout();										# if so then log out
		}
	#
	# Is it a direct link?
	#
	elsif ($::g_InputHash{ACTION} eq 'DIRECTLINK')
		{
		#
		# Print the product page or the warning bounce page
		#
		if ($sProdRef &&	 								# product ref parameter is passed
			!ACTINIC::IsProductVisible($sProdRef)) # the product is not visible for the user
			{
			CAccPrintWarningBouncePage();				# print the bounce page
			}
		else
			{
			#
			# If so then process the frameset template
			#
			my @Response = ACTINIC::TemplateFile(ACTINIC::GetPath() . $$::g_pSetupBlob{FRAMESET_PAGE});	# make the substitutions
			if ($Response[0] != $::SUCCESS)
				{
				ACTINIC::TerminalError($Response[1]);
				}
			@Response = ACTINIC::MakeLinksAbsolute($Response[2], $::g_InputHash{ACTINIC_REFERRER}, $::g_InputHash{ACTINIC_REFERRER});
			$ACTINIC::B2B->Set('BaseFile', $::g_InputHash{ACTINIC_REFERRER});
			ACTINIC::PrintPage($Response[2], $::Session->GetSessionID());
			}
			exit;
		}
	if (defined $::g_InputHash{SSLBOUNCE} &&
		 $::g_InputHash{SSLBOUNCE} == 1)
		 {
		 PrintSSLBouncePage();
		 }
	#
	# Authorise the user
	#
	ACTINIC::CAccLogin();
	#
	# if we are just logging in, then do a bounce to the same page,
	# so in case of a split SSL config , the page after the successful login
	# won't have any ssl warning or sending unencrypted data warning.
	#
	if (($$::g_pSetupBlob{SSL_USEAGE} == 1) &&	# if SplitSSL is set
		($::g_bJustAfterLogin == $::TRUE))			# and we have just logged in
		{
		my @Response = ACTINIC::BounceToPagePlain(0, undef, undef, $::g_sWebSiteUrl,
			$::g_sContentUrl, $::g_pSetupBlob, $::g_sAccountScript . "?PRODUCTPAGE=" . $::g_pInputHash{PRODUCTPAGE}, \%::g_InputHash);
		if ($Response[0] != $::SUCCESS)
			{
			ACTINIC::ReportError($Response[1], ACTINIC::GetPath());
			}
		my $sHTML = $Response[2];
		my $sCartCookie = ActinicOrder::GenerateCartCookie();
		ACTINIC::SaveSessionAndPrintPage($sHTML, $::Session->GetSessionID(), $::TRUE, "", $::TRUE, $sCartCookie);
		exit;
		}
	#
	# Print the product page directy, if the product is visible for the user
	# Print bounce page otherwise
	#
	if ($sProdRef &&	 									# product ref parameter is passed
		!ACTINIC::IsProductVisible($sProdRef)) 	# the product is not visible for the user
		{
		CAccPrintWarningBouncePage();					# print the bounce page
		}
	else
		{
		#
		# If it is a product page then prepare for display
		#
		if( $::g_InputHash{PRODUCTPAGE} =~ /\S/ )
			{
			$ACTINIC::B2B->Set('ProductPage',$::g_InputHash{PRODUCTPAGE});
			}
		#
		# Display the required page
		#
		my @Response = CAccPrintPage();
		if ($Response[0] != $::SUCCESS)
			{
			ACTINIC::ReportError($Response[1], ACTINIC::GetPath());
			}
		}
	}

#######################################################
#
# CaccLogout - redirect to the login page and clean up
#		the busines cookie
#
#######################################################

sub CaccLogout
	{
	my $sHTML;
	#
	# Get the full URL of the home page
	#
	my $sBaseFile = $::Session->GetBaseUrl() . $$::g_pSetupBlob{'HOMEPAGEURL'};
	#
	# Generate redirect page
	#
	my @Response = ACTINIC::BounceToPagePlain(0, undef, undef, $::g_sWebSiteUrl,
		$::g_sContentUrl, $::g_pSetupBlob, $sBaseFile, \%::g_InputHash);
	if ($Response[0] != $::SUCCESS)
		{
		ACTINIC::ReportError($Response[1], ACTINIC::GetPath());
		}
	$sHTML = $Response[2];
	#
	# Clean up the cookie
	#
	$ACTINIC::B2B->Set('UserIDCookie',".");
	$ACTINIC::B2B->Set('ClearIDCookie','CLEAR');
	#
	# Clear the checkout file
	#
	my (%hashBillAddress, %hashShipAddress, %hashShipInfo, %hashTaxInfo,
		%hashGeneralInfo, %hashPaymentInfo, %hashLocationInfo);
	#
	# Save the session
	#
	my @Response = $::Session->UpdateCheckoutInfo(
		\%hashBillAddress, \%hashShipAddress, \%hashShipInfo, \%hashTaxInfo,
		\%hashGeneralInfo, \%hashPaymentInfo, \%hashLocationInfo);
	#
	# Then write the redirect page and exit
	#
	CAccPrintPageWithOptionalHighlight($sHTML, undef, $::FALSE);
	exit;
	}

#######################################################
#
# CAccPrintPage - Print the HTML to the browser.
#
# Params:	[0] - HTML
#
# Returns: 	nothing if successful
#				otherwise:
#					0 - status
#					1 - error message
#
#######################################################

sub CAccPrintPage
	{
	my $sHTML = shift;
	#
	# Retrieve the cart ID to provide defined cooke value
	#
	if( $sHTML )
		{
		CAccPrintPageWithOptionalHighlight($sHTML, $::Session->GetSessionID(), $::FALSE);
		exit;
		}
	#
	# Build the HTML, print and exit - don't return
	#
	my ($sProductPage,$sBodyPage);
	if( $::g_InputHash{PRODUCTPAGE} =~ /\S/ )
		{
		$sProductPage = $::g_InputHash{PRODUCTPAGE};
		if( $::g_InputHash{MAINFRAMEURL} =~ /\S/ )
			{
			$sBodyPage = $::g_InputHash{MAINFRAMEURL};
			}
		}
	else
		{
		#
		# If it is a brochure login call then make sure the page will be
		# displayed in the brochure frameset
		#
		if ($::g_InputHash{BROCHUREMAINFRAMEURL} =~ /\S/)
			{
			$::g_InputHash{MAINFRAMEURL} = $::g_InputHash{BROCHUREMAINFRAMEURL};
			($sBodyPage,$sProductPage) = ($::g_InputHash{BROCHUREMAINFRAMEURL}, $$::g_pSetupBlob{BROCHURE_FRAMESET_PAGE});
			}
		else
			{
			($sBodyPage,$sProductPage) = ACTINIC::CAccCatalogBody();
			}
		}

	my ($sFirst,$sLast) = split("#",$sProductPage);							 		# isolate anchors
	#
	# Check for Brochure frameset page and strip acatalog/ if there is any
	#
	my $StoreFolderName = ACTINIC::GetStoreFolderName();
	$sFirst =~ s/^$StoreFolderName\///;
	#
	# The file I/O may fail for binary files on Win32 (see: cix:actinic_catlog/bugs_details5:1151)
	# so do some sanity check here
	#
	my $bBinmode = $::FALSE;
	if (!ACTINIC::IsStaticPage($sFirst))
		{
		$bBinmode = $::TRUE;
		}
	my @Response = ACTINIC::TemplateFile(ACTINIC::GetPath() . $sFirst, undef, $bBinmode);	# make the substitutions
	if ($Response[0] != $::SUCCESS)
		{
		return (@Response);
		}
	#
	# clean up the links
	#
	my $sPath = $ACTINIC::B2B->Get('BaseFile');
	if( $sLast ) { $sPath .= "#$sLast" }												# insert anchor back
	my $sCgiUrl = $::g_sAccountScript;
	$sCgiUrl   .= ($::g_InputHash{SHOP} ? '?SHOP=' . ACTINIC::EncodeText2($::g_InputHash{SHOP}, $::FALSE) . '&' : '?');
	$sCgiUrl   .= "ACTINIC_REFERRER=" . ACTINIC::EncodeText2($::g_sAccountScript) . '&';
	if( $sBodyPage and $sBodyPage ne $sProductPage )
		{
		$sCgiUrl .= "MAINFRAMEURL=$sBodyPage" . '&PRODUCTPAGE=';
		}
	else
		{
		$sCgiUrl .= "PRODUCTPAGE=";
		}
	#
	# Probably links in XML covered parts of the pages needs link adjustment
	# therefore do the parse right now and skip the default parsing
	#
	$sHTML = ACTINIC::ParseXML($Response[2]);
	@Response = ACTINIC::MakeLinksAbsolute($sHTML, $sCgiUrl, $sPath);
	if ($Response[0] != $::SUCCESS)
		{
		return (@Response);
		}
	$sHTML = $Response[2];
	#
	# Replace PRODUCTPAGE=acatalog/my.html by PRODUCTPAGE=my.html
	#
	$sHTML =~ s/PRODUCTPAGE=$StoreFolderName\//PRODUCTPAGE=/gi;
	#
	# Force BASE HREF to a valid value to avoid broken images
	#
	if ($sFirst =~ /\.\.\//)
		{
		$sHTML =~ s/(<Actinic:BASEHREF)/$1 FORCED=1/;
		}
	#
	# Insert ACTINIC_REFERRER for product pages
	#
	if( $::g_InputHash{PRODUCTPAGE} =~ /\S/ )
		{
		my $sReplace = sprintf("<INPUT TYPE=HIDDEN NAME=ACTINIC_REFERRER VALUE='%s?PRODUCTPAGE=%s'>", $::g_sAccountScript, $sProductPage );
		$sHTML =~ s/(<FORM[^>]*>)/$1$sReplace/gi;
		my @Response = ACTINIC::EncodeText($sReplace); # encode the text to be inserted
		if ($Response[0] != $::SUCCESS)
			{
			return (@Response);
			}
		my $sEncodedReplace = $Response[1];
		$sHTML =~ s/(&\#60;FORM.*?&\#62;)/$1$sEncodedReplace/gi	# look for the encoded <FORM...> parts and do the replace
		}
	#
	# Now do the XML tags and print
	#
	CAccPrintPageWithOptionalHighlight($sHTML, $::Session->GetSessionID(), $::FALSE, $::TRUE);
	exit;
	}

#######################################################
#
# CAccPrintPageWithOptionalHighlight - print the page
#   If the search script arguments are in place, do
#   the search script highlighting before print.
#
#  Input:     0 - HTML to print
#             1 - cookie
#             2 - HTTP header cache status
#                 ($::TRUE = no cache)
#				  3 - Skip XML parse
#
#  Expects:   %::g_InputHash to contain the CGI params
#             $::g_pSearchSetup blob with search config
#                hash
#
#######################################################

sub CAccPrintPageWithOptionalHighlight
	{
#? ACTINIC::ASSERT($#_ >= 2, "Incorrect parameter count CAccPrintPageWithOptionalHighlight(" . join(', ', @_) . ").", __LINE__, __FILE__);
	my ($sHTML, $sCookie, $bNoCache, $bSkipXMLParse) = @_;
	if (!defined $bSkipXMLParse)
		{
		$bSkipXMLParse = $::FALSE;
		}
	#
	# Some text to be highlighted may be enclosed by XML tags (e.g. products hidden for retail)
	# therefore these must be extracted first. So do the XML parsing here and disable
	# when calling PrintPage
	#
	if (!$bSkipXMLParse)
		{
		$sHTML = ACTINIC::ParseXML($sHTML);
		}
	#
	# See if we are to highlight anything
	#
	my $sWords = $::g_InputHash{WD};					# retrieve the words to highlight
	my $bParseAgain = $::FALSE;
	if ($sWords)
		{
		ACTINIC::HighlightWords($sWords, $$::g_pSearchSetup{SEARCH_HIGHLIGHT_START}, $$::g_pSearchSetup{SEARCH_HIGHLIGHT_END}, \$sHTML);
		#
		# ACTINIC::HighlightWords creates a few XML tags to protect HTML fragments
		# which shouldn't be highlighted. Therefore the XML parse should be done
		# again if this function were called.
		#
		$bParseAgain = $::TRUE;
		}

	my $sCartCookie = ActinicOrder::GenerateCartCookie();
	ACTINIC::SaveSessionAndPrintPage($sHTML, $sCookie, $bNoCache, "",
		!$bParseAgain, 									# XML parsing is already done so should be skipped here
		$sCartCookie);
	}

#######################################################
#
# CAccPrintWarningBouncePage
#	Print the warning HTML bounce page to the browser.
#
# Author: Tibor Vajda
#
#######################################################

sub CAccPrintWarningBouncePage
	{
	#
	# bounce to the product bage after warning
	#
	my ($Status, $Message, $sHTML) = ACTINIC::BounceToPageEnhanced(2,
		ACTINIC::GetPhrase(-1, 2177),					# 'The product is not available...' warning message
		'',													# default title
		$::g_sWebSiteUrl,
		$::g_sContentUrl,
		$::g_pSetupBlob,
		$::g_sAccountScript . "?PRODUCTPAGE=" . $::g_pInputHash{PRODUCTPAGE}, # destination page constructed from the current url
		\%::g_InputHash);
	if ($Status != $::SUCCESS)							# error out
		{
		ACTINIC::TerminalError($Message);
		}
	ACTINIC::SaveSessionAndPrintPage($sHTML, $::Session->GetSessionID(), $::FALSE);
	}

#######################################################
#
# Init - initialize the script
#
#######################################################

sub Init
	{
	$::g_bFirstError = $::TRUE;						# this flag indicates that the display page method has entered recursion
																# due to errors - it prevents infinite recursion
	my (@Response, $Status, $Message, $temp);

	($Status, $Message, $::g_OriginalInputData, $temp, %::g_InputHash) = ACTINIC::ReadAndParseInput();
	if ($Status != $::SUCCESS)
		{
		ACTINIC::ReportError($Message, ACTINIC::GetPath());
		}

	@Response = ReadAndParseBlobs();					# read the catalog blobs
	($Status, $Message) = @Response;					# parse the response
	if ($Status != $::SUCCESS)
		{
		ACTINIC::ReportError($Message, ACTINIC::GetPath());
		}
	#
	# Set the old global variables for compatibility
	#
	$::g_sWebSiteUrl = $::Session->GetBaseUrl();
	$::g_sContentUrl = $::g_sWebSiteUrl;
	}

#######################################################
#
# ReadAndParseBlobs - read the blobs and store them
#	in global data structures
#
# Expects:	%::g_InputHash - the input hash table should
#					be defined
#
# Affects:	$g_sCartId - the cart ID for this customer
#				%g_BillContact - the invoice contact information
#				%g_ShipContact - the delivery contact information
#				%g_ShipInfo - the shipping information
#				%g_TaxInfo - the tax information
#				%g_GeneralInfo - general information
#				%g_PaymentInfo - payment information
#
# Returns:	($ReturnCode, $Error)
#				if $ReturnCode = $FAILURE, the operation failed
#					for the reason specified in $Error
#				Otherwise everything is OK
#
#######################################################

sub ReadAndParseBlobs
	{
	my ($Status, $Message, @Response, $sPath);

	$sPath = ACTINIC::GetPath();						# get the path to the web site

	@Response = ACTINIC::ReadCatalogFile($sPath); # read the catalog blob
	($Status, $Message) = @Response;					# parse the response
	if ($Status != $::SUCCESS)							# on error, bail
		{
		return (@Response);
		}

	@Response = ACTINIC::ReadSetupFile($sPath);	# read the setup
	($Status, $Message) = @Response;
	if ($Status != $::SUCCESS)
		{
		return (@Response);
		}

	@Response = ACTINIC::ReadLocationsFile($sPath);	# read the locations
	($Status, $Message) = @Response;
	if ($Status != $::SUCCESS)
		{
		return (@Response);
		}
	#
	# read the phase blob
	#
	@Response = ACTINIC::ReadPhaseFile($sPath);
	if ($Response[0] != $::SUCCESS)
		{
		return (@Response);
		}
	#
	# read the prompt blob
	#
	@Response = ACTINIC::ReadPromptFile($sPath);
	if ($Response[0] != $::SUCCESS)
		{
		return (@Response);
		}
	#
	# read the tax blob
	#
	@Response = ACTINIC::ReadTaxSetupFile($sPath);
	if ($Response[0] != $::SUCCESS)
		{
		return (@Response);
		}
	#
	# read the tax blob
	#
	@Response = ACTINIC::ReadSearchSetupFile($sPath);
	if ($Response[0] != $::SUCCESS)
		{
		return (@Response);
		}
	#
	# Initialise session
	#
	my ($sCartID, $sContactDetails) = ACTINIC::GetCookies();
	$::Session = new Session($sCartID, $sContactDetails, ACTINIC::GetPath(), $::TRUE);
	#
	# read the checkout status
	#
	my ($pBillContact, $pShipContact, $pShipInfo, $pTaxInfo, $pGeneralInfo, $pPaymentInfo, $pLocationInfo);
	@Response = $::Session->RestoreCheckoutInfo();
	if ($Response[0] != $::SUCCESS)
		{
		return (@Response);
		}
	no strict 'refs';
	($Status, $Message, $pBillContact, $pShipContact, $pShipInfo, $pTaxInfo, $pGeneralInfo, $pPaymentInfo, $pLocationInfo) = @Response;
	%::g_BillContact = %$pBillContact;					# copy the hashes to global tables
	%::g_ShipContact = %$pShipContact;
	%::g_ShipInfo		= %$pShipInfo;
	%::g_TaxInfo		= %$pTaxInfo;
	%::g_GeneralInfo = %$pGeneralInfo;
	%::g_PaymentInfo = %$pPaymentInfo;
	%::g_LocationInfo = %$pLocationInfo;

	return ($::SUCCESS, "", 0, 0);
	}

#######################################################
#
# PrintSSLBouncePage
#	When SSL is used only on essential pages we use bounce
#	page to avoid browser warnings about unsecured transmission.
#	This sub is used to generate this page when required.
#
# Params:	none
#
# Expects:	%::g_InputHash should be defined
#
# Returns:	nothing
#
#######################################################

sub PrintSSLBouncePage
	{
#	my $sHTML;
	my ($sParams, $sKey, $sValue);
	undef $::g_InputHash{SSLBOUNCE};					# clean up the redirect flag
	#
	# Generate parameter list
	#
	while (($sKey, $sValue) = each (%::g_InputHash))
		{
		$sParams .= "$sKey=" . ACTINIC::EncodeText2($sValue, $::FALSE) . "&";
		}
	#
	# Generate the SSL redirect page
	#
	my @Response = ACTINIC::BounceToPagePlain(0, undef, undef, $::g_sWebSiteUrl,
		$::g_sContentUrl, $::g_pSetupBlob, sprintf("%s?%s", $::g_sAccountScript, $sParams), \%::g_InputHash);
	if ($Response[0] != $::SUCCESS)
		{
		ACTINIC::ReportError($Response[1], ACTINIC::GetPath());
		}
	ACTINIC::PrintPage($Response[2], $::Session->GetSessionID());
	exit;
	}
