#!/usr/bin/perl
##
## core.cgi 3.3
$versions{'core.cgi'} = "3.3e" . $ENV{"coreWRAP"};
$versions{'perl'} = "$]";
$versions{'OSNAME'} = "$^O";
$versions{'server'} = $ENV{'SERVER_SOFTWARE'} if $ENV{'SERVER_SOFTWARE'};
##
## This version is heavely modified by Lennie Core
## http://www.coreave.com
#### THIS IS NOT FREE SOFTWARE. YOU ARE LICENSED TO USE THIS
## CART SYSTEM ONLY IF IT WAS INSTALLED AND UPDATED BY
## LENNIE CORE. IT MAY BE PURCHASED FOR INDIVIDUAL WEB
## SITE USE. Contact: operations@coreave.com for information.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
##
## There are several add-on modest-cost modules planned, see the
## http://www.coreave.com web site for more details. Licensing
## for these add-on modules will be different than for this program.
##
$| = 1;
$ENV{"PATH"} = "/bin:/usr/bin";
$test=`whoami`;
$versions{'whoami'} = $test if $test;
$versions{'id'} = `id`;
if ((-f "./wrap_agc.o") && (!($ARGV[0] =~ /nowrap/i))) { # use wrapper
$ENV{"coreWRAP"}="*";
print `./wrap_agc.o`;
&call_exit;
}
$time = time;
$main_program_running = "yes";
&require_supporting_libraries (__FILE__, __LINE__,
"./admin_core/core_user_lib.pl",
"./dll_lib/cgi-lib.pl");
# read and parse here, if just serving images no need to load
# up all the other libraries, makes it much faster
&read_and_parse_form_data;
&require_supporting_libraries (__FILE__, __LINE__,
"./dll_lib/core.setup.db");
&codehook("after_loading_setup_db");
&require_supporting_libraries (__FILE__, __LINE__,
"./admin_core/$sc_gateway_name-user_lib.pl",
"./dll_lib/core_order_lib.pl",
"$sc_html_setup_file_path",
"$sc_mail_lib_path",
"$sc_cookie_lib");
$sc_loading_primary_gateway = "yes";
&require_supporting_libraries(__FILE__,__LINE__,"$sc_process_order_lib_path");
$sc_loading_primary_gateway = "no";
&codehook("before_loading_custom_libs");
opendir (USER_LIBS, "./custom") || &codehook("cannot-open-custom-dir");
@mylibs = readdir(USER_LIBS);
closedir (USER_LIBS);
foreach $zlib (@mylibs) {
$lib = $zlib;
$lib =~ /([\w\-\=\+]+)(\.pl)/i;
$zfile = "$1$2";
$zlib =~ /([^\n|;]+)/;
$lib = $1;
if ((-f "./custom/$lib") && ($lib eq $zfile)) {
&require_supporting_libraries(__FILE__, __LINE__,"./custom/$lib");
}
}
&codehook("after_loading_custom_libs");
&get_cookie;
&alias_and_override;
&error_check_form_data;
$cart_id = $form_data{'cart_id'};
if ($cookie{'cart_id'} eq "" && $form_data{'cart_id'} eq "") {
&delete_old_carts;
&assign_a_unique_shopping_cart_id;
$cart_id_history .= "set new cart value "; #for debugging of course
&codehook("got_a_new_cart");
} else {
if ($form_data{'cart_id'} eq "") {
$cart_id = $cookie{'cart_id'};
$cart_id_history .= "from cookie "; #for debugging of course
&set_sc_cart_path;
} else {
$cart_id = $form_data{'cart_id'};
$cart_id_history .= "set from form data "; #for debugging of course
&set_sc_cart_path;
}
}
&codehook("pre_header_navigation");
print $sc_browser_header;
$sc_header_printed = 1;
#print "cart_id: $cart_id $cart_id_for_html $cart_id_history<br>\n";# debugging
$are_any_query_fields_filled_in = "no";
&codehook("open_for_business");
foreach $query_field (@sc_db_query_criteria)
{
@criteria = split(/\|/, $query_field);
if ($form_data{$criteria[0]} ne "")
{
$are_any_query_fields_filled_in = "yes";
}
}
if (($search_request ne "") && ($are_any_query_fields_filled_in eq "no")) {
$page = "searchpage.html"; #load up the advanced search form page
$search_request = ""; # not really a search, nothing filled in!
if (!(-f "$sc_html_product_directory_path/$page")){
#no such page, just show everything
$page = "";
$form_data{'product'} = "."; # show everything
$are_any_query_fields_filled_in = "yes";
} else {
$form_data{'page'} = $page; # set it back, in case somebody uses it
}
}
&codehook("special_navigation");
if ($form_data{'display_cart'} ne "")
{
&display_cart_contents;
&call_exit;
}
if (($form_data{'add_to_cart_button.x'} ne "") ||
($form_data{'add_to_cart_button'} ne ""))
{
&add_to_the_cart;
&call_exit;
}
elsif (($form_data{'modify_cart_button.x'} ne "") ||
($form_data{'modify_cart_button'} ne ""))
{
&display_cart_contents;
&call_exit;
}
elsif (($form_data{'change_quantity_button.x'} ne "") ||
($form_data{'change_quantity_button'} ne ""))
{
&output_modify_quantity_form;
&call_exit;
}
elsif (($form_data{'submit_change_quantity_button.x'} ne "") ||
($form_data{'submit_change_quantity_button'} ne ""))
{
&modify_quantity_of_items_in_cart;
&call_exit;
}
elsif (($form_data{'delete_item_button.x'} ne "") ||
($form_data{'delete_item_button'} ne ""))
{
&output_delete_item_form;
&call_exit;
}
elsif (($form_data{'submit_deletion_button.x'} ne "") ||
($form_data{'submit_deletion_button'} ne ""))
{
&delete_from_cart;
&call_exit;
}
elsif (($form_data{'order_form_button.x'} ne "") ||
($form_data{'order_form_button'} ne ""))
{
&require_supporting_libraries (__FILE__, __LINE__, "$sc_order_lib_path");
&display_order_form;
&call_exit;
}
elsif ($form_data{'mail_order_form_button'} ne "")
{
&require_supporting_libraries (__FILE__, __LINE__, "$sc_order_lib_path");
&process_Mail_Order;
&call_exit;
}
elsif (($form_data{'clear_order_form_button'} ne "") ||
($form_data{'clear_order_form_button.x'} ne ""))
{
&require_supporting_libraries (__FILE__, __LINE__, "$sc_order_lib_path");
&clear_verify_file;
&codehook("display_cleared_order_form");
&display_order_form;
&call_exit;
}
elsif (($form_data{'submit_order_form_button'} ne "") ||
($form_data{'submit_order_form_button.x'} ne ""))
{
&require_supporting_libraries (__FILE__, __LINE__, "$sc_order_lib_path");
if ($sc_test_repeat) {
&display_order_form;
} else {
&process_order_form;
}
&call_exit;
}
elsif (($page ne "" || $search_request ne ""
|| $form_data{'continue_shopping_button'}
|| $form_data{'continue_shopping_button.x'}
|| $are_any_query_fields_filled_in =~ /yes/i) &&
($form_data{'return_to_frontpage_button'} eq ""))
{
&display_products_for_sale;
&call_exit;
}
$sc_processing_order="yes"; # assume unless we fall through
&codehook("gateway_response");
#AuthorizeNet
if ($form_data{'x_response_code'})
{
$cart_id = $form_data{'x_cust_id'};
&set_sc_cart_path;
&codehook("AuthorizeNet_order");
&process_AuthorizeNet_Order;
&call_exit;
}
#iTransact
elsif ($form_data{'authcode'})
{
$cart_id = $form_data{'p4'};
&set_sc_cart_path;
&codehook("iTransact_order");
&process_iTransact_Order;
&call_exit;
}
# Linkpoint
elsif ($form_data{'approval_code'})
{
$cart_id = $form_data{'custnum'};
&set_sc_cart_path;
&codehook("Linkpoint_order");
&process_Linkpoint_Order;
&call_exit;
}
#Offline
elsif ($form_data{'process_order'})
{
$cart_id = $form_data{'cart_id'};
&set_sc_cart_path;
&codehook("Offline_order");
&processOrder;
&call_exit;
}
else
{
$sc_processing_order="no"; # fell through!
&output_frontpage;
&call_exit;
}
#######################################################################
# Require Supporting Libraries. #
#######################################################################
# require_supporting_libraries is used to read in some of
# the supporting files that this script will take
# advantage of.
#
# require_supporting_libraries takes a list of arguments
# beginning with the current filename, the current line
# number and continuing with the list of files which must
# be required using the following syntax:
#
# &require_supporting_libraries (__FILE__, __LINE__,
# "file1", "file2",
# "file3"...);
#
# Note: __FILE__ and __LINE__ are special Perl variables
# which contain the current filename and line number
# respectively. We'll continually use these two variables
# throughout the rest of this script in order to generate
# useful error messages.
sub require_supporting_libraries
{
# The libraries are required by us,so exit if loading error
local ($file, $line, @require_files) = @_;
local ($require_file);
&request_supporting_libraries("warn exit",$file, $line, @require_files);
}
sub request_supporting_libraries
{
# The incoming file and line arguments are split into
# the local variables $file and $line while the file list
# is assigned to the local list array @require_files.
#
# $require_file which will just be a temporary holder
# variable for our foreach processing is also defined as a
# local variable.
local ($what_to_do_on_error, $file, $line, @require_files) = @_;
local ($require_file);
# Next, the script checks to see if every file in the
# @require_files list array exists (-e) and is readable by
# it (-r). If so, the script goes ahead and requires it.
foreach $require_file (@require_files)
{
if (-e "$require_file" && -r "$require_file")
{ # file is there, now try to require it
$result = eval('require "$require_file"'); # require it in a not-fatal way
if ($@ ne "") {
if($what_to_do_on_error =~ /warn/i) {
if ($error_header_done ne "yes") {
$error_header_done = "yes";
print "Content-type: text/html\n\n";
}
print "<div><table width=500><tr><td>\n";
print "Error loading library $require_file:<br><br>\n $@\n";
print "<br><br>Please contact the site administrator to ",
"fix the error. \($ENV{'SERVER_ADMIN'}\)<br>\n";
print "</td></tr></table></div>\n";
}
if($what_to_do_on_error =~ /exit/i) {
&call_exit;
}
}
}
# If not, the scripts sends back an error message that
# will help the admin isolate the problem with the script.
else
{
if($what_to_do_on_error =~ /warn/i) {
if ($error_header_done ne "yes") {
$error_header_done = "yes";
print "Content-type: text/html\n\n";
}
print "I am sorry but I was unable to require $require_file at line
$line in $file. <br>\nWould you please make sure that you have the
path correct and that the permissions are set so that I have
read access? Thank you. \($ENV{'SERVER_ADMIN'}\)<br>\n";
}
if($what_to_do_on_error =~ /exit/i) {
&call_exit;
}
}
} # End of foreach $require_file (@require_files)
} # End of sub require_supporting_libraries
#######################################################################
# Read and Parse Form Data. #
#######################################################################
# read_and_parse_form_data is a short subroutine
# responsible for calling the ReadParse subroutine in
# cgi-lib.pl to parse the incoming form data. The script
# also tells cgi-lib to prepare that information in the
# associative array named %form_data which we will be able
# to use for the rest of this script.
#
# read_and_parse_form_data takes no arguments and is
# called with the following syntax:
#
# &read_and_parse_form_data;
sub read_and_parse_form_data
{
local ($junk);
&ReadParse(*form_data);
# DELUXE feature ... check here if we are just serving images
if ($form_data{'picserve'} ne "") {
&serve_picture($form_data{'picserve'},$sc_path_of_images_directory);
&call_exit;
}
if ($form_data{'secpicserve'} ne "") {
&serve_picture($form_data{'secpicserve'},"./protected/images/");
&call_exit;
}
}
#########################################################################
#
# Writen by Steve K to serve images 04-FEB-2000
# HTML usage examples:
# <IMG SRC="xxx.cgi?picserve=/images/store.jpg" BORDER=0>
# <IMG SRC="xxx.cgi?picserve=http://www.site.com/images/store.jpg" BORDER=0>
#
# Note: using the http:// format is less efficient
# converted to taint-mode sub 2/5/2000
sub serve_picture
{
local ($qstr,$sc_path_of_images_directory) = @_;
local ($test, $test2, $my_path_to_image);
$qstr =~ /([\w\-\=\+\/\.\:]+)/;
$qstr = "$1";
$my_path_to_image = $sc_path_of_images_directory . $qstr ;
$test = substr($my_path_to_image,0,6);
$test2 = substr($my_path_to_image,(length($my_path_to_image)-3),3);
if ($test2=~ /jpg/i || $test2 =~ /gif/i || $test2 =~ /png/i) {
# file is ok to display
if ($test2=~ /jpg/i) {# .jpg is jpeg file
$test2 = "jpeg";
}
if ($test=~ /http:\//i || $test =~ /https:/i) {
# need to GET the info .. no implemented here in core
# use LWP::Simple;
# print "Content-type: image/$test2\n\n";
# print get($my_path_to_image);
} else { # is a filename we can load up directly
print "Content-type: image/$test2\n\n";
if (!(-f $my_path_to_image)) {# try adding another slash!
$my_path_to_image = $sc_path_of_images_directory ."/" . $qstr ;
}
open (MYPIC,$my_path_to_image);
$size = 250000;
while ($size > 0) {
$size = read(MYPIC,$the_picture,$size);
print "$the_picture";
}
close(MYPIC);
}
}
}
#######################################################################
# Alias and Override
#
# This routine allows the use of aliases for switches, such as
# using xm= instead of exact_match=
#
# Also, override certain setup variables under certain conditions
#
#######################################################################
sub alias_and_override {
local ($junk,$raw_text)="";
local (@mylibs,$lib);
local ($testval,$testval2,$found_response);
&codehook("alias_and_override_top");
if (defined($form_data{'versions'})) {
print "Content-type: text/html\n\n";
print "<HTML>\n<TITLE>VERSIONS</TITLE>\n<BODY BGCOLOR=WHITE>\n";
print "<br><br>Info and Versions of loaded libraries:<br>\n";
print "<table border=1 cellpadding=2 cellspacing=2>\n";
foreach $junk (sort(keys(%versions)))
{
print "<tr><td>$junk </td><td>$versions{$junk}</td></tr>\n";
}
print "</table>\n";
$junk .= `grep -h "versions{'" ./custom/* |grep "}="`;
$junk .= `grep -h "versions{'" ./custom/* |grep "} ="`;
$junk .= `grep -h "versions{'" ./protected/* |grep "}="`;
$junk .= `grep -h "versions{'" ./protected/* |grep "} ="`;
$junk .= `grep -h "versions{'" ./protected/custom/* |grep "}="`;
$junk .= `grep -h "versions{'" ./protected/custom/* |grep "} ="`;
$junk .= `grep -h "versions{'" ./dll_lib/* |grep "}="`;
$junk .= `grep -h "versions{'" ./dll_lib/* |grep "} ="`;
$junk =~s/\n/ /g;
$junk =~ /([\w\-\=\+\/\;\{\}\'\ \.\"\$]+)/;
$junk = $1;
while ($junk ne "") {
$result = $lib;
($junk1,$key,$junk) = split(/\'/,$junk,3);
($junk1,$val,$junk) = split(/\"/,$junk,3);
if ($versions{$key} eq "") {
$versions{$key} = $val;
}
($junk1,$junk) = split(/versions/,$junk,2);
}
# if ($@ eq "") {
print "<br><br>info and Versions of loaded and unloaded libraries:<br>\n";
print "<table border=1 cellpadding=2 cellspacing=2>\n";
foreach $junk (sort(keys(%versions)))
{
print "<tr><td>$junk </td><td>$versions{$junk}</td></tr>\n";
}
print "</table>\n";
# }
print "</BODY>\n</HTML>\n";
&call_exit;
}
# Get rid of extraneous stuff, if present, on the cart id
# need to test for a repeated loading of critical pages ...
if (defined($form_data{'cart_id'})) {
($form_data{'cart_id'},$junk) = split(/\*/,$form_data{'cart_id'},2);
$sc_unique_cart_modifier = $junk;
}
# Check for proper URL in use, helps with cookies but not required
$found_response = "";
foreach $testval (keys %sc_order_response_vars) {
$testval2 = $sc_order_response_vars{$testval};
if ($form_data{$testval2} ne "") {
$found_response .= "*";
}
}
if (("$sc_domain_name_for_cookie" ne $ENV{'HTTP_HOST'}) &&
($sc_allow_location_redirect =~ /yes/i ) &&
($form_data{'process_order.x'} eq "" ) &&
($form_data{'process_order'} eq "" ) &&
($found_response eq "" ) &&
($form_data{'submit_order_form_button.x'} eq "" ) &&
($form_data{'submit_order_form_button'} eq "" ) &&
($form_data{'order_form_button.x'} eq "" ) &&
($form_data{'order_form_button'} eq "" )){ #redrect them to standard URL
if ($cookie{'cart_id'} ne "") {
$cart_id = $cookie{'cart_id'};
}
if ($form_data{'cart_id'} ne "") {
$cart_id = $form_data{'cart_id'};
}
$sc_cart_path = "$sc_user_carts_directory_path/${cart_id}_cart";
if (!(-f $sc_cart_path)){ #no cart, forget the number
$cart_id = "";
}
$href = "$sc_store_url";
if ($cart_id ne "") {
$href .= "?cart_id=$cart_id";
}
print "Location: $href\n\n";
&call_exit;
}
$search_request = ($form_data{'search_request_button'} ||
$form_data{'search_request_button.x'});
if (($form_data{'maxp'} > 0) && ($form_data{'maxp'} < 301)) {
$sc_db_max_rows_returned = $form_data{'maxp'};
}
if (defined($form_data{'srb'})) { #is an override/shortcut
$search_request = $form_data{'srb'};
}
if (defined($form_data{'xc'})) {
$form_data{'exact_case'} = $form_data{'xc'};
}
if (defined($form_data{'xm'})) {
$form_data{'exact_match'} = $form_data{'xm'};
}
if (defined($form_data{'dc'})) {
$form_data{'display_cart'} = $form_data{'dc'};
}
if (defined($form_data{'pid'})) {
$form_data{'p_id'} = $form_data{'pid'};
}
if (defined($form_data{'p'})) {
if ($form_data{'product'} ne "") {
$form_data{'product'} .= " " . $form_data{'p'};
} else {
$form_data{'product'} = $form_data{'p'};
}
}
if (defined($form_data{'ppovr'})) {
$form_data{'ppinc'} = $form_data{'ppovr'};
}
if (defined($form_data{'k'})) {
if ($form_data{'keywords'} ne "") {
$form_data{'keywords'} .= " " . $form_data{'k'};
} else {
$form_data{'keywords'} = $form_data{'k'};
}
}
if (defined($form_data{'kovr'})) {
$form_data{'keywords'} = $form_data{'kovr'};
}
if (($form_data{'add_to_cart_button'} eq "") &&
($form_data{'add_to_cart_button.x'} ne "")) {
$form_data{'add_to_cart_button'} = "1";
}
if ($form_data{'viewOrder'} eq "yes") {
$sc_should_i_display_cart_after_purchase = "yes";
} else {
$sc_should_i_display_cart_after_purchase = "no";
}
&codehook("alias_and_override_end");
}
#######################################################################
# Error Check Form Data. #
#######################################################################
# error_check_form_data is responsible for checking to
# make sure that only authorized pages are viewable using
# this application. It takes no arguments and is called
# with the following syntax:
#
# &error_check_form_data;
#
# The routine simply checks to make sure that if
# the page variable extension is not one that is defined
# in the setup file as an appropriate extension like .html
# or .htm, or there is no page being requestd (ie: the
# store front is being displayed) it will send a warning
# to the user, append the error log, and exit.
#
# @acceptable_file_extensions_to_display is an array of
# acceptable file extensions defined in the setup file.
# To be more or less restrictive, just modify this list.
#
# Specifically, for each extension defined in the setup
# file, if the value of the page variable coming in from
# the form ($page) is like the extension (/$file_extension/)
# or there is no value for page (eq ""), we will set
# $valid_extension equal to yes.
sub error_check_form_data
{
# These expressions will strip of any path information so
# files are only loaded from the appropriate directory.
# We will also only load pages of the proper extension,
# which is checked in sub error_check_form_data.
$page = $form_data{'page'};
$page =~ /([\w\-\=\+\/]+)\.(\w+)/;
$page = "$1.$2";
$page_extension = ".$2";
$page = "" if ($page eq ".");
$page =~ s/^\/+//; # Get rid of any residual / prefix
$form_data{'page'} = $page; # set it back, in case somebody uses it
foreach $file_extension (@acceptable_file_extensions_to_display)
{
if ($page_extension eq $file_extension || $page eq "")
{
$valid_extension = "yes";
}
}
# Next, the script checks to see if $valid_extension has
# been set to "yes".
#
# If the value for page satisfied any of the extensions
# in @acceptable_file_extensions_to_display, the script
# will set $valid_extension equal to yes. If the value
# is set to yes, the subroutine will go on with it's work.
# Otherwise it will exit with a warning and write to the
# eror log if appropriate
#
# Notice that we pass three parameters to the
# update_error_log subroutine which will be discussed
# later. The subroutine gets a warning, the
# name of the file, and the line number of the error.
#
# $sc_page_load_security_warning is a variable set in
# core.setup.db If you want to give a more or less
# informative error message, you are welcome to change the
# text there.
if ($valid_extension ne "yes") {
print "Content-type: text/html\n\n$sc_page_load_security_warning\n";
&update_error_log("PAGE LOAD WARNING", __FILE__, __LINE__);
&call_exit;
}
$form_data{'page'} = $page; # set it to the untainted & filtered one
#
# error check this, paranoia I know ... just in case regular expr. get
# broken somehow, this is our safety net
if ($form_data{'page'} =~ /\.\.\//) {
print "Content-type: text/html\n\nNo, you cannot go navigating";
print " outside the html directory for pages, that is a security ";
print " risk. Sorry!\n ";
&call_exit;
}
# now un-taint the value of $form_data{'cart_id'}
# also pattern match it, in case the form has 2+ cart_id fields
if ($form_data{'cart_id'} ne "") {
if ($form_data{'cart_id'} =~ /([\w\-\=\+\/]+)\.(\w+)/) {
$form_data{'cart_id'} = "$1.$2";
if ($form_data{'cart_id'} eq ".") {
$form_data{'cart_id'} = "";
}
} else {
$form_data{'cart_id'} = "";
}
}
if ($cookie{'cart_id'} ne "") {
if ($cookie{'cart_id'} =~ /([\w\-\=\+\/]+)\.(\w+)/) {
$cookie{'cart_id'} = "$1.$2";
if ($cookie{'cart_id'} eq ".") {
$cookie{'cart_id'} = "";
}
} else {
$cookie{'cart_id'} = "";
}
}
}
#######################################################################
sub parse_options_to_verify{
local($orig_str) = @_;
local($str) = $orig_str;
local($name) = "";
local($nextname,$stuff,$parta,$partb,$val,@items);
# first group options by their 'name = ' part
while ($str =~ /(name)([ \n\r]*)(=)([ \n\r]*)([\"\'])([^\"\']*)([\"\'])/i) {
$nextname = $6;
$str =~ s/(name)([ \n\r]*)(=)([ \n\r]*)([\"\'])([^\"\']*)([\"\'])/%##%/i;
($stuff,$str) = split(/%##%/,$str,2);
if ($name ne "") {
$items{$name} = $stuff;
}
$name = $nextname;
}
# get the last part, if name was found
if ($name ne "") {
$items{$name} = $str;
}
# for each named option, parse the value associated with it
foreach $name (keys %items) {
$str = $items{$name};
while ($str =~ /(value)([ \n\r]*)(=)([ \n\r]*)([\"\'])([^\"\']*)([\"\'])/i) {
$val = $6;
($parta,$partb) = split(/\|/,$val,2);
$item_opt_verify{$name . "|" . $parta} = $partb;
$str =~ s/(value)([ \n\r]*)(=)([ \n\r]*)([\"\'])([^\"\']*)([\"\'])//i;
}
}
return $orig_str;
}
#######################################################################
sub option_prep {
local ($field,$option_location,$product_id)= @_;
local ($very_first_part,$junk);
$field = &corescript($field,"optpre","$option_location",__FILE__,__LINE__);
$field =~ s/%%PRODUCT_ID%%/$product_id/g;
$field =~ s/%%PRODUCTID%%/$product_id/g;
$field = &corescript($field,"optpost","$option_location",__FILE__,__LINE__);
# DELUXE feature ... take only the part between <h3>--cut here--</h3>
# tokens
# if ($chop =~ /yes/i) {
($very_first_part,$field,$junk) =
split(/<h3>--cut here--<\/h3>/i,$field,3);
if ($field eq "") {
$field = $very_first_part;
}
if ($field eq "") {
$field = "(file $option_location not found)";
}
# }
return $field;
}
#######################################################################
# Delete Old Carts. #
#######################################################################
# delete_old_carts is a subroutine which is used to prune
# the carts directory, cleaning out all the old carts
# after some time interval defined in the setup file. It
# takes no argumnetes and is called with the following
# syntax:
#
# &delete_old_carts;
sub check_cart_expiry {
&check_cart_type_file_expiry("$sc_cart_path");
&check_cart_type_file_expiry("$sc_verify_order_path");
}
sub check_cart_type_file_expiry {
local($cart_type_file_path) = @_;
if (-M "$cart_type_file_path" > $sc_number_days_keep_old_carts)
{
if ($cart_type_file_path =~ /cart/i) {
&codehook("delete-cart");
} else {
&codehook("delete-non-cart");
}
unlink("$cart_type_file_path");
}
sub delete_old_carts
{
# The subroutine begins by grabbing a listing of all of
# the client created shoppping carts in the User_carts
# directory.
#
# It then opens the directory and reads the contents using
# grep to grab every file with the extension _cart. Then
# it closes the directory.
#
# If the script has any trouble opening the directory,
# it will output an error message using the
# file_open_error subroutine discussed later. To the
# subroutine, it will pass the name of the file which had
# trouble, as well as the current routine in the script
# having trouble , the filename and the current line
# number.
opendir (USER_CARTS, "$sc_user_carts_directory_path") || &file_open_error("$sc_user_carts_directory_path", "Delete Old Carts", __FILE__, __LINE__);
@carts = grep(/\.[0-9]/,readdir(USER_CARTS)); # must have . followed by digits
closedir (USER_CARTS);
# Now, for every cart in the directory, delete the cart if
# it is older than half a day. The -M file test returns
# the number of days since the file was last modified.
# Since the result is in terms of days, if the value is
# greater than the value of $sc_number_days_keep_old_carts
# set in core.setup.db, we'll delete the file.
foreach $cart (@carts)
{
# code below deletes carts and other files in this directory that have expired
$sc_cart_path = "$sc_user_carts_directory_path/$cart";
$sc_cart_path =~ /([\w\-\=\+\/\.]+)/;
$sc_cart_path = "$1";
$sc_cart_path = "" if ($sc_cart_path eq ".");
$sc_cart_path =~ s/^\/+//; # Get rid of any residual / prefix
&check_cart_expiry;
}
}# end of foreach
}# End of sub delete_old_carts
#######################################################################
# Assign a Shopping Cart. #
#######################################################################
# assign_a_unique_shopping_cart_id is a subroutine used to
# assign a unique cart id to every new clinet. It takes
# no argumnets and is called with the following syntax:
#
# &assign_a_unique_shopping_cart_id;
sub assign_a_unique_shopping_cart_id
{
# First we will check to see if the admin has asked us to
# log all new clients. If so, we will get the current
# date using the get_date subroutine discussed later, open the
# access log file for appending, and print to the access
# log file all of the environment variable values as well
# as the current date and time.
#
# However, we will protect ourselves from multiple,
# simultaneous writes to the access log by using the
# lockfile routine documented at the end of this file,
# passing it the name of a temporary lock file to use.
#
# Remember that there may be multimple simultaneous
# executions of this script because there may be many
# people shopping all at once. It would not do if one
# customer was able to overwrite the information of
# another customer if they accidentally wanted to acccess
# the log file at the same exact time.
if ($sc_shall_i_log_accesses eq "yes")
{
$date = &get_date;
&get_file_lock("$sc_access_log_path.lockfile");
open (ACCESS_LOG, ">>$sc_access_log_path");
# Using the keys function, the script grabs all the
# keys of the %ENV associative array and assigns them as
# elements of @env_keys. It then creates a new row for
# the access log which will be a pipe delimited list of
# the date as well as all the environment variables and
# their values.
$remote_addr = $ENV{'REMOTE_ADDR'};
$request_uri = $ENV{'REQUEST_URI'};
$http_user_agent = $ENV{'HTTP_USER_AGENT'};
if ($ENV{'HTTP_REFERER'} ne "")
{
$http_referer = $ENV{'HTTP_REFERER'};
}
else
{
$http_referer = "possible bookmarks";
}
$remote_host = $ENV{'REMOTE_HOST'};
#$shortdate = `date +"%T"`;
$shortdate = date;
chop ($shortdate);
$unixdate = time;
$new_access = "$form_data{'url'}\|$shortdate\|$request_uri\|$cookie{'visit'}\|$remote_addr\|$http_user_agent\|$http_referer\|$unixdate\|";
# The script then takes off the final pipe, adds the new
# access to the log file, closes the log file and removes
# the lock file.
chop $new_access;
print ACCESS_LOG "$new_access\n";
close (ACCESS_LOG);
&release_file_lock("$sc_access_log_path.lockfile");
}
# Now that the new access is recorded, the script assigns
# the user their own unique shopping cart. To do so,
# it generates a random (rand) 8 digit (100000000)
# integer (int) and then appends to that string the current
# process id ($$). However, the srand function is seeded
# with the time and the current process id in order to
# produce a more random random number. $sc_cart_path is
# also defined now that we have a unique cart id number.
srand (time|$$);
$cart_id = int(rand(10000000));
$cart_id .= ".$$";
$cart_id =~ s/-//g;
$sc_cart_path = "$sc_user_carts_directory_path/${cart_id}_cart";
# However, before we can be absolutely sure that we have
# created a unique cart, the script must check the existing
# list of carts to make sure that there is not one with
# the same value.
#
# It does this by checking to see if a cart with the
# randomly generated ID number already exists in the Carts
# directory. If one does exit (-e), the script grabs
# another random number using the same routine as
# above and checks again.
#
# Using the $cart_count variable, the script executes this
# algorithm three times. If it does not succeede in finding
# a unique cart id number, the script assumes that there is
# something seriously wrong with the randomizing routine
# and exits, warning the user on the web and the admin
# using the update_error_log subroutine discussed later.
$cart_count = 0;
while (-e "$sc_cart_path")
{
if ($cart_count == 3)
{
print "$sc_randomizer_error_message";
&update_error_log("COULD NOT CREATE UNIQUE CART ID", __FILE__, __LINE__);
&call_exit;
}
$cart_id = int(rand(10000000));
$cart_id .= "_$$";
$cart_id =~ s/-//g;
$sc_cart_path = "$sc_user_carts_directory_path/${cart_id}_cart";
$cart_count++;
} # End of while (-e $sc_cart_path)
# Now that we have generated a truly unique id
# number for the new client's cart, the script may go
# ahead and create it in the User_carts sub-directory.
#
# If there is a problem opening the new cart, we'll output
# an error message with the file_open_error subroutine
# discussed later.
&set_sc_cart_path; # there are other paths that must be set as well
&codehook("assign-cart_id");
&SetCookies;
}
#######################################################################
# Output Frontpage. #
#######################################################################
# output_frontpage is used to display the frontpage of the
# store. It takes no argumnets and is accessed with the
# following syntax:
#
# &output_frontpage;
#
# The subroutine simply utilizes the display_page
# subroutine which is discussed later to output the
# frontpage file, the location of which, is defined
# in core.setup.db. display_page takes four arguments:
# the cart path, the routine calling it, the current
# filename and the current line number.
sub output_frontpage {
&codehook("output_frontpage");
&display_page("$sc_store_front_path", "Output Frontpage", __FILE__,__LINE__);
}
#######################################################################
# Add to Shopping Cart #
#######################################################################
# The add_to_the_cart subroutine is used to add items to
# the customer's unique cart. It is called with no
# arguments with the following syntax:
#
# &add_to_the_cart;
sub add_to_the_cart
{
local (@database_rows, @database_fields, @item_ids, @display_fields);
local ($junk,$zzzitem,$temp)="";
local (%item_opt_verify);
&checkReferrer;
if (!($sc_db_lib_was_loaded =~ /yes/i)) {
&require_supporting_libraries (__FILE__, __LINE__, "$sc_db_lib_path");
}
# the script first opens the user's shopping cart with read/write access,
# creating it if for some reason it is not already there. If there is a
# problem opening the file, it will call file_open_error subroutine
# to handle the error reporting.
open (CART, "+>>$sc_cart_path") || &file_open_error("$sc_cart_path", "Add to Shopping Cart", __FILE__, __LINE__);
# The script then retrieves the highest item number of the items already
# in the cart (if any). The item number is an arbitrary number used to
# uniquely identify each item, as described below.
# init highest item number (start at 100)
$highest_item_number = 100;
# make sure we're positioned at top of file
seek (CART, 0, 0);
# loop on cart contents, if any
while (<CART>)
{
# get rid of terminating newline
chomp $_;
# split cart row into fields
my @row = split (/\|/, $_);
# get item number of row (last field)
my $item_number_info = pop (@row);
($item_number,$item_modifier) = split(/\*/,$item_number_info,2);
$highest_item_number = $item_number if ($item_number > $highest_item_number);
}
# $highest_item_number is now either the highest item number,
# or 0 if the cart was empty. Position the file pointer to the
# end of the cart, in preparation for appending the new items later.
# position to end of file
seek (CART, 0, 2);
# The script must first figure out what the client has
# ordered.
#
# It begins by using the %form_data associative array
# given to it by cgi-lib.pl. It takes all of the keys
# of the form_data associative array and drops them into
# the @items_ordered array.
#
# Note: An associative array key is like a variable name
# whereas an associative array value is the
# value associated with that variable name. The
# benefit of an associative array is that you can have
# many of these key/value pairs in one array.
# Conveniently enough, you'll notice that input fields on
# HTML forms will have associated NAMES and VALUES
# corresponding to associative array KEYS and VALUES.
#
# Since each of the text boxes in which the client could
# enter quantities were associated with the database id
# number of the item that they accompany, (as defined
# in the display_page routine at the end of this
# script), the HTML should read
#
# <INPUT TYPE = "text" NAME = "1234">
#
# for the item with database id number 1234 and
#
# <INPUT TYPE = "text" NAME = "5678">
#
# for item 5678.
#
# If the client orders 2 of 1234 and 9 of 5678, then
# @incoming_data will be a list of 1234 and 5678 such that
# 1234 is associated with 2 in %form_data associative
# array and 5678 is associated with 9. The script uses
# the keys function to pull out just the keys. Thus,
# @items_ordered would be a list like (1234, 5678, ...).
@items_ordered = keys (%form_data);
# Next it begins going through the list of items ordered
# one by one.
foreach $item (@items_ordered)
{
# However, there are some incoming items that don't need
# to be processed. Specifically, we do not care about cart_id,
# page, keywords, add_to_cart, or whatever incoming
# administrative variables exist because these are all
# values set internally by this script. They will be
# coming in as form data just like the client-defined
# data, and we will need them for other things, just not
# to fill up the user's cart. In order to bypass all of
# these administrartive variables, we use a standard
# method for denoting incoming items. All incoming items
# are prefixed with the tag "item-". When the script sees
# this tag, it knows that it is seeing an item to be added
# to the cart.
#
# Similarly, items which are actually options info are
# denoted with the "option" keyword. We will also accept
# those for further processing.
#
# And of course, we will not need to worry about any items
# which have empty values. If the shopper did not enter a
# quantity, then we won't add it to the cart.
if (($item =~ /^item-/i || $item =~ /^option/i) && $form_data{$item} ne "")
{
# Once the script has determined that the current element
# ($item) of @items_ordered is indeeed a non-admin item,
# it must separate out the items that have been ordered
# from the options which modify those items. If $item
# begins with the keyword "option", which we set
# specifically in the HTML file, the script will add
# (push) that item to the array called @options. However,
# before we make the check, we must strip the "item-"
# keyword off the item so that we have the actual row
# number for comparison.
$item =~ s/^item-//i;
if ($item =~ /^option/i)
{
#Manual price entry
if ($item =~ /^option\|price/i){
$form_data{$item} =~ s/\$//ig;
$form_data{$item} = &format_price("$form_data{$item}");
$form_data{$item} = "Price|"."$form_data{$item}";
}
# end manual price hack
push (@options, $item);
}
# On the other hand, if it is not an option, the script adds
# it to the array @items_ordered_with_options, but adds
# both the item and its value as a single array element.
#
# The value will be a quantity and the item will be
# something like "item-0001|12.98|The letter A" as defined in
# the HTML file. Once we extract the initial "item-"
# tag from the string using regular expressions ($item =~
# s/^item-//i;), the resulting string would be something
# like the following:
#
# 2|0001|12.98|The letter A
#
# where 2 is the quantity.
#
# Firstly, it must be a digit ($form_data{$item} =~ /\D/).
# That is, we do not want the clients trying to enter
# values like "a", "-2", ".5" or "1/2". They might be
# able to play havok on the ordering system and a sneaky
# client may even gain a discount because you were not
# reading the order forms carefully.
#
# Secondly, the script will dissallow any zeros
# ($form_data{$item} == 0). In both cases the client will
# be sent to the subroutine bad_order_note located in
# core_html_lib.pl.
else
{
if (($form_data{"item-$item"} =~ /\D/) || ($form_data{"item-$item"} == 0))
{
&bad_order_note;
}
else
{
$quantity = $form_data{"item-$item"};
push (@items_ordered_with_options, "$quantity\|$item\|");
}
}
# End of if ($item ne "$variable" && $form_data{$item} ne "")
}
#End of foreach $item (@items_ordered)
}
# Now the script goes through the array
# @items_ordered_with_options one item at a time in order
# to modify any item which has had options applied to it.
# Recall that we just built the @options array with all
# the options for all the items ordered. Now the script
# will need to figure out which options in @options belong
# to which items in @items_ordered_with_options.
foreach $item_ordered_with_options (@items_ordered_with_options)
{
&codehook("foreach_item_ordered_top");
# First, clear out a few variables that we are going to
# use for each item.
#
# $options will be used to keep track of all of the
# options selected for any given item.
#
# $option_subtotal will be used to determine the total
# cost of each option.
#
# $option_grand_total will be used to calculate the
# total cost of all ordered options.
#
# $item_grand_total will be used to calculate the total
# cost of the item ordered factoring in quantity and
# options.
$options = "";
$option_subtotal = "";
$option_grand_total = "";
$item_grand_total = "";
# Now split out the $item_ordered_with_options into it's
# fields. Note that we have defined the index location of
# some important fields in core.setup.db Specifically,
# the script must know the index of quantity, item_id and
# item_price within the array. It will need these values
# in particular for further calculations. Also, the
# script will change all occurances of "~qq~" to a double
# quote (") character, "~gt~" to a greater than sign (>)
# and "~lt~" to a less than sign (<). The reason that
# this must be done is so that any double quote, greater
# than, or less than characters used in URLK strings can
# be stuffed safely into the cart and passed as part of
# the NAME argumnet in the "add item" form. Consider the
# following item name which must include an image tag.
#
# <INPUT TYPE = "text"
# NAME = "item-0010|Vowels|15.98|The letter A|~lt~IMG SRC = ~qq~Html/Images/a.jpg~qq~ ALIGN = ~qq~left~qq~~gt~"
#
# Notice that the URL must be edited. If it were not, how
# would the browser understand how to interpret the form
# tag? The form tag uses the double quote, greater
# than, and less than characters in its own processing.
$item_ordered_with_options =~ s/~qq~/\"/g;
$item_ordered_with_options =~ s/~gt~/\>/g;
$item_ordered_with_options =~ s/~lt~/\</g;
@cart_row = split (/\|/, $item_ordered_with_options);
&codehook("foreach_item_ordered_split_cart_row");
$item_quantity = $cart_row[$sc_cart_index_of_quantity];
$item_id_number = $cart_row[$sc_cart_index_of_item_id];
$item_price = $cart_row[$sc_cart_index_of_price];
$item_shipping = $cart_row[$cart{"shipping"}];
$item_option_numbers = "";
$item_user1 = "$cart_row[7]";
$item_user2 = "";
$item_user3 = "";
$item_corescript = "";
undef(%item_opt_verify);
# need to lookup options add-to-cart type corescript, if present in
# option file(s)
$found = &check_db_with_product_id($item_id_number,*database_fields);
&create_display_fields(@database_fields);
&codehook("cart_add_read_db_item");
foreach $zzzitem (@database_fields) {
$field = $zzzitem;
if ($field =~ /^%%OPTION%%/i) {
($empty, $option_tag, $option_location) = split (/%%/, $field);
$field = "";
open (OPTION_FILE, "<$sc_options_directory_path/$option_location") ||
&file_open_error ("$sc_options_directory_path/$option_location",
"Add To Cart", __FILE__,__LINE__);
read (OPTION_FILE,$field,99999); # read it in all at once
close (OPTION_FILE);
# do %%token%% substitution and exec runtime corescript
# so that option value verification is possible
$junk = &option_prep($field,$option_location,$item_id_number);
$junk = &prep_displayProductPage($junk);
# save entire thing for later potential execution of corescript
$item_corescript .= $field;
# End of if ($field =~ /^%%OPTION%%/)
}
}
&codehook("cart_add_read_item_corescript");
# Then for every option in @options, the script splits up
# each option into it's fields.
#
# Once it does both splits, the script can compare the name
# of the item with the name associated with the option.
# If they are the same, it knows that this is an option
# which was meant to enhance this item.
foreach $option (@options)
{
($option_marker, $option_number, $option_item_number) = split (/\|/, $option);
# If the script finds a match, it records the option
# information contained in the $option variable.
if ($option_item_number eq "$item_id_number")
{
# Since it must apply this option to this item, the script
# splits out the value associated with the option and
# appends it to $options. Once it has gone through all of
# the options, using .=, the script will have one big string
# containing all the options so that it can print them
# out. Note that in the form on which the client chooses
# options, each option is denoted with the form
#
# NAME = "a|b|c" VALUE = "d|e"
#
# where
#
# a is the option marker "option"
# b is the option number (you might have multiple options
# which all modify the same item. Option number
# identifies each option uniquely)
# c is the option item number (the unique item id number
# which the option modifies)
# d is the option name (the descriptive name of the
# option)
# e is the option price.
#
# For example, consider this option from the default
# Vowels.html file which modifies item number 0001:
#
# <INPUT TYPE = "radio" NAME = "option|2|0001"
# VALUE = "Red|0.00" CHECKED>Red<BR>
#
# This is the second option modifying item number 0001.
# When displayed in the display cart screen, it will read
# "Red 0.00, and will not affect the cost of the item.
# need to process specific add-to-cart-opt type corescript, if present in
# option file(s)
$field = &corescript($item_corescript,"add-to-cart-opt-" . $option_number,
"$option_location",__FILE__,__LINE__);
($option_name,$option_price,$option_shipping)=split(/\|/,$form_data{$option});
if($option_name) {
if ($sc_use_verified_opt_values =~ /yes/i) {
$temp = $item_opt_verify{$option . '|' . $option_name};
($option_price,$option_shipping) = split(/\|/,$temp,2);
if ($temp ne "") {
$temp = $option_name . '|' . $temp;
} else {
$option_name=""; # erase it, unverifiable
}
} else {
$temp = $form_data{$option};
}
if($option_name) {# still here, either verified or not doing verification
# Keep track of the numbers chosen and their value (3.3c)
$temp =~ s/\|/~/g; # cannot have pipes, change to ~ char
if ($item_option_numbers eq ""){
$item_option_numbers = "${option_number}*$temp";
} else {
$item_option_numbers .= ",${option_number}*$temp";
}
if ((0 + $option_price) == 0) { #price zero, do not display it
$display_option_price = "";
} else { # price non-zero, must format it
$display_option_price = " " . &display_price_nospaces($option_price);
}
#Below displays options in html with comma after each by Lennie
#does not affect email layout.
# This line displays option and price during check out
#$options .= "$option_name$display_option_price, ";
# The below line only displays option name with no dollar amount.
$options .= "$option_name$display_option_price, ";
}
}
# But the script must also calculate the cost changes with
# options. To do so, it will take the current value of
# $option_grand_total and add to it the value of the
# current option. It will then format the result to
# two decimal places using the format_price subroutine
# discussed later and assign the new result to
# $option_grand_total
&codehook("process_cart_options");
$item_shipping = $item_shipping + $option_shipping;
$unformatted_option_grand_total = $option_grand_total + $option_price;
$option_grand_total = &format_price($unformatted_option_grand_total);
# End of if ($option_item_number eq "$item_id_number")
}
# End of foreach $option (@options)
}
# Next, calculate $item_number which the script can use to
# identify a shopping cart item absolutely. This must be done
# so that when we modify and delete from the cart, we will
# know exactly which item to affect. We cannot rely simply
# on the unique database id number because a client may
# purchase two of the same item but with different
# options. Unless there is a separate, unique cart row id
# number, how would the script know which to delete if the
# client asked to delete one of the two. Add 1 to
# $highest_item_number, which was set at the beginning of
# the subroutine.
$item_number = ++$highest_item_number;
# Finally, the script makes the last price calculations
# and appends every ordered item to $cart_row
#
# A completed cart row might look like the following:
# 2|0001|Vowels|15.98|Letter A|Times New Roman 0.00|15.98|161
$unformatted_item_grand_total = $item_price + $option_grand_total;
$item_grand_total = &format_price("$unformatted_item_grand_total");
# now, make the cart value for shipping be the shipping with options
$cart_row[$cart{"shipping"}] = $item_shipping;
$cart_row[$cart{"shipping_calc_flag"}] = "";
# Add the id #s of the options too
$cart_row[$cart{"options_ids"}] = $item_option_numbers;
# need to process generic add-to-cart type corescript, if present in
# option file(s)
$field = &corescript($item_corescript,"add-to-cart",
"$option_location",__FILE__,__LINE__);
&codehook("before_build_cart_row");
$cart_row[$cart{"user1"}] = $item_user1;
$cart_row[$cart{"user2"}] = $item_user2;
$cart_row[$cart{"user3"}] = $item_user3;
foreach $field (@cart_row) {
$cart_row .= "$field\|";
}
$cart_row .= "$options\|$item_grand_total\|$item_number\n";
# End of foreach $item_ordered_with_options.....
&codehook("foreach_item_ordered_end");
}
# When it is done appending all the items to $cart_row,
# the script appends the new items to the end of the
# shopping cart, which was opened at the beginning of the subroutine.
&codehook("before_add_cart_rows");
if (-e "$sc_cart_path")
{
open (CART, ">>$sc_cart_path") || &file_open_error("$sc_cart_path", "Add to Shopping Cart", __FILE__, __LINE__);
&codehook("add_cart_row_to_cart");
print CART "$cart_row";
close (CART);
}
else
{
open (CART, ">$sc_cart_path") || &file_open_error("$sc_cart_path", "Add to Shopping Cart", __FILE__, __LINE__);
&codehook("add_cart_row_to_cart");
print CART "$cart_row";
close (CART);
}
&codehook("after_add_cart_rows");
# Then, the script sends the client back to a previous
# page. There are two pages that the customer can be sent
# of course, the last product page they were on or the
# page which displays the customer's cart. Which page the
# customer is sent depends on the value of
# $sc_should_i_display_cart_after_purchase which is defined
# in core.setup.db If the customer should be sent to
# the display cart page, the script calls
# display_cart_contents, otherwise it calls display_page
# if this is an HTML-based cart or
# create_html_page_from_db if this is a database-based
# cart.
&finish_add_to_the_cart;
}
############################################################
sub finish_add_to_the_cart {
&codehook("finish_add_to_the_cart");
if ($sc_use_html_product_pages eq "yes")
{
if ($sc_should_i_display_cart_after_purchase eq "yes")
{
&display_cart_contents;
}
else
{
&display_page("$sc_html_product_directory_path/$page", "Display Products for Sale");
}
}
else
{
if ($sc_should_i_display_cart_after_purchase eq "yes")
{
&display_cart_contents;
}
elsif ($are_any_query_fields_filled_in =~ /yes/i)
{
$page = "";
&display_products_for_sale;
}
else
{
&create_html_page_from_db;
}
}
}
#######################################################################
# Output Modify Quantity Form #
#######################################################################
# output_modify_quantity_form is the subroutine
# responsible for displaying the form which customers can
# use to modify the quantity of items in their cart. It
# is called with no argumnets with the following syntax:
#
# &output_modify_quantity_form;
sub output_modify_quantity_form
{
# The subroutine begins by outputting the HTML header
# using standard_page_header, adds the modify form using
# display_cart_table and finishes off the HTML page with
# modify_form_footer. All of these subrotuines are
# discussed in core_html_lib.pl
&standard_page_header("Change Quantity");
&display_cart_table("changequantity");
&modify_form_footer;
}
#######################################################################
# Modify Quantity of Items in the Cart #
#######################################################################
# The modify_quantity_of_items_in_cart subroutine is
# responsible for making quantity modifications in the
# customer's cart. It takes no arguments and as called
# with the following syntax:
#
# &modify_quantity_of_items_in_cart;
sub modify_quantity_of_items_in_cart
{
&checkReferrer;
# First, the script gathers the keys as it did for the
# add_to_cart routine previously, checking to make
# sure the customer entered a positive integer (not
# fractional and not less than one).
@incoming_data = keys (%form_data);
foreach $key (@incoming_data)
{
if (($key =~ /[\d]/) && ($form_data{$key} =~ /\D/) &&
(!($form_data{$key} < 0)) && (!($form_data{$key} > 0)))
{
$form_data{$key}="";
}
# Just as the script did in the add to cart routine
# previuosly, it will create an array (@modify_items) of
# valid keys.
unless ($key =~ /[\D]/ && $form_data{$key} =~ /[\D]/)
{
if ($form_data{$key} ne "")
{
push (@modify_items, $key);
}
}
# End of foreach $key (@incoming_data)
}
# Then, the script must open up the client's cart and go
# through it line by line. File open problems are
# handled by file_open_error as usual.
open (CART, "<$sc_cart_path") || &file_open_error("$sc_cart_path", "Modify Quantity of Items in the Cart", __FILE__, __LINE__);
# As the script goes through the cart, it will split each
# row into its database fields placing them as elements in
# @database_row. It will then grab the unique cart row
# number and subsequently replace it in the array.
#
# The script needs this number to check the current line
# against the list of items to be modified. Recall that
# this list will be made up of all the cart items which
# are being modified.
#
# The script also grabs the current quantity of that row.
# Since it is not yet sure if it wants the current
# quantity, it will hold off on adding it back to the
# array. Finally, the script chops the newline character
# off the cart row number.
while (<CART>)
{
@database_row = split (/\|/, $_);
$cart_row_number = pop (@database_row);
push (@database_row, $cart_row_number);
$old_quantity = shift (@database_row);
chop $cart_row_number;
# Next, the script checks to see if the item number
# submitted as form data is equal to the number of the
# current database row.
foreach $item (@modify_items)
{
if ($item eq $cart_row_number)
{
# If so, it means that the script must change the quantity
# of this item. It will append this row to the
# $shopper_row variable and begin creating the modified
# row. That is, it will replace the old quantity with the
# quantity submitted by the client ($form_data{$item}).
# Recall that $old_quantity has already been shifted off
# the array.
# if negative value entered, "subtract" from old value
# same if, for example, +6 is entered, add 6 to the current value
if ($form_data{$item} =~ /\-/) {
$form_data{$item} =~ s/\-//g;
$form_data{$item} = 0 - $form_data{$item};
}
if (($form_data{$item} < 0) || ($form_data{$item} =~ /\+/)) {
&codehook("item_quantity_to_be_modified");
$form_data{$item} =~ s/\+//g;
$form_data{$item} = $old_quantity + $form_data{$item};
}
# if invalid qty entered, removes item
$form_data{$item} = 0 + $form_data{$item};
# if negative or zero, then delete the item from the cart
if ($form_data{$item} le 0) {
$shopper_row .= "\|"; #this forces a deletion from CART
} else {
$shopper_row .= "$form_data{$item}\|";
# Now the script adds the rest of the database row to
# $shopper_row and sets two flag variables.
#
# $quantity_modified lets us know that the current row
# has had a quantity modification for each iteration of
# the while loop.
foreach $field (@database_row)
{
$shopper_row .= "$field\|";
}
}
$quantity_modified = "yes";
&codehook("item_quantity_modified");
chop $shopper_row; # Get rid of last pipe symbol but not the
# newline character
# End of if ($item eq $cart_row_number)
}
# End of foreach $item (@modify_items)
}
# If the script gets this far and $quantity_modified has
# not been set to "yes", it knows that the above routine
# was skipped because the item number submitted from the
# form was not equal to the curent database id number.
#
# Thus, it knows that the current row is not having its
# quantity changed and can be added to $shopper_row as is.
# Remember, we want to add the old rows as well as the new
# modified ones.
if ($quantity_modified ne "yes")
{
$shopper_row .= $_;
}
# Now the script clears out the quantity_modified variable
# so that next time around it will have a fresh test.
$quantity_modified = "";
# End of while (<CART>)
}
close (CART);
# At this point, the script has gone all the way through
# the cart. It has added all of the items without
# quantity modifications as they were, and has added all
# the items with quantity modifications but made the
# modifications.
#
# The entire cart is contained in the $shopper_row
# variable.
#
# The actual cart still has the old values, however. So
# to change the cart completely the script must overwrite
# the old cart with the new information and send the
# client back to the view cart screen with the
# display_cart_contents subroutine which will be discussed
# later. Notice the use of the write operator (>) instead
# of the append operator (>>).
open (CART, ">$sc_cart_path") || &file_open_error("$sc_cart_path", "Modify Quantity of Items in the Cart", __FILE__, __LINE__);
print CART "$shopper_row";
close (CART);
&codehook("modify_quantity_of_items_in_cart_bot");
&finish_modify_quantity_of_items_in_cart;
# End of if ($form_data{'submit_change_quantity'} ne "")
}
#######################################################################
sub finish_modify_quantity_of_items_in_cart {
&codehook("finish_modify_quantity_of_items_in_cart");
&display_cart_contents;
}
#######################################################################
# Output Delete Item Form #
#######################################################################
# The output_delete_item_form subroutine is responsible
# for displaying the HTML form which the customer can use
# to delete items from their cart. It takes no arguments
# and is called with the following syntax:
#
# &output_delete_item_form;
sub output_delete_item_form
{
# As it did when it printed the modification form, the
# script uses several subroutines in core_html_lib.pl
# to generate the header, body and footer of the delete
# form.
&standard_page_header("Delete Item");
&display_cart_table("delete");
&delete_form_footer;
# End of if ($form_data{'delete_item'} ne "")
}
#######################################################################
# Delete Item From Cart #
#######################################################################
# The job of delete_from_cart is to take a set of items
# submitted by the user for deletion and actually delete
# them from the customer's cart. The subroutine takes no
# arguments and is called with the following syntax:
#
# &delete_from_cart;
sub delete_from_cart
{
&checkReferrer;
# As with the modification routines, the script first
# checks for valid entries. This time though it only needs
# to make sure that it filters out the extra form
# keys rather than make sure that it has a positive
# integer value as well because unlike with a text entry,
# clients have less ability to enter bad values with
# checkbox submit fields.
@incoming_data = keys (%form_data);
foreach $key (@incoming_data)
{
# We still want to make sure that the key is a cart row
# number though and that it has a value associated with
# it. If it is actually an item which the user has asked to
# delete, the script will add it to the delete_items
# array.
unless ($key =~ /[\D]/)
{
if ($form_data{$key} ne "")
{
push (@delete_items, $key);
}
# End of unless ($key =~ /[\D]/...
}
# End of foreach $key (@incoming_data)
}
# Once the script has gone through all the incomming form
# data and collected the list of all items to be deleted,
# it opens up the cart and gets the $cart_row_number,
# $db_id_number, and $old_quantity as it did in the
# modification routines previously.
open (CART, "<$sc_cart_path") || &file_open_error("$sc_cart_path", "Delete Item From Cart", __FILE__, __LINE__);
while (<CART>)
{
@database_row = split (/\|/, $_);
$cart_row_number = pop (@database_row);
$db_id_number = pop (@database_row);
push (@database_row, $db_id_number);
push (@database_row, $cart_row_number);
chop $cart_row_number;
$old_quantity = shift (@database_row);
# Unlike modification however, for deletion all we need to
# do is check to see if the current database row matches
# any submitted item for deletion. If it does not match
# the script adds it to $shopper_row. If it is equal,
# it does not. Thus, all the rows will be added to
# $shopper_row except for the ones that should be deleted.
$delete_item = "";
foreach $item (@delete_items)
{
if ($item eq $cart_row_number)
{
$delete_item = "yes";
&codehook("mark_item_for_delete");
}
# End of foreach $item (@add_items)
}
if ($delete_item ne "yes")
{
$shopper_row .= $_;
}
# End of while (<CART>)
}
close (CART);
# Then, as it did for modification, the scipt overwrites
# the old cart with the new information and
# sends the client back to the view cart page with the
# display_cart_contents subroutine which will be discussed
# later.
open (CART, ">$sc_cart_path") || &file_open_error("$sc_cart_path", "Delete Item From Cart", __FILE__, __LINE__);
print CART "$shopper_row";
close (CART);
&finish_delete_from_cart;
# End of if ($form_data{'submit_deletion'} ne "")
}
#######################################################################
sub finish_delete_from_cart{
&codehook("finish_delete_from_cart");
&display_cart_contents;
}
#######################################################################
# Display Products for Sale #
#######################################################################
# display_products_for_sale is used to generate
# dynamically the "product pages" that the client will
# want to browse through. There are two cases within it
# however.
#
# Firstly, if the store is an HTML-based store, this
# routine will either display the requested page
# or, in the case of a search, perform a search on all the
# pages in the store for the submitted keyowrd.
#
# Secondly, if this is a database-based store, the script
# will use the create_html_page_from_db to output the
# product page requested or to perform the search on the
# database.
#
# The subroutine takes no arguments and is called with the
# following syntax:
#
# &display_products_for_sale;
sub display_products_for_sale
{
if ($form_data{'keywords'} ne "")
{
open(SEARCH,$sc_search_log_path)||die "$sc_access_log_path doesn't look good";
@lines=<SEARCH>;
close(SEARCH);
foreach $link(@lines)
{
chomp($link);
($phrase,$hits)=split(/\|/,$link);
$phrase_array{$phrase}=$hits;
}
{$phrase_used=$form_data{'keywords'}}
$phrase_array{$phrase_used}++;
{@keys=sort {$phrase_array{$a} <=> $phrase_array{$b}} keys(%phrase_array)}
open(SEARCH,">$sc_search_log_path");
foreach $key(@keys)
{
print SEARCH qq~$key|$phrase_array{$key}\n~;
}
close(SEARCH);
}
# The script first determines which type of store this is.
# If it turns out to be an HTML-based store, the script
# will check to see if the current request is a keyword
# search or simply a request to display a page. If it is
# a keyword search, the script will require the html
# search library and use the html_search subroutine with
# in it to perform the search.
if ($sc_use_html_product_pages eq "yes")
{
if ($search_request ne "")
{
&standard_page_header("Search Results");
require "$sc_html_search_routines_library_path";
&html_search;
&html_search_page_footer;
&call_exit;
}
# If the store is HTML-based and there is no current
# keyword however, the script simply displays the page as
# requested with display_page which will be discussed
# shortly.
&display_page("$sc_html_product_directory_path/$page", "Display Products for Sale", __FILE__, __LINE__);
}
# On the other hand, if $sc_use_html_product_pages was set to
# no, it means that the admin wants the script to generate
# HTML product pages on the fly using the format string
# and the raw database rows. The script will do so
# using the create_html_page_from_db subroutine which will
# be discussed next.
else
{
&create_html_page_from_db;
}
}
#######################################################################
# create_html_page_from_db Subroutine #
#######################################################################
# create_html_page_from_db is used to genererate the
# navigational interface for database-base stores. It is
# used to create both product pages and "list of products"
# pages. The subroutine takes no arguments and is called
# with the following syntax:
#
# &create_html_page_from_db;
sub create_html_page_from_db
{
# First, the script defines a few working variables which
# will remain local to this subroutine.
local (@database_rows, @database_fields, @item_ids, @display_fields);
local ($total_row_count, $id_index, $display_index, $found, $product_id);
local ($row, $field, $empty, $option_tag, $option_location, $output);
# Next the script checks to see if there is actually a
# page which must be displayed. If there is a value for
# the page variable incoming as form data, (ie: list of
# product page) the script will simply display that page
# with the display_page subroutine and exit.
if ($page ne "" && $search_request eq "" &&
$form_data{'continue_shopping_button'} eq "")
{
&display_page("$sc_html_product_directory_path/$form_data{'page'}",
"Display Products for Sale", __FILE__, __LINE__);
&call_exit;
}
# If there is no page value, then the script knows that it
# must generate a dynamic product page using the value of
# the product form variable to query the database.
#
# First, the script uses the product_page_header
# subroutine in order to dynamically generate the product
# page header. We'll pass to the subroutine the value of
# the page we have been asked to display so that it can
# display something useful in the <TITLE></TITLE> area.
#
# The product_page_header subroutine is located in
# core_html_lib.pl and $sc_product_display_title is
# defined in the setup file.
#&product_page_header($sc_product_display_title);
#
#if ($form_data{'add_to_cart_button.x'} ne "" && $sc_shall_i_let_client_know_item_added eq "yes")
#
#{
#print "$sc_item_ordered_message";
#}
# Next the database is querried for rows containing the
# value of the incoming product variable in the correct
# category as defined in core.setup.db The script uses
# the submit_query subroutine in core_db_lib.pl
# passing to it a reference to the list array
# database_rows.
#
# submit_query returns a descriptive status message
# if there was a problem and a total row count
# for diagnosing if the maximum rows returned
# variable was exceeded.
if (!($sc_db_lib_was_loaded =~ /yes/i)) {
&require_supporting_libraries (__FILE__, __LINE__, "$sc_db_lib_path");
}
($status,$total_row_count) = &submit_query(*database_rows);
# Now that the script has the database rows to be
# displayed, it will display them.
#
# Firstly, the script goes through each database row
# contained in @database_rows splitting it into it's
# fields.
#
# For the most part, in order to display the database
# rows, the script will simply need to take each field
# from the database row and substitute it for a %s in the
# format string defined in core.setup.db
#
# However, in the case of options which will modify a
# product, the script must grab the code from an options
# file.
#
# The special way that options are denoted in the database
# are by using the format %%OPTION%%option.html in the
# data file. This string includes two important bits of
# information.
#
# Firstly, it begins with %%OPTION%%. This is a flag
# which will let the script know that it needs to deal
# with this database field as if it were an option. When
# it sees the flag, it will then look to the bit after the
# flag to see which file it should load. Thus, in this
# example, the script would load the file option.html for
# display.
#
# Why go through all the trouble? Well basically, we need
# to create a system which will handle large chunks of
# HTML code within the database that are very likely to be
# similar. If there are options on product pages, it is
# likely that they are going to be repeated fairly
# often. For example, every item in a database might have
# an option like tape, cd or lp. By creating one
# options.html file, we could easily put all the code into
# one shared location and not need to worry about typing
# it in for every single database entry.
# DELUXE version sanity check
if (($form_data{'next'}+$sc_db_max_rows_returned) < 1) {
$form_data{'next'} = 0;
}
$nextCount = $form_data{'next'}+$sc_db_max_rows_returned;
$prevCount = $form_data{'next'}-$sc_db_max_rows_returned;
$minCount = $form_data{'next'};
$maxCount = $form_data{'next'}+$sc_db_max_rows_returned;
if ($maxCount < @database_rows) {
$my_max_count = $maxCount;
} else {
$my_max_count = @database_rows;
}
$num_returned = @database_rows;
$nextHits = $sc_db_max_rows_returned;
$prod_message = &product_message($status,$num_returned,$nextHits);
&product_page_header($sc_product_display_title);
if ($form_data{'add_to_cart_button.x'} ne "" &&
$sc_shall_i_let_client_know_item_added eq "yes") {
print "$sc_item_ordered_message";
}
$last_product_displayed = "no";
# core version 3.2b -- now it is a list of keys, not full rows
foreach $row (@database_rows)
{
$rowCount++;
$prevHits = $sc_db_max_rows_returned;
$nextHits = $sc_db_max_rows_returned;
if ($rowCount > $minCount && $rowCount <= $maxCount)
{
#@database_fields = split (/\|/, $row);
$product_id = $row;
$found = &check_db_with_product_id($product_id,*database_fields);
&codehook("create_html_page_read_db_item");
foreach $field (@database_fields)
{
# DELUXE feature ... if field starts with %%IMG%% then it is an image,
# and we will generate an HTML IMG tag for it
if ($field =~ /^%%IMG%%/i)
{
($empty, $image_tag, $image_location) = split (/%%/, $field);
$field = '<IMG SRC="' . "$URL_of_images_directory/$image_location" .
'" BORDER=0>';
}
# For every field in every database row, the script simply
# checks to see if it begins (^) with %%OPTION%%. If so,
# it splits out the string into three strings, one
# empty, one equal to OPTION and one equal to the location
# of the option to be used. Then the script resets the
# field to null because it is about to overwrite it.
if ($field =~ /^%%OPTION%%/i)
{
($empty, $option_tag, $option_location) = split (/%%/, $field);
$field = "";
# The option file is then opened and read. Next, every
# line of the option file is appended to the $field
# variable and the file is closed again. Then the
# current product id number is substituted for the
# %%PRODUCT_ID%% flag in the option_prep subroutine and
# and any optpre and optpost corescript is run
open (OPTION_FILE, "<$sc_options_directory_path/$option_location") ||
&file_open_error ("$sc_options_directory_path/$option_location", "Display Products for Sale", __FILE__,__LINE__);
read (OPTION_FILE,$field,99999); # read it in all at once
close (OPTION_FILE);
$field = &option_prep($field,$option_location,$product_id);
# End of if ($field =~ /^%%OPTION%%/)
}
# Now see if we need to load a generic file of some type
if ($field =~ /^%%FILE%%/i)
{
($empty, $option_tag, $option_location) = split (/%%/, $field);
$field = "";
open (OPTION_FILE, "<$sc_generic_directory_path/$option_location");
read (OPTION_FILE,$field,99999); # read it in all at once
close (OPTION_FILE);
$field = &corescript($field,"pre","$option_location",__FILE__,__LINE__);
$cart_id_for_html = &cart_id_for_html;
$field =~ s/%%PRODUCT_ID%%/$database_fields[$sc_db_index_of_product_id]/g;
$field =~ s/%%PRODUCTID%%/$database_fields[$sc_db_index_of_product_id]/g;
$field =~ s/%%URLofImages%%/$URL_of_images_directory/g;
$field =~ s/%%cart_id%%/$cart_id_for_html/g;
$field = &corescript($field,"post","$option_location",__FILE__,__LINE__);
($very_first_part,$field,$junk) =
split(/<h3>--cut here--<\/h3>/i,$field,3);
if ($field eq "") {
$field = $very_first_part;
}
if ($field eq "") {
$field = "(file $option_location not found)";
}
# End of if ($field =~ /^%%FILE%%/)
}
# End of foreach $field (@database_fields)
}
if ($rowCount == (1 + $minCount)) {
$first_product_displayed = "yes";
} else {
$first_product_displayed = "no";
if ($rowCount == $maxCount) {
$last_product_displayed = "yes";
}
}
&create_display_fields(@database_fields);
&displayProductPage;
# End of foreach $row (@database_rows)
}
}
&product_page_footer($status,$total_row_count);
&call_exit;
}
#######################################################################
# display_cart_contents Subroutine #
#######################################################################
# display_cart_contents is used to display the current
# contents of the customer's cart. It takes no arguments
# and is called with the following syntax:
#
# &display_cart_contents;
sub display_cart_contents
{
local ($my_gt,$my_tq,$tmq,$tc,$st) = "";
# The subroutine begins by defining some working variables
# as local to the subroutine.
local (@cart_fields);
local ($field, $cart_id_number, $quantity, $display_number,
$unformatted_subtotal, $subtotal, $unformatted_grand_total,
$grand_total);
# Next, as when we created the modification and deletion
# forms for cart manipulation, we will use the routines in
# core_html_lib.pl to generate the header, body and
# footer of the cart page. However, unlike with the
# modification and deletion forms, we will not need an
# extra table cell for the checkbox or text field. Thus,
# we will not pass anything to display_cart_table. We
# will simply get a table representing the current
# contents of the customer's cart.
$sc_special_page_meta_tags = "\n";
$sc_special_page_meta_tags .= '<META HTTP-EQUIV="Cache-Control"' .
' Content="no-cache">';
$sc_special_page_meta_tags .= "\n";
$sc_special_page_meta_tags .= '<META HTTP-EQUIV="Pragma"' .
' Content="no-cache">';
$sc_special_page_meta_tags .= "\n";
&standard_page_header("View/Modify Cart");
($my_gt,$my_tq,$tmq,$tc,$st) = &display_cart_table("");
&cart_footer((0+$my_gt),(0+$my_tq));
&call_exit;
# End of sub display_cart_contents
}
#######################################################################
# file_open_error Subroutine #
#######################################################################
# If there is a problem opening a file or a directory, it
# is useful for the script to output some information
# pertaining to what problem has occurred. This
# subroutine is used to generate those error messages.
#
# file_open_error takes four arguments: the file or
# directory which failed, the section in the code in which
# the call was made, the current file name and
# line number, and is called with the following syntax:
#
# &file_open_error("file.name", "ROUTINE", __FILE__,
# __LINE__);
sub file_open_error
{
# The subroutine simply uses the update_error_log
# subroutine discussed later to modify the error log and
# then uses CgiDie in cgi-lib.pl to gracefully exit the
# application with a useful debugging error message sent
# to the browser window.
local ($bad_file, $script_section, $this_file, $line_number) = @_;
&update_error_log("FILE OPEN ERROR-$bad_file", $this_file, $line_number);
open(ERROR, $error_page);
while (<ERROR>)
{
print $_;
}
close (ERROR);
}
#######################################################################
# display_page Subroutine #
#######################################################################
# display_page is used to filter HTML pages through the
# script and display them to the browser window.
#
# display_page takes four arguments: the file or
# directory which failed, the section in the code in which
# the erroneous call was made, the current file name and
# line number, and is called with the following syntax:
#
# &file_open_error("file.name", "ROUTINE", __FILE__,
# __LINE__);
#
# (notice the two special Perl variables __FILE__, which
# equals the current filename, and __LINE__ which equals
# the current line number).
sub display_page
{
local ($page, $routine, $file, $line) = @_;
local($the_file)="";
local($href_fields,$hidden_fields);
$href_fields = &make_href_fields;
$hidden_fields = &make_hidden_fields;
$cart_id_for_html = "%%ZZZ%%";
# the subroutine begins by opening the requested file for
# reading, exiting with file_open_error if there is a
# problem as usual.
open (PAGE, "<$page") || &file_open_error("$page", "$routine", $file, $line);
# It then reads in the file one line at a time.
while (<PAGE>)
{
# Check to see if the add_to_cart_button button
# has been clicked. if so, it means that we have just
# added an item and are returning to the display of the
# product page. In this case, we will sneak in an addition
# confirmation message right after the <FORM> tag line.
if (($form_data{'add_to_cart_button'} ne "") &&
($sc_allow_sneak_in_message =~ /yes/i) &&
($sc_shall_i_let_client_know_item_added =~ /yes/i)) {
if ($_ =~ /<FORM/) {
$the_file .= "$_";
$the_file .= "$sc_item_ordered_message";
$_ = ""; #do not write it twice
}
}
# If it is any other line, simply print it out to the
# browser window. Once we have gone through all of the
# lines in the file, the HTML will be complete and
# filtered.
$the_file .= $_;
}
close (PAGE);
$the_file = &script_and_substitute($the_file,$page);
print $the_file;
# End of sub display_page
}
#################################################################
sub script_and_substitute {
local ($the_file,$page)=@_;
local($href_fields,$hidden_fields,$item_ordered_message,$my_text)="";
$href_fields = &make_href_fields;
$hidden_fields = &make_hidden_fields;
$cart_id_for_html = "%%ZZZ%%";
# All forms must include at least two hidden field lines
# with "tags" to be substituted for imbedded as follows:
#
# <INPUT TYPE = "hidden" NAME = "cart_id" VALUE = "%%cart_id%%">
# <INPUT TYPE = "hidden" NAME = "page" VALUE = "%%page%%">
#
# When the script reads in these lines, it will see the
# tags "%%cart_id%%" and"%%page%%" and substitute them for
# the actual page and cart_id values which came in as form
# data.
#
# Similarly it might see the following URL reference:
#
# <A HREF = "core.cgi?page=Letters.html&cart_id=">
#
# In this case, it will see the cartid= tag and
# substitute in the correct and complete
# "cartid=some_number".
if (($form_data{'add_to_cart_button'} ne "" )&&
($sc_shall_i_let_client_know_item_added =~ /yes/i)) {
$item_ordered_message = $sc_item_ordered_msg_token;
}
$the_file = &corescript($the_file,"pre","$page",__FILE__,__LINE__);
$the_file =~ s/%%item_ordered_msg%%/$item_ordered_message/ig;
$the_file =~ s/%%CartID%%/%%cart_id%%/g;# must prevent double substitution
$the_file =~ s/%%cartID%%/%%cart_id%%/ig;
$the_file =~ s/cart_id=%%cart_id%%/cart_id=/ig;
$the_file =~ s/cart_id=/cart_id=$cart_id_for_html/ig;
$the_file =~ s/%%cart_id%%/$cart_id_for_html/ig;
$the_file =~ s/%%page%%/$form_data{'page'}/ig;
$the_file =~ s/%%date%%/$date/ig;
$the_file =~ s/%%corecgi_ver%%/$versions{'core.cgi'}/ig;
$the_file =~ s/%%URLofImages%%/$URL_of_images_directory/ig;
$the_file =~ s/%%scriptURL%%/$sc_main_script_url/ig;
$the_file =~ s/%%sc_order_script_url%%/$sc_order_script_url/ig;
$the_file =~ s/%%StepOneURL%%/$sc_stepone_order_script_url/ig;
$the_file =~ s/%%href_fields%%/$href_fields/ig;
$the_file =~ s/%%make_hidden_fields%%/$hidden_fields/ig;
$the_file =~ s/%%ppinc%%/$form_data{'ppinc'}/ig;
$the_file =~ s/%%maxp%%/$form_data{'maxp'}/ig;
$the_file =~ s/%%product%%/$form_data{'product'}/ig;
$the_file =~ s/%%p_id%%/$form_data{'p_id'}/ig;
$the_file =~ s/%%keywords%%/$keywords/ig;
$the_file =~ s/%%next%%/$form_data{'next'}/ig;
$the_file =~ s/%%exact_match%%/$form_data{'exact_match'}/ig;
$the_file =~ s/%%exact_case%%/$form_data{'exact_case'}/ig;
while ($the_file =~ /%%ZZZ%%/) {
$cart_id_for_html = &cart_id_for_html;
$the_file =~ s/%%ZZZ%%/$cart_id_for_html/;
}
$the_file = &corescript($the_file,"post","$page",__FILE__,__LINE__);
$the_file = &corescript($the_file,"","$page",__FILE__,__LINE__);
# Very Last thing, load headers and footers
# These routines already have substitutions, corescript, etc, and
# are stand-alones, so do not need to make any additional changes to them
while ($the_file =~ /%%StoreHeader%%/i) {
$my_text = &GetStoreHeader;
$the_file =~ s/%%StoreHeader%%/$my_text/i;
}
while ($the_file =~ /%%StoreFooter%%/i) {
$my_text = &GetStoreFooter;
$the_file =~ s/%%StoreFooter%%/$my_text/i;
}
return $the_file;
}
#################################################################
# update_error_log Subroutine #
#################################################################
# update_error_log is used to append to the error log if
# there has been a process executing this script and/or
# email the admin.
#
# The subroutine takes three arguments, the type of error,
# the current filename and current line number and is
# called with the following syntax:
#
# &update_error_log("WARNING", __FILE__, __LINE__);
sub update_error_log
{
# The subroutine begins by assigning the incoming
# argumnets to local variables and defining some other
# local variables to use during its work.
#
# $type_of_error will be a text string explaining what
# kind of error is being logged.
#
# $file_name is the current filename of this script.
#
# $line_number is the line number on which the error
# occurred. Note that it is essential that the line
# number, stored in __LINE__ be passed through all levels
# of subroutines so that the line number value will truly
# represent the line number of the error and not the
# line number of some subroutine for error handling.
local ($type_of_error, $file_name, $line_number) = @_;
local ($log_entry, $email_body, $variable, @env_vars);
# The list of the HTTP environment variables are culled
# into the @env_vars list array and get_date is used to
# assign the current date to $date
@env_vars = keys(%ENV);
$date = &get_date;
# Now, if the admin has instructed the script to log
# errors by setting $sc_shall_i_log_errors in
# core.setup.db, the script will create an error log
# entry.
if ($sc_debug_mode eq "yes")
{
if ($sc_header_printed ne 1) {
print $sc_browser_header;
}
print '<DIV ALIGN=LEFT><TABLE WIDTH=500><TR><TD>' . "\n";
print "<PRE>ERROR: $type_of_error<br>FILE: $file_name<br>",
"LINE: $line_number\n</PRE>";
print '</TD></TR></TABLE></DIV>' . "\n";
}
if ($sc_shall_i_log_errors eq "yes")
{
# First, the new log entry row is created as a pipe
# delimited list beginning with the error type, filename,
# line number and current date.
$log_entry = "$type_of_error\|FILE=$file_name\|LINE=$line_number\|";
$log_entry .= "DATE=$date\|";
# Then the error log file is opened securely by using the
# lock file routines in get_file_lock discussed later.
&get_file_lock("$sc_error_log_path.lockfile");
open (ERROR_LOG, ">>$sc_error_log_path") || &CgiDie ("The Error Log could not be opened");
# Now, the script adds to the log entry row, the values
# associated with all of the HTTP environment variables
# and prints the whole row to the log file which it then
# closes and opens for use by other instances of this
# script by removing the lock file.
foreach $variable (@env_vars)
{
$log_entry .= "$ENV{$variable}\|";
}
print ERROR_LOG "$log_entry\n";
close (ERROR_LOG);
&release_file_lock("$sc_error_log_path.lockfile");
# End of if ($sc_shall_i_log_errors eq "yes")
}
# Next, the script checks to see if the admin has
# instructed it to also send an email error notification
# to the admin by setting the $sc_shall_i_email_if_error
# in core.setup.db
#
# If so, it prepares an email with the same info contained
# in the log file row and mails it to the admin using the
# send_mail routine in mail-lib.pl. Note that a common
# sourse of email errors lies in the admin not setting the
# correct path for sendmail in mail-lib.pl on line 42.
# Make sure that you set this variable there if you are
# not receiving your mail and you are using the sendmail
# version of the mail-lib package.
if ($sc_shall_i_email_if_error eq "yes")
{
$email_body = "$type_of_error\n\n";
$email_body .= "FILE = $file_name\n";
$email_body .= "LINE = $line_number\n";
$email_body .= "DATE=$date\|";
foreach $variable (@env_vars)
{
$email_body .= "$variable = $ENV{$variable}\n";
}
&send_mail("$sc_admin_email", "$sc_admin_email", "Web Store Error", "$email_body");
# End of if ($sc_shall_i_email_if_error eq "yes")
}
}
#################################################################
# get_date Subroutine #
#################################################################
# get_date is used to get the current date and time and
# format it into a readable form. The subroutine takes no
# arguments and is called with the following syntax:
#
# $date = &get_date;
#
# It will return the value of the current date, so you
# must assign it to a variable in the calling routine if
# you are going to use the value.
sub get_date
{
# The subroutine begins by defining some local working
# variables
local ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst,$date);
local (@days, @months);
@days = ('Sun','Mon','Tue','Wed','Thu', 'Fri','Sat');
@months = ('Jan','Feb','Mar','Apr','May','Jun','Jul',
'Aug','Sep','Oct','Nov','Dec');
# Next, it uses the localtime command to get the current
# time, from the value returned by the time
# command, splitting it into variables.
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
# Then the script formats the variables and assign them to
# the final $date variable.
if ($hour < 10)
{
$hour = "0$hour";
}
if ($min < 10)
{
$min = "0$min";
}
if ($sec < 10)
{
$sec = "0$sec";
}
$year += 1900;
$date = "$days[$wday], $months[$mon] $mday, $year at $hour\:$min\:$sec";
return $date;
}
#################################################################
# display_price Subroutine #
#################################################################
# display_price is used to format the price string so that
# the store can take into account differing methods for
# displaying prices. For example, some countries use
# "$xxx.yyy". Others may use "xx.yy UNIT". This
# subroutine will use the $sc_money_symbol_placement and
# the $sc_money_symbol variables defined in
# core.setup.db to format the entire price string for
# display. The subroutine takes one argument, the price
# to be formatted, and is called with the following
# syntax:
#
# $price = &display_price(xx.yy);
#
# Where xx.yy is some number like 23.99.
#
# Note that the main routine calling this subroutine must
# prepare a variable for the returned formatted price to
# be assigned to.
sub display_price {
local ($price) = @_;
local ($format_price);
# set to 2 decimal places ... SPK 1/26/2000
$price = &format_price($price);
if ($sc_money_symbol_placement eq "front") {
$format_price = "$sc_money_symbol$price";
} else {
$format_price = "$price$sc_money_symbol";
}
return $format_price;
}
sub display_price_nospaces {
local ($price) = @_;
local ($holdme) = $sc_money_symbol_spaces;
$sc_money_symbol_spaces='';
$price = &display_price($price);
$sc_money_symbol_spaces = $holdme;
return $price;
}
#######################################################################
# get_file_lock #
#######################################################################
# get_file_lock is a subroutine used to create a lockfile.
# Lockfiles are used to make sure that no more than one
# instance of the script can modify a file at one time. A
# lock file is vital to the integrity of your data.
# Imagine what would happen if two or three people
# were using the same script to modify a shared file (like
# the error log) and each accessed the file at the same
# time. At best, the data entered by some of the users
# would be lost. Worse, the conflicting demands could
# possibly result in the corruption of the file.
#
# Thus, it is crucial to provide a way to monitor and
# control access to the file. This is the goal of the
# lock file routines. When an instance of this script
# tries to access a shared file, it must first check for
# the existence of a lock file by using the file lock
# checks in get_file_lock.
#
# If get_file_lock determines that there is an existing
# lock file, it instructs the instance that called it to
# wait until the lock file disappears. The script then
# waits and checks back after some time interval. If the
# lock file still remains, it continues to wait until some
# point at which the admin has given it permissios to just
# overwrite the file because some other error must have
# occurred.
#
# If, on the other hand, the lock file has dissappeared,
# the script asks get_file_lock to create a new lock file
# and then goes ahead and edits the file.
#
# The subroutine takes one argumnet, the name to use for
# the lock file and is called with the following syntax:
#
# &get_file_lock("file.name");
sub get_file_lock
{
local ($lock_file) = @_;
local ($endtime);
local ($exit_get_file_lock)="";
&codehook("get_file_lock");
if ($exit_get_file_lock ne "") {return;}
$endtime = 25;
$endtime = time + $endtime;
# We set endtime to wait 20 seconds. If the lockfile has
# not been removed by then, there must be some other
# problem with the file system. Perhaps an instance of
# the script crashed and never could delete the lock file.
while (-e $lock_file && time < $endtime)
{
sleep(1);
}
open(LOCK_FILE, ">$lock_file") ||
&CgiDie ("I could not open the lockfile - check your permission " .
"settings ($lock_file)");
# Note: If flock is available on your system, feel free to
# use it. flock is an even safer method of locking your
# file because it locks it at the system level. The above
# routine is "pretty good" and it will server for most
# systems. But if youare lucky enough to have a server
# with flock routines built in, go ahead and uncomment
# the next line and comment the one above.
# flock(LOCK_FILE, 2); # 2 exclusively locks the file
}
#######################################################################
# release_file_lock #
#######################################################################
# release_file_lock is the partner of get_file_lock. When
# an instance of this script is done using the file it
# needs to manipulate, it calls release_file_lock to
# delete the lock file that it put in place so that other
# instances of the script can get to the shared file. It
# takes one argument, the name of the lock file, and is
# called with the following syntax:
#
# &release_file_lock("file.name");
sub release_file_lock
{
local ($lock_file) = @_;
local ($exit_release_file_lock)="";
&codehook("release_file_lock");
if ($exit_release_file_lock ne "") {return;}
# flock(LOCK_FILE, 8); # 8 unlocks the file
# As we mentioned in the discussion of get_file_lock,
# flock is a superior file locking system. If your system
# has it, go ahead and use it instead of the hand rolled
# version here. Uncomment the above line and comment the
# two that follow.
close(LOCK_FILE);
unlink($lock_file);
}
#######################################################################
# format_price #
#######################################################################
# format_price is used to format prices to two decimal
# places. It takes one argumnet, the price to be formatted
# and is called with the following syntax:
#
# $price =&format_price(xxx.yyyyy);
#
# Notice that the main calling routine must assign the
# returned formatted price to some variable for its own
# use.
#
# Also notice that this routine takes a value even if it
# is longer than two decimal places and formats it with
# rounding. Thus, you can utilize price calculations such
# as 12.99 * 7.985 (where 7.985 might be some tax value.
sub format_price
{
# The incoming price is set to a local variables and a few
# wroking local variables are defined.
local ($unformatted_price) = @_;
local ($formatted_price);
# The script then uses the rounding method in EXCEL. If
# the 3rd decimal place is > 4, then we round the 2nd
# decimal place up 1. Otherwise, we leave the number
# alone. Notice that we will use the substr function to
# pull off the last value in the three decimal place
# number and compare it using the EXCEL logic.
#
# Basically, the routine uses the rounding rules of
# sprintf.
# The unformatted_price is rounded to
# to two decimal places and returned to the calling
# routine.
$formatted_price = sprintf ("%.2f", $unformatted_price);
return $formatted_price;
}
############################################################
#
# subroutine: format_text_field
# Usage:
# $formatted_value =
# &format_text_field($value, [$width]);
#
# Parameters:
# $value = text value to format.
# $width = optional field width. Defaults to 25.
#
# This routine takes the value and appends enough
# spaces so that the field width is 25 spaces.
# in order to justify the fields that are stored
# eventually in the $text_of_cart.
#
# Output:
# The formatted value
#
############################################################
sub format_text_field
{
local($value, $width) = @_;
$width = 25 if (!$width);
# Very simple. We return the value in
# $value plus a string of 25 spaces which
# has been truncated by the length of
# the $value string.
#
# This results in a left justified
# field of width = 25.
#
return ($value . (" " x ($width - length($value))));
#End of format_text_field
}
###########################################################################################
sub SetCookies
{
$cookie{'cart_id'} = "$cart_id";
# Set the domain to be correct for your domain
$domain = $sc_domain_name_for_cookie;
$secureDomain = $sc_secure_domain_name_for_cookie;
# The path to your 'store' directory
$path = $sc_path_for_cookie;
$securePath = $sc_secure_path_for_cookie;
# Leave this as is.
$secure = "";
# Cookie will expire in 24 hours times the number of cookie days
$now = time;
# Second in twenty four hours
$twenty_four_hours = "86400";
$cookie_hours = $sc_cookie_days * $twenty_four_hours;
$expiration = $now+$cookie_hours;#number of days until cookie expires
&codehook("about_to_set_cookie");
if(!$form_data{'secure'}){
&set_cookie($expiration,$domain,$path,$secure);
} else {
&set_cookie($expiration,$secureDomain,$securePath,$secure);
}
}
############################################################
sub checkReferrer
{
# BEGIN REFERRING SITE VALIDATION and REPEATED PAGE LOADING
local ($referringDomain, $acceptedDomain);
local ($test_repeat,$raw_text);
$referringDomain = $ENV{'HTTP_REFERER'};
$acceptedDomain = $sc_domain_name_for_cookie;
$referringDomain =~ s/\?.*//g;
$referringDomain =~ s/http:\/\///g;
$referringDomain =~ s/https:\/\///g;
$referringDomain =~ s/\/.*//g;
$referringDomain =~ s/\/core.cgi//g;
if ($referringDomain =~ "^w*\.")
{
$referringDomain =~ s/^w*\.//i;
}
if ($acceptedDomain =~ "^w*\.")
{
$acceptedDomain =~ s/^w*\.//i;
}
$test_repeat = 0;
if ($sc_test_for_store_cart_change_repeats) {
$test_repeat = $sc_test_repeat;
}
if (($referringDomain ne $acceptedDomain) || ($test_repeat)) {
if ($test_repeat) {
if ($sc_repeat_fake_it =~ /yes/i) {
&repeat_fake_it;
} else {
$special_message = $messages{'chkref_01'};
&display_cart_contents;
}
}
elsif ($cart_id == $cookie{'cart_id'}) { # okay to show the stuff ...
$special_message = $messages{'chkref_02'};
&display_cart_contents;
} else {
print "$acceptedDomain is the accepted referrer.<br>";
print "$referringDomain is not a valid referrer<br>";
print $messages{'chkref_03'};
}
&call_exit;
}
# END REFERRING SITE VALIDATION
}
############################################################
sub repeat_fake_it {
if ($form_data{'add_to_cart_button.x'} ne "") {
&finish_add_to_the_cart;
&call_exit;
}
elsif ($form_data{'submit_change_quantity_button.x'} ne "") {
&finish_modify_quantity_of_items_in_cart;
&call_exit;
}
elsif ($form_data{'submit_deletion_button.x'} ne "") {
&finish_delete_from_cart;
&call_exit;
}
else {
$special_message = $messages{'chkref_01'};
&display_cart_contents;
}
}
############################################################
sub set_sc_cart_path {
local($raw_text)="";
# untaint cart_id ... plus set the original form data variable just in
# case somebody mistakenly uses it later
$cart_id =~ /([\w\-\=\+\/]+)\.(\w+)/;
$cart_id = "$1.$2";
$form_data{'cart_id'} = $cart_id;
# have already untainted $cart_id, this should be all we need to do
$sc_cart_path = "$sc_user_carts_directory_path/${cart_id}_cart";
$sc_capture_path = "$sc_user_carts_directory_path/${cart_id}_CAPTURE";
$sc_verify_order_path = "$sc_user_carts_directory_path/${cart_id}_VERIFY";
$sc_trans_rec_path = "$sc_user_carts_directory_path/${cart_id}_TRANSLOG";
$cart_id_for_html = "$cart_id*" . &make_random_chars; # deprecated!
&check_cart_expiry;
# $sc_test_repeat = 0;
# if (-f $sc_trans_rec_path) {
# open(TRANS_FILE, "<$sc_trans_rec_path") || &file_open_error(
# "$sc_trans_rec_path", "Reading TRANS LOG", __FILE__,__LINE__);
# read(TRANS_FILE,$raw_text,99999); # read it in all at once
# close(TRANS_FILE);
# } else {
# $raw_text="";
# }
# if (!($raw_text =~ /$sc_unique_cart_modifier/)){
# open (TRANS_FILE, ">>$sc_trans_rec_path") || &file_open_error(
# "$sc_trans_rec_path", "Trans Repeat Write", __FILE__,__LINE__);
# print TRANS_FILE "$sc_unique_cart_modifier\n"; # save record!
# close(TRANS_FILE);
# } else {
# $sc_test_repeat = 1;
#}
&codehook("set_sc_cart_path_bot");
chmod (0755, $sc_cart_path);
return;
}
#######################################################################
sub cart_id_for_html{ # nice and simple ... append random chars as tag
#return "$cart_id*" . &make_random_chars;
return "$cart_id";
}
#######################################################################
# For running codehooks at various places
#######################################################################
sub codehook{
local($hookname)=@_;
local($codehook,$err_code,@hooklist);
if ($codehooks{$hookname} ne "") {
@hooklist = split(/\|/,$codehooks{$hookname});
foreach $codehook (@hooklist) {
eval("&$codehook;");
$err_code = $@;
if ($err_code ne "") { #script died, error of some kind
&update_error_log("code-hook $hookname $codehook $err_code","","");
}
}
}
}
#######################################################################
# For adding codehooks to the list for later execution
#######################################################################
sub add_codehook{
local($hookname,$sub_name)=@_;
local($codehook,$err_code,@hooklist);
if ($sub_name eq "") { return;}
@hooklist = split(/\|/,$codehooks{$hookname});
foreach $codehook (@hooklist) {
if ($codehook eq $sub_name) { # already on the list, no need to add
return;
}
}
if ($codehooks{$hookname} eq "") {
$codehooks{$hookname} = $sub_name;
} else {
$codehooks{$hookname} .= "|" . $sub_name;
}
}
#######################################################################
sub my_die {
local ($msg) = @_;
if ($sc_in_throes_of_death eq "yes") {die $msg;}
$sc_in_throes_of_death="yes";
&call_exit;
die $msg;
}
#######################################################################
# For cleanup purposes such as closing files, removing locks, etc.
#######################################################################
sub call_exit {
codehook("cleanup_before_exit");
if ($sc_in_throes_of_death ne "yes") {
exit;
}
}