#!/usr/bin/perl
################################################################
# #
# package ACTINIC_PXML - ACTINIC specific parser #
# #
# Separated from ACTINIC package in v6 #
# #
# This module contains the ACTINIC_PXML object description. #
# This object is the Actinic specific event driven extension #
# of the core PXML object. #
# The basic member functions are inherited form the parent #
# PXML object. The below described functions are the event #
# (XML tag) handler functions. #
# #
# Each event hadler is called twice for each XML tag (open #
# and end tag). These calls can be identified by the tag name.#
# Each event handler receives the following arguments: #
# $sTag - tag name #
# $sInsideText - reference to text between start and end #
# $ParameterHash - hash of parameters, #
# $sId - current tag prefix, #
# $sFullTag - full text of current tag; #
# #
# Author: Zoltan Magyar #
# #
# Copyright (c)2002 Actinic Software Ltd #
# #
################################################################
package ACTINIC_PXML;
push (@INC, "cgi-bin");
NETQUOTEVAR:INCLUDEPATHADJUSTMENT
require NETQUOTEVAR:PXMLPACKAGE;
#
# Version
#
$ACTINIC_PXML::prog_name = 'ACTINIC_PXML.pm'; # Program Name
$ACTINIC_PXML::prog_name = $ACTINIC_PXML::prog_name; # remove compiler warning
$ACTINIC_PXML::prog_ver = '$Revision: 28 $ '; # program version
$ACTINIC_PXML::prog_ver = substr($ACTINIC_PXML::prog_ver, 11); # strip the revision information
$ACTINIC_PXML::prog_ver =~ s/ \$//; # and the trailers
#use constant Version => "1.0, (PXML: " . PXML->Version . ")";
############################################################
#
# ACTINIC_PXML->new() - constructor for ACTINIC_PXML class
#
# A very standard constructor. Derives itself from PXML and
# set up the event handler functions.
# See object header and PXML.pm for more details.
#
# Author: Ryszard Zybert Dec 1 18:15:36 GMT 1999
#
# Copyright (c) Actinic Software Ltd 1999
#
############################################################
use vars qw(@ISA);
@ISA = qw(PXML); # inheritance
sub new
{
my $Proto = shift;
my $Class = ref($Proto) || $Proto;
my $self = $Class->SUPER::new(); # dont pass arguments, we can use Set()
bless ($self, $Class);
#
# Set up event handler functions
#
$self->Set(
ID => 'Actinic:', # default prefix
XMLERROR => " " . ACTINIC::GetPhrase(-1, 1972, $::g_sRequiredColor) . "". ACTINIC::GetPhrase(-1, 218) . "" . ACTINIC::GetPhrase(-1, 1970) . " ",
MAINFRAME => sub { $self->MainFrameTagHandler(@_) }, # handle url of main frame
PRICES => sub { $self->PriceTagHandler(@_) }, # price tag
PRICE_EXPLANATION => sub { $self->ExplanationTagHandler(@_) }, # price explanation tag
RETAIL_PRICE_TEXT => sub { $self->RetailPriceTextTagHandler(@_)}, # retail price text tag
VAR => sub { $self->VarTagHandler(@_) }, # var tag
SECTION => sub { $self->SectionTagHandler(@_) }, # section tag
ADDRESSES => sub { $self->AddressTagHandler(@_) }, # addresses tag
UNREG => sub { $self->UnregTagHandler(@_) }, # unregistered user tag
IGNORE => sub { $self->IgnoreTagHandler(@_) }, # IGNORE tag (deletes text)
REMOVE => sub { $self->RemoveTagHandler(@_) }, # Remove tag (deletes text if its parameter not defined)
NOTINB2B => sub { $self->NotInB2BTagHandler(@_) }, # NOTINB2B tag (deletes text)
BASEHREF => sub { $self->BaseHrefTagHandler(@_) }, # BASEHREF tag
DEFAULT => sub { $self->DefaultTagHandler(@_) }, # unknown tags here
XMLTEMPLATE => sub { $self->XMLTemplateTagHandler(@_) }, # XML template tag handler
CARTERROR => sub { $self->CartErrorTagHandler(@_) }, # Cart error placeholder
RETAIL_ONLY_SEARCH => sub { $self->RetailOnlySearchTagHandler(@_)},
LOCATION => sub { $self->LocationTagHandler(@_) }, # LOCATION tags
EXTRAFOOTERTEXT => sub { $self->ExtraFooterTagHandler(@_) }, # EXTRAFOOTERTEXT tags
EXTRACARTTEXT => sub { $self->ExtraCartTagHandler(@_) }, # EXTRACARTTEXT tags
EXTRACARTBASEPLUSPERTEXT => sub { $self->ExtraCartBasePlusPerTagHandler(@_) }, # EXTRACARTBASEPLUSPERTEXT tags
EXTRASHIPPINGTEXT => sub { $self->ExtraShippingTagHandler(@_) }, # EXTRASHIPPINGTEXT tags
BASEPLUSPERRATEWARNING => sub { $self->BasePlusPerInfoTagHandler(@_) }, # BASEPLUSPERRATEWARNING tags
DEFAULTTAXZONEMESSAGE => sub { $self->DefaultTaxZoneMessageTagHandler(@_)}, # DEFAULTTAXZONEMESSAGE tags
SHOWFORPRICESCHEDULE => sub { $self->ShowForPriceScheduleTagHandler(@_) }, # ShowForPriceSchedule tags
COOKIECHECK => sub { $self->AddCookieCheck(@_) }, # Cookie checking code placeholder
);
$self->Set(@_);
return $self;
}
############################################################
#
# ExplanationTagHandler - process the price explanation tag
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Zoltan Magyar Feb 22 23:22 GMT 2001
#
# Copyright (c) Actinic Software Ltd (2001)
#
############################################################
sub ExplanationTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
if( $sTag =~ /^\// ) # If End tag
{
return "";
}
if( $Self->{CurrentSectionBlob} ) # If section blob set
{
my @Response;
@Response = ACTINIC::GetProduct($ParameterHash->{PROD_REF}, $Self->{CurrentSectionBlob},
ACTINIC::GetPath()); # get this product object
my ($Status, $Message, $pProduct) = @Response;
if ($Status != $::SUCCESS)
{
return "";
} # If any problem, forget it
if (defined $$pProduct{PRICES})
{
#
# Need to work out which prices to show
#
my ($bShowRetailPrices, $bShowCustomerPrices, $nAccountSchedule) = ACTINIC::DeterminePricesToShow();
my $sComments;
if ($nAccountSchedule == -1)
{
$nAccountSchedule = $ActinicOrder::RETAILID;
}
#
# Look up the apropriate product or component comment
#
if (defined $ParameterHash->{COMPONENTID} &&
$ParameterHash->{COMPONENTID} != -1)
{
my $nComponentID = $ParameterHash->{COMPONENTID};
#
# Check that associated product pricing is used or not
# and select the appropriate message
#
if ($pProduct->{COMPONENTS}[$nComponentID][$::CBIDX_ASSOCPRODPRICE] == 1) # if associated product prices are used
{
#
# Get the message from associated product hash
#
my $Assoc = $pProduct->{COMPONENTS}[$nComponentID][$::CBIDX_PERMUTATIONS][0][$::PBIDX_ASSOCIATEDPROD];
#
# Check if the associated product blob is defined
# It is not defined when the associated product is out of stock
# or the permutation is invalid. The [3][0][1] item contains
# '+' or '-' strings in these cases (IOW no explanation hash).
#
if (ref $Assoc eq 'HASH')
{
$sComments = $$Assoc{PRICE_COMMENTS}->{$nAccountSchedule};
}
}
elsif (defined $pProduct->{COMPONENTS}[$nComponentID][$::CBIDX_EXPLANATION] &&
ref($pProduct->{COMPONENTS}[$nComponentID][$::CBIDX_EXPLANATION]) eq 'HASH')
{
$sComments = $pProduct->{COMPONENTS}[$nComponentID][$::CBIDX_EXPLANATION]->{$nAccountSchedule};
}
}
else
{
$sComments = $pProduct->{'PRICE_COMMENTS'}->{$nAccountSchedule};
}
if ($sComments ne '')
{
$$sInsideText = ACTINIC::GetPhrase(-1, 2296). $sComments . ACTINIC::GetPhrase(-1, 2297); # wrap non empty text with BLOCKQUOTES
}
}
}
return "";
}
############################################################
#
# RetailOnlySearchTagHandler - process the search tag
#
# Note: acts globally
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
############################################################
sub RetailOnlySearchTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
my $sDigest = $ACTINIC::B2B->Get('UserDigest'); # get the user identifying digest
if ($sTag !~ /^\//) # If not End tag
{
if ($sDigest) # If there is a user remove tags and text
{
if (ref($sInsideText))
{
$$sInsideText = "";
}
}
}
else # here on the second call (the end tag)
{
return (''); # on the second pass, return nothing to prevent duplicate entries
}
#
# If the buyer exists and does not see retail prices, note that the search is retail prices only
#
my $sRetailMessage = ACTINIC::GetPhrase(-1, 357);
if ($sDigest) # see which price schedule they use
{
my ($Status, $sMessage, $pBuyer) = ACTINIC::GetBuyer($sDigest, ACTINIC::GetPath()); # look up the buyer
if ($Status == $::SUCCESS)
{
my $pAccount;
($Status, $sMessage, $pAccount) = ACTINIC::GetCustomerAccount($pBuyer->{AccountID}, ACTINIC::GetPath()); # find the account information
if ($Status == $::SUCCESS)
{
if ($pAccount->{PriceSchedule} == $ActinicOrder::RETAILID) # if we can confirm that this buyer is using the retail schedule
{
$sRetailMessage = ''; # the message is unnecessary
}
}
}
}
return ($sRetailMessage);
}
############################################################
#
# AddressTagHandler - callback for addresses
# Replaces tag by address table
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Ryszard Zybert Jan 3 16:44:37 GMT 2000
#
# Copyright (c) Actinic Software Ltd (2000)
#
############################################################
sub AddressTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
my $sDigest = $ACTINIC::B2B->Get('UserDigest');
if( $sTag =~ /^\// ) # Ignore end-tags
{
return "";
}
my ($Status, $sMessage, $pBuyer, $pAccount) = ACTINIC::GetBuyerAndAccount($sDigest, ACTINIC::GetPath());
if ($Status != $::SUCCESS)
{
if ($Status != $::NOTFOUND)
{
ACTINIC::ReportError($sMessage, ACTINIC::GetPath()); # if the error is not the missing digest the error should be reported
}
return("");
}
#
# Get the lists of valid addresses
#
my ($pAddress, $plistValidAddresses, $plistValidInvoiceAddresses, $plistValidDeliveryAddresses);
($Status, $sMessage, $plistValidInvoiceAddresses, $plistValidDeliveryAddresses) =
ACTINIC::GetCustomerAddressLists($pBuyer, $pAccount);
if ($Status != $::SUCCESS)
{
return("");
}
my ($sType,$sSelect,$nRule,$sChecked);
if ($ParameterHash->{TYPE} =~ /^INVOICE/) # Invoice address
{
$plistValidAddresses = $plistValidInvoiceAddresses;
if ($pAccount->{InvoiceAddressRule} == 1) # The Customer rule overrides buyer rule
{
$nRule = 0;
$sSelect = $pAccount->{InvoiceAddress};# Default (or fixed) address
($Status, $sMessage, $pAddress) = ACTINIC::GetCustomerAddress($$pBuyer{AccountID}, $sSelect, ACTINIC::GetPath());
if ($Status != $::SUCCESS)
{
ACTINIC::CloseCustomerAddressIndex(); # The customer index is left open for multiple access, so clean it up here
return("");
}
}
else
{
$nRule = $pBuyer->{InvoiceAddressRule}; # Address rule for this user
$sSelect = $pBuyer->{InvoiceAddressID}; # Default (or fixed) address
if($nRule == 0 || ($nRule == 1 && $#$plistValidAddresses == 0))
{
$nRule = 0;
$pAddress = $plistValidAddresses->[0];
$sSelect = $pAddress->{ID};
}
}
}
elsif( $ParameterHash->{TYPE} =~ /^DELIVERY/ ) # Delivery address
{
$plistValidAddresses = $plistValidDeliveryAddresses;
$nRule = $pBuyer->{DeliveryAddressRule}; # Address rule for this user
if($nRule == 0)
{
$sSelect = $pBuyer->{DeliveryAddressID};
($Status, $sMessage, $pAddress) = ACTINIC::GetCustomerAddress($$pBuyer{AccountID}, $sSelect, ACTINIC::GetPath());
if ($Status != $::SUCCESS)
{
ACTINIC::CloseCustomerAddressIndex(); # The customer index is left open for multiple access, so clean it up here
return ("");
}
}
elsif($nRule == 1 && $#$plistValidAddresses == 0)
{
$nRule = 0;
$pAddress = $plistValidAddresses->[0];
$sSelect = $pAddress->{ID};
}
else
{
$sSelect = $pBuyer->{DeliveryAddressID}; # Default (or fixed) address
}
}
if( $ParameterHash->{TYPE} =~ /FORM$/ ) # Address form
{
if( $nRule != 2 ) # Only shown for Rule 2
{
$$sInsideText = "";
}
ACTINIC::CloseCustomerAddressIndex(); # The customer index is left open for multiple access, so clean it up here
return "";
}
ACTINIC::CloseCustomerAddressIndex(); # The customer index is left open for multiple access, so clean it up here
#
# Format 'mini templates'.
# Table title and address format depend on $nRule, there must be one for each rule
#
my $sTableFormat = $Self->{Variables}->{ADDRESS_TABLE};
my $sTitle = $Self->{Variables}->{'ADDRESS_TITLE' . $nRule};
my $sTitle_1 = $Self->{Variables}->{'ADDRESS_TITLE1' . $nRule};
my $sForm = '
';
#
# Number of columns only matters if it results in more than one row
# Otherwise existing addresses will expand to fill the table
#
my $nColumns = $Self->{Variables}->{ADDRESS_COLUMNS} || 1; # Number of columns - default to 1
if( !$sForm or !$sTableFormat )
{
return "";
} # No formats - we cannot do that
my $sAddressText = "";
if( $nRule == 0 ) # Rule 0 - fixed address
{
$sAddressText .= '
'; # Just a single cell
$sAddressText .= sprintf($sForm,
$sSelect, # Address ID
$pAddress->{Name}, # Address text follows
$pAddress->{Line1},
$pAddress->{Line2},
$pAddress->{Line3},
$pAddress->{Line4},
$pAddress->{PostCode},
ACTINIC::GetCountryName($pAddress->{CountryCode}));
$sAddressText .= '
';
}
else # Rule 1 - select from list
{ # Rule 2 - select or fill form
$sTitle = sprintf($sTitle,ACTINIC::GetPhrase(-1, 302)); # Insert title from prompts
if( $nRule == 2 ) # Insert text for address form
{
if( $ParameterHash->{TYPE} =~ /^INVOICE/ )
{
$sTitle_1 = sprintf($sTitle_1,ACTINIC::GetPhrase(-1, 303,ACTINIC::GetPhrase(-1, 304)));
}
else
{
$sTitle_1 = sprintf($sTitle_1,ACTINIC::GetPhrase(-1, 303,ACTINIC::GetPhrase(-1, 305)));
}
}
my $nCount = 0;
my $nRowCount = 0;
my $sCh;
foreach $pAddress (@$plistValidAddresses)
{
if( $nCount % $nColumns == 0 )
{
$sAddressText .= '
'; # Close row
$nRowCount++; # Count rows
}
}
while( $nCount % $nColumns != 0 ) # Close table row if not closed
{
if( $nRowCount > 0 ) { $sAddressText .= '
' } # If more than one row - add empty cells
$nCount++;
if( $nCount % $nColumns == 0 )
{
$sAddressText .= '';
last;
}
}
}
$sAddressText =~ s/ [,\s]*/ /gi; # Remove leading commas
$sAddressText =~ s/[,\s]* / /gi; # Remove trailing commas
$sAddressText =~ s/( )+/ /gi; # Remove blank lines
return sprintf($sTableFormat,
$sTitle,
$$::g_pSetupBlob{FORM_EMPHASIS_COLOR}, # Border
$$::g_pSetupBlob{FORM_BACKGROUND_COLOR}, # Background
$sAddressText,
$sTitle_1);
return "";
}
############################################################
#
# sub VarTagHandler - callback for variables
# Sets variables
# There should be NAME and VALUE parameters
# $Self->{Variables}->{name} is set to value
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Ryszard Zybert Dec 7 20:58:25 GMT 1999
#
# Copyright (c) Actinic Software Ltd (1999)
#
############################################################
sub VarTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
if( $sTag !~ /^\// )
{
$Self->{Variables}->{$ParameterHash->{NAME}} = $ParameterHash->{VALUE};
}
return "";
}
############################################################
#
# sub CartErrorTagHandler - cart error tag handler
#
# If any error message is set for the actual product reference
# (in the ProdRef parameter) then replace the tag to the
# error message.
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Zoltan Magyar, 5/14/2003
#
# Copyright (c) Actinic Software Ltd 2003
#
############################################################
sub CartErrorTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
if( $sTag =~ /^\// )
{
return "";
}
#
# Check if we have error message stored for the actual product reference
#
my $sErrorValue = $ACTINIC::B2B->GetXML("CartError_" . $ParameterHash->{ProdRef});
if (defined $sErrorValue)
{
return $sErrorValue;
}
return "";
}
############################################################
#
# sub DefaultTagHandler - callback for unknown tags
# Looks up the tag in the B2B XML Tags hash
# If found - replaces the tag by it
# (meaning the whole sequence)
# If not doesn't -leaves everything untouched
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Ryszard Zybert Dec 7 20:58:25 GMT 1999
#
# Copyright (c) Actinic Software Ltd (1999)
#
############################################################
sub DefaultTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
my $sXMLTag = $ACTINIC::B2B->GetXML($sTag);
if (defined $sXMLTag)
{
return $sXMLTag;
}
return $sFullTag;
}
############################################################
#
# XMLTemplateTagHandler - callback for XMLTEMPLATE tags
# Looks up the NAME parameter in the B2B XML Tags hash
# If found - replaces the tag by it
# (meaning the whole sequence)
# If not doesn't - removes everything
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Ryszard Zybert Dec 7 20:58:25 GMT 1999
#
# Copyright (c) Actinic Software Ltd (1999)
#
############################################################
sub XMLTemplateTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
if( $sTag =~ /^\// ) # Ignore end-tag completely
{
return "";
}
my $sTagname = $ParameterHash->{NAME};
my $sXMLTag = $ACTINIC::B2B->GetXML($sTagname);
if (defined $sXMLTag)
{
$$sInsideText = ""; # replace (i.e. don't leave enclosed text)
return $sXMLTag; # return replacement
}
$$sInsideText = "";
return "";
}
############################################################
#
# sub RetailPriceTextTagHandler - callback for retail text
# Sets XML variable
# B2B->{XML}->{tag} is set to value of text between tags
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : empty string
#
############################################################
sub RetailPriceTextTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
if( $sTag !~ /^\// ) # Ignore end-tag completely
{
if(ref($sInsideText)) # If there is text store it in XML variable
{
$ACTINIC::B2B->SetXML($sTag, $$sInsideText);
my $sDigest = $ACTINIC::B2B->Get('UserDigest');
if ($sDigest)
{
$$sInsideText = ""; # Text not needed anymore for logged in
}
}
}
return ""; # Both tags also removed
}
############################################################
#
# DefaultRemovingTagHandler - callback for unknown tags
# As DefaultTagHandler except that unknown tags are removed
# together with all text between tags
#
# Looks up the tag in the B2B XML Tags hash
# If found - replaces the tag by it
# (meaning the whole sequence)
# If not removes everything
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Ryszard Zybert Dec 7 20:58:25 GMT 1999
#
# Copyright (c) Actinic Software Ltd (1999)
#
############################################################
sub DefaultRemovingTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
my $sXMLTag = $ACTINIC::B2B->GetXML($sTag);
if( defined($sXMLTag) ) # Don't touch text, return replacement tag
{
return $sXMLTag;
}
else # Clear both text and tag
{
if( ref($sInsideText) )
{
$$sInsideText = "";
}
return "";
}
}
############################################################
#
# IgnoreTagHandler
# Remove text within the tag and the tag
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Ryszard Zybert Jul 25 22:30:51 BST 2000
#
# Copyright (c) Actinic Software Ltd (2000)
#
############################################################
sub IgnoreTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
if( ref($sInsideText) )
{
$$sInsideText = "";
}
return "";
}
############################################################
#
# RemoveTagHandler
# Remove text within the tag and the tag if the tag is not defined
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Zoltan Magyar 10:30 PM 3/13/2002
#
# Copyright (c)2002 Actinic Software Ltd
#
############################################################
sub RemoveTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
my $sTagID;
if( $ParameterHash->{TAG} ) # VALUE contains HREF
{
$sTagID = $ParameterHash->{TAG}; # use it
}
my $sXMLTag = $ACTINIC::B2B->GetXML($sTagID);
if( ref($sInsideText) && !$sXMLTag)
{
$$sInsideText = "";
}
return "";
}
############################################################
#
# sub BaseHrefTagHandler
# Insert BASE HREF tag so that it is only present in dynamic pages
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Zoltan Magyar
#
# Copyright (c) Actinic Software Ltd (2000)
#
############################################################
sub BaseHrefTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
if( $sTag =~ /^\// ) # If not End tag
{
return "";
}
my $sReplace;
my $sURL;
if (defined $::Session)
{
$sURL = $::Session->GetBaseUrl();
}
#
# Separated CGI and catalog servers and the store branding are
# mutually exclusive. So don't care store branding feature when
# SSL is used for login and checkout pages only
#
if ($$::g_pSetupBlob{'SSL_USEAGE'} == "1") # if SSL is used for some pages
{
if( $ParameterHash->{VALUE} ) # VALUE contains HREF
{
$sReplace = $ParameterHash->{VALUE}; # use it
}
}
#
# Otherwise try to detemine the correct BASE HREF value to
# maintain the store branding feature.
#
else
{
if ($sURL) # if non script page found use it
{
$sReplace = $sURL; # use referer
}
elsif( $ParameterHash->{VALUE} ) # VALUE contains HREF
{
$sReplace = $ParameterHash->{VALUE}; # use it
}
#
# If it is the Brochure index page uploaded above acatalog
# the fix up the URL by removing acatalog/
#
if ( $ParameterHash->{FORCED} )
{
$sReplace =~ s/acatalog\///;
}
}
$$sInsideText = ''; # Insert the tag
return "";
}
############################################################
#
# NotInB2BTagHandler
# If there is a registered user removes the tags end text between
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Ryszard Zybert Jul 28 14:20:06 BST 2000
#
# Copyright (c) Actinic Software Ltd (2000)
#
############################################################
sub NotInB2BTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
if( $sTag !~ /^\// ) # If not End tag
{
my $sDigest = $ACTINIC::B2B->Get('UserDigest');
if( $sDigest ) # If there is a user remove tags and text
{
if( ref($sInsideText) )
{
$$sInsideText = "";
}
}
}
return "";
}
############################################################
#
# UnregTagHandler - callback for UNREG tag
# If there is a registered user removes the tags end text between
# Otherwise produces a warning page and bounces to login page
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Ryszard Zybert May 16 15:23:37 BST 2000
#
# Copyright (c) Actinic Software Ltd (1999)
#
############################################################
sub UnregTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
my $sDigest = $ACTINIC::B2B->Get('UserDigest');
if( $sTag =~ /^\// ) # If not End tag
{
return "";
}
#
# When we get here by an invalid user or password from the login page on a closed B2B site
# the $sDigest won't be defined and we get "unregistered customers not allowed" error
# instead of "invalid user" message.
# So lets be tricky and check this case as well.
#
if( $sDigest || # If there is a user remove tags and text
$::g_bLoginPage ) # or invalid user or password
{
if( ref($sInsideText) ) { $$sInsideText = ""; }
return "";
}
else
{
#
# If we were here already then the processing should be stopped here
# to avoid infinitive loop
#
if ($::g_RECURSION_ACTIVE)
{
return "";
}
#
# This will only have effect if JavaScript is disabled.
# Otherwise there is a JavaScript alert and this script is no called
# So - in this case we just show warning and jup back to original page
#
my ($Status, $sError, $sHTML) = ACTINIC::ReturnToLastPage(7," " ,
ACTINIC::GetPhrase(-1, 208),
$::g_sWebSiteUrl,
$::g_sContentUrl, $::g_pSetupBlob, %::g_InputHash);
if ($Status != $::SUCCESS) # If even this didn't work - we give up - there is an error
{
ACTINIC::ReportError($sError, ACTINIC::GetPath());
}
#
# ACTINIC::PrintPage calls the parser again
# We should make sure this function won't be called recursively
# so se a flag here and check above
#
$::g_RECURSION_ACTIVE = $::TRUE;
ACTINIC::PrintPage($sHTML, undef, $::TRUE); # Print warning page and exit
exit;
}
return "";
}
############################################################
#
# PriceTagHandler - price tag callback
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Ryszard Zybert Dec 7 21:06:24 GMT 1999
#
# Copyright (c) Actinic Software Ltd (1999)
#
############################################################
sub PriceTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
if( $sTag =~ /^\// ) # If not End tag
{
return "";
}
if( !$Self->{CurrentSectionBlob} || # If section blob not set
!$ACTINIC::B2B->Get('UserDigest') ) # or not Business customer
{
return "";
}
my @Response;
#
# We need the tax information to calculate the prices
#
if(!$ActinicOrder::bTaxDataParsed)
{
#
# read the tax blob
#
@Response = ACTINIC::ReadTaxSetupFile(ACTINIC::GetPath());
if ($Response[0] != $::SUCCESS)
{
return (@Response);
}
ActinicOrder::ParseAdvancedTax();
}
$Self->Parse($$sInsideText);
@Response = ACTINIC::GetProduct($ParameterHash->{PROD_REF}, $Self->{CurrentSectionBlob},
ACTINIC::GetPath()); # get this product object
my ($Status, $Message, $pProduct) = @Response;
if ($Status != $::SUCCESS)
{
return "";
} # If any problem, forget it
if (defined $$pProduct{PRICES})
{
#
# Need to know if this product has any variants
#
my ($VariantList, $sLine);
if( $pProduct->{COMPONENTS} )
{
($VariantList, $sLine) = ACTINIC::GetVariantList($ParameterHash->{PROD_REF});
}
#
# Need to work out which prices to show
#
my ($bShowRetailPrices, $bShowCustomerPrices, $nAccountSchedule) = ACTINIC::DeterminePricesToShow();
my $sPriceLabelText = $ACTINIC::B2B->GetXML('RETAIL_PRICE_TEXT');
if($bShowRetailPrices && $bShowCustomerPrices)
{
my $sPriceLabel = ACTINIC::GetPhrase(-1, 294, $sPriceLabelText);
#
# Show dealer and retail price
#
@Response = ActinicOrder::FormatSchedulePrices($pProduct, $ActinicOrder::RETAILID,
\$VariantList, $sPriceLabel, $::TRUE, $::TRUE); # Show the retail price
$$sInsideText = $Response[2];
$sPriceLabel = ACTINIC::GetPhrase(-1, 293, $sPriceLabelText);
@Response = ActinicOrder::FormatSchedulePrices($pProduct,
$nAccountSchedule, \$VariantList, $sPriceLabel, $::FALSE, $::TRUE); # Show the dealer price
$$sInsideText .= $Response[2];
}
elsif($bShowCustomerPrices)
{
#
# Show only dealer price
#
if (0 == scalar(@{$pProduct->{'PRICES'}->{$nAccountSchedule}}))
{
#
# The product is unavailable if user's price schedule is not included
#
$$sInsideText = ACTINIC::GetPhrase(-1, 351); # 'This product is currently unavailable'
}
else # user's price schedule included
{
@Response = ActinicOrder::FormatSchedulePrices($pProduct,
$nAccountSchedule, \$VariantList, $ACTINIC::B2B->GetXML('RETAIL_PRICE_TEXT'), $::FALSE, $::TRUE);
$$sInsideText = $Response[2];
}
}
else
{
#
# Show only retail price
#
if (0 == scalar(@{$pProduct->{'PRICES'}->{$ActinicOrder::RETAILID}}))
{
#
# The product is unavailable if the retail price is not included
#
$$sInsideText = ACTINIC::GetPhrase(-1, 351); # 'This product is currently unavailable'
}
else
{
@Response = ActinicOrder::FormatSchedulePrices($pProduct,
1, \$VariantList, $ACTINIC::B2B->GetXML('RETAIL_PRICE_TEXT'), undef, $::TRUE, $::TRUE);
$$sInsideText = $Response[2];
}
}
}
return ""; # Always remove tag
}
############################################################
#
# sub SectionTagHandler - section tag callback
#
# Note: acts globally
# $Self->{CurrentSectionBlob} is set here and kept
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Ryszard Zybert Dec 20 21:06:24 GMT 1999
#
# Copyright (c) Actinic Software Ltd (1999)
#
############################################################
sub SectionTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId) = @_;
if( $sTag !~ /^\// ) # If not End tag
{
$Self->{CurrentSectionBlob} = $ParameterHash->{BLOB};
}
return ""; # Always remove tag
}
############################################################
#
# sub MainFrameTagHandler
# replace SRC parameter in a FRAME tag
#
# If MAINFRAME XML variable is defined and SRC=name is found
# in inside text, name will be replaced by the value of MAINFRAME XML
# variable.
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Ryszard Zybert Jul 18 11:26:08 BST 2000
#
# Copyright (c) Actinic Software Ltd (2000)
#
############################################################
sub MainFrameTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId) = @_;
if( $sTag =~ /^\// ) # If not End tag
{
return "";
}
my $sXMLTag;
if( $::g_InputHash{MAINFRAMEURL} )
{
$sXMLTag = $::g_InputHash{MAINFRAMEURL};
}
else
{
$sXMLTag = $ACTINIC::B2B->GetXML("MAINFRAMEURL");
}
if( defined($sXMLTag) ) # Replace SRC parameter by tag value
{
if( ref($sInsideText) )
{
if( $sXMLTag !~ /^((http(s?):)|(\/))/ )
{
#
# Be sure we don't get frames in frames
#
if( $sXMLTag eq $$::g_pSetupBlob{FRAMESET_PAGE} ) # for catalog
{
$sXMLTag = $$::g_pSetupBlob{CATALOG_PAGE};
}
if( $sXMLTag eq $$::g_pSetupBlob{BROCHURE_FRAMESET_PAGE} ) # for brochure
{
$sXMLTag = $$::g_pSetupBlob{BROCHURE_MAIN_PAGE};
}
#
# We should use absolute URLs here
#
$sXMLTag = $::g_sAccountScript . '?' . ($::g_InputHash{SHOP} ? 'SHOP=' . $::g_InputHash{SHOP} . "&" : "") . 'PRODUCTPAGE=' . $sXMLTag;
}
$$sInsideText =~ s/(\s+SRC\s*=\s*)((\"[^\"]+\")|([^\ \>]+))((\s+)|(\>+))/$1\"$sXMLTag\"$5/is;
}
}
return ""; # Always remove tag
}
############################################################
#
# FormatPrice - format single price
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Ryszard Zybert Dec 29 23:07:05 GMT 1999
#
# Copyright (c) Actinic Software Ltd (1999)
#
############################################################
sub FormatPrice
{
my $Self = shift;
my ($Price,$sPriceMsg,$sTax,$sIncTax,$bTaxExlusiveOnly,$bTaxInclusiveOnly) = @_;
my ($sPrice,$sEPrice,$fPrice,$sPriceexl,$sPriceincl);
my $sCurrency = $::g_pCatalogBlob->{SCURRENCY};
my $sEFormat = $::g_pSetupBlob->{EURO_FORMAT};
my $sECurrency = $::g_pCatalogBlob->{EUR}->{SCURRENCY};
my $fEuroConversion = $::g_pCatalogBlob->{EUR}->{EXCH_RATE};
my $sPFormat = '%s%.2f';
if( $bTaxExlusiveOnly ) # Exlusive only
{
$fPrice = $Price/100.0; # Price in real money
}
else # Inclusive or both
{
$fPrice = (1.0 + $::g_pSetupBlob->{TAX_1_RATE}/10000.0) * $Price/100.0; # Add tax
}
if( !$bTaxInclusiveOnly and !$bTaxExlusiveOnly ) # Display exclusive and inclusive prices
{
$sPriceexl = sprintf($sPFormat,$sCurrency,$Price/100.0); # Format exlusive price
$sPriceincl = sprintf($sPFormat,$sCurrency,$fPrice); # Format inclusive price
if( $::g_pSetupBlob->{EURO_PRICES} ) # Euro prices if needed
{
$sEPrice = sprintf($sPFormat,$sECurrency,$Price/$fEuroConversion/100.0);# Calculate Euro exclusive price
$sPriceexl = sprintf($sEFormat,$sPriceexl,$sEPrice); # Format exclusive price string
$sEPrice = sprintf($sPFormat,$sECurrency,$fPrice/$fEuroConversion); # Calculate Euro inclusive price
$sPriceincl = sprintf($sEFormat,$sPriceincl,$sEPrice); # Format inclusive price string
}
return ACTINIC::GetPhrase(-1,227,$sPriceMsg,$sPriceexl,$sPriceincl,$sIncTax);
}
$sPrice = sprintf($sPFormat,$sCurrency,$fPrice); # Format price
if( $::g_pSetupBlob->{EURO_PRICES} ) # Add Euro price if needed
{
$sEPrice = sprintf($sPFormat,$sECurrency,$fPrice/$fEuroConversion); # Calculate Euro price
$sPrice = sprintf($sEFormat,$sPrice,$sEPrice); # Format complete price string
}
return ACTINIC::GetPhrase(-1,225,$sPriceMsg,$sPrice,$sTax);
}
############################################################
#
# FormatPriceRow - format price row
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Ryszard Zybert Dec 29 23:07:05 GMT 1999
#
# Copyright (c) Actinic Software Ltd (1999)
#
############################################################
sub FormatPriceRow
{
my $Self = shift;
my ($Price,$sIncTax,$sQlimit,$bTaxExlusiveOnly,$bTaxInclusiveOnly) = @_;
my ($sPrice,$sEPrice,$fPrice,$sPriceexl,$sPriceincl);
my $sCurrency = $::g_pCatalogBlob->{SCURRENCY};
my $sEFormat = $::g_pSetupBlob->{EURO_FORMAT};
my $sECurrency = $::g_pCatalogBlob->{EUR}->{SCURRENCY};
my $fEuroConversion = $::g_pCatalogBlob->{EUR}->{EXCH_RATE};
my $sPFormat = '%s%.2f';
if( $bTaxExlusiveOnly ) # Exclusive only
{
$fPrice = $Price/100.0; # Price in real money
}
else # Inclusive or both
{
$fPrice = (1.0 + $::g_pSetupBlob->{TAX_1_RATE}/10000.0) * $Price/100.0; # Add tax
}
if( !$bTaxInclusiveOnly and !$bTaxExlusiveOnly ) # Display exclusive and inclusive prices
{
$sPriceexl = sprintf($sPFormat,$sCurrency,$Price/100.0); # Format exclusive
$sPriceincl = sprintf($sPFormat,$sCurrency,$fPrice); # Format inclusive
if( $::g_pSetupBlob->{EURO_PRICES} ) # Add Euro price if needed
{
$sEPrice = sprintf($sPFormat,$sECurrency,$Price/$fEuroConversion/100.0);# Exclusive
$sPriceexl = sprintf($sEFormat,$sPriceexl,$sEPrice);
$sEPrice = sprintf($sPFormat,$sECurrency,$fPrice/$fEuroConversion); # Inclusive
$sPriceincl = sprintf($sEFormat,$sPriceincl,$sEPrice);
}
if( $Self->{Variables}->{FORMAT_PRICE_ROW_BOTH} ) # If there is a variable, use it
{
return sprintf($Self->{Variables}->{FORMAT_PRICE_ROW_BOTH},$sPriceexl,$sPriceincl,$sIncTax,$sQlimit);
}
else # Otherwise use prompt 228
{
return ACTINIC::GetPhrase(-1,228,$sPriceexl,$sPriceincl,$sIncTax,$sQlimit);
}
}
$sPrice = sprintf($sPFormat,$sCurrency,$fPrice); # Display either exclusive or inclusive
if( $::g_pSetupBlob->{EURO_PRICES} ) # Add Euro prices if needed
{
$sEPrice = sprintf($sPFormat,$sECurrency,$fPrice/$fEuroConversion);
$sPrice = sprintf($sEFormat,$sPrice,$sEPrice);
}
if( $Self->{Variables}->{FORMAT_PRICE_ROW} ) # If there is a variable, use it
{
return sprintf($Self->{Variables}->{FORMAT_PRICE_ROW},$sPrice,$sQlimit);
}
else # Otherwise use prompt 224
{
return ACTINIC::GetPhrase(-1,224,$sPrice,$sQlimit);
}
}
############################################################
#
# LocationTagHandler - callback for LOCATION tag
#
# Displays the location in the appropriate form
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
############################################################
sub LocationTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
if( $sTag =~ /^\// )
{
return "";
}
my $sType = $ParameterHash->{TYPE};
my ($sHTMLFormat, $sHTML, $sReplace);
my $sNonEditableFormat = ACTINIC::GetPhrase(-1, 2066);
my $sEditableFormat = ACTINIC::GetPhrase(-1, 2067, ACTINIC::GetPhrase(-1, 1973), '%s', ACTINIC::GetPhrase(-1, 1970), '%s', '%s', ACTINIC::GetPhrase(0, 18));
my $sDigest = $ACTINIC::B2B->Get('UserDigest');
#
# Get the lists of valid customer account buyer addresses
#
my ($pAddress,
$plistValidInvoiceAddresses, $plistValidDeliveryAddresses,
$nInvoiceID, $nDeliveryID,
$sCountryInvoiceHTML, $sStateInvoiceHTML,
$sCountryDeliveryHTML, $sStateDeliveryHTML);
$nInvoiceID = -1;
$nDeliveryID = -1;
my ($pSingleInvoiceAddress, $pSingleDeliveryAddress);
if($sDigest ne '')
{
my ($Status, $sMessage, $pBuyer, $pAccount) = ACTINIC::GetBuyerAndAccount($sDigest, ACTINIC::GetPath());
if ($Status != $::SUCCESS)
{
ACTINIC::ReportError($sMessage, ACTINIC::GetPath());
}
($Status, $sMessage,
$plistValidInvoiceAddresses, $plistValidDeliveryAddresses,
$nInvoiceID, $nDeliveryID) =
ACTINIC::GetCustomerAddressLists($pBuyer, $pAccount, $::TRUE);
if ($Status != $::SUCCESS)
{
ACTINIC::ReportError($sMessage, ACTINIC::GetPath());
}
#
# If there's a single invoice address, get it
#
if($nInvoiceID != -1)
{
$pSingleInvoiceAddress = pop(@$plistValidInvoiceAddresses);
}
elsif($pBuyer->{InvoiceAddressRule} == 1)
{
($Status, $sMessage, $sCountryInvoiceHTML, $sStateInvoiceHTML) =
ActinicOrder::GetBuyerLocationSelections($plistValidInvoiceAddresses,
'LocationInvoiceCountry', 'LocationInvoiceRegion',
'lstInvoiceCountry', 'lstInvoiceRegion',
'INVOICE', $pBuyer->{InvoiceAddressID});
}
#
# If there's a single delivery address, get it
#
if($nDeliveryID != -1)
{
$pSingleDeliveryAddress = pop(@$plistValidDeliveryAddresses);
}
elsif($pBuyer->{DeliveryAddressRule} == 1)
{
($Status, $sMessage, $sCountryDeliveryHTML, $sStateDeliveryHTML) =
ActinicOrder::GetBuyerLocationSelections($plistValidDeliveryAddresses,
'LocationDeliveryCountry', 'LocationDeliveryRegion',
'lstDeliveryCountry', 'lstDeliveryRegion',
'DELIVERY', $pBuyer->{DeliveryAddressID});
}
}
if(ref($sInsideText))
{
if(!$$::g_pLocationList{EXPECT_INVOICE} && !$$::g_pLocationList{EXPECT_DELIVERY})
{
return('');
}
#
# Handle location selection for customer accounts
#
# Start with delivery country selection
#
if($sType eq 'DELIVERSELECTCOUNTRY') # location country selection?
{
if($pSingleDeliveryAddress)
{
$$sInsideText = sprintf($sNonEditableFormat,
ACTINIC::GetCountryName($pSingleDeliveryAddress->{CountryCode}),
'LocationDeliveryCountry',
$pSingleDeliveryAddress->{CountryCode});
}
elsif($sCountryDeliveryHTML ne '')
{
$$sInsideText = $sCountryDeliveryHTML;
}
}
#
# Next with delivery state selection
#
if($sType eq 'DELIVERSELECTSTATE') # location state selection?
{
if($pSingleDeliveryAddress)
{
my $sStateName = ACTINIC::GetCountryName($pSingleDeliveryAddress->{StateCode});
$$sInsideText = sprintf($sNonEditableFormat,
($sStateName ne '') ? $sStateName : '',
'LocationDeliveryRegion',
($sStateName ne '') ? $pSingleDeliveryAddress->{StateCode} : $ActinicOrder::UNDEFINED_REGION);
}
elsif($sStateDeliveryHTML ne '')
{
$$sInsideText = $sStateDeliveryHTML;
}
}
#
# Next invoice country selection
#
if($sType eq 'INVOICESELECTCOUNTRY') # location country selection?
{
if($pSingleInvoiceAddress)
{
$$sInsideText = sprintf($sNonEditableFormat,
ACTINIC::GetCountryName($pSingleInvoiceAddress->{CountryCode}),
'LocationInvoiceCountry',
$pSingleInvoiceAddress->{CountryCode});
}
elsif($sCountryInvoiceHTML ne '')
{
$$sInsideText = $sCountryInvoiceHTML;
}
}
#
# Next invoice state selection
#
if($sType eq 'INVOICESELECTSTATE') # location state selection?
{
if($pSingleInvoiceAddress)
{
my $sStateName = ACTINIC::GetCountryName($pSingleInvoiceAddress->{StateCode});
$$sInsideText = sprintf($sNonEditableFormat,
($sStateName ne '') ? $sStateName : '',
'LocationInvoiceRegion',
($sStateName ne '') ? $pSingleInvoiceAddress->{StateCode} : $ActinicOrder::UNDEFINED_REGION);
}
elsif($sStateInvoiceHTML ne '')
{
$$sInsideText = $sStateInvoiceHTML;
}
}
if($sType eq 'SEPARATESHIP') # separate shipping address?
{
if($::g_LocationInfo{SEPARATESHIP}) # turned on?
{
$sReplace = sprintf($sEditableFormat,
ACTINIC::GetPhrase(-1, 1914),
$sType,
ACTINIC::GetPhrase(-1, 1914));
}
else
{
$sReplace = sprintf($sEditableFormat,
ACTINIC::GetPhrase(-1, 1915),
$sType,
"");
}
$$sInsideText =~ s//$sReplace/ig;
#
# Replace the checkbox instruction prompt with an appropriate label
#
my $sPrompt = ACTINIC::GetPhrase(0, 16);
$sReplace = ACTINIC::GetPhrase(0, 19);
if($sPrompt ne '')
{
$$sInsideText =~ s/$sPrompt/$sReplace/;
}
}
#
# If we're expecting invoice information or
# we expect delivery but the same addresses are used
#
if($$::g_pLocationList{EXPECT_INVOICE} ||
($$::g_pLocationList{EXPECT_DELIVERY} && $::g_LocationInfo{SEPARATESHIP} eq ''))
{
#
# Get the number of available countries depending upon whether we expect invoica and/or delivery info
#
my $nCountryCount;
if($$::g_pLocationList{EXPECT_INVOICE})
{
$nCountryCount = $$::g_pLocationList{INVOICE_COUNTRY_COUNT};
}
else
{
$nCountryCount = $$::g_pLocationList{DELIVERY_COUNTRY_COUNT};
}
#
# Now go through the location tag types
#
if($sType eq 'INVOICEPOSTALCODE')
{
if($nInvoiceID != -1)
{
$sReplace = sprintf($sNonEditableFormat,
$::g_LocationInfo{INVOICEPOSTALCODE},
$sType,
$::g_LocationInfo{INVOICEPOSTALCODE});
$$sInsideText =~ s//$sReplace/ig;
}
elsif((defined $$::g_pLocationList{INVOICEPOSTALCODE} &&
$$::g_pLocationList{INVOICEPOSTALCODE}) ||
(defined $$::g_pLocationList{DELIVERPOSTALCODE} &&
$$::g_pLocationList{DELIVERPOSTALCODE} &&
$::g_LocationInfo{SEPARATESHIP} eq ''))
{
$sReplace = sprintf($sEditableFormat,
$::g_LocationInfo{INVOICEPOSTALCODE},
$sType,
$::g_LocationInfo{INVOICEPOSTALCODE});
$$sInsideText =~ s//$sReplace/ig;
}
}
elsif($sType eq 'INVOICEADDRESS3')
{
# $$sInsideText = '
' .$sType. '
';
}
elsif($sType eq 'INVOICEADDRESS4')
{
if(((defined $$::g_pLocationList{INVOICEADDRESS4} &&
$$::g_pLocationList{INVOICEADDRESS4}) ||
(defined $$::g_pLocationList{DELIVERADDRESS4} &&
$$::g_pLocationList{DELIVERADDRESS4} &&
$::g_LocationInfo{SEPARATESHIP} eq '')) &&
$::g_LocationInfo{INVOICE_REGION_CODE} &&
$::g_LocationInfo{INVOICE_REGION_CODE} ne $ActinicOrder::UNDEFINED_REGION)
{
if($$::g_pLocationList{$::g_LocationInfo{INVOICE_COUNTRY_CODE}}{INVOICE_STATE_COUNT} < 2)
{
$sHTMLFormat = $sNonEditableFormat;
}
else
{
$sHTMLFormat = $sEditableFormat;
}
$sReplace = sprintf($sHTMLFormat,
ACTINIC::GetCountryName($::g_LocationInfo{INVOICE_REGION_CODE}),
$sType,
ACTINIC::GetCountryName($::g_LocationInfo{INVOICE_REGION_CODE}));
$$sInsideText =~ s//$sReplace/ig;
}
}
elsif($sType eq 'INVOICECOUNTRY')
{
if(($$::g_pLocationList{INVOICECOUNTRY} ||
($$::g_pLocationList{DELIVERCOUNTRY} && $::g_LocationInfo{SEPARATESHIP} eq '')))
{
#
# Find out which country code we should be using
#
my $sKnownCountryCode;
if($$::g_pLocationList{INVOICECOUNTRY})
{
if($::g_LocationInfo{INVOICE_COUNTRY_CODE} ne $ActinicOrder::UNDEFINED_COUNTRY &&
$::g_LocationInfo{INVOICE_COUNTRY_CODE} ne $ActinicOrder::REGION_NOT_SUPPLIED)
{
$sKnownCountryCode = $::g_LocationInfo{INVOICE_COUNTRY_CODE};
}
}
elsif($$::g_pLocationList{DELIVERCOUNTRY} && $::g_LocationInfo{SEPARATESHIP} eq '')
{
if($::g_LocationInfo{DELIVERY_COUNTRY_CODE} ne $ActinicOrder::UNDEFINED_COUNTRY &&
$::g_LocationInfo{DELIVERY_COUNTRY_CODE} ne $ActinicOrder::REGION_NOT_SUPPLIED)
{
$sKnownCountryCode = $::g_LocationInfo{DELIVERY_COUNTRY_CODE};
}
}
#
# If we don't have a code, leave untouched
#
if($sKnownCountryCode eq '')
{
return('');
}
#
# Decide whether we can change it
#
if($nCountryCount < 2)
{
$sHTMLFormat = $sNonEditableFormat;
}
else
{
$sHTMLFormat = $sEditableFormat;
}
#
# Format the replacement
#
$sReplace = sprintf($sHTMLFormat,
ACTINIC::GetCountryName($::g_LocationInfo{INVOICE_COUNTRY_CODE}),
$sType,
ACTINIC::GetCountryName($::g_LocationInfo{INVOICE_COUNTRY_CODE}));
#
# Do the replacement
#
$$sInsideText =~ s//$sReplace/ig;
}
}
}
if($$::g_pLocationList{EXPECT_DELIVERY} ||
($$::g_pLocationList{EXPECT_INVOICE} && $::g_LocationInfo{SEPARATESHIP} eq ''))
{
#
# Get the number of available countries depending upon whether we expect invoica and/or delivery info
#
my $nCountryCount;
if($$::g_pLocationList{EXPECT_DELIVERY})
{
$nCountryCount = $$::g_pLocationList{DELIVERY_COUNTRY_COUNT};
}
else
{
$nCountryCount = $$::g_pLocationList{INVOICE_COUNTRY_COUNT};
}
if($sType eq 'DELIVERPOSTALCODE')
{
if($$::g_pLocationList{DELIVERPOSTALCODE})
{
$sReplace = sprintf($sEditableFormat,
$::g_LocationInfo{DELIVERPOSTALCODE},
$sType,
$::g_LocationInfo{DELIVERPOSTALCODE});
$$sInsideText =~ s//$sReplace/ig;
}
}
elsif($sType eq 'DELIVERADDRESS3')
{
# $$sInsideText = '
' .$sType. '
';
}
elsif($sType eq 'DELIVERADDRESS4')
{
if($::g_LocationInfo{DELIVERY_REGION_CODE} &&
$::g_LocationInfo{DELIVERY_REGION_CODE} ne $ActinicOrder::UNDEFINED_REGION)
{
if($$::g_pLocationList{$::g_LocationInfo{DELIVERY_COUNTRY_CODE}}{DELIVERY_STATE_COUNT} < 2)
{
$sHTMLFormat = $sNonEditableFormat;
}
else
{
$sHTMLFormat = $sEditableFormat;
}
$sReplace = sprintf($sHTMLFormat,
ACTINIC::GetCountryName($::g_LocationInfo{DELIVERY_REGION_CODE}),
$sType,
ACTINIC::GetCountryName($::g_LocationInfo{DELIVERY_REGION_CODE}));
$$sInsideText =~ s//$sReplace/ig;
}
}
elsif($sType eq 'DELIVERCOUNTRY')
{
if($::g_LocationInfo{DELIVERY_COUNTRY_CODE} &&
$::g_LocationInfo{DELIVERY_COUNTRY_CODE} ne $ActinicOrder::UNDEFINED_COUNTRY &&
$::g_LocationInfo{DELIVERY_COUNTRY_CODE} ne $ActinicOrder::REGION_NOT_SUPPLIED)
{
if($nCountryCount < 2)
{
$sHTMLFormat = $sNonEditableFormat;
}
else
{
$sHTMLFormat = $sEditableFormat;
}
$sReplace = sprintf($sHTMLFormat,
ACTINIC::GetCountryName($::g_LocationInfo{DELIVERY_COUNTRY_CODE}),
$sType,
ACTINIC::GetCountryName($::g_LocationInfo{DELIVERY_COUNTRY_CODE}));
$$sInsideText =~ s//$sReplace/ig;
}
}
}
}
return('');
}
############################################################
#
# ExtraFooterTagHandler - callback for ExtraFooter tag
#
# Displays the extra footer in the appropriate form
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Mike Purnell
#
############################################################
sub ExtraFooterTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
if( $sTag !~ /^\// )
{
if(ref($sInsideText))
{
my $nSSPProviderID;
my $sTemplate = $$sInsideText;
$$sInsideText = '';
#
# For each shipping provider display their trademark text + logo
#
my %hTrademarkProviderIDs;
if ($ACTINIC::B2B->GetXML('ShippingDisclaimingDisplayed') == $::TRUE) # we are on the shipping charge checkout page
{
%hTrademarkProviderIDs = (%::s_Ship_hShippingClassProviderIDs, %::s_Ship_hBasePlusPerProviderIDs); # collect shipping class providers and base-plus-per providers
}
if ($::s_Ship_bDisplayExtraCartInformation && # the shipping cost is calculated by a shipping provider
$::s_Ship_nSSPProviderID != -1)
{
$hTrademarkProviderIDs{$::s_Ship_nSSPProviderID} = $::TRUE; # add the actual shipping provider
}
foreach $nSSPProviderID (keys %hTrademarkProviderIDs)
{
my %hVariables;
$hVariables{$::VARPREFIX . 'POWEREDBYLOGO'} = $$::g_pSSPSetupBlob{$nSSPProviderID}{'POWERED_BY_LOGO'};
$hVariables{$::VARPREFIX . 'TRADEMARKS'} = $$::g_pSSPSetupBlob{$nSSPProviderID}{'TRADEMARKS'};
my @Response = ACTINIC::TemplateString($sTemplate, \%hVariables); # make the substitutions
my ($Status, $Message, $sLine) = @Response;
if ($Status != $::SUCCESS)
{
#
# Display nothing in case of an error
#
$$sInsideText = '';
return ('');
}
$$sInsideText .= $sLine;
}
return ('');
}
}
#
# Nothing will be displayed at this phase
#
$$sInsideText = '';
return('');
}
############################################################
#
# ExtraCartTagHandler - callback for EXTRACARTTEXT tag
#
# Displays the extra cart text in the appropriate form
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Tibor Vajda
#
############################################################
sub ExtraCartTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
if( $sTag !~ /^\// )
{
if(ref($sInsideText))
{
if ($::s_Ship_bDisplayExtraCartInformation &&
$::s_Ship_nSSPProviderID != -1 &&
$::s_Ship_sOpaqueShipData !~ /BasePlusIncrement/)
{
#
# Diplay the rate disclaimer text + logo for the current shipping provider
#
my %hVariables;
$hVariables{$::VARPREFIX . 'POWEREDBYLOGO'} = $$::g_pSSPSetupBlob{$::s_Ship_nSSPProviderID}{'POWERED_BY_LOGO'};
$hVariables{$::VARPREFIX . 'RATEDISCLAIMER'} = $$::g_pSSPSetupBlob{$::s_Ship_nSSPProviderID}{'RATE_DISCLAIMER'};
my @Response = ACTINIC::TemplateString($$sInsideText, \%hVariables); # make the substitutions
my ($Status, $Message, $sLine) = @Response;
if ($Status == $::SUCCESS)
{
$$sInsideText = $sLine;
return ('');
}
}
}
}
#
# Nothing will be displayed at this phase
#
$$sInsideText = '';
return('');
}
############################################################
#
# ExtraCartBasePlusPerTagHandler - callback for EXTRACARTBASEPLUSPERTEXT tag
#
# Displays the extra cart base plus per text in the appropriate form
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Tibor Vajda
#
############################################################
sub ExtraCartBasePlusPerTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
if( $sTag !~ /^\// )
{
if(ref($sInsideText))
{
if ($::s_Ship_bDisplayExtraCartInformation &&
$::s_Ship_nSSPProviderID != -1 &&
$::s_Ship_sOpaqueShipData =~ /BasePlusIncrement/)
{
#
# Diplay the rate disclaimer text + logo for the current shipping provider
#
my %hVariables;
$hVariables{$::VARPREFIX . 'BASE_PLUS_PER_RATE_DISCLAIMER'} = $$::g_pSSPSetupBlob{$::s_Ship_nSSPProviderID}{'BASE_PLUS_PER_RATE_DISCLAIMER'};
my @Response = ACTINIC::TemplateString($$sInsideText, \%hVariables); # make the substitutions
my ($Status, $Message, $sLine) = @Response;
if ($Status == $::SUCCESS)
{
$$sInsideText = $sLine;
return ('');
}
}
}
}
#
# Nothing will be displayed at this phase
#
$$sInsideText = '';
return('');
}
############################################################
#
# ExtraShippingTagHandler - callback for EXTRASHIPPINGTEXT tag
#
# Displays the extra shipping bar text in the appropriate form
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Tibor Vajda
#
############################################################
sub ExtraShippingTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
if( $sTag !~ /^\// )
{
if(ref($sInsideText))
{
#
# Remember that we displayed provider info cause we have to display tradmark info as well
#
$ACTINIC::B2B->SetXML('ShippingDisclaimingDisplayed', $::TRUE);
#
# Init variables
#
my $nSSPProviderID;
my $sTemplate = $$sInsideText;
$$sInsideText = '';
#
# For each shipping class provider display their disclaimer text + logo
#
foreach $nSSPProviderID (keys %::s_Ship_hShippingClassProviderIDs)
{
my %hVariables;
$hVariables{$::VARPREFIX . 'POWEREDBYLOGO'} = $$::g_pSSPSetupBlob{$nSSPProviderID}{'POWERED_BY_LOGO'};
$hVariables{$::VARPREFIX . 'RATEDISCLAIMER'} = $$::g_pSSPSetupBlob{$nSSPProviderID}{'RATE_DISCLAIMER'};
my @Response = ACTINIC::TemplateString($sTemplate, \%hVariables); # make the substitutions
my ($Status, $Message, $sLine) = @Response;
if ($Status != $::SUCCESS)
{
#
# Display nothing in case of an error
#
$$sInsideText = '';
return ('');
}
$$sInsideText .= $sLine;
}
return ('');
}
}
#
# Nothing will be displayed at this phase
#
$$sInsideText = '';
return('');
}
############################################################
#
# BasePlusPerInfoTagHandler - callback for EXTRABASEPLUSPERTEXT tag
#
# Displays the extra base plus per warning text in the appropriate form
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Tibor Vajda
#
############################################################
sub BasePlusPerInfoTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
if( $sTag !~ /^\// )
{
if(ref($sInsideText))
{
#
# Remember that we displayed provider info cause we have to display tradmark info as well
#
$ACTINIC::B2B->SetXML('ShippingDisclaimingDisplayed', $::TRUE);
#
# Init variables
#
my $nSSPProviderID;
my $sTemplate = $$sInsideText;
$$sInsideText = '';
#
# For each base plus per provider display their disclaimer text + logo
#
foreach $nSSPProviderID (keys %::s_Ship_hBasePlusPerProviderIDs)
{
my %hVariables;
$hVariables{$::VARPREFIX . 'BASE_PLUS_PER_RATE_DISCLAIMER'} = $$::g_pSSPSetupBlob{$nSSPProviderID}{'BASE_PLUS_PER_RATE_DISCLAIMER'};
my @Response = ACTINIC::TemplateString($sTemplate, \%hVariables); # make the substitutions
my ($Status, $Message, $sLine) = @Response;
if ($Status != $::SUCCESS)
{
#
# Display nothing in case of an error
#
$$sInsideText = '';
return ('');
}
$$sInsideText .= $sLine;
}
return ('');
}
}
#
# Nothing will be displayed at this phase
#
$$sInsideText = '';
return('');
}
############################################################
#
# DefaultTaxZoneMessageTagHandler - callback for DEFAULTTAXZONEMESSAGE tag
#
# Displays the default tax zone message in the appropriate form
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : replacement for the tag
#
# Author : Mike Purnell
#
############################################################
sub DefaultTaxZoneMessageTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
if( $sTag !~ /^\// )
{
return "";
}
if(ref($sInsideText))
{
if($ActinicOrder::s_nContext != $ActinicOrder::FROM_CART)
{
return('');
}
my ($sMessage, $sLocationDescription);
#
# Display message in smallest font
#
my $sFontOpen = ACTINIC::GetPhrase(-1, 1967);
my $sFontClose = ACTINIC::GetPhrase(-1, 1970);
#
# Customise the message depending upon delivery or invoice
#
if($::g_pTaxSetupBlob->{TAX_BY} != $ActinicOrder::eTaxAlways)
{
$sLocationDescription = ACTINIC::GetPhrase(-1, 2084);
if($::g_pTaxSetupBlob->{TAX_BY} == $ActinicOrder::eTaxByInvoice)
{
if(defined $::g_LocationInfo{INVOICE_COUNTRY_CODE} &&
$::g_LocationInfo{INVOICE_COUNTRY_CODE} ne '' &&
$::g_LocationInfo{INVOICE_COUNTRY_CODE} ne $ActinicOrder::UNDEFINED_REGION &&
$::g_LocationInfo{INVOICE_COUNTRY_CODE} ne $ActinicOrder::REGION_NOT_SUPPLIED)
{
if(defined $::g_LocationInfo{INVOICE_REGION_CODE} &&
$::g_LocationInfo{INVOICE_REGION_CODE} ne '' &&
$::g_LocationInfo{INVOICE_REGION_CODE} ne $ActinicOrder::UNDEFINED_REGION)
{
$sLocationDescription = ACTINIC::GetCountryName($::g_LocationInfo{INVOICE_REGION_CODE});
}
else
{
$sLocationDescription = ACTINIC::GetCountryName($::g_LocationInfo{INVOICE_COUNTRY_CODE});
}
}
}
else
{
if(defined $::g_LocationInfo{DELIVERY_COUNTRY_CODE} &&
$::g_LocationInfo{DELIVERY_COUNTRY_CODE} ne '' &&
$::g_LocationInfo{DELIVERY_COUNTRY_CODE} ne $ActinicOrder::UNDEFINED_REGION &&
$::g_LocationInfo{DELIVERY_COUNTRY_CODE} ne $ActinicOrder::REGION_NOT_SUPPLIED)
{
if(defined $::g_LocationInfo{DELIVERY_REGION_CODE} &&
$::g_LocationInfo{DELIVERY_REGION_CODE} ne '' &&
$::g_LocationInfo{DELIVERY_REGION_CODE} ne $ActinicOrder::UNDEFINED_REGION)
{
$sLocationDescription = ACTINIC::GetCountryName($::g_LocationInfo{DELIVERY_REGION_CODE});
}
else
{
$sLocationDescription = ACTINIC::GetCountryName($::g_LocationInfo{DELIVERY_COUNTRY_CODE});
}
}
}
#
# Customise the message depending upon the location info early flag
#
my $bRequestInfoEarly = $$::g_pSetupBlob{'TAX_AND_SHIP_EARLY'};
my $sMessage = $sFontOpen . sprintf(ACTINIC::GetPhrase(-1, 2083), $sLocationDescription);
$sMessage .= $sFontClose;
$$sInsideText = $sMessage;
}
else
{
$$sInsideText = '';
}
}
return('');
}
############################################################
#
# ShowForPriceScheduleTagHandler - process the price schedule tags
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : $sInsideText contains replacement for the tag
#
# Author : Tibor Vajda
#
# Copyright (c) Actinic Software Ltd (2002)
############################################################
sub ShowForPriceScheduleTagHandler
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
#
# There is nothing to do with the End tag
#
if ($sTag =~ /^\//) # If End tag
{
return ('');
}
#
# Find the schedule Id of the actual user
#
my $nScheduleID = $ActinicOrder::RETAILID; # current user's schedule id (retail by default)
my ($Status, $sMessage, $pBuyer, $pAccount); # helpers
my $sDigest = $ACTINIC::B2B->Get('UserDigest'); # get the user identifying digest
if ($sDigest) # if there is logged in user
{
my ($Status, $sMessage, $pBuyer) = ACTINIC::GetBuyer($sDigest, ACTINIC::GetPath()); # look up the buyer
if ($Status == $::SUCCESS) # we found the buyer info associated to this user
{
($Status, $sMessage, $pAccount) = ACTINIC::GetCustomerAccount($pBuyer->{AccountID}, ACTINIC::GetPath()); # find the account information
if ($Status == $::SUCCESS)
{
$nScheduleID = $pAccount->{PriceSchedule}
}
}
#
# Handling error
#
if ($Status != $::SUCCESS) # schedule ID couldn't be located for some reason
{
ACTINIC::ReportError($sMessage, ACTINIC::GetPath());
}
}
#
# Determine html text to be printed out
# - if the xml element contains attribute 'HTML', then use its content
# - otherwise use the node's text value (which is actually $sInsideText)
#
if ($ParameterHash->{'HTML'})
{
$$sInsideText = $ParameterHash->{'HTML'};
}
#
# Loop through the specified inclusive schedule ids.
# If one of them identical to the user's schedule is,
# - then pass the specified html code back in the $sInsideText reference
# - otherwise pass back empty string in $sInsideText
#
my @aIncludedScheduleIds = split(/,/, $ParameterHash->{'Schedules'}); # included schedule ids are stored in the Schedule attribute of the xml element
my $nIncludedScheduleId;
foreach $nIncludedScheduleId (@aIncludedScheduleIds)
{
if ($nIncludedScheduleId eq $nScheduleID)
{
#
# User's schedule id is defined,
# thus we don't clear $sInsideText (this will be inserted into the generated html)
return ''; # Always return ''
}
}
#
# If current user's price schedule is not defined,
# then clear $sInsideText -> nothing will be added to the generated html
#
$$sInsideText = '';
return (''); # Always return ''
}
#######################################################
#
# GetTemplateFragment - get a named fragment of the XML template
#
# Params: 0 - XML entity structure
# 1 - fragment name
#
# Returns: 0 - HTML
#
# Author: Zoltan Magyar, 9:04 PM 3/13/2002
#
#######################################################
sub GetTemplateFragment
{
my $pXML = shift;
my $sFragment = shift;
#
# Find the order line HTML
#
my $pNode = $pXML->FindNode("XMLTEMPLATE", "NAME", $sFragment);
if (!$pNode) # the error is critical here
{
ACTINIC::TerminalError(ACTINIC::GetPhrase(-1, 2201, $sFragment));
}
return ($pNode->GetOriginal());
}
#######################################################
#
# AddCookieCheck - Adding cookie checking code
#
# Input : $sTag - tag name
# $sInsideText - reference to text between start and end,
# $ParameterHash - hash of parameters,
# $sId - current tag prefix,
# $sFullTag - full text of current tag;
#
# Output : $sInsideText contains replacement for the tag
#
# Author : Tibor Vajda
#
# Copyright (c) Actinic Software Ltd (2002)
############################################################
sub AddCookieCheck
{
my $Self = shift;
my ($sTag, $sInsideText, $ParameterHash, $sId, $sFullTag) = @_;
my $sScript = ''; # stores the cookie checking javascript code if needed
if ($::bCookieCheckRequired) # cookie checking javascript should be added to the html
{
#
# Determine the url of the warning page generation script
#
my $sCgiUrl = ACTINIC::GetScriptUrl($::sShoppingScriptID); # shopping script is used to display warning
$sCgiUrl .= '?ACTION=COOKIEERROR'; # with this parameter
#
# Compose the cookie checking javascript
#
$sScript = '';
}
$$sInsideText = $sScript;
return ('');
}
1;