|
Server : Apache/2.4.62 System : FreeBSD fbsdweb2.web.rcn.net 14.1-RELEASE FreeBSD 14.1-RELEASE releng/14.1-n267679-10e31f0946d8 GENERIC amd64 User : www ( 80) PHP Version : 8.3.8 Disable Function : NONE Directory : /domains/toc/cgi-bin/mystore/ |
Upload File : |
#! /usr/bin/perl
#
$PerlShop_version = 3.1;
#
# A product of ARPAnet Corp. - [email protected], www.arpanet.com/perlshop
#
# Copyright (c) 1996, 1997 by ARAPnet Corp., All rights reserved
#
# Author: Edward Taussig.
# (Portions Copyright (c) 1993 Steven E. Brenner)
# (SHA algorithm written by: John Allen ([email protected]).
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version, WITH THE FOLLOWING EXCEPTION:
# You may not remove the the code that includes the PerlShop logo and the
# link back to the PerlShop home page on any generated pages,
# Nor may you modify the PerlShop logo itself.
#
# 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. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
########### Revision History ##############################################
# Version 3.1
# -added SSI "include", "fsize", "flastmod", "echo", "config", "exec cgi" commands
# -added $add_navigation variable
# -allow fractional quantities if: $allow_fractional_qty eq 'yes'
# -allow !MYURL! within <form> block
# -allow PSTAG within an html comment
# -option to put CC# on email (only if not using a secure server)
# -put source/suggestions on email to vendor
# -script will now print errors to browser instead of dying
# -can now do new search from search results screen
# -will now trap errors in order of html tags
# Version 3.0
# -added First Virtual payment functionality
# -added SecureOrder payment functionality
# -added Secure https ability for order form
# -added support for cookies
# -Search feature will now search subdirectories and highlight hits
# -added logging of patterns that were searched for
# -added option to treat search string as regular expression (default is now not to)
# -added SHA self test
# -fixed bug in SHA using ~0
# -fixed bug in CC check digit routine for CC #'s ending in Zero
# -fixed bug in locking of logfile
# -All dates are now Year 2000 compliant (Incl. CC expire date)
# -Standardized Country to 2 character ISO codes
# -fixed sockets mail routine to include mime & content headers
# -added test for possible prior use of supposedly unique order id
# -only put 'view orders' button if orders exist
# Version 2.2
# -added image option for generated submit buttons
# -added currency and date format customization variables.
# -added '!MYWWW!' option anywhere on page for server independence.
# -Can now use <a href ...> to create navigation 'link' in addition to submit button.
# -added 'ALL' shipping country option.
# -added wrapping of long item names to next line(s) on confirmation screen/email.
# -added direct sockets sendmail option
# -fixed missing quotes around item_name & options in generated hidden tags in view_cart
# -Item name left aligned in view_cart table.
# -added table for different handling amounts per country.
# -version number now prints correctly from command line
# -put $cod_charge in customer file only if paying by COD, else 0
# -put sub_total without tax or discount in customer file
# -put $Handling charge in customer file
# -added $local_time variable and added leading zero to minutes
# -changed search catalog function from 'glob' to 'readdir'
# -change permissions mask only if using cgiwrap
# -fixed self_test for discount/shipping to use 0.01 increment for price
# -only put prev/next page links if pstag is used
# Version 2.1
# -fixed shipping table indexes did not all start at 0
# -fixed bug in Search catalog function due to converion to all uppercase cgi input
# -added !MYURL! option to form tag to allow server independent catalog pages
# Version 2.0
# -added edit to check that 'OTHER' shipper chosen if Country not listed in shipping table
# -fixed formatting of Qty on confirmation screen/email
# -fixed $cod_charge not being written to customer file
# -fixed customer/order files not moved from temp directories if $convert_delim_to_commas not set to 'yes'
# -added $catalog_country variable
# -convert country, shipper and cardtype to uppercase before all comparisons
# -add '<PREV' and 'NEXT>' buttons/menus only if prev/next page is defined in catalog page
# -added $accept_any_country variable to optionally restrict orders to only listed countries
# -added internal table validation test
# -added support for weight and options hidden fields.
# -Search & Replace only done within <FORM>...</FORM> block now for efficiency
# -added support for multipart forms
# -added support for shipping based on weight
# -added support for a Handling charge per order
# -updated SHA algorithm to handle longer input
# -added $stay_on_page option
# -added support for discounts based on price or quantity
# -made Windows compatible
# -added support for non-taxable items (and/or other kinds of Taxes)
# -added Country name to email confirmation if not same as catalog country
# -added 'Paid by:' to email confirmation
# -changed time format on email confirmation from 24 hour to am/pm format
# -The 'ENTER SHOP' button can now have different text
# -made all comparisons using cgi input variables case insensitive
# -allow any characters (except ") in item_id and item_name values.
############################################################################
require 5.000; ## This script requires perl version 5.000 or higher
$|=1; ## Don't buffer output
$testing = 'no'; ## yes, no
$use_cgiwrap = 'no'; ## yes, no
$use_secure_server = 'no'; ## yes, no
$add_navigation = 'yes'; ## yes, no (if yes, first line of script will have prev,next page info)
$use_cookies = 'yes'; ## yes, no
$cookie_expire_days = 1;
$allow_ssi_cgi = 'no'; ## Do NOT set this to 'yes' unless you are sure, it can create a big security hole.
$cardno_on_email = 'no'; ## Do NOT set this to 'yes' unless you are sure, it can create a big security hole.
$allow_fractional_qty = 'no';
&ReadParse(*input); ### Subroutine ReadParse is part of cgi-lib.pl library, Copyright 1993 Steven E. Brenner (see full text below)
print "Content-type: text/html\n";
if (lc $use_cookies ne 'yes')
{print "\n";}
### When using cgiwrap, this script's permissions should be set to 700 so that the ##
### script would not even run unless cgiwrap were used, but in case you forgot to ##
### set the permission to 700, the following fail-safe check is used. ##
if (($< == 65534) && ($use_cgiwrap eq 'yes')) {
print "Attempt to bypass Cgiwrap!\n";
exit;
}
###---------- Get the Current Directory and program title ----------
$curr_dir = '';
$windows = 0;
if (index($0,'\\') != -1) #### True if running on Dos/Windows
{
$program_title = substr($0, rindex($0, '\\') + 1);
$curr_dir = substr($0,0,-(length($0) - rindex($0, '\\') - 1));
$windows = 1;
}
else #### else running on *nix
{$program_title = substr($0, rindex($0, '/') + 1);}
###-----------------------------------------------------------------
##########################################################################
################### Server Customization Variables #######################
##########################################################################
$server_address = 'www.jaustinforbes.com';
$secure_server_address = "http://ssl3.pair.com"; ## "https://ssl.pair.com/taussig"
$cgiwrap_directory = '';
$cgi_directory = 'http://www.jaustinforbes.com/cgi-bin/'; ###must be actual cgi directory name (not 'cgi-bin' if aliased)
$mail_via = 'sendmail'; ### Either 'sockets' or 'sendmail' or 'blat'
$blat_loc = 'c:\\winnt35\\system32\\blat';
$sendmail_loc = '/usr/sbin/sendmail';
$smtp_addr = 'smtp.erols.com'; ### must use ip address on Win95, not hostname (hostname ok on NT)
$catalog_home = '/'; ### This is a Subdirectory of Public_Html, NOT cgi-bin!!!
$home_page = 'index.html';
$image_directory = '/'; ### This is a Subdirectory of Public_Html, NOT cgi-bin!!!
$secure_image_directory = '/taussig/PolishBooks/images';
$image_location = "http://$server_address$image_directory";
$home_icon = 'home.gif'; ### must reside in $image_directory if it exists.
$create_page_log = 'yes'; ### ("yes" or "no")
$create_search_log = 'yes';
###-----------------------------------------------------------
### Assume that following subdirectories are directly under
### the (cgi-bin) directory this script is running in. If not,
### change the value of $curr_dir to the desired directory title
### Here (and include the trailing '/').
###-----------------------------------------------------------
$customers_directory = $curr_dir . 'customers';
$orders_directory = $curr_dir . 'orders';
$catalog_directory = $curr_dir . 'catalog';
$token_directory = $curr_dir . 'tokens';
$temp_customers_directory = $curr_dir . 'temp_customers';
$temp_orders_directory = $curr_dir . 'temp_orders';
$log_directory = $curr_dir . 'log';
###-----------------------------------------------------------
###push (@INC, $cgi_directory);
if ($use_cgiwrap eq 'yes')
{
umask 077; ## make readable/writeable by owner only
$cgi_prog_location = $server_address . $cgiwrap_directory . "/$program_title";
}
else
{$cgi_prog_location = $server_address . $cgi_directory . "/$program_title";}
$delim = chr(1);
$convert_delim_to_commas = 'yes';
$menu_bar = ""; #must be empty string here
$id_length = 9; #length of unique order id key, must be > 3.
$catalog_page = "";
###--------For Secure Server Setup----------------------------
if ($use_cgiwrap eq 'yes')
{$secure_prog_location = "$secure_server_address$cgiwrap_directory/$program_title";}
else
{$secure_prog_location = "$secure_server_address$cgi_directory/$program_title";}
$secure_image_location= "$secure_server_address$secure_image_directory";
###-----------------------------------------------------------
##########################################################################
################### Company Customization Variables ######################
##########################################################################
#==== To Include an Image on your pages =============#
$banner = ''; ### arpanet.gif
$hspace = '5';
$vspace = '5';
$border = '0';
$height = '111';
$width = '111';
$align = 'center';
#====================================================#
#==== To Add background image or change color =======#
$background = ''; ### good1.jpg
$text_color = "";
$background_color = "#FFFFFF"; ### white=#FFFFFF
$link_color = "";
$vlink_color = "";
$alink_color = "";
#====================================================#
$company_name = 'J. Austin Forbes.';
$company_address = 'address';
$company_email = '[email protected]';
$mail_order_to = '[email protected]';
$line_length = 80;
@accept_payment_by = ('Credit', 'Check', 'COD'); ### valid types are: Credit, Check, COD
### if only one entry in @accept_payment_by, it will be the default and user will not have to choose it on order form.
@valid_credit_cards = ('Visa', 'MasterCard'); ### valid types are: MasterCard, Visa, American Express, Optima, Carte Blanche, Diners Club, Discover, JCB.
$online_credit_verify = 'no'; ## Options are: 'no', 'SecureOrder'
$online_check_verify = 'no'; ## Options are: 'no', 'SecureOrder' (not implemented yet)
$accept_first_virtual = 'no'; ## 'yes', 'no'
###--------First Virtual Configuration Section-----------------
$fv_aab_url = "http://www.fv.com/fv/aab";
### for Production ##
##$fv_seller_pin = 'test-sums-testseller'; ### Set ONLY if First Virtual is valid payment option!!!!
##$fv_ips = "card.com";
### for Testing ##
$fv_seller_pin = 'test-seize-programmer'; ### Set ONLY if First Virtual is valid payment option!!!!
$fv_ips = "test.card.com";
###-----------------------------------------------------------
###-------SecureOrder Configuration Section-------------------
$SecureOrder_id = "TEST1"; ### The 5 character alphanumeric string that is your MER_ID
## for Production ##
##$SecureOrder_check_url = "https://www.atsbank.com/cgi-bin/strcheck";
##$SecureOrder_credit_url = "https://www.atsbank.com/cgi-bin/strcredit";
## for Testing ##
$SecureOrder_check_url = "http://www.atsbank.com/cgi-bin/strtcheck";
$SecureOrder_credit_url = "http://www.atsbank.com/cgi-bin/strtcred";
###-----------------------------------------------------------
$cod_charge = 5.00; ### amount to add to order (0.00 if none)
@Handling_table = ( ### amount to add to order (0.00 if none)
['US', 0.00],
['CA', 0.00],
['OTHER', 0.00],
);
$Pay_checks_to = 'J. Austin Forbes Ltd.';
$return_policy = 'J. Austin Forbes offers a seven day inspection of their reels and rods if ';
$return_policy .= 'they are ordered with a credit card. Inspected products must be returned in new condition.';
$catalog_country = 'US'; ### must be all capital letters, 2 letter country code.
$accept_any_country = 'yes'; ### ('yes' or 'no') #Allow orders from countries not specifically listed in shipping rates table?
$local_currency = 'USD';
$currency_decimal = '.'; ### decimal separator for currency format
$currency_separator = ','; ### thousands separator for currency format
$currency_symbol = '$'; ### Symbol for currency
$local_weight = 'lbs.'; ### Unit of measure for WEIGHT field if used.
$local_time = 'EST'; ### The time zone your <<SERVER>> is located in (eg: est, pst)
$date_format = 'mmddyy';### options are: mmddyy, ddmmyy, mmddyyyy, ddmmyyyy
$date_separator = '/';
###-----------------------------------------------------------
### Leave blank (i.e. = '';) to use default submit buttons
### To use an image, jut use the file title (i.e. = 'update.gif';)
$button_image{'UPDATE'} = '';
$button_image{'HOME'} = '';
$button_image{'VIEW ORDERS'} = '';
$button_image{'CHECK OUT'} = '';
$button_image{'SECURE CHECK OUT'} = '';
$button_image{'SUBMIT'} = '';
$button_image{'SECURE SUBMIT'} = '';
$button_image{'PLACE ORDER'} = '';
$button_image{'SEARCH'} = '';
$button_image{'SEARCH CATALOG'} = '';
$button_image{'SHIPPING RATES'} = '';
$button_image{'CONTINUE SHOPPING'} = '';
###-----------------------------------------------------------
# If the WEIGHT or OPTION hidden input fields exist on the catalog page,
# then you MUST enter a value for the caption below, otherwise it must be blank (i.e. '').
$weight_caption = 'Weight'; # e.g. 'Weight'
$option1_caption = 'Color'; # e.g. 'Color'
$option2_caption = 'Size'; # e.g. 'Size'
$option3_caption = '';
$shipping_type = 'quantity'; ### shipping_type is either 'price' or 'quantity' or 'weight' or 'included'
### price or quantity means the minimum/maximum refers to total prices or total quantities respectively.
### '+' means add the Amount specified to the order total
### '*' means multiply the Amount times the Number of items ordered.
### '%' means take the given percentage of the total Amount ordered.
### Country, Ship via, Minimum, Maximum, Add or Multiply or Percentage, Amount ###
@Shipping_Rates = (
[$catalog_country, 'UPS Ground', 0, 2, '+', 5.00], ### Index must start at 0 in case $shipping_type='weight'
[$catalog_country, 'UPS Ground', 3, 5, '+', 10.00], ### Min. should be .01 more that prev max. if based on price
[$catalog_country, 'UPS Ground', 6, 99999999,'*', 2.00],
[$catalog_country, 'UPS Blue', 0, 2, '+', 10.00],
[$catalog_country, 'UPS Blue', 3, 5, '+', 15.00],
[$catalog_country, 'UPS Blue', 6, 99999999, '*', 3.00],
[$catalog_country, 'FedEx', 0, 99999999, '+', 10],
['ALL', 'Airborne Express',0, 2, '+', 7.00], ### 'ALL' applies to any country (but is overriden by $accept_any_country = 'no')
['ALL', 'Airborne Express',3, 99999999, '*', 5.00], ### 'ALL' applies to any country
['OTHER','DHL', 0, 3, '*', 5.00], ### Default for any country not specfically listed above.
['OTHER','DHL', 4, 99999999, '*', 4.00], ### Default for any country not specfically listed above.
);
$discount_type = 'quantity'; ### $discount_type is either 'quantity' or 'price' or 'none'.
@Discount_Rates = ( ### For no discount use: $discount_type = 'none';
[1, 3, 0.00], ### Min. should be .01 more that prev max. if based on price
[4, 99999999, 10.00],
);
@Tax_States = ("CT 6.00"); ### List of: State to Apply Tax to, and Tax Rate (NOT percentage!) separated by a singe space
### e.g. @Tax_States = ("NY 8.25", "CA 4.5");
$stay_on_page = 'no'; ### ('yes' or 'no') #if 'yes', adds cart to current page
### this default can be overriden by cgi input field StayOnPage = YES
${SO} = '<b>'; ${SE} = '</b>'; ### Starting/Ending highlight tag for search results
##########################################################################
############# END OF CUSTOMIZATION AREAS #########################
##########################################################################
###-----------------------------------------------------------
$action = $input{'ACTION'};
### Create a unique order ID for each user to pass along to each form
### and to use as the file title to store the items ordered
if ( (uc substr($action,0,5) eq 'ENTER') ||
(uc substr($action,0,5) eq 'GO TO') ||
( substr($action,0,2) eq '->') ||
( substr($action,0,1) eq '[') ) {
if ($input{'ORDER_ID'} eq '!ORDERID!')
{
$token_exists = 0;
if ((lc $use_cookies eq 'yes') && (defined($ENV{'HTTP_COOKIE'})) )
{
### RETRIEVE COOKIE HERE AND CHECK IF TOKEN & TEMP_ORDER
### STILL EXISTS AND ASK IF USER WANTS TO CONTINUE OLD ORDER
%Cookies = map split (/=/), split (/; /,$ENV{HTTP_COOKIE});
$unique_id = $Cookies{'orderid'};
if ( $unique_id !~ /\d{$id_length}?/ )
{&Transmission_error(0);}
$token_file_name = "$token_directory/$unique_id";
$order_file_name = "$temp_orders_directory/$unique_id";
$customer_file_name = "$temp_customers_directory/$unique_id";
if (-e $token_file_name) {
$token_exists = 1;
if (-e $order_file_name) {
unlink $customer_file_name;
print "\n";
print "<html>\n";
print "<head><title>Previous Order Selections</title></head>\n";
&add_menu_bar('CONTINUE SHOPPING');
&add_company_header;
($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime) = stat(_);
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($atime);
$mon++;
print "<center><b>You have an Existing Order placed on: $mon/$mday/$year, as Shown Below.<br>";
print "If you do <i>Not</i> want to finish this order Press the RESTART button to delete<br>";
print "this order and go to the first catalog page to start a new order.</b></center><br>";
print "<center><form method=post action=\"http://$cgi_prog_location\">";
print "<input type=hidden name=ORDER_ID value=$unique_id><center>";
if ($button_image{'RESTART'} eq '')
{print "<input type=submit name=ACTION value=\"RESTART\"></center>";}
else
{
print "<input type=hidden name=ACTION value=\"RESTART\">";
print "<input type=image name=dummy src=\"$image_location/$button_image{'RESTART'}\" border=0>";
}
print "<input type=hidden name=thispage value=$input{'THISPAGE'}>";
print "</form></center>";
print '<HR width="75%">';
$add_cart = 1;
$resuming_order = 1;
&view_cart;
&add_button_bar('CONTINUE SHOPPING');
&add_company_footer;
exit;
} #order file exists
} # token file exists
} ##using cookies and have a cookie
if ($token_exists == 0) {
srand(time() ^ ($$ + ($$ << 15)));
$rand_len = '9' x ($id_length - 3);
do {
$unique_id = &zero_fill(abs($$),3) . &zero_fill(int(rand($rand_len)),$id_length - 3);
$token_file_name = "$token_directory/$unique_id";
}
until (! (-e $token_file_name)); ### Now check if really unique (i.e. does it already exist?)
### Create a random token to use with SHA signature
$token = int(rand(1000000));
open(token_file, ">$token_file_name") || &err_trap("Cannot open $token_file_name for writing\n");
print(token_file "$token\n");
close token_file;
}
if (lc $use_cookies eq 'yes')
{
&create_cookie('orderid', $unique_id, $cookie_expire_days);
print "\n";
}
}
else
{&Transmission_error(1);}
}
else {
if ( (! defined $input{'ACTION'})
&& ((lc $online_credit_verify eq 'secureorder') || (lc $online_check_verify eq 'secureorder'))
&& ($ENV{'QUERY_STRING'} =~ /^(\d+)\&(a|i|d|b){1}?\&(.*)/i) )
{
if ($ENV{'HTTP_REFERER'} ne "http://$cgi_prog_location")
{&Transmission_error(2);}
if (length($1) > $id_length)
{$unique_id = substr($1, - $id_length);}
else
{$unique_id = '0' x ($id_length - length($1));
$unique_id .= $1;}
$SecureOrder_return_code = $2;
$SecureOrder_return_msg = $3;
if ($SecureOrder_return_code eq 'a')
{$action = 'PLACE ORDER';}
elsif ($SecureOrder_return_code eq 'd')
{
print "\n<html>\n";
print "<head><title>SecureOrder Error</title></head>\n";
print "<b><center>Sorry, your Charge was declined. ";
print "You can go back and try another card, or try again later.<br>Thank you.</center><br>";
exit;
}
else {
print "\n<html>\n";
print "<head><title>SecureOrder Error</title></head>\n";
print "<b><center>The following error was encounterd in attempting to process your ";
print "charge, please press your browser's BACK button, and go back and correct the information.<br>Thank you.</center><br>";
print "<br>Error: $SecureOrder_return_msg</b><br>";
exit;
}
}
else
{$unique_id = $input{'ORDER_ID'};}
if (($unique_id eq '!ORDERID!') || ( $unique_id !~ /\d{$id_length}?/ ))
{&Transmission_error(3);}
if (lc $use_cookies eq 'yes') {
if ($action eq 'RESTART')
{&create_cookie('orderid', $unique_id, $cookie_expire_days);} ## Reset Expiration date
elsif ($action eq 'PLACE ORDER')
{&create_cookie('orderid', $unique_id, -1);} ## 'delete' cookie
print "\n";
}
$token_file_name = "$token_directory/$unique_id";
if ( !(-e $token_file_name) )
{
print "<html>\n";
print "<head><title>Already Checked Out</title></head>\n";
print "<body>\n";
print "<h3>You cannot revise an order after checking out. You must enter the shop ";
print "again if you wish to order more items, or contact the merchant directly if you ";
print "need to cancel an order.</h3><br>";
print "<center>Press the button below if you wish to start a new shopping session.</center><br><br>";
$unique_id = '!ORDERID!';
&add_button_bar();
print "</body>\n";
print "</html>\n";
exit;
}
}
$order_file_name = "$temp_orders_directory/$unique_id";
$customer_file_name = "$temp_customers_directory/$unique_id";
$token_file_name = "$token_directory/$unique_id";
if (uc substr($action,0,6) eq 'SECURE')
{$image_location=$secure_image_location;}
if ( (uc substr($action,0,5) eq 'ORDER') ||
(uc substr($action,0,3) eq 'ADD') ||
(uc substr($action,0,3) eq 'PUT') ||
(uc substr($action,0,3) eq 'BUY') )
### write out the order to a file in comma delimited, quoted format (CSV)
{
### check for duplicates first
if (-e $order_file_name) {
open (order_file, $order_file_name)|| &err_trap( "Cannot open $order_file_name for reading\n" );
while (<order_file>) {
chop;
($order_id, $item_id, $item_name, $item_price, $item_qty, $item_weight, $item_taxtype, $item_option1, $item_option2, $item_option3) = split(/$delim/,$_);
&UnQuote($item_id); &UnQuote($item_option1); &UnQuote($item_option2); &UnQuote($item_option3); #Remove surrounding Quotation marks
$index="";
do {
if (! defined $input{'ITEM_OPTION1'.$index})
{$input{'ITEM_OPTION1'.$index} = "";}
if (! defined $input{'ITEM_OPTION2'.$index})
{$input{'ITEM_OPTION2'.$index} = "";}
if (! defined $input{'ITEM_OPTION3'.$index})
{$input{'ITEM_OPTION3'.$index} = "";}
if ( ($input{'QTY'.$index} > 0)
&& ($item_id eq $input{'ITEM_ID'.$index})
&& ($item_option1 eq $input{'ITEM_OPTION1'.$index})
&& ($item_option2 eq $input{'ITEM_OPTION2'.$index})
&& ($item_option3 eq $input{'ITEM_OPTION3'.$index}) )
{
print "<html>\n";
print "<head><title>Duplicate Item</title></head>\n";
print "<body>\n";
print "<center><h3>The Item: \"$input{'ITEM_NAME'.$index}\"";
if ($item_option1 ne "")
{print ", $item_option1";}
if ($item_option2 ne "")
{print ", $item_option2";}
if ($item_option3 ne "")
{print ", $item_option3";}
print ' Has Already Been Ordered!<br><br>';
print "You May Change the Quantity ordered by pressing the VIEW ORDERS button below.</h3><br></center>";
&add_button_bar('CONTINUE SHOPPING', 'VIEW ORDERS');
print "</body>\n";
print "</html>\n";
exit;
}
if ($index eq "")
{$index = 1;}
else
{$index++;}
} until (! defined $input{'ITEM_ID'.$index});
}#while order_file
close order_file;
}#if file exists
### Check if the Item # and Price have been tampered with !!!
if (-e $token_file_name) {
open(token_file, $token_file_name) || &err_trap("Cannot open token file: $token_file_name");
$token = <token_file>;
chop($token);
$index=""; $item_code=""; $items_ordered=0;
do {
&Check_Valid_Quantity($input{'QTY'.$index}, $input{'ITEM_NAME'.$index}); ### exit with err msg if not valid quantity
if ($input{'QTY'.$index} > 0)
{$items_ordered++;}
if (! defined $input{'ITEM_WEIGHT'.$index})
{$input{'ITEM_WEIGHT'.$index} = 0;}
if (! defined $input{'ITEM_TAXTYPE'.$index})
{$input{'ITEM_TAXTYPE'.$index} = "";}
$input{'ITEM_PRICE'.$index} = &UnCurrency($input{'ITEM_PRICE'.$index});
$item_code .= $input{'ITEM_ID'.$index} . $input{'ITEM_PRICE'.$index} . $input{'ITEM_WEIGHT'.$index} . $input{'ITEM_TAXTYPE'.$index};
if ($index eq "")
{$index = 1;}
else
{$index++;}
} until (! defined $input{'ITEM_ID'.$index});
$item_code = &SHA( $ENV{'REMOTE_ADDR'} . $item_code . $token);
if ($item_code ne $input{'ITEM_CODE'})
{&Transmission_error(4);}
}
if ($items_ordered == 0) {
print "<html>\n";
print "<head><title>No Items Ordered</title></head>\n";
print "<body>\n";
print "<center><h3>All Quantities Were Zero (0), Please go back and enter a valid ";
print "quantity for at least one item</h3></center>";
&add_button_bar('CONTINUE SHOPPING', 'VIEW ORDERS');
print "</body>\n";
print "</html>\n";
exit;
}
$index="";
open(order_file, ">>$order_file_name") || &err_trap("Cannot open $order_file_name for writing\n");
do {
if ($input{'QTY'.$index} > 0)
{
### now append the data to the file
if (! defined $input{'ITEM_WEIGHT'.$index})
{$input{'ITEM_WEIGHT'.$index} = 0;}
if (! defined $input{'ITEM_TAXTYPE'.$index})
{$input{'ITEM_TAXTYPE'.$index} = "";}
if (! defined $input{'ITEM_OPTION1'.$index})
{$input{'ITEM_OPTION1'.$index} = "";}
if (! defined $input{'ITEM_OPTION2'.$index})
{$input{'ITEM_OPTION2'.$index} = "";}
if (! defined $input{'ITEM_OPTION3'.$index})
{$input{'ITEM_OPTION3'.$index} = "";}
print(order_file "\"$unique_id\"$delim");
print(order_file "\"$input{'ITEM_ID'.$index}\"$delim");
print(order_file "\"$input{'ITEM_NAME'.$index}\"$delim");
print(order_file "\"$input{'ITEM_PRICE'.$index}\"$delim");
print(order_file "\"$input{'QTY'.$index}\"$delim");
print(order_file "\"$input{'ITEM_WEIGHT'.$index}\"$delim");
print(order_file "\"$input{'ITEM_TAXTYPE'.$index}\"$delim");
print(order_file "\"$input{'ITEM_OPTION1'.$index}\"$delim");
print(order_file "\"$input{'ITEM_OPTION2'.$index}\"$delim");
print(order_file "\"$input{'ITEM_OPTION3'.$index}\"\n");
}
if ($index eq "")
{$index = 1;}
else
{$index++;}
} until (! defined $input{'ITEM_ID'.$index});
### now output the order details page
close order_file;
if (($stay_on_page eq 'yes') || (uc $input{'STAYONPAGE'} eq 'YES'))
{$add_cart = 1;}
else
{
&view_cart;
exit;
}
}
elsif ($action eq 'VIEW ORDERS') {
&view_cart;
exit;
}
elsif ($action eq 'UPDATE') {
foreach $index(1..$input{'NUM_ITEMS'} - 1) {
&Check_Valid_Quantity($input{'QTY'.$index}, $input{'ITEM_NAME'.$index}); ### exit with err msg if not valid quantity
}
### update order file with updated order info
$tempfile = $order_file_name . '.bak';
rename($order_file_name, $tempfile);
open (order_file, $tempfile)|| &err_trap("Cannot open $order_file_name for reading\n");
open (out_file, ">$order_file_name");
$index = 1;
### if input item is not in order file, ignore it, View Orders page may have been tampered with
### and take all data except Quantity from input file, not from web page, to prevent tampering.
while (<order_file>) {
chop;
($order_id, $item_id, $item_name, $price, $quantity, $weight, $item_taxtype, $option1, $option2, $option3) = split(/$delim/,$_);
&UnQuote($item_id); &UnQuote($option1); &UnQuote($option2); &UnQuote($option3);
if ( ($item_id eq $input{'ITEM_ID'.$index})
&& ($option1 eq $input{'ITEM_OPTION1'.$index})
&& ($option2 eq $input{'ITEM_OPTION2'.$index})
&& ($option3 eq $input{'ITEM_OPTION3'.$index}) )
{
if ($input{'QTY'.$index} > 0) {
print(out_file "\"$unique_id\"$delim");
print(out_file "\"$item_id\"$delim");
print(out_file "$item_name$delim");
print(out_file "$price$delim");
print(out_file "\"$input{'QTY'.$index}\"$delim");
print(out_file "$weight$delim");
print(out_file "$item_taxtype$delim");
print(out_file "\"$option1\"$delim");
print(out_file "\"$option2\"$delim");
print(out_file "\"$option3\"\n");
}
}
$index += 1;
}
close out_file;
close order_file;
unlink $tempfile;
if ((($stay_on_page eq 'yes') || (uc $input{'STAYONPAGE'} eq 'YES')) && (! -e $customer_file_name))
{$add_cart = 1;}
else
{
&view_cart;
exit;
}
}
elsif (($action eq 'CHECK OUT') or ($action eq 'SECURE CHECK OUT')) {
&display_order_form;
exit;
}
elsif (($action eq 'SUBMIT') or ($action eq 'SECURE SUBMIT')) {
### Validate & Save Order (Shipping & Payment) info, and make sure
### it's linked to an Order Number! (i.e. that an order file exists).
&check_if_orders_exist;
&self_test;
$error_msg = "";
&require("First Name", $input{'FNAME'});
&require("Last Name", $input{'LNAME'});
&require("Street1", $input{'STREET1'});
&require("City", $input{'CITY'});
&require("State/Province", $input{'STATE'});
&require("Zip Code", $input{'ZIP'});
&check_country($input{'COUNTRY'});
&require("Country", $input{'COUNTRY'});
&require("Email Address", $input{'EMAIL'});
&check_zip($input{'ZIP'}, $input{'COUNTRY'});
$input{'STATE'} = &check_state($input{'STATE'}, $input{'COUNTRY'});
&check_email($input{'EMAIL'});
if (($input{'PAYBY'} eq 'CREDIT')
&& ((lc $online_credit_verify eq 'secureorder') || (lc $online_check_verify eq 'secureorder'))
&& (($input{'DPHONE'} eq '') && ($input{'NPHONE'} eq '')))
{&require("Daytime or Nighttime Phone", $input{'DPHONE'});}
$input{'DPHONE'} = &check_phone($input{'DPHONE'}, $input{'COUNTRY'});
$input{'NPHONE'} = &check_phone($input{'NPHONE'}, $input{'COUNTRY'});
$input{'FAX'} = &check_phone($input{'FAX'}, $input{'COUNTRY'});
if (not (exists $input{'PAYBY'})) {
$input{'PAYBY'} = uc @accept_payment_by[0];
}
if ($input{'PAYBY'} ne 'CREDIT') {
if ($input{'CARDNO'} ne "") {
$error_msg .= "<li>Credit Card number entered, but Pay By [Credit] not selected.";
}
}
else {
&require("Card Type", $input{'CARDTYPE'});
&require("Credit Card #", $input{'CARDNO'});
&require("Expiration Month", $input{'EXPMONTH'});
&require("Expiration Year", $input{'EXPYEAR'});
&check_card_num($input{'CARDNO'}, $input{'CARDTYPE'});
&check_expire_date($input{'EXPMONTH'}, $input{'EXPYEAR'});
}
if (($input{'STREET1'} =~ /(^.*[\s.]+|^)box\s+\d+/i )
&& ( substr($input{'SHIPTYPE'},0,3) eq 'UPS' ||
substr($input{'SHIPTYPE'},0,3) eq 'DHL' ||
substr($input{'SHIPTYPE'},0,5) eq 'FedEx') ) {
$error_msg .="<li>$input{'SHIPTYPE'} cannot ship to a P.O. Box. Enter a valid Street address.";
}
$country_uc = uc($input{'COUNTRY'});
$shipper_found = 0; $country_found = 0;
foreach $index(0..$#Shipping_Rates) {
($Ship_Country, $Shipper, $Ship_Min, $Ship_Max, $Ship_Mul, $Ship_Amt) = @{$Shipping_Rates[$index]};
if ( (($country_uc eq uc $Ship_Country) || ($Ship_Country eq 'ALL')) && ($input{'SHIPTYPE'} eq $Shipper) )
{$shipper_found = 1;}
if ($country_uc eq uc $Ship_Country)
{$country_found = 1;}
}
if ($shipper_found == 0) {
if ($accept_any_country eq 'no')
{$error_msg .= "<li>Orders from: $country_uc cannot be accepted at this time, Sorry.<br>";}
else {
### If country not in table, make sure Shipper entered is the one in the table for 'OTHER' (last one in table)
($Ship_Country, $Shipper, $Ship_Min, $Ship_Max, $Ship_Mul, $Ship_Amt) = @{$Shipping_Rates[$#Shipping_Rates]};
if (($input{'SHIPTYPE'} ne $Shipper) || ($country_found == 1))
{
$valid_shippers = "";
if ($country_found == 0)
{$valid_shippers = $Shipper;}
$prev_Shipper = "";
foreach $index(0..$#Shipping_Rates) {
($Ship_Country, $Shipper, $Ship_Min, $Ship_Max, $Ship_Mul, $Ship_Amt) = @{$Shipping_Rates[$index]};
if (((uc $Ship_Country eq 'ALL') || ($country_uc eq $Ship_Country)) && ($Shipper ne $prev_Shipper))
{
if ($valid_shippers eq "")
{$valid_shippers = $Shipper;}
else
{$valid_shippers .= ', or ' . $Shipper;}
}
$prev_Shipper = $Shipper;
}#foreach
$error_msg .= "<li>$input{'SHIPTYPE'} is not a valid Shipper for $country_uc, Only $valid_shippers is.<br>";
}#if
}#else
}#if
if ($error_msg ne "") {
print "<html>\n";
print "<head><title>Errors on Order Form</title></head>\n";
print "<body>\n";
print "<blockquote><h2>The Following Errors Were Encountered!</h2></blockquote><hr>";
print "<blockquote><i>Press your browser's BACK button to Go back to the CheckOut form and fix them. Thank you.</i></blockquote><hr>";
print "<ul><h3>$error_msg</ul></h3><hr>";
print "</body>\n";
print "</html>\n";
if ($testing ne 'yes') {
exit;
}
}
open(customer_file, ">$customer_file_name") || &err_trap("Cannot open $customer_file_name for writing\n");
print(customer_file "\"$unique_id\"$delim");
print(customer_file "\"$ENV{'REMOTE_ADDR'}\"$delim");
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$mon++;
if ( ($date_format eq 'mmddyyyy') ||($date_format eq 'ddmmyyyy') )
{&Year2000($year);}
if ($date_format eq 'mmddyy')
{print(customer_file "\"$mon$date_separator$mday$date_separator$year\"$delim");}
elsif ($date_format eq 'ddmmyy')
{print(customer_file "\"$mday$date_separator$mon$date_separator$year\"$delim");}
print(customer_file "\"$hour:$min:$sec\"$delim");
print(customer_file "\"$input{'TITLE'}\"$delim");
print(customer_file "\"$input{'FNAME'}\"$delim");
print(customer_file "\"$input{'LNAME'}\"$delim");
print(customer_file "\"$input{'COMPANY'}\"$delim");
print(customer_file "\"$input{'STREET1'}\"$delim");
print(customer_file "\"$input{'STREET2'}\"$delim");
print(customer_file "\"$input{'CITY'}\"$delim");
print(customer_file "\"$input{'STATE'}\"$delim");
print(customer_file "\"$input{'ZIP'}\"$delim");
print(customer_file "\"$input{'COUNTRY'}\"$delim");
print(customer_file "\"$input{'EMAIL'}\"$delim");
print(customer_file "\"$input{'DPHONE'}\"$delim");
print(customer_file "\"$input{'DEXTEN'}\"$delim");
print(customer_file "\"$input{'NPHONE'}\"$delim");
print(customer_file "\"$input{'NEXTEN'}\"$delim");
print(customer_file "\"$input{'FAX'}\"$delim");
print(customer_file "\"$input{'SHIPTYPE'}\"$delim");
print(customer_file "\"$input{'PAYBY'}\"$delim");
print(customer_file "\"$input{'CARDTYPE'}\"$delim");
print(customer_file "\"$input{'CARDNO'}\"$delim");
print(customer_file "\"$input{'EXPMONTH'}\"$delim");
print(customer_file "\"$input{'EXPYEAR'}\"$delim");
print(customer_file "\"$input{'SOURCE'}\"$delim");
$input{'SUGGEST'} =~ tr/\"\n\r/\` /d;
print(customer_file "\"$input{'SUGGEST'}\"$delim");
print(customer_file "\"$input{'FVPIN'}\"\n");
close customer_file;
&view_cart;
exit;
}
elsif ($action eq 'PLACE ORDER') {
&send_confirmation;
open (order_file, $order_file_name)|| &err_trap("Cannot open $order_file_name for reading\n");
open (out_file, ">$orders_directory/$unique_id");
while (<order_file>) {
if ($convert_delim_to_commas eq 'yes')
{$_ =~ eval "tr/$delim/,/";}
print(out_file $_);
}
close out_file;
open (customer_file, $customer_file_name)|| &err_trap("Cannot open $customer_file_name for reading\n");
open (out_file, ">$customers_directory/$unique_id");
while (<customer_file>) {
chop;
if ($convert_delim_to_commas eq 'yes')
{$_ =~ eval "tr/$delim/,/";}
$sub_total = sprintf("%.2f", $sub_total);
$tax = sprintf("%.2f", $tax);
$shipping = sprintf("%.2f", $shipping);
$grand_total = sprintf("%.2f", $grand_total);
$total_discount = sprintf("%.2f", $total_discount);
if ($Payby eq 'COD')
{$cod_charge = sprintf("%.2f", $cod_charge);}
else
{$cod_charge = 0;}
$Handling = sprintf("%.2f", $Handling);
print(out_file "$_,\"$sub_total\",\"$tax\",\"$shipping\",\"$grand_total\",\"$total_discount\",\"$cod_charge\",\"$Handling\"\n");
}
close out_file;
if ($testing ne 'yes')
{
unlink $token_file_name; ##delete token file
unlink $order_file_name;
unlink $customer_file_name;
}
exit;
}
elsif ($action eq 'SHIPPING RATES')
{
&show_shipping_rates;
exit;
}
elsif ($action eq 'SEARCH')
{
print "<html>\n";
print "<head><title>Search the Catalog</title></head>\n";
&add_menu_bar('CONTINUE SHOPPING');
&add_company_header;
&add_search_screen;
&add_company_footer;
exit;
}
elsif (($action eq 'SEARCH CATALOG') || ($input{'DOSEARCH'} eq 'SEARCH CATALOG'))
{
print "<html>\n";
print "<head><title>Search Results</title></head>\n";
&add_menu_bar('SEARCH', 'CONTINUE SHOPPING');
&add_company_header;
$found = 0;
$pattern = $input{'SEARCH STRING'};
if ($pattern eq "") {
print "<b>You did not enter a pattern to search for!<b>";
&add_button_bar('SEARCH', 'CONTINUE SHOPPING');
&add_company_footer;
exit;
}
if ($input{'REGEXP'} ne 'TRUE')
{$pattern = "\Q$pattern\E";}
if ($input{'MATCHWORD'} eq 'TRUE')
{$pattern = '(^|\b)+' . $pattern . '($|\b)+';}
if ($input{'MATCHCASE'} ne 'TRUE')
{$pattern = '(?i)' . $pattern;}
### Match pattern only if it is not part of a valid HTML tag, ###
### then Remove all HTML tags from matched line ###
$matches = 0;
&matchfile($catalog_directory);
if ($matches == 0)
{print "<br><h3>The pattern: \"$input{'SEARCH STRING'}\" was Not found!</h3><br>";}
else
{print '</table></center><br>';}
&add_search_screen;
&add_button_bar('CONTINUE SHOPPING');
&add_company_footer;
if ($create_search_log eq 'yes')
{&create_log("Searches", $input{'SEARCH STRING'}, $matches );}
exit;
}
elsif ($action eq 'RESTART')
{
unlink $order_file_name;
}
#------------------------------------------------------------------#
if (defined($input{'THISPAGE'})) { ### Send a catalog page back with the unique ID set
$prev_page = ""; $next_page= "";
if ($add_navigation eq 'yes') {
$catalog_page = "$catalog_directory/$input{'THISPAGE'}";
if (-e $catalog_page) {
open(TEMPLATE, $catalog_page) || &err_trap("cannot open template file: $catalog_page");
$temp = <TEMPLATE>;
if ($temp =~ /<(\!\-\-)?PSTAG\s+prevpage=(\w+\.?\w*)\s+nextpage=(\w+\.?\w*)\s*(\-\-)?>/i )
{$prev_page = $2; $next_page = $3;}
}
}
### process hidden form command [thispage xxxxx]
$result_page = &parse_file($catalog_page);
if ((-e $order_file_name) && (! -z _)) ###file found and is not empty
{&add_menu_bar('VIEW ORDERS', 'SEARCH');}
else
{&add_menu_bar('SEARCH');}
&add_company_header;
print $result_page;
if ($add_cart == 1)
{
print '<br><HR width="75%">';
&view_cart;
&add_button_bar('SEARCH');
}
else
{
if ((-e $order_file_name) && (! -z _)) ###file found and is not empty
{&add_button_bar('VIEW ORDERS', 'SEARCH');}
else
{&add_button_bar('SEARCH');}
}
&add_company_footer;
if ($create_page_log eq 'yes')
{&create_log("PageHits", $input{'THISPAGE'});}
}
exit;
#------------------------------------------------------------------#
sub parse_file {
my $catalog_page = $_[0];
my ($result_page, $item_id, $item_price, $item_qty, $item_name, $item_weight, $item_taxtype, $item_code, $index);
my $sizefmt = 'bytes';
my $timefmt ="%c";
my $ssi_errmsg='[an error occurred while processing this directive]';
local $_;
local *TEMPLATE;
sub process_ssi {
local $_;
$ssi_command = lc $1;
$ssi_arg = lc $3;
if (lc $2 eq 'file')
{$ssi_arg = "$catalog_directory/$ssi_arg";}
elsif (lc $2 eq 'virtual')
{$ssi_arg = "$ENV{'DOCUMENT_ROOT'}$ssi_arg";}
if ( ((lc $2 eq 'file' || lc $2 eq 'virtual')) && (! -e $ssi_arg) )
{$result_page = $ssi_errmsg;}
elsif ($ssi_command eq 'include')
{$result_page .= &parse_file($ssi_arg);}
elsif ($ssi_command eq 'fsize')
{
$size = -s $ssi_arg;
if (lc $sizefmt eq 'abbrev')
{$result_page .= int(($size / 1024) + 1) . ' Kbytes';}
else
{$result_page .= "$size bytes";}
}
elsif ($ssi_command eq 'flastmod')
{
($t,$t,$t,$t,$t,$t,$t,$t,$t,$nowtime,$t,$t,$t)=stat($ssi_arg);
$result_page .= &format_time($nowtime, $timefmt, 1);
}
elsif ($ssi_command eq 'config')
{
if ($2 eq 'errmsg')
{$ssi_errmsg = $ssi_arg;}
elsif ($2 eq 'sizefmt')
{
if ($ssi_arg eq 'bytes' || $ssi_arg eq 'abbrev')
{$sizefmt = $ssi_arg;}
else
{$result_page .= $ssi_errmsg;}
}
elsif ($2 eq 'timefmt')
{$timefmt = $ssi_arg;}
else
{$result_page .= $ssi_errmsg;}
}
elsif ($ssi_command eq 'echo')
{
if ($ssi_arg eq 'document_name')
{$result_page .= $input{'THISPAGE'};}
elsif ($ssi_arg eq 'document_uri')
{$result_page .= $catalog_page;}
elsif ($ssi_arg eq 'date_local')
{$result_page .= &format_time(time(), $timefmt, 1);}
elsif ($ssi_arg eq 'date_gmt')
{$result_page .= &format_time(time(), $timefmt, 0);}
elsif ($ssi_arg eq 'last_modified')
{
($t,$t,$t,$t,$t,$t,$t,$t,$t,$nowtime,$t,$t,$t)=stat($catalog_page);
$result_page .= &format_time($nowtime, $timefmt, 1);
}
}
elsif (($ssi_command eq 'exec') && (lc $allow_ssi_cgi eq 'yes'))
{
@lines = qx { "./$ssi_arg" };
foreach $line (@lines)
{$result_page .= $line;}
}
}
if (&check_file_title($catalog_page) == 0)
{
print $error_msg;
exit;
}
if (-e $catalog_page) {
open(TEMPLATE, $catalog_page) || &err_trap("cannot open template file: $catalog_page");
### read template file replacing !ORDERID! with the unique generated order ID
$item_id = ""; $item_price = ""; $item_qty = ""; $item_name=""; $item_weight = 0; $item_taxtype="";
if (-e $token_file_name) {
open(token_file, $token_file_name) || &err_trap("cannot open token file: $token_file_name");
$token = <token_file>;
chop($token);
}
$result_page = "";
while (<TEMPLATE>) {
s/(\"?)!MYWWW!([\.\-\_\/\w]*)(\"?)/\"http\:\/\/$server_address$2\"/ig;
s/(\"?)!MYURL!(\"?)/${1}http\:\/\/$cgi_prog_location$2/ig;
s/!ORDERID!/$unique_id/ig;
if ( /\<!\-\-\#(include|fsize|flastmod|config|echo|exec)\s+(file|virtual|errmsg|sizefmt|timefmt|var|cmd|cgi)\s*\=\s*\"(.*?)\" \-\-\>/i )
{&process_ssi;}
if (/<FORM{1}?\s+?/i) {
s/(\"?)!MYURL!(\"?)/\"http\:\/\/$cgi_prog_location\"/ig;
$result_page .= $_;
$_ = <TEMPLATE>;
$index = ""; $item_code="";
do {
if ( /\<!\-\-\#(include|fsize|flastmod|config|echo|exec)\s+(file|virtual|errmsg|sizefmt|timefmt|var|cmd|cgi)\s*\=\s*\"(.*?)\" \-\-\>/i )
{&process_ssi;}
elsif ( /ITEM_ID{1}?\s+VALUE\s*?=\s*?\"?([^\"]+)\"?/i)
{
$item_id = $1;
s/ITEM_ID/ITEM_ID$index/i;
}
elsif ( /ITEM_PRICE{1}?\s+VALUE\s*?=\s*?\"?([^\"]+)\"?/i)
{
$item_price = &UnCurrency($1);
if ($item_price !~ /(\d+\.\d{1,2}|\d+\.?|\.\d{1,2}){1}/)
{&error_trap("ITEM_PRICE ($1) format is not valid");}
s/ITEM_PRICE/ITEM_PRICE$index/i;
}
elsif ( /ITEM_NAME{1}?\s+VALUE\s*?=\s*?\"?([^\"]+)\"?/i)
{
$item_name=$1;
s/ITEM_NAME/ITEM_NAME$index/i;
}
elsif ( /NAME\s*?=\s*?QTY{1}?\s+VALUE\s*?=\s*?\"?(\d+\.\d+|\d+\.?|\.\d+){1}\"?/i)
{
$item_qty = $1;
s/NAME\s*?=\s*?QTY/NAME=QTY$index/i;
}
elsif ( /ITEM_WEIGHT{1}?\s+VALUE\s*?=\s*?\"?(\d+\.\d+|\d+\.?|\.\d+){1}\"?/i)
{
$item_weight = $1;
s/ITEM_WEIGHT/ITEM_WEIGHT$index/i;
}
elsif ( /ITEM_TAXTYPE{1}?\s+VALUE\s*?=\s*?\"?(\w+)\"?/i)
{
$item_taxtype = $1;
s/ITEM_TAXTYPE/ITEM_TAXTYPE$index/i;
}
elsif ($_ =~ s/ITEM_OPTION(\d)/ITEM_OPTION$1$index/i) {}
s/(\"?)!MYWWW!([\.\-\_\/\w]*)(\"?)/\"http\:\/\/$server_address$2\"/ig;
s/(\"?)!MYURL!(\"?)/\"http\:\/\/$cgi_prog_location\"/ig;
if (/<FORM{1}?\s+?/i)
{&err_trap("Found opening <FORM...> tag with no closing </FORM...> tag");}
if ($item_id ne "" && $item_price ne "" && $item_qty ne "" && $item_name ne "")
{
$item_code .= $item_id . $item_price . $item_weight . $item_taxtype;
$item_id=""; $item_price=""; $item_weight = 0; $item_qty = ""; $item_name=""; $item_taxtype="";
if ($index eq "")
{$index = 1;}
else
{$index++;}
}
if (/!ITEMCODE!/i)
{
if ($item_code eq "")
{&err_trap("!ITEMCODE! found before one of: ITEM_ID, ITEM_PRICE, ITEM_WEIGHT, ITEM_TAXTYPE.<br>Tags may be in wrong order, or Each tag may not be completely on a line by itself.");}
$item_code = &SHA( $ENV{'REMOTE_ADDR'} . $item_code . $token );
$_ =~ s/!ITEMCODE!/$item_code/igeo;
if ($index > 1)
{$_ .= '<INPUT TYPE=HIDDEN NAME=MULTIPART VALUE=TRUE>';}
}
$_ =~ s/!ORDERID!/$unique_id/igeo;
$result_page .= $_;
if (eof TEMPLATE)
{&err_trap("Unexpected EOF in file: $catalog_page. <FORM> without matching </FORM>?<br>\n");}
$_ = <TEMPLATE>;
} #do
until ( m|</FORM{1}?|i );
} #if
$result_page .= $_;
} #while
}
else { ### if the file is missing, send error message back.
print "<html>\n";
print "<head><title>Page Not Available</title></head>\n";
print "<body><h3>\n";
print "The page ($catalog_page) you have requested is not available.<br><br>";
$catalog_page = "";
&add_button_bar();
print "</body>\n";
print "</html>\n";
}
close TEMPLATE;
return $result_page;
}## parse_file
#------------------------------------------------------------------#
sub add_search_screen {
print "<br><center><hr width=75%></center><h3>\n";
print "Enter the pattern to search for in the box below.</h3>";
print "<form method=post action=\"http://$cgi_prog_location\"><pre>";
print "<p><b>Search Pattern: </b><INPUT TYPE=TEXT NAME=\"SEARCH STRING\" MAXLENGTH=45 SIZE=45></p><br>";
print '<p><b>Match Case? </b><INPUT TYPE=CHECKBOX NAME=MATCHCASE VALUE=TRUE></p><br>';
print '<p><b>Match Whole Word? </b><INPUT TYPE=CHECKBOX NAME=MATCHWORD VALUE=TRUE></p><br>';
print '<p><b>Find all hits on page? </b><INPUT TYPE=CHECKBOX NAME=MATCHALL VALUE=TRUE></p><br>';
print "<p><b>Treat as <a href=\"http://$server_address$catalog_home/perlre.html\">Regular Expression</a>? </b><INPUT TYPE=CHECKBOX NAME=REGEXP VALUE=TRUE></p><br>";
print "</pre><input type=hidden name=ORDER_ID value=$unique_id><center>";
if ($button_image{'SEARCH CATALOG'} eq '')
{print "<input type=submit name=ACTION value=\"SEARCH CATALOG\"></center>";}
else
{
print "<input type=hidden name=ACTION value=\"SEARCH CATALOG\">";
print "<input type=image name=dummy src=\"$image_location/$button_image{'SEARCH CATALOG'}\" border=0>";
}
print "</center><input type=hidden name=DOSEARCH value=\"SEARCH CATALOG\">"; ### in case 'enter' pressed istead of submit button
print "<input type=hidden name=thispage value=$input{'THISPAGE'}>";
print "</form><center><hr width=75%></center><br>";
}
#------------------------------------------------------------------#
sub view_cart {
&check_if_orders_exist;
if (-e $customer_file_name) {
open(customer_file, "$customer_file_name") || &err_trap("Cannot open $customer_file_name for reading\n");
$customer_data = <customer_file>;
chop($customer_data);
($id, $ip, $date, $time, $title, $first, $last, $company, $street1, $street2, $city, $state, $zip, $country, $email, $dphone, $dexten, $nphone, $nexten, $fax, $Shiptype, $Payby, $card_type, $card_no, $exp_mon, $exp_yr, $source, $suggest, $FVpin) = split(/$delim/, $customer_data);
&UnQuote($first);&UnQuote($last);&UnQuote($street1);&UnQuote($street2);&UnQuote($city);&UnQuote($state);&UnQuote($zip);&UnQuote($country);&UnQuote($email);&UnQuote($dphone);&UnQuote($nphone);&UnQuote($Shiptype);&UnQuote($Payby);&UnQuote($FVpin);&UnQuote($card_type);
&UnQuote($card_no);&UnQuote($exp_mon);&UnQuote($exp_yr);
if ((&UnQuote($ip) ne $ENV{'REMOTE_ADDR'}) && ($resuming_order != 1))
{&Transmission_error(5);}
}
$order_total = 0;
$total_quantity = 0;
$total_weight = 0;
$item_num = 1;
if ($add_cart != 1)
{
print "<html><title>Current Order Selections</title></head>\n";
&add_menu_bar('CONTINUE SHOPPING');
&add_company_header;
}
&load_orders; ##load orders file into an array
print "<form method=post action=\"http://$cgi_prog_location\">";
print "<center><table border=2><caption><font SIZE=+1>Current Order Selections</font></caption>";
print '<tr><th>Product ID</th><th>Product Name</th>';
$colspan = 4;
if ($weight_caption ne "")
{print "<th width=53>$weight_caption ($local_weight)</th>"; $colspan++;}
if ($option1_caption ne "")
{print "<th>$option1_caption</th>"; $colspan++;}
if ($option2_caption ne "")
{print "<th>$option2_caption</th>"; $colspan++;}
if ($option3_caption ne "")
{print "<th>$option3_caption</th>"; $colspan++}
print '<th>Unit Price</th><th>Qty</th><th>Item Total</th></tr>';
$col_width = $colspan;
foreach $taxtype (@taxtypes) { ### first display taxable items, then other taxtype (e.g. non-taxable) items
if ($#orders > 0) {
if ($taxtype eq "" && $#taxtypes > 0)
{
$col_width = $colspan + 1;
print "<tr><td colspan=$col_width align=center>** Taxable Items **</td></tr>";
}
elsif ($taxtype eq 'none')
{
$col_width = $colspan + 1;
print "<tr><td colspan=$col_width align=center>** NON Taxable Items **</td></tr>";
}
elsif ($taxtype ne "")
{
$col_width = $colspan + 1;
print "<tr><td colspan=$col_width align=center>** $taxtype Tax Items **</td></tr>";
}
}
$sub_total = 0;
LOOP: foreach $i (0 .. $#orders) {
($order_id, $item_id, $item_name, $price, $quantity, $weight, $item_taxtype, $option1, $option2, $option3) = @{$orders[$i]};
if (lc $item_taxtype ne $taxtype)
{next LOOP;}
print "<input type=hidden name=ITEM_ID$item_num value=\"$item_id\">";
print "<input type=hidden name=ITEM_NAME$item_num value=\"$item_name\">";
print "<input type=hidden name=ITEM_OPTION1$item_num value=\"$option1\">";
print "<input type=hidden name=ITEM_OPTION2$item_num value=\"$option2\">";
print "<input type=hidden name=ITEM_OPTION3$item_num value=\"$option3\">";
print "<tr align=\"right\">";
$total_weight += $weight * $quantity;
$item_total = $price * $quantity;
$sub_total = $sub_total + $item_total;
$item_total = Currency($item_total);
$price = Currency($price);
print "<td>$item_id</td><td align=left>$item_name</td>";
if ($weight_caption ne "")
{print "<td width=50 align=right>$weight</td>";}
if ($option1_caption ne "")
{
if ($option1 eq "")
{print "<td> </td>";}
else
{print "<td>$option1</td>";}
}
if ($option2_caption ne "")
{
if ($option2 eq "")
{print "<td> </td>";}
else
{print "<td>$option2</td>";}
}
if ($option3_caption ne "")
{
if ($option3 eq "")
{print "<td> </td>";}
else
{print "<td>$option3</td>";}
}
print "<td>$price</td>";
if (lc $allow_fractional_qty eq 'yes')
{$qtylen = 6;}
else
{$qtylen = 3;}
print "<td><input type=text name=QTY$item_num size=$qtylen MaxLength=$qtylen value=$quantity></td><td>$item_total</td>";
print "</tr>";
$item_num = $item_num + 1;
} ###foreach order detail
$sub_tot = Currency($sub_total);
print "<tr align=right><td colspan=$colspan>Sub Total: </td><td>$sub_tot</td></tr>";
if (&calculate_discount != 0)
{
print "<tr align=right><td colspan=$colspan>Discount of $Disc_Rate%: </td><td>$discount_currency</td></tr>";
$sub_tot = Currency($discount_total);
print "<tr align=right><td colspan=$colspan>Sub Total: </td><td>$sub_tot</td></tr>";
}
if (-e _) { ##customer file exists and has been opened.
if (&calculate_tax > 0)
{print "<tr align=right><td colspan=$colspan>$state State Tax @ $Tax_Rate%: </td><td>$tax_currency</td></tr>";}
if ($#taxtypes > 0) {
$tax_tot = Currency($tax_total);
print "<tr align=right><td colspan=$col_width>Sub Total: </td><td>$tax_tot</td></tr>";
}
}
} ###foreach $taxtype
if (-e _) ##customer file exists and has been opened.
{
if (&calculate_shipping > 0)
{print "<tr align=right><td colspan=$col_width>Shipping: </td><td>$shipping_currency</td></tr>";}
if ($Payby eq 'COD')
{print "<tr align=right><td colspan=$col_width>COD Charge: </td><td>$cod_currency</td></tr>";}
if ($Handling > 0)
{print "<tr align=right><td colspan=$col_width> Handling: </td><td>$Handling_currency</td></tr>";}
print "<tr align=right><td colspan=$col_width>Grand Total: </td><td>$grand_total_currency</td></tr>";
print "</table></center><br>";
$checkout_msg = "<li>If you wish to revise your shipping method or other payment info, press your browser's ";
$checkout_msg .= "BACK button, change the field(s) on the order form, then submit it again.<br>";
$checkout_msg .= "<li>If you are satisfied with your order, press the PLACE ORDER button now, and your order will be final.";
}
else {
print "</table></center><br>";
if ($shipping_type eq 'included')
{
print "<center><i>Tax will be added when you check out</i></center>";
print "<center><i>Shipping is already included in prices</i></center><br><br>";
}
else
{print "<center><i>Tax and Shipping will be added when you check out</i></center><br><br>";}
$checkout_msg = "<li>If have finished shopping, press the CHECK OUT button to enter your payment and shipping info.<br>";
if (lc $use_secure_server eq 'yes')
{$checkout_msg .= "<li>If your browser supports secure transmissions, press the SECURE CHECK OUT button instead.<br>";}
}
print "<strong><ul><li>To change your order, enter a new quantity, then press the UPDATE button.<br>";
print "<li>To Remove an item, change the quantity to 0 (zero), then press UPDATE.<br>";
print $checkout_msg;
if ($add_cart != 1)
{print "<li>If you wish to order more merchandise, press the CONTINUE SHOPPING button.<br></ul></strong>";}
else
{print '<br></ul></strong>';}
print "<input type=hidden name=ORDER_ID value=$unique_id>";
print "<input type=hidden name=NUM_ITEMS value=$item_num>";
print "<p><center><table border=0><tr><td>";
if ($button_image{'UPDATE'} eq '')
{print "<input type=submit name=ACTION value=\"UPDATE\">";}
else
{
print "<input type=hidden name=ACTION value=\"UPDATE\">";
print "<input type=image name=dummy src=\"$image_location/$button_image{'UPDATE'}\" border=0>";
}
print "</td><input type=hidden name=thispage value=$input{'THISPAGE'}>";
print '</form>'; ### Only update needs to send data back, so it's a separate <form>.
print '<td>';
if (-e _)
{
if ((uc $Payby eq "FIRST VIRTUAL") && (lc $accept_first_virtual eq 'yes'))
{
print "<form method=post action=\"$fv_aab_url\">";
$full_name = "$first $last";
print "<input type=hidden name=\"x-full-name\" value=\"$full_name\">";
print "<input type=hidden name=\"x-street-address\" value=\"$street1\">";
print "<input type=hidden name=\"x-street-address-2\" value=\"$street2\">";
print "<input type=hidden name=\"x-city\" value=\"$city\">";
print "<input type=hidden name=\"x-state\" value=\"$state\">";
print "<input type=hidden name=\"x-postal-code\" value=\"$zip\">";
print "<input type=hidden name=\"x-country\" value=\"$country\">";
print "<input type=hidden name=\"x-email-address\" value=\"$email\">";
if ($dphone ne "")
{print "<input type=hidden name=\"x-phone-number\" value=\"$dphone\">";}
elsif ($nphone ne "")
{print "<input type=hidden name=\"x-phone-number\" value=\"$nphone\">";}
print "<input type=hidden name=\"x-vpin\" value=\"$FVpin\">";
print "<input type=hidden name=\"x-inv-number\" value=\"$unique_id\">";
$grand_total = sprintf("%.2f", $grand_total);
print "<input type=hidden name=\"x-amount\" value=\"$grand_total\">";
print "<input type=hidden name=\"x-currency\" value=\"$local_currency\">";
print "<input type=hidden name=\"x-description\" value=\"miscl. \">";
print "<input type=hidden name=\"fv-human-email\" value=\"$company_email\">";
print "<input type=hidden name=\"fv-url\" value=\"http://$cgi_prog_location?ACTION=PLACE+ORDER\&ORDER_ID=$unique_id\">";
print "<input type=hidden name=\"fv-seller\" value=\"$fv_seller_pin\">";
print "<input type=hidden name=\"fv-ips\" value=\"$fv_ips\">";
print "<input type=hidden name=\"fv-notification-cc\" value=\"$mail_order_to\">";
}
elsif ( ((lc $online_credit_verify eq 'secureorder') && (uc $Payby eq 'CREDIT'))
|| ((lc $online_check_verify eq 'secureorder') && ( $Payby =~ /CHECK/i )) )
{
if (uc $Payby eq 'CREDIT')
{print "<form method=post action=\"$SecureOrder_credit_url\">";}
else
{print "<form method=post action=\"$SecureOrder_check_url\">";}
print "<INPUT TYPE=HIDDEN NAME=MSP VALUE=\"VersaNet_MSP1.0\">";
print "<INPUT TYPE=HIDDEN NAME=MSP VALUE=\"BLANK\">";
print "<INPUT TYPE=HIDDEN NAME=MSP VALUE=\"BLANK\">";
$item_num--;
print "<INPUT TYPE=HIDDEN NAME=MSP VALUE=\"$item_num\">";
foreach $i (0 .. $#orders) {
($order_id, $item_id, $item_name, $price, $quantity) = @{$orders[$i]};
print "<INPUT TYPE=HIDDEN NAME=prod_id VALUE=\"$item_id\">";
print "<INPUT TYPE=HIDDEN NAME=name VALUE=\"$item_name\">";
print "<INPUT TYPE=HIDDEN NAME=quant VALUE=\"$quantity\">";
print "<INPUT TYPE=HIDDEN NAME=price VALUE=\"$price\">";
}
$grand_total = sprintf("%.2f", $grand_total);
print "<INPUT TYPE=HIDDEN NAME=AMOUNT VALUE=\"$grand_total\">";
if (uc $Payby eq 'CREDIT')
{
$card_type = uc $card_type;
if ($card_type =~ /Master|MC/i )
{$card_type = "MC";}
elsif ($card_type =~ /AM.*?EX/i )
{$card_type = "AMEX";}
elsif ($card_type =~ /DISC/i )
{$card_type = "DISC";}
print "<INPUT TYPE=HIDDEN NAME=PAYMENT VALUE=\"$card_type\">";
}
else
{print "<INPUT TYPE=HIDDEN NAME=PAYMENT VALUE=\"PCHK\">";}
$oid = '0' x (10 - length($order_id)) . $order_id;
print "<INPUT TYPE=HIDDEN NAME=ORDER_ID VALUE=\"$oid\">";
print "<INPUT TYPE=HIDDEN NAME=MERCHANT VALUE=\"$company_name\">";
print "<INPUT TYPE=HIDDEN NAME=MER_ID VALUE=\"$SecureOrder_id\">";
print "<INPUT TYPE=HIDDEN NAME=MER_EMAIL VALUE=\"$company_email\">";
print "<INPUT TYPE=HIDDEN NAME=TYPE_ACCT VALUE=\"E\">";
print "<INPUT TYPE=HIDDEN NAME=MER_URL VALUE=\"http://$cgi_prog_location\">";
print "<INPUT TYPE=HIDDEN NAME=ACC_URL VALUE=\"http://$cgi_prog_location\">";
print "<INPUT TYPE=HIDDEN NAME=DEN_URL VALUE=\"http://$cgi_prog_location\">";
print "<input type=HIDDEN NAME=RECUR value=\"\">";
print "<input type=HIDDEN NAME=NUM_TIMES value=\"(null)\">";
$full_name = "$first $last";
print "<INPUT TYPE=HIDDEN NAME=CC_NAMEON VALUE=\"$full_name\">";
print "<INPUT TYPE=HIDDEN NAME=CC_NUMBER VALUE=\"$card_no\">";
my (@day_of_month) = ( "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December" );
$exp_mon_txt = $day_of_month[$exp_mon - 1];
print "<INPUT TYPE=HIDDEN NAME=EXP_MON VALUE=\"$exp_mon_txt\">";
$exp_yr_2000 = &Year2000($exp_yr);
print "<INPUT TYPE=HIDDEN NAME=EXP_YEAR VALUE=\"$exp_yr_2000\">";
print "<INPUT TYPE=HIDDEN NAME=NAME VALUE=\"$full_name\">";
print "<INPUT TYPE=HIDDEN NAME=CUST_EMAIL VALUE=\"$email\">";
if ($dphone ne "")
{$phone = $dphone;}
elsif ($nphone ne "")
{$phone = $nphone;}
else {$phone = "";}
$phone =~ /[(\s]*(\d{3}?)[)\s]*(\d{3}?)[-\s]*(\d{4}?)/;
$area_code = $1;
$prefix = $2;
$suffix = $3;
print "<INPUT TYPE=HIDDEN NAME=PHONE_AREA VALUE=\"$area_code\">";
print "<INPUT TYPE=HIDDEN NAME=PHONE_PRE VALUE=\"$prefix\">";
print "<INPUT TYPE=HIDDEN NAME=PHONE_SUFF VALUE=\"$suffix\">";
print "<INPUT TYPE=HIDDEN NAME=CK_DLNUM VALUE=\"\">";
## Billing Address
print "<INPUT TYPE=HIDDEN NAME=ADD1 VALUE=\"$street1\">";
print "<INPUT TYPE=HIDDEN NAME=ADD2 VALUE=\"$street2\">";
print "<INPUT TYPE=HIDDEN NAME=CITY VALUE=\"$city\">";
print "<INPUT TYPE=HIDDEN NAME=STATE VALUE=\"$state\">";
print "<INPUT TYPE=HIDDEN NAME=COUNTRY VALUE=\"$country\">";
print "<INPUT TYPE=HIDDEN NAME=ZIP1 VALUE=\"$zip\">";
print "<INPUT TYPE=HIDDEN NAME=ZIP2 VALUE=\"\">";
print "<INPUT TYPE=HIDDEN NAME=\"same_as_bill\" VALUE=\"same_as_bill\">";
## Shipping Address
print "<INPUT TYPE=HIDDEN NAME=SHIPNAME VALUE=\"\">";
print "<INPUT TYPE=HIDDEN NAME=SHIPADD1 VALUE=\"\">";
print "<INPUT TYPE=HIDDEN NAME=SHIPADD2 VALUE=\"\">";
print "<INPUT TYPE=HIDDEN NAME=SHIPCITY VALUE=\"\">";
print "<INPUT TYPE=HIDDEN NAME=SHIPSTATE VALUE=\"\">";
print "<INPUT TYPE=HIDDEN NAME=SHIPCOUNTRY VALUE=\"\">";
print "<INPUT TYPE=HIDDEN NAME=SHIPZIP1 VALUE=\"\">";
print "<INPUT TYPE=HIDDEN NAME=SHIPZIP2 VALUE=\"\">";
}
else
{
print "<form method=post action=\"http://$cgi_prog_location\">";
print "<input type=hidden name=ORDER_ID value=$unique_id>";
print "<input type=hidden name=thispage value=$input{'THISPAGE'}>";
}
if ($button_image{'PLACE ORDER'} eq '')
{print "<input type=submit name=ACTION value=\"PLACE ORDER\">";}
else
{
print "<input type=hidden name=ACTION value=\"PLACE ORDER\">";
print "<input type=image name=dummy src=\"$image_location/$button_image{'PLACE ORDER'}\" border=0>";
}
print "</td></form>";
}
else
{
print "<form method=post action=\"http://$cgi_prog_location\">";
print "<input type=hidden name=ORDER_ID value=$unique_id>";
print "<input type=hidden name=thispage value=$input{'THISPAGE'}>";
if ($button_image{'CHECK OUT'} eq '')
{print "<input type=submit name=ACTION value=\"CHECK OUT\">";}
else
{
print "<input type=hidden name=ACTION value=\"CHECK OUT\">";
print "<input type=image name=dummy src=\"$image_location/$button_image{'CHECK OUT'}\" border=0>";
}
print "</td></form>";
if (lc $use_secure_server eq 'yes') {
print "<td><form method=post action=\"$secure_prog_location\">";
print "<input type=hidden name=ORDER_ID value=$unique_id>";
print "<input type=hidden name=thispage value=$input{'THISPAGE'}>";
if ($button_image{'SECURE CHECK OUT'} eq '')
{print "<input type=submit name=ACTION value=\"SECURE CHECK OUT\">";}
else
{
print "<input type=hidden name=ACTION value=\"SECURE CHECK OUT\">";
print "<input type=image name=dummy src=\"$image_location/$button_image{'SECURE CHECK OUT'}\" border=0>";
}
print "</td></form>";
}
}
print "<form method=post action=\"http://$cgi_prog_location\">";
print "<input type=hidden name=ORDER_ID value=$unique_id>";
print "<input type=hidden name=thispage value=$input{'THISPAGE'}>";
if ($add_cart != 1)
{
print '<td>';
if ($button_image{'CONTINUE SHOPPING'} eq '')
{print "<input type=submit name=ACTION value=\"CONTINUE SHOPPING\">";}
else
{
print "<input type=hidden name=ACTION value=\"CONTINUE SHOPPING\">";
print "<input type=image name=dummy src=\"$image_location/$button_image{'CONTINUE SHOPPING'}\" border=0>";
}
print '</td>';
}
if ($shipping_type ne 'included')
{
print '<td>';
if ($button_image{'SHIPPING RATES'} eq '')
{print "<input type=submit name=ACTION value=\"SHIPPING RATES\">";}
else
{
print "<input type=hidden name=ACTION value=\"SHIPPING RATES\">";
print "<input type=image name=dummy src=\"$image_location/$button_image{'SHIPPING RATES'}\" border=0>";
}
print '</td>';
}
print '</form>';
if ($add_cart != 1)
{
print "<form method=GET action=\"http://$server_address$catalog_home/$home_page\"><td>";
if ($button_image{'HOME'} eq '')
{print "<input type=submit name=ACTION value=\"HOME\">";}
else
{
print "<input type=hidden name=ACTION value=\"HOME\">";
print "<input type=image name=dummy src=\"$image_location/$button_image{'HOME'}\" border=0>";
}
print '</td></form>';
}
print '</tr></table></center>';
if ($add_cart != 1)
{
&add_company_footer;
exit;
}
}
#------------------------------------------------------------------#
sub add_company_footer {
print '<p>';
if ($home_icon ne "")
{print "<a href=\"http://$server_address$catalog_home/$home_page\"><img src=\"$image_location/$home_icon\" border=0></a>";}
print "<center><address><a href=\"http://$server_address$catalog_home/$home_page\">$company_name</a><br>$company_address<br>";
print "<a HREF=\"mailto:$company_email\">$company_email</a></address><center>";
print "<hr width=\"100%\"><div align=right><a href=\"http://www.arpanet.com/PerlShop/PerlShop.html\"><img src=\"$image_location/perllogo.gif\" border=0 height=51 width=171></a></div>";
print "</p></body></html>";
}
#------------------------------------------------------------------#
sub add_company_header {
$body = "";
if ($text_color ne "") { $body .= "text=\"$text_color\" ";}
if ($background_color ne "") { $body .= "bgcolor=\"$background_color\" ";}
if ($link_color ne "") { $body .= "link=\"$link_color\" ";}
if ($vlink_color ne "") { $body .= "vlink=\"$vlink_color\" ";}
if ($alink_color ne "") { $body .= "alink=\"$alink_color\" ";}
if ($background ne "") { $body .= "background=\"$image_location/$background\" ";}
print "<body $body >";
print $menu_bar; ### must be after <body ...> tag.
if ($banner ne "") {
$banner = "<img src=\"$image_location/$banner\" ";
if ($align ne "") { $banner = "<div align=$align>$banner";}
if ($hspace ne "") { $banner .= "hspace=$hspace ";}
if ($vspace ne "") { $banner .= "vspace=$vspace ";}
if ($border ne "") { $banner .= "border=$border ";}
if ($height ne "") { $banner .= "height=$height ";}
if ($width ne "") { $banner .= "width=$width ";}
$banner .= '>';
if ($align ne "") { $banner .= "</div>";}
print $banner;
}
}
#------------------------------------------------------------------#
sub display_order_form {
print "<HTML><HEAD><TITLE>Order Form</TITLE></HEAD>";
if ($shipping_type ne 'included')
{&add_menu_bar('CONTINUE SHOPPING', 'VIEW ORDERS', 'SHIPPING RATES');}
else
{&add_menu_bar('CONTINUE SHOPPING', 'VIEW ORDERS');}
&add_company_header;
if ($action eq 'SECURE CHECK OUT')
{print "<FORM METHOD=POST ACTION=\"$secure_prog_location\">";}
else
{print "<FORM METHOD=POST ACTION=\"http://$cgi_prog_location\">";}
if (@valid_credit_cards[0] ne "")
{$cc_msg1 = "If paying by credit,";
$cc_msg2 = "must match name on card.";}
print <<"END_PRINT";
<INPUT TYPE=HIDDEN NAME=ORDER_ID VALUE=$unique_id>
<I>Enter your shipping and payment information below, then press submit. </I>
<HR>
<I>Shipping Address:</I>
<PRE>
<B> Title</B>: <select NAME="title"><option SELECTED>Mr.<option>Mrs.<option>Miss.<option>Ms.<option>Dr.</select>
<B> First Name</B>: <INPUT NAME="Fname" MAXLENGTH="40" SIZE="40"> $cc_msg1
<B> Last Name</B>: <INPUT NAME="Lname" MAXLENGTH="40" SIZE="40"> $cc_msg2
<B> Company</B>: <INPUT NAME="company" MAXLENGTH="40" SIZE="40">
<B> Street1</B>: <INPUT NAME="street1" MAXLENGTH="40" SIZE="40">
<B> Street2</B>: <INPUT NAME="street2" MAXLENGTH="40" SIZE="40">
<B> City</B>: <INPUT NAME="city" MAXLENGTH="40" SIZE="40">
<B> State/Province</B>: <INPUT NAME="state" MAXLENGTH="20" SIZE="20">
<B> Zip Code</B>: <INPUT NAME="zip" MAXLENGTH="15" SIZE="15">
END_PRINT
print "<B> Country</B>: <INPUT NAME=\"country\" VALUE=\"$catalog_country\" MAXLENGTH=\"2\" SIZE=\"2\"> <a href=\"http://$server_address$catalog_home/country.html\">[Country Code List]</a><br>";
print <<"END_PRINT";
<B> Email Address</B>: <INPUT NAME="email" MAXLENGTH="60" SIZE="40">
<B> Daytime Phone</B>: <INPUT NAME="Dphone" MAXLENGTH="15" SIZE="15"><B> Extension: </B><INPUT NAME="Dexten" MAXLENGTH="6" SIZE="6">
<B>Nighttime Phone</B>: <INPUT NAME="Nphone" MAXLENGTH="15" SIZE="15"><B> Extension: </B><INPUT NAME="Nexten" MAXLENGTH="6" SIZE="6">
<B> Fax</B>: <INPUT NAME="fax" MAXLENGTH="40" SIZE="40">
</PRE>
<HR>
END_PRINT
print '<I>Payment Information:</I><br>';
if ($#accept_payment_by > 0) {
print '<pre><b>Pay by: </b>';
$checked = 'checked';
foreach $accept_by (@accept_payment_by) {
$accept_by_uc = uc($accept_by);
print "$accept_by:<input type=radio name=\"Payby\" value=\"$accept_by_uc\" $checked> ";
$checked = "";
}
print '</pre>';
}
if (lc $accept_first_virtual eq "yes") {
print '<HR><PRE>';
print "<B>First VirtualPIN: </B><input type=text name=FVpin value=\"\" size=30><br>";
print "If you select Pay by First Virtual, but don't have an account yet, just leave<br>";
print "the PIN field blank and you'll be prompted later to apply for an account.";
print '</PRE><HR>';
}
if (@valid_credit_cards[0] ne "") {
print '<PRE>';
$checked = 'SELECTED';
print '<B> Card Type</B>: <select NAME="Cardtype">';
foreach $credit_card (@valid_credit_cards) {
print "<option $checked>$credit_card";
$checked = "";
}
print '</select><br>';
print '<B> Credit Card #</B>: <INPUT NAME="Cardno" MAXLENGTH="40" SIZE="40"><br>';
print '<B>Expiration Date</B>: <B>Month (e.g."07") </B><INPUT NAME="Expmonth" MAXLENGTH="2" SIZE="2"><B> Year (e.g."96") </B><INPUT NAME="Expyear" MAXLENGTH="2" SIZE="2"><br>';
print '</PRE><HR>';
}
if ($shipping_type ne "included") {
print '<I>Shipping Information:</I>';
print '<PRE>';
print '<B> Ship via</B>: <select NAME="Shiptype"><option SELECTED>';
($Ship_Country, $Shipper, $Ship_Min, $Ship_Max, $Ship_Mul, $Ship_Amt) = @{$Shipping_Rates[0]};
print $Shipper;
$ship_option = $Shipper;
foreach $index (0..$#Shipping_Rates)
{
($Ship_Country, $Shipper, $Ship_Min, $Ship_Max, $Ship_Mul, $Ship_Amt) = @{$Shipping_Rates[$index]};
if ($ship_option ne $Shipper)
{
$ship_option = $Shipper;
print "<option>$Shipper";
}
}
print '</select><br>';
print '</PRE><HR>';
}
if ($action eq 'SECURE CHECK OUT')
{$secure_text = 'SECURE SUBMIT';}
else
{$secure_text = 'SUBMIT';}
print <<"END_PRINT";
<h2>optional:</h2>
<p>Where did you hear about our site: <input TYPE="text" NAME="source"></p>
<p><b>Suggestions:</b> </p>
<p><textarea NAME="Suggest" ROWS="5" COLS="65"></textarea></p>
<p><i>(Press $secure_text to see Order totals, you can return back to this form to revise Payment and Shipping info before finalizing your order)</i></p>
<input type="submit" name=ACTION value="$secure_text">
<input type=hidden name=thispage value=$input{'THISPAGE'}>
<input type=reset value="CLEAR"></p>
</FORM>
<HR>
END_PRINT
if ($shipping_type ne 'included')
{&add_button_bar('CONTINUE SHOPPING', 'VIEW ORDERS', 'SHIPPING RATES');}
else
{&add_button_bar('CONTINUE SHOPPING', 'VIEW ORDERS');}
&add_company_footer;
}
#------------------------------------------------------------------#
sub check_if_orders_exist {
if ((not -e $order_file_name) or (-z _)) { ###file not found or is empty
print "<html>\n";
print "<head><title>No Items Ordered</title></head>\n";
print "<body><h3>\n";
if (-z _) {
print "You have deleted all your Items!<br>";
}
else {
print "No Items Have Been Ordered Yet!<br>";
}
&add_button_bar('CONTINUE SHOPPING');
print "</body>\n";
print "</html>\n";
exit;
}
}
#------------------------------------------------------------------#
sub self_test { ### verify consistancy of internal tables
if (&SHA("squeamish ossifrage\n") ne "82055066 4cf29679 2b38d164 7a4d8c0e 1966af57")
{&error_trap("SHA function is not working!<br>");}
if (! (($date_format eq 'mmddyy') || ($date_format eq 'ddmmyy')))
{&error_trap("Invalid date format: $date_format, must be mmddyy or ddmmyy !!<br>");}
if (! (($mail_via eq 'sendmail') || ($mail_via eq 'blat') || ($mail_via eq 'sockets')))
{&error_trap("Unknown Mail program: $mail_via !!!<br>");}
$discount_type = lc $discount_type;
if (! ( ($discount_type eq 'price') ||
($discount_type eq 'quantity') ||
($discount_type eq 'none') ))
{&error_trap("\$discount_type=$discount_type, is not valid.<br>");}
if ($discount_type ne 'none') {
if ($discount_type eq 'price' || lc $allow_fractional_qty eq 'yes')
{$discount_precision = 0.01;}
else
{$discount_precision = 1;}
($prev_Disc_Min, $prev_Disc_Max, $prev_Disc_Amt) = @{$Discount_Rates[0]};
foreach $index(1..$#Discount_Rates) {
($Disc_Min, $Disc_Max, $Disc_Amt) = @{$Discount_Rates[$index]};
if ($Disc_Min != $prev_Disc_Max + $discount_precision)
{&error_trap("Entire range (1 to 99999999) In Discount Table Not Covered!<br>");}
($prev_Disc_Min, $prev_Disc_Max, $prev_Disc_Amt) = @{$Discount_Rates[$index]};
}
if ($prev_Disc_Max != 99999999)
{&error_trap("Last Value in Range in Discount_Rates table not equal to 99999999!<br>");}
}
$shipping_type = lc $shipping_type;
if (! ( ($shipping_type eq 'price') ||
($shipping_type eq 'quantity') ||
($shipping_type eq 'weight') ||
($shipping_type eq 'included') ))
{&error_trap("\$shipping_type=$shipping_type, is not valid.<br>");}
if ($shipping_type ne 'included') {
if ($accept_any_country eq 'yes') {
($Ship_Country, $Shipper, $Ship_Min, $Ship_Max, $Ship_Mul, $Ship_Amt) = @{$Shipping_Rates[$#Shipping_Rates]};
if (uc $Ship_Country ne 'OTHER')
{&error_trap('$accept_any_country = "yes", but no "OTHER" entry exists in shipping table!<br>');}
}
($prev_Ship_Country, $prev_Shipper, $prev_Ship_Min, $prev_Ship_Max, $prev_Ship_Mul, $prev_Ship_Amt) = @{$Shipping_Rates[0]};
if (($prev_Ship_Mul eq '%') && ($shipping_type ne 'price'))
{&error_trap('Cannot have "%" with shipping type = "price" in shipping table!<br>');}
if ($prev_Ship_Min != 0)
{&error_trap("First Value in Range for: $Ship_Country not equal to 0 (Zero)!<br>");}
$has_ALL_entry = 0;
if (uc $prev_Ship_Country eq 'ALL')
{$has_ALL_entry = 1;}
if ($shipping_type eq 'price')
{$shipping_precision = 0.01;}
else
{$shipping_precision = 1;}
foreach $index(1..$#Shipping_Rates) {
($Ship_Country, $Shipper, $Ship_Min, $Ship_Max, $Ship_Mul, $Ship_Amt) = @{$Shipping_Rates[$index]};
if ($Ship_Country eq $prev_Ship_Country && $Shipper eq $prev_Shipper) {
if ($Ship_Min != $prev_Ship_Max + $shipping_precision)
{&error_trap("Entire range (0 to 99999999) for: [$Ship_Country + $Shipper] not covered!<br>");}
}
else
{
if ($Ship_Min != 0)
{&error_trap("First Value in Range for: $Ship_Country not equal to 0 (Zero)!<br>");}
if ($prev_Ship_Max != 99999999)
{&error_trap("Last Value in Range for: $prev_Ship_Country not equal to 99999999!<br>");}
}
if (($Ship_Mul eq '%') && ($shipping_type ne 'price'))
{&error_trap('Cannot have "%" with shipping type = "price" in shipping table!<br>');}
if (uc $Ship_Country eq 'ALL')
{$has_ALL_entry = 1;}
($prev_Ship_Country, $prev_Shipper, $prev_Ship_Min, $prev_Ship_Max, $prev_Ship_Mul, $prev_Ship_Amt) = @{$Shipping_Rates[$index]};
}
if ($accept_any_country eq 'yes') {
($Ship_Country, $Shipper, $Ship_Min, $Ship_Max, $Ship_Mul, $Ship_Amt) = @{$Shipping_Rates[$#Shipping_Rates]};
if ((uc $Ship_Country ne 'OTHER') && ($has_ALL_entry ==0))
{&error_trap('$accept_any_country = "yes", but no "OTHER" or "ALL" entry exists in shipping table!<br>');}
}
}
}
#------------------------------------------------------------------#
sub Currency {
my $price = $_[0];
$price = sprintf("%.2f", $price);
if ($currency_decimal ne '.')
{$price =~ s/\./$currency_decimal/;}
while ($price =~ s/(\d)(\d\d\d)(?!\d)/$1$currency_separator$2/g) {}
$price = $currency_symbol . $price;
return $price;
}
#------------------------------------------------------------------#
sub UnCurrency {
my $price = $_[0];
$price =~ tr/0-9.$,/0-9./d;
return $price;
}
#------------------------------------------------------------------#
### Check for valid input data (user can only change quantity).
### Must be a valid integer, and be greater than zero (unless UPDATE pressed).
sub Check_Valid_Quantity {
my $num = $_[0]; my $item = $_[1];
if ( (lc $allow_fractional_qty eq 'no' && ($num =~ /\D{1,}?/))
or (lc $allow_fractional_qty eq 'yes' && ($num !~ /(\d+\.\d+|\d+\.?|\.\d+){1}/))
or (($action ne "UPDATE") and ($input{'MULTIPART'} ne 'TRUE') and ($num == 0))) {
print "<html>\n";
print "<head><title>Bad Value for Quantity Field</title></head>\n";
print "<body>\n";
print "<h3>The data: \"$num\" in the QUANTITY field ";
print "for the Item: \"$item\" is not a valid Quantity!<br>";
print "Press your browser's BACK button to go back and enter a valid Quantity.</h3>";
print "</body>\n";
print "</html>\n";
exit;
}
}
#------------------------------------------------------------------#
sub Transmission_error {
my $errnum = $_[0];
print "\nInvalid Transmission \#$errnum received from: $ENV{'REMOTE_ADDR'}<br>";
print "If your connection was interrupted, you must Enter the shop from the beginning again.";
exit;
}
#------------------------------------------------------------------#
sub UnQuote {
my $Param = $_[0];
if ($Param ne "")
{$_[0] = substr($Param,1,length($Param) - 2);} #Remove surrounding Quotation marks
}
#------------------------------------------------------------------#
sub send_confirmation {
### display confirmation screen with customer & order info, and the
### date & time of the order, and the order number.
&check_if_orders_exist;
my $padlen = 0;
$confirm = "";
@company_addr = split(/<br>/, $company_address);
$confirm .= '<pre>' . ¢er($company_name) . '<br>';
foreach $company_line (@company_addr) {
$confirm .= ¢er($company_line) . '<br>';
}
$confirm .= "</pre>";
open(customer_file, "$customer_file_name") || &err_trap("Cannot open $customer_file_name for reading\n");
$customer_data = <customer_file>;
chop($customer_data);
($id, $ip, $date, $time, $title, $first, $last, $company, $street1, $street2, $city, $state, $zip, $country, $email, $dphone, $dexten, $nphone, $nexten,$fax,$Shiptype,$Payby,$Cardtype, $Cardno, $Expyr, $Expmo, $Source, $Suggest) = split(/$delim/, $customer_data);
if (&UnQuote($ip) ne $ENV{'REMOTE_ADDR'})
{&Transmission_error(6);}
&UnQuote($id);&UnQuote($date);&UnQuote($time);&UnQuote($title);&UnQuote($first);&UnQuote($last);&UnQuote($company);&UnQuote($street1);&UnQuote($street2);&UnQuote($city);&UnQuote($state);
&UnQuote($zip);&UnQuote($country);&UnQuote($email);&UnQuote($dphone);&UnQuote($dexten);&UnQuote($nphone);&UnQuote($nexten);&UnQuote($fax);&UnQuote($Shiptype);&UnQuote($Payby);&UnQuote($Cardtype);&UnQuote($Cardno);&UnQuote($Expyr);&UnQuote($Expmo);&UnQuote($Source);&UnQuote($Suggest);
if ($Payby eq 'FIRST VIRTUAL') {
if ( $input{'X-OUTCOME'} eq "buy") {
if ($ENV{'HTTP_REFERER'} ne "http://$cgi_prog_location")
{&Transmission_error(7);}
}
elsif ($input{'X-OUTCOME'} eq "apply") {
print "<html>\n";
print "<head><title>Enter First Virtual vPIN</title></head>\n";
print "<body>\n";
print "<b>Please check your email to activate your VirtualPIN!<br>";
print "and when you have completed the First Virtual application process,<br>";
print "press your browser's BACK button to go back to the registration<br>";
print "form and <i>enter your new First Virtual vPIN</i> press SUBMIT,<br>";
print "then press PLACE ORDER again.<br>";
print "Thank you.</b><br></body></html>\n";
exit;
} else
{
print "Unknown First Virtual Result: $input{'X-OUTCOME'} ???<br>";
exit;
}
}
$confirm .= "<br><br><pre>" . ¢er('SALES INVOICE') . '</pre><br>';
($hh, $mm, $ss) = split(/:/, $time);
$mm = sprintf("%02d", $mm);
if ($hh > 12)
{$hh -= 12; $time = "$hh:$mm" . 'pm';}
else
{
if ($hh == 0) {$hh = 12;}
$time = "$hh:$mm" . 'am';
}
$confirm .= "<pre>Invoice #: $id Invoice Date: $date Time: $time $local_time</pre><br><pre>";
$confirm .= "Sold To: $title $first $last<br>";
if ($company ne "")
{$confirm .= " $company<br>";}
$confirm .= " $street1<br>";
if ($street2 ne "")
{$confirm .= " $street2<br>";}
if (uc $country ne uc $catalog_country)
{$confirm .= " $city, $state $zip $country<br>";}
else
{$confirm .= " $city, $state $zip<br>";}
if ($dphone ne "") {
$confirm .= " Daytime Phone: $dphone";
if ($dexten ne "")
{$confirm .= " Ext: $dexten";}
$confirm .= "<br>";
}
if ($nphone ne "") {
$confirm .= " Evening Phone: $nphone";
if ($nexten ne "")
{$confirm .= " Ext: $nexten";}
$confirm .= "<br>";
}
if ($fax ne "")
{$confirm .= " Fax: $fax<br>";}
if ($email ne "")
{$confirm .= " Email: $email<br>";}
if ($Payby eq 'CREDIT') {
$confirm .= "</pre><pre>Paid by: $Payby $Cardtype ";
if (lc $online_credit_verify eq 'no')
{$confirm .= '(Subject to Verification) ';}
if (lc $cardno_on_email eq 'yes' && lc $use_secure_server ne 'yes')
{$confirm .= "<br>Card #: $Cardno Expires: $Expyr/$Expmo ";}
}
else
{$confirm .= "</pre><pre>Paid by: $Payby ";}
$confirm .= "<br> Ship via: $Shiptype";
$confirm .= '</pre><br>';
print "<html>\n";
print "<head><title>Order Confirmation</title></head>\n";
print "<body>\n";
print "Thank you very much for your order, you may print this screen out as a record ";
print "of your order, a copy has also been emailed to you.<br>";
if ($Payby eq 'CHECK') {
print "Send a copy of this form to the address below along with your check.<br>";
print "Make checks payable to: $Pay_checks_to<br>";
}
elsif ($Payby eq 'CREDIT') {
if ($online_credit_verify eq 'no')
{print "You will receive an email confirmation once your payment information has been verified.<br>";}
else
{print "Your Credit Card has been charged the Grand Total shown below.<br>";}
}
elsif ($Payby eq 'COD') {
print "Your order will be shipped COD for the Grand Total shown below. If you refuse delivery, you will still be charged for the COD charge shown below.<br>";
}
elsif ($Payby eq 'FIRST VIRTUAL') {
if ( $input{'X-OUTCOME'} eq "apply" ) {
print "Please check your email to activate your VirtualPIN!<br>";
print "after you have completed the First Virtual application process.<br>";
} else ### $input{'X-OUTCOME'} eq "buy"
{print "Please check your email from First Virtual to confirm your purchase.<br>";}
}
print "If you have any questions about your order, please reference your ";
print "order number when calling.<br>";
print "We appreciate your business and hope you will return soon.<br>";
print "-----------------------------------------------------------------------------------------------<br><br>";
$order_total = 0;
$total_quantity = 0;
$total_weight = 0;
$total_discount = 0;
$confirm .= "<pre>";
$confirm .= "------------------------------------------------------------------------<br>";
$confirm .= "Product ID Product Name Unit Price Qty Item Total<br>";
$confirm .= "------------------------------------------------------------------------<br>";
&load_orders; ##load orders file into an array
foreach $taxtype (@taxtypes) { ### first display taxable items, then other taxtype (e.g. non-taxable) items
if ($#orders > 0) {
if ($taxtype eq "" && $#taxtypes > 0)
{
$padlen = 10;
$confirm .= '-------------------- ** Taxable Items ** -------------------------------' . ('-' x $padlen) . '<br>';
}
elsif ($taxtype eq 'none')
{
$padlen = 10;
$confirm .= '------------------- ** NON Taxable Items **-----------------------------' . ('-' x $padlen) . '<br>';
}
elsif ($taxtype ne "")
{
$padlen = 10;
$confirm .= "------------------- ** $taxtype Tax Items ** ---------------------------" . ('-' x $padlen) . '<br>';
}
}
$sub_total = 0;
LOOP: foreach $i (0 .. $#orders) {
($order_id, $item_id, $item_name, $price, $quantity, $weight, $item_taxtype, $option1, $option2, $option3) = @{$orders[$i]};
if (lc $item_taxtype ne $taxtype)
{next LOOP;}
$item_id = &right($item_id,10);
$item_name_part = &left($item_name,20);
$total_weight += $weight * $quantity;
$item_total = $price * $quantity;
$quantity = &right($quantity,4);
$sub_total = $sub_total + $item_total;
$item_total = &right(&Currency($item_total),13);
$price = &right(&Currency($price),13);
$confirm .= "$item_id $item_name_part $price $quantity $item_total<br>";
$item_name = substr($item_name, 20);
while ($item_name ne "")
{
$item_name_part = &left($item_name,20);
$confirm .= " $item_name_part<br>";
$item_name = substr($item_name, 20);
}
if ($weight_caption ne "")
{
if ($weight > 0)
{$confirm .= " $weight_caption ($local_weight): $weight<br>"}
}
if ($option1_caption ne "")
{
if ($option1 ne "")
{$confirm .= " $option1_caption: $option1<br>"}
}
if ($option2_caption ne "")
{
if ($option2 ne "")
{$confirm .= " $option2_caption: $option2<br>"}
}
if ($option3_caption ne "")
{
if ($option3 ne "")
{$confirm .= " $option3_caption: $option3<br>"}
}
} ###foreach order detail
$sub_tot = &right(&Currency($sub_total),15);
$confirm .= '------------------------------------------------------------------------<br>';
$confirm .= " Sub Total: $sub_tot<br>";
if (&calculate_discount != 0) {
$discount_currency = &right($discount_currency,15);
$confirm .= ' Discount of ' . &right($Disc_Rate, 5) . "%: $discount_currency<br>";
$sub_tot = &right(&Currency($discount_total),15);
$confirm .= ' -------------------------------------------<br>';
$confirm .= " Sub Total: $sub_tot<br>";
}
if (&calculate_tax > 0) {
$tax_currency = &right($tax_currency,15);
$confirm .= ' ' . $state . ' State Tax @ ' . &right($Tax_Rate, 5) . "%: $tax_currency<br>";
}
if ($#taxtypes > 0) {
$tax_tot = &right(&Currency($tax_total),15);
$confirm .= ' -------------------------------------------' . ('-' x $padlen) . '<br>';
$confirm .= " Sub Total: " . (' ' x $padlen) . "$tax_tot<br>";
}
} ###foreach $taxtype
if (&calculate_shipping > 0) {
$shipping_currency = &right($shipping_currency,15);
$confirm .= " Shipping: " . (' ' x $padlen) . "$shipping_currency<br>";
}
if ($Payby eq 'COD') {
$cod_currency = &right($cod_currency,15);
$confirm .= " COD Charge: " . (' ' x $padlen) . "$cod_currency<br>";
}
if ($Handling > 0) {
$Handling_currency = &right($Handling_currency,15);
$confirm .= " Handling: " . (' ' x $padlen) . "$Handling_currency<br>";
}
$grand_total_currency = &right($grand_total_currency,15);
$confirm .= ' -------------------------------------------' . ('-' x $padlen) . '<br>';
$confirm .= ' Grand Total: ' . (' ' x $padlen) . "$grand_total_currency</pre><br>";
$confirm .= "<br><pre>" . ¢er('RETURN POLICY') . "</pre><br>";
$confirm .= $return_policy;
print $confirm;
print "</body>\n";
print "</html>\n";
######### Now send email confirmation to Catalog Company and to Customer #######
$confirm =~ s'<pre>''g;
$confirm =~ s/<\/pre>|<br>/\n/g;
&sendmail($email, $company_email, "Order", $confirm); ### to Customer
if ($Source ne "")
{$confirm .= "\nHow did you find us? $Source\n";}
if ($Suggest ne "")
{$confirm .= "\nSuggestions? $Suggest\n";}
&sendmail($mail_order_to, $server_address, "Order", $confirm); ### to Catalog Company
}
#------------------------------------------------------------------#
sub load_orders
{
open (order_file, $order_file_name) || &err_trap("Cannot open $order_file_name for reading\n");
$index = 0;
@taxtypes = ();
while (<order_file>) { ### load the Orders file into an Array
chop;
($order_id, $item_id, $item_name, $price, $quantity, $weight, $item_taxtype, $option1, $option2, $option3) = split(/$delim/,$_);
&UnQuote($order_id); &UnQuote($item_id); &UnQuote($item_name); &UnQuote($price); &UnQuote($quantity); &UnQuote($weight); &UnQuote($item_taxtype); &UnQuote($option1); &UnQuote($option2); &UnQuote($option3);
$orders[$index] = [($order_id, $item_id, $item_name, $price, $quantity, $weight, $item_taxtype, $option1, $option2, $option3)];
$total_quantity += $quantity;
$total_price += $price * $quantity;
$found = 0;
foreach $taxtype (@taxtypes)
{
if (lc $item_taxtype eq $taxtype)
{$found = 1;}
}
if ($found == 0)
{push(@taxtypes, lc $item_taxtype);}
$index++;
}
close order_file;
}
#------------------------------------------------------------------#
sub sendmail
{
my($to, $from, $subject, $body) = @_;
if (lc $mail_via eq 'sendmail')
{
open (MAIL, "|$sendmail_loc -t -oi") || &err_trap("Can't open $sendmail_loc!\n");
print MAIL "To: $to\n";
print MAIL "From: $from\n";
print MAIL "Subject: $subject\n";
print MAIL "$body\n";
close MAIL;
}
else
{
if (lc $mail_via eq 'blat')
{
open (MAIL, "|$blat_loc - -t $to -s $subject") || &err_trap("Can't open $blat_loc!\n");
print MAIL "$body\n\x1a";
close MAIL;
}
else
{
$err = &sockets_mail($to, $from, $subject, $body);
if ($err < 1)
{print "<br>\nSendmail error # $err<br>\n";}
}
}
}
#------------------------------------------------------------------#
sub sockets_mail
{
my ($to, $from, $subject, $message) = @_;
my ($replyaddr) = $from;
if (!$to) { return -8; }
my ($proto, $port, $smptaddr);
my ($AF_INET) = 2;
my ($SOCK_STREAM) = 1;
$proto = (getprotobyname('tcp'))[2];
$port = 25;
$smtpaddr = ($smtp_addr =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)
? pack('C4',$1,$2,$3,$4)
: (gethostbyname($smtp_addr))[4];
if (!defined($smtpaddr)) { return -1; }
if (!socket(S, $AF_INET, $SOCK_STREAM, $proto)) { return -2; }
if (!connect(S, pack('Sna4x8', $AF_INET, $port, $smtpaddr))) { return -3; }
my($oldfh) = select(S); $| = 1; select($oldfh);
$_ = <S>; if (/^[45]/) { close S; return -4; }
print S "helo localhost\r\n";
$_ = <S>; if (/^[45]/) { close S; return -5; }
print S "mail from: $from\r\n";
$_ = <S>; if (/^[45]/) { close S; return -5; }
print S "rcpt to: $to\r\n";
$_ = <S>; if (/^[45]/) { close S; return -6; }
print S "data\r\n";
$_ = <S>; if (/^[45]/) { close S; return -5; }
print S "X-Mailer: PerlShop Sendmail \r\n";
print S "Mime-Version: 1.0\r\n";
print S "Content-Type: text/plain; charset=us-ascii\r\n";
print S "To: $to\r\n";
print S "From: $from\r\n";
print S "Reply-to: $replyaddr\r\n" if $replyaddr;
print S "Subject: $subject\r\n\r\n";
print S "$message";
print S "\r\n.\r\n";
$_ = <S>; if (/^[45]/) { close S; return -7; }
print S "quit\r\n";
$_ = <S>;
close S;
return 1;
}
#------------------------------------------------------------------#
sub center
{
my $field = $_[0];
$padlen = ($line_length / 2) - (length($field) / 2);
$padding = " " x $padlen;
return $padding . $field;
}
#------------------------------------------------------------------#
sub right
{
my $field = $_[0];
my $field_size = $_[1];
$padlen = $field_size - length($field);
$padding = " " x $padlen;
return $padding . $field;
}
#------------------------------------------------------------------#
sub left
{
my $field = $_[0];
my $field_size = $_[1];
my $result;
if (length($field) > $field_size) {
$result = substr($field,0,$field_size);
}
else { $padlen = $field_size - length($field);
$padding = " " x $padlen;
$result = $field . $padding;
}
while (substr($result,0, 1) eq ' ')
{$result = substr($result, 1) . ' ';}
return $result;
}
#------------------------------------------------------------------#
sub zero_fill
{
my $field = $_[0];
my $field_size = $_[1];
if (length($field) > $field_size) {
return substr($field,0,$field_size);
}
else { $padlen = $field_size - length($field);
$padding = "0" x $padlen;
return $field . $padding;
}
}
#------------------------------------------------------------------#
sub require
{
my $field_name = $_[0];
my $field_val = $_[1];
if ($field_val eq "")
{
$error_msg .= "<li>The field: \"$field_name\" is a required field.<br>";
return 0;
}
else
{return 1;}
}
#------------------------------------------------------------------#
sub check_email
{
my $mail_addr = $_[0];
if ($mail_addr eq "")
{return 0;}
if ($mail_addr =~ /^[\s]*[\w-.]+\@[\w-]+([\.]{1}[\w-]+)+[\s]*$/ )
{
return 1;
}
else {
$error_msg .= "<li>Email address is not in the form: \"nobody\@nowhere.com\"<br>";
return 0;
}
}
#------------------------------------------------------------------#
sub check_file_title
{
my $file_title = $_[0];
if ($file_title eq "")
{
$error_msg = "Missing File Title\n";
return 0;
}
if ($file_title !~ /\.\./ )
{
return 1;
}
else {
$error_msg = "File Title '$file_title' is Invalid - Cannot contain '..' \n";
return 0;
}
}
#------------------------------------------------------------------#
sub check_zip { #Must be 5 or 9 digits for a US Zip Code
my $zip_code = $_[0];
my $zip_type = $_[1];
if (uc $zip_type eq 'US') {
if (!((length($zip_code) == 5) || (length($zip_code) == 9))) {
$error_msg .= '<li>Zip code must have 5 or 9 digits<br>';
return 0;
}
}
}
#------------------------------------------------------------------#
sub check_state {
my $state_code = $_[0];
my $state_type = $_[1];
if (uc $state_type eq 'US') {
$state_code = uc($state_code);
$sc{'AL'} = 'ok';$sc{'AK'} = 'ok';$sc{'AZ'} = 'ok';$sc{'AR'} = 'ok';$sc{'AS'} = 'ok';
$sc{'CA'} = 'ok';$sc{'CO'} = 'ok';$sc{'CT'} = 'ok';$sc{'DE'} = 'ok';$sc{'DC'} = 'ok';
$sc{'FL'} = 'ok';$sc{'GA'} = 'ok';$sc{'GU'} = 'ok';$sc{'HI'} = 'ok';$sc{'ID'} = 'ok';
$sc{'IL'} = 'ok';$sc{'IN'} = 'ok';$sc{'IA'} = 'ok';$sc{'KS'} = 'ok';$sc{'KY'} = 'ok';
$sc{'LA'} = 'ok';$sc{'ME'} = 'ok';$sc{'MD'} = 'ok';$sc{'MA'} = 'ok';$sc{'MI'} = 'ok';
$sc{'MN'} = 'ok';$sc{'MS'} = 'ok';$sc{'MO'} = 'ok';$sc{'MT'} = 'ok';$sc{'NE'} = 'ok';
$sc{'NV'} = 'ok';$sc{'NH'} = 'ok';$sc{'NJ'} = 'ok';$sc{'NM'} = 'ok';$sc{'NY'} = 'ok'; $sc{'NC'} = 'ok';$sc{'ND'} = 'ok';$sc{'OH'} = 'ok';$sc{'OK'} = 'ok';$sc{'OR'} = 'ok';
$sc{'PA'} = 'ok';$sc{'PR'} = 'ok';$sc{'RI'} = 'ok';$sc{'SC'} = 'ok';$sc{'SD'} = 'ok'; $sc{'TN'} = 'ok';$sc{'TT'} = 'ok';$sc{'TX'} = 'ok';$sc{'UT'} = 'ok';$sc{'VT'} = 'ok';
$sc{'VA'} = 'ok';$sc{'VI'} = 'ok';$sc{'WA'} = 'ok';$sc{'WV'} = 'ok';$sc{'WI'} = 'ok';
$sc{'WY'} = 'ok';
if ($sc{$state_code} eq 'ok')
{
return $state_code;
}
else
{
$error_msg .= '<li>State must be a valid 2 letter State abbreviation<br>';
return 0;
}
}
}
#------------------------------------------------------------------#
sub check_country {
my $country_code = $_[0];
if (length($country_code) != 2) {
$error_msg .= "<li>$country_code is not a valid 2 letter Country Code.<br>";
return 0;
}
$country_code = lc $country_code;
$vc{'ad'} = 'ok';$vc{'ae'} = 'ok';$vc{'af'} = 'ok';$vc{'ag'} = 'ok';$vc{'ai'} = 'ok';
$vc{'al'} = 'ok';$vc{'am'} = 'ok';$vc{'an'} = 'ok';$vc{'ao'} = 'ok';$vc{'aq'} = 'ok';
$vc{'ar'} = 'ok';$vc{'as'} = 'ok';$vc{'at'} = 'ok';$vc{'au'} = 'ok';$vc{'aw'} = 'ok';
$vc{'az'} = 'ok';$vc{'ba'} = 'ok';$vc{'bb'} = 'ok';$vc{'bd'} = 'ok';$vc{'be'} = 'ok';
$vc{'bf'} = 'ok';$vc{'bg'} = 'ok';$vc{'bh'} = 'ok';$vc{'bi'} = 'ok';$vc{'bj'} = 'ok';
$vc{'bm'} = 'ok';$vc{'bn'} = 'ok';$vc{'bo'} = 'ok';$vc{'br'} = 'ok';$vc{'bs'} = 'ok';
$vc{'bt'} = 'ok';$vc{'bv'} = 'ok';$vc{'bw'} = 'ok';$vc{'by'} = 'ok';$vc{'bz'} = 'ok';
$vc{'ca'} = 'ok';$vc{'cc'} = 'ok';$vc{'cf'} = 'ok';$vc{'cg'} = 'ok';$vc{'ch'} = 'ok';
$vc{'ci'} = 'ok';$vc{'ck'} = 'ok';$vc{'cl'} = 'ok';$vc{'cm'} = 'ok';$vc{'cn'} = 'ok';
$vc{'co'} = 'ok';$vc{'cr'} = 'ok';$vc{'cs'} = 'ok';$vc{'cu'} = 'ok';$vc{'cv'} = 'ok';
$vc{'cx'} = 'ok';$vc{'cy'} = 'ok';$vc{'cz'} = 'ok';$vc{'de'} = 'ok';$vc{'dj'} = 'ok';
$vc{'dk'} = 'ok';$vc{'dm'} = 'ok';$vc{'do'} = 'ok';$vc{'dz'} = 'ok';$vc{'ec'} = 'ok';
$vc{'ee'} = 'ok';$vc{'eg'} = 'ok';$vc{'eh'} = 'ok';$vc{'er'} = 'ok';$vc{'es'} = 'ok';
$vc{'et'} = 'ok';$vc{'fi'} = 'ok';$vc{'fj'} = 'ok';$vc{'fk'} = 'ok';$vc{'fm'} = 'ok';
$vc{'fo'} = 'ok';$vc{'fr'} = 'ok';$vc{'ga'} = 'ok';$vc{'gb'} = 'ok';$vc{'gd'} = 'ok';
$vc{'ge'} = 'ok';$vc{'gf'} = 'ok';$vc{'gh'} = 'ok';$vc{'gi'} = 'ok';$vc{'gl'} = 'ok';
$vc{'gm'} = 'ok';$vc{'gn'} = 'ok';$vc{'gp'} = 'ok';$vc{'gq'} = 'ok';$vc{'gr'} = 'ok';
$vc{'gs'} = 'ok';$vc{'gt'} = 'ok';$vc{'gu'} = 'ok';$vc{'gw'} = 'ok';$vc{'gy'} = 'ok';
$vc{'hk'} = 'ok';$vc{'hm'} = 'ok';$vc{'hn'} = 'ok';$vc{'hr'} = 'ok';$vc{'ht'} = 'ok';
$vc{'hu'} = 'ok';$vc{'id'} = 'ok';$vc{'ie'} = 'ok';$vc{'il'} = 'ok';$vc{'in'} = 'ok';
$vc{'io'} = 'ok';$vc{'is'} = 'ok';$vc{'it'} = 'ok';$vc{'jm'} = 'ok';$vc{'jo'} = 'ok';
$vc{'jp'} = 'ok';$vc{'ke'} = 'ok';$vc{'kg'} = 'ok';$vc{'kh'} = 'ok';$vc{'ki'} = 'ok';
$vc{'km'} = 'ok';$vc{'kn'} = 'ok';$vc{'kp'} = 'ok';$vc{'kr'} = 'ok';$vc{'kw'} = 'ok';
$vc{'ky'} = 'ok';$vc{'kz'} = 'ok';$vc{'la'} = 'ok';$vc{'lb'} = 'ok';$vc{'lc'} = 'ok';
$vc{'li'} = 'ok';$vc{'lk'} = 'ok';$vc{'lr'} = 'ok';$vc{'ls'} = 'ok';$vc{'lt'} = 'ok';
$vc{'lu'} = 'ok';$vc{'lv'} = 'ok';$vc{'ly'} = 'ok';$vc{'ma'} = 'ok';$vc{'mc'} = 'ok';
$vc{'md'} = 'ok';$vc{'mg'} = 'ok';$vc{'mh'} = 'ok';$vc{'mk'} = 'ok';$vc{'ml'} = 'ok';
$vc{'mm'} = 'ok';$vc{'mn'} = 'ok';$vc{'mo'} = 'ok';$vc{'mp'} = 'ok';$vc{'mq'} = 'ok';
$vc{'mr'} = 'ok';$vc{'ms'} = 'ok';$vc{'mt'} = 'ok';$vc{'mu'} = 'ok';$vc{'mv'} = 'ok';
$vc{'mw'} = 'ok';$vc{'mx'} = 'ok';$vc{'my'} = 'ok';$vc{'mz'} = 'ok';$vc{'na'} = 'ok';
$vc{'nc'} = 'ok';$vc{'ne'} = 'ok';$vc{'nf'} = 'ok';$vc{'ng'} = 'ok';$vc{'ni'} = 'ok';
$vc{'nl'} = 'ok';$vc{'no'} = 'ok';$vc{'np'} = 'ok';$vc{'nr'} = 'ok';$vc{'nu'} = 'ok';
$vc{'nz'} = 'ok';$vc{'om'} = 'ok';$vc{'pa'} = 'ok';$vc{'pe'} = 'ok';$vc{'pf'} = 'ok';
$vc{'pg'} = 'ok';$vc{'ph'} = 'ok';$vc{'pk'} = 'ok';$vc{'pl'} = 'ok';$vc{'pm'} = 'ok';
$vc{'pn'} = 'ok';$vc{'pr'} = 'ok';$vc{'pt'} = 'ok';$vc{'pw'} = 'ok';$vc{'py'} = 'ok';
$vc{'qa'} = 'ok';$vc{'re'} = 'ok';$vc{'ro'} = 'ok';$vc{'ru'} = 'ok';$vc{'rw'} = 'ok';
$vc{'sa'} = 'ok';$vc{'sb'} = 'ok';$vc{'sc'} = 'ok';$vc{'sd'} = 'ok';$vc{'se'} = 'ok';
$vc{'sg'} = 'ok';$vc{'sh'} = 'ok';$vc{'si'} = 'ok';$vc{'sj'} = 'ok';$vc{'sk'} = 'ok';
$vc{'sl'} = 'ok';$vc{'sm'} = 'ok';$vc{'sn'} = 'ok';$vc{'so'} = 'ok';$vc{'sr'} = 'ok';
$vc{'st'} = 'ok';$vc{'su'} = 'ok';$vc{'sv'} = 'ok';$vc{'sy'} = 'ok';$vc{'sz'} = 'ok';
$vc{'tc'} = 'ok';$vc{'td'} = 'ok';$vc{'tf'} = 'ok';$vc{'tg'} = 'ok';$vc{'th'} = 'ok';
$vc{'tj'} = 'ok';$vc{'tk'} = 'ok';$vc{'tm'} = 'ok';$vc{'tn'} = 'ok';$vc{'to'} = 'ok';
$vc{'tp'} = 'ok';$vc{'tr'} = 'ok';$vc{'tt'} = 'ok';$vc{'tv'} = 'ok';$vc{'tw'} = 'ok';
$vc{'tz'} = 'ok';$vc{'ua'} = 'ok';$vc{'ug'} = 'ok';$vc{'uk'} = 'ok';$vc{'um'} = 'ok';
$vc{'us'} = 'ok';$vc{'uy'} = 'ok';$vc{'uz'} = 'ok';$vc{'va'} = 'ok';$vc{'vc'} = 'ok';
$vc{'ve'} = 'ok';$vc{'vg'} = 'ok';$vc{'vi'} = 'ok';$vc{'vn'} = 'ok';$vc{'vu'} = 'ok';
$vc{'wf'} = 'ok';$vc{'ws'} = 'ok';$vc{'ye'} = 'ok';$vc{'yt'} = 'ok';$vc{'yu'} = 'ok';
$vc{'za'} = 'ok';$vc{'zm'} = 'ok';$vc{'zr'} = 'ok';$vc{'zw'} = 'ok';
if ($vc{$country_code} ne 'ok') {
$error_msg .= "<li>$country_code is not a valid 2 letter Country Code.<br>";
return 0;
}
}
#--------------------------------------------------------------#
sub check_phone { #Must be 6-18 digits with possible leading "+".
my $phone_no = $_[0];
my $phone_type = $_[1];
if ($phone_no eq "")
{return "";}
unless ((uc $phone_type eq 'US') || (uc $phone_type eq 'CA')) #check international phone (Must be 6-18 digits with possible leading "+")
{
if ($phone_no =~ /^[\s]*(\+?[\d\s]{6,26})[\s]*$/) {
$phone_no =~ tr/0-9\(\)\- /0-9/d; #Remove Non-digits
return $phone_no;
}
else {
$error_msg .= '<li>International Phone # is Not Valid<br>';
return 0;
}
}
else { #check US phone #
$phone_no =~ tr/0-9\(\)\- /0-9/d; #Remove Non-digits
### First Virtual requires Country Code even for US & Canada
if ((length($phone_no) == 11) && (substr($phone_no, 0, 1) eq '1')) {
$phone_no =~ /\d{1}([\d]{3})([\d]{3})([\d]{4})/;
$phone_no = sprintf("1(%3.3d)%3.3d-%4.4d", $1, $2, $3);
return $phone_no;
}
elsif (length($phone_no) != 10) {
$error_msg .= "<li>Phone # \"$phone_no\" has: " . length($phone_no) . ' digits, Must Have 10 or 11 Digits<br>';
return 0;
}
else {
$phone_no =~ /([\d]{3})([\d]{3})([\d]{4})/;
$phone_no = sprintf("1(%3.3d)%3.3d-%4.4d", $1, $2, $3);
return $phone_no;
}
}
}
#------------------------------------------------------------------#
sub check_expire_date # check credit card expiration date
{
my $expire_month = $_[0];
my $expire_year = $_[1];
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$mon++;
&Year2000($expire_year);
&Year2000($year);
if ($expire_year < $year)
{
$error_msg .= '<li>Expiration year has passed<br>';
return 0;
}
elsif ($expire_year == $year)
{
if ($expire_month < $mon)
{
$error_msg .= '<li>Expiration Month has passed<br>';
return 0;
}
}
else {return 1;}
}
#------------------------------------------------------------------#
sub check_card_num #check credit card length, prefix and checkdigit
{ #See ANSI/ISO/IEC 7812-1-1993 Identification of Issuers - Part 1: Numbering System.
my $card_num = $_[0];
my $card_type = $_[1];
if ($card_num eq "")
{return 0;}
$card_num =~ tr/0-9 -/0-9/d; #Remove spaces and dashes.
if ($card_num =~ /\D{1,}?/) #Check for any other non-digits
{
$error_msg .= "<li>Credit Card Number cannot contain a \"$1\" Character.<br>";
return 0;
}
$card_len = length($card_num);
unless ( ($card_type eq 'MasterCard' && $card_len == 16)
|| ($card_type eq 'Visa' && ($card_len == 13 || $card_len == 16))
|| ($card_type eq 'American Express' && $card_len == 15)
|| ($card_type eq 'Optima' && $card_len == 15)
|| ($card_type eq 'Carte Blanche' && $card_len == 15)
|| ($card_type eq 'Diners Club' && $card_len == 15)
|| ($card_type eq 'Discover' && $card_len == 16)
|| ($card_type eq 'JCB' && ($card_len == 15 || $card_len == 16)) )
{
$error_msg .= "<li>A $card_type Credit Card # cannot have $card_len digits.<br>";
return 0;
}
$prefix_type{'35'} = 'JCB';
$prefix_type{'21'} = 'JCB';
$prefix_type{'18'} = 'JCB';
$prefix_type{'51'} = 'MasterCard';
$prefix_type{'52'} = 'MasterCard';
$prefix_type{'53'} = 'MasterCard';
$prefix_type{'54'} = 'MasterCard';
$prefix_type{'55'} = 'MasterCard';
$prefix_type{'4'} = 'Visa';
$prefix_type{'34'} = 'American Express';
$prefix_type{'37'} = 'American Express';
$prefix_type{'3707'} = 'Optima';
$prefix_type{'3717'} = 'Optima';
$prefix_type{'3727'} = 'Optima';
$prefix_type{'3737'} = 'Optima';
$prefix_type{'3747'} = 'Optima';
$prefix_type{'3757'} = 'Optima';
$prefix_type{'3767'} = 'Optima';
$prefix_type{'3777'} = 'Optima';
$prefix_type{'3787'} = 'Optima';
$prefix_type{'3797'} = 'Optima';
$prefix_type{'94'} = 'Carte Blanche';
$prefix_type{'95'} = 'Carte Blanche';
$prefix_type{'38'} = 'Carte Blanche';
$prefix_type{'30'} = 'Diners Club';
$prefix_type{'31'} = 'Diners Club';
$prefix_type{'35'} = 'Diners Club';
$prefix_type{'36'} = 'Diners Club';
$prefix_type{'38'} = 'Diners Club';
$prefix_type{'6011'} = 'Discover';
if ($card_type eq 'MasterCard') {$card_prefix = substr($card_num, 0, 2);}
elsif ($card_type eq 'Visa') {$card_prefix = substr($card_num, 0, 1);}
elsif ($card_type eq 'American Express') {$card_prefix = substr($card_num, 0, 2);}
elsif ($card_type eq 'Optima') {$card_prefix = substr($card_num, 0, 4);}
elsif ($card_type eq 'Carte Blanche') {$card_prefix = substr($card_num, 0, 2);}
elsif ($card_type eq 'Diners Club') {$card_prefix = substr($card_num, 0, 2);}
elsif ($card_type eq 'Discover') {$card_prefix = substr($card_num, 0, 4);}
elsif ($card_type eq 'JCB') {$card_prefix = substr($card_num, 0, 2);}
if ($prefix_type{$card_prefix} ne $card_type)
{
$error_msg .= "<li>Invalid Credit Card # for a \"$card_type\" Card<br>";
return 0;
}
### Now do a LUHN MOD 10 check digit check on the card number.
$weight = 2;
$sum = 0;
for ($i = $card_len - 2; $i >= 0; $i--)
{
$curr_digit = substr($card_num, $i, 1);
$product = $weight * $curr_digit;
$ones= chop($product);
$sum += $ones + $product;
$weight = $weight % 2 + 1; ### 2->1, 1->2
}
if (substr($card_num, $card_len - 1, 1) == (10 - ($sum % 10)) % 10)
{
return 1;
}
else
{
$error_msg .= '<li>The Credit Card Number is Invalid<br>';
return 0;
}
}
#------------------------------------------------------------------#
sub SHA { ### This algorithm is based on the implementation of SHA
### written by: John Allen ([email protected]).
### &SHA("squeamish ossifrage\n");
### Should return 82055066 4cf29679 2b38d164 7a4d8c0e 1966af57
my ($msg, $p, $l) = @_; #$p=0; $l=0
local $_;
$temp = 'D9T4C`>_-JXF8NMS^$#)4=L/2X?!:@GF9;MGKH8\;O-S*8L\'6';
$m = 4294967296;
###$m=1+~0;
@A=unpack"N*",unpack u,$temp;
@K=splice@A,5,4;
sub M{($x=pop)-($m)*int$x/$m};
sub L{$n=pop;($x=pop)<<$n|2**$n-1&$x>>32-$n}
@F=(sub{$b&($c^$d)^$d},$S=sub{$b^$c^$d},sub{($b|$c)&$d|$b&$c},$S);
do{
$msg=~s/.{0,64}//s;$_=$&;
$l+=$r=length;
$r++,$_.="\x80"if$r<64&&!$p++;@W=unpack N16,$_."\0"x7;$W[15]=$l*8
if$r<57; for(16..79){push@W,L$W[$_
-3]^$W[$_-8]^$W[$_-14]^$W[$_-16],1}($a,$b,$c,$d,$e)=@A;
for(0..79){$t=M&{$F[$_/ 20]}+$e+$W[$_]+$K[$_/20]+L$a,5; $e=$d; $d=$c;
$c=L$b,30; $b=$a; $a=$t}$v='a'; @A=map{ M$_+${$v++}}@A
}while$r>56;
return sprintf'%8x 'x4 . '%8x',@A;
}
#------------------------------------------------------------------#
sub calculate_tax {
$tax = 0;
$tax_total = $discount_total;
if (lc $taxtype eq 'none')
{return 0;}
else { #### Calculate for the Default Tax Type
#### Add Tax if tax should be added for the customer's State ####
if (uc $country eq 'US') {
foreach $Tax_State_Rate (@Tax_States) {
($Tax_State, $Tax_Rate) = split(/ /,$Tax_State_Rate);
if ($state eq $Tax_State) {
$tax = $sub_total * ($Tax_Rate / 100);
$tax = sprintf("%.2f", $tax);
$tax_currency = &Currency($tax);
$tax_total = $discount_total + $tax;
$order_total += $tax;
last;
}
}
}
return $tax;
}
}#sub
#------------------------------------------------------------------#
sub calculate_shipping {
$shipping = 0;
$grand_total = $order_total;
if ($shipping_type ne 'included')
{
if ($shipping_type eq 'quantity')
{$ship_amount = $total_quantity;}
elsif ($shipping_type eq 'weight')
{$ship_amount = $total_weight;}
else ##$shipping_type eq 'price'
{$ship_amount = $order_total;}
$country_uc = uc($country);
$country_found = 0;
### If Country not in shippping table use 'OTHER' entry for rates.
foreach $index(0..$#Shipping_Rates) {
($Ship_Country, $Shipper, $Ship_Min, $Ship_Max, $Ship_Mul, $Ship_Amt) = @{$Shipping_Rates[$index]};
if ($country_uc eq uc $Ship_Country)
{$country_found = 1;}
}
if ($country_found == 0)
{$country_uc = 'OTHER';}
foreach $index(0..$#Shipping_Rates) {
($Ship_Country, $Shipper, $Ship_Min, $Ship_Max, $Ship_Mul, $Ship_Amt) = @{$Shipping_Rates[$index]};
if ( ((($country_uc eq uc $Ship_Country) || ($Ship_Country eq 'ALL')) && ($Shiptype eq $Shipper) )
&& ($ship_amount >= $Ship_Min)
&& ($ship_amount <= $Ship_Max) )
{
if ($Ship_Mul eq '+')
{$shipping = $Ship_Amt}
elsif ($Ship_Mul eq '*')
{$shipping = $ship_amount * $Ship_Amt}
else ## $Ship_Mul eq '%' ##
{$shipping = $ship_amount * ($Ship_Amt / 100)}
$shipping = sprintf("%.2f", $shipping);
$shipping_total = $order_total + $shipping;
$shipping_currency = &Currency($shipping);
$grand_total = $shipping_total;
last;
} #if
} #foreach
} #else
if ($Payby eq 'COD') {
$grand_total += $cod_charge;
$cod_currency = &Currency($cod_charge);
}
$Handling = 0;
$country_found = 0;
foreach $index(0..$#Handling_table) {
($Handling_Country, $Handling_Amt) = @{$Handling_table[$index]};
if ( uc($country) eq uc($Handling_Country) )
{
$Handling = $Handling_Amt;
$country_found = 1;
last;
}
}
if ($country_found == 0)
{
($Handling_Country, $Handling_Amt) = @{$Handling_table[$#Handling_table]};
$Handling = $Handling_Amt;
}
$grand_total += $Handling;
$Handling_currency = &Currency($Handling);
$grand_total_currency = &Currency($grand_total);
return $shipping;
}#sub
#------------------------------------------------------------------#
sub calculate_discount {
$discount = 0;
$discount_total = $sub_total;
$order_total += $sub_total;
if (lc $discount_type eq 'quantity')
{$discount_amount = $total_quantity;}
elsif (lc $discount_type eq 'price')
{$discount_amount = $total_price;}
else
{return 0;}
foreach $index(0..$#Discount_Rates) {
($Disc_Min, $Disc_Max, $Disc_Rate) = @{$Discount_Rates[$index]};
if ( ($discount_amount >= $Disc_Min) && ($discount_amount <= $Disc_Max) )
{
$discount = - ($Disc_Rate * ($sub_total / 100) );
$discount = sprintf("%.2f", $discount);
$discount_total = $sub_total + $discount;
$order_total += $discount;
$total_discount += $discount;
$discount_currency = &Currency($discount);
last;
} #if
} #foreach
return $discount;
}#sub
#------------------------------------------------------------------#
sub show_shipping_rates {
print "<html>\n";
print "<head><title>Shipping Rates</title></head>\n";
&add_company_header;
print "<center><table border=2><caption><font SIZE=+1>Shipping Rates<br><i>(based on $shipping_type)</i></font></caption>";
print "<tr><th>Country</th><th>Shipper</th><th>Minimum $shipping_type</th><th>Maximum $shipping_type</th><th>Function</th><th>Amount</th></tr>";
$examples = 0;
foreach $index(0..$#Shipping_Rates) {
($Ship_Country, $Shipper, $Ship_Min, $Ship_Max, $Ship_Mul, $Ship_Amt) = @{$Shipping_Rates[$index]};
if ($Ship_Mul eq '%')
{$Ship_Amt = sprintf("%.2f", $Ship_Amt) . '%';}
else
{$Ship_Amt = &Currency($Ship_Amt) . ' ';}
print "<tr><td>$Ship_Country</td><td>$Shipper</td><td>$Ship_Min</td><td>$Ship_Max</td><td>$Ship_Mul</td><td align =\"right\">$Ship_Amt</td><tr>";
if (($Ship_Mul eq '+' && $has_plus == 0) || ($Ship_Mul eq '*' && $has_mul == 0) || ($Ship_Mul eq '%' && $has_percent == 0)) {
$example[$examples] = "For example: If the Country is $Ship_Country and the Shipper is $Shipper and the total $shipping_type ordered was between $Ship_Min and $Ship_Max ";
if ($shipping_type eq 'quantity')
{$example[$examples] .= 'items';}
elsif ($shipping_type eq 'price')
{$example[$examples] .= $local_currency;}
elsif ($shipping_type eq 'weight')
{$example[$examples] .= $local_weight;}
$example[$examples] .= ', then you would ';
if ($Ship_Mul eq '+') {
$example[$examples] .= "add $Ship_Amt to your order.";
$has_plus = 1;
}
elsif ($Ship_Mul eq '*') {
$example[$examples] .= "multiply the $shipping_type times $Ship_Amt and add it to your order.";
$has_mul = 1;
}
elsif ($Ship_Mul eq '%') {
$example[$examples] .= "take $Ship_Amt of the $shipping_type and add it to your order.";
$has_percent = 1;
}
$examples += 1;
}
}
print '</table></center><br><i>';
print "<pre>Function '+' means add the Amount shown.<br>";
if ($shipping_type eq 'quantity')
{print " '*' means multiply the Quantity ordered times the Amount Shown.<br>";}
elsif ($shipping_type eq 'price')
{print " '%' means take the given percentage (shown as Amount) of the total order price.<br>";}
elsif ($shipping_type eq 'weight')
{print " '*' means multiply the total Weight times the Amount Shown.<br>";
print " '%' means take the given percentage (shown as Amount) of the total Weight<br>";}
print "</pre>The rate shown for Country 'OTHER' applies to any country not explicitly listed.<br>";
foreach $index(0..$examples) {
print "<br>$example[$index]<br>";
}
print '</i><br>';
&add_company_footer;
}
#------------------------------------------------------------------#
sub add_button_bar {
my @buttons = @_;
print '<p><center><table border=0><tr>';
if (($prev_page ne "") && ($catalog_page ne "") && ($prev_page ne $input{'THISPAGE'})) {
print "<td><form method=post action=\"http://$cgi_prog_location\">";
print "<input type=hidden name=ORDER_ID value=$unique_id>";
print "<input type=hidden name=thispage value=\"$prev_page\">";
print "<input type=submit name=ACTION value=\"< PREV PAGE\">";
print '</form></td>';
}
foreach $button(@buttons) {
print "<td><form method=post action=\"http://$cgi_prog_location\">";
if ($button_image{$button} eq '')
{print "<input type=submit name=ACTION value=\"$button\">";}
else
{
print "<input type=hidden name=ACTION value=\"$button\">";
print "<input type=image name=dummy src=\"$image_location/$button_image{$button}\" border=0>";
}
print "<input type=hidden name=ORDER_ID value=$unique_id>";
print "<input type=hidden name=thispage value=\"$input{'THISPAGE'}\">";
print '</form></td>';
}
print "<td><form method=GET action=\"http://$server_address$catalog_home/$home_page\"><input type=submit name=dummy value=HOME></form></td>";
if (($next_page ne "") && ($catalog_page ne "") && ($next_page ne $input{'THISPAGE'})) {
print "<td><form method=post action=\"http://$cgi_prog_location\">";
print "<input type=hidden name=ORDER_ID value=$unique_id>";
print "<input type=hidden name=thispage value=\"$next_page\">";
print "<input type=submit name=ACTION value=\"NEXT PAGE> \">";
print '</form></td>';
}
print '</tr></table></center></p><br>';
}
#------------------------------------------------------------------#
sub add_menu_bar {
my @menus = @_;
$menu_bar = '<center><font SIZE=-1>';
if (($prev_page ne "") && ($catalog_page ne "") && ($prev_page ne $input{'THISPAGE'}))
{$menu_bar .= "[<a href=\"http://$cgi_prog_location?ACTION=dummy\&thispage=$prev_page\&ORDER_ID=$unique_id\">< Prev Page</a>] ";}
foreach $menu(@menus) {
$menu_name = $menu;
$menu =~ tr / /+/; ### URL encode
$menu_bar .= "[<a href=\"http://$cgi_prog_location?ACTION=$menu&thispage=$input{'THISPAGE'}\&ORDER_ID=$unique_id\">$menu_name</a>] ";
}
$menu_bar .= "[<a href=\"http://$server_address$catalog_home/$home_page\">HOME</a>] ";
if (($next_page ne "") && ($catalog_page ne "") && ($next_page ne $input{'THISPAGE'}))
{$menu_bar .= "[<a href=\"http://$cgi_prog_location?ACTION=dummy\&thispage=$next_page\&ORDER_ID=$unique_id\">Next Page ></a>] ";}
$menu_bar .= '</font></center><br>';
}
#------------------------------------------------------------------#
# Perl Routines to Manipulate CGI input
# [email protected]
# $Header: /people/seb1005/http/cgi-bin/RCS/cgi-lib.pl,v 1.2 1994/01/10 15:05:40 seb1005 Exp $
#
# Copyright 1993 Steven E. Brenner
# Unpublished work.
# Permission granted to use and modify this library so long as the
# copyright above is maintained, modifications are documented, and
# credit is given for any use of the library.
# ReadParse
# Reads in GET or POST data, converts it to unescaped text, and puts
# one key=value in each member of the list "@in"
# Also creates key/value pairs in %in, using '\0' to separate multiple
# selections
# If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse,
# information is stored there, rather than in $in, @in, and %in.
sub ReadParse {
if (@_) {
local (*in) = @_;
}
local ($i, $loc, $key, $val);
# Read in text
if ($ENV{'REQUEST_METHOD'} eq "GET") {
$in = $ENV{'QUERY_STRING'};
} elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++) {
$in .= getc;
}
}
else {
print "PerlShop version $PerlShop_version copyright (c) 1996 by ARPAnet Corp.\n";
exit;
}
@in = split(/&/,$in);
foreach $i (0 .. $#in) {
# Convert plus's to spaces
$in[$i] =~ s/\+/ /g;
# Convert %XX from hex numbers to alphanumeric
$in[$i] =~ s/%(..)/pack("c",hex($1))/ge;
# Split into key and value.
$loc = index($in[$i],"=");
$key = uc substr($in[$i],0,$loc); ### uc function added by E.T.
$val = substr($in[$i],$loc+1);
$in{$key} .= '\0' if (defined($in{$key})); # \0 is the multiple separator
$in{$key} .= $val;
}
return 1; # just for fun
}
#------------------------------------------------------------------#
sub create_cookie {
my ($cookie_name, $cookie_value, $expire_days) = @_;
my $cookie;
$expiration_date = &create_expire_date($expire_days);
if ($use_cgiwrap eq 'yes')
{$minimum_cookie_path = $cgiwrap_directory;}
else
{$minimum_cookie_path = $cgi_directory;}
$cookie = "Set-Cookie: $cookie_name=$cookie_value; ";
$cookie .= "expires=$expiration_date; ";
$cookie .= "path=$minimum_cookie_path; ";
$cookie .= "domain=$server_address;";
print "$cookie\n";
}
#------------------------------------------------------------------#
sub create_expire_date {
my ($expire_days) = @_;
my (@day_of_week) = ( "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" );
my (@day_of_month) = ( "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" );
if ($expire_days < 0)
{$expiration_date = "Thu, 01-Jan-1970 00:00:01 GMT";}
else
{
$newtime = 86400 * $expire_days + time;
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($newtime);
&Year2000($year);
$expiration_date = "$day_of_week[$wday], $mday-$day_of_month[$mon]-$year 23:59:59 GMT";
}
return $expiration_date;
}
#------------------------------------------------------------------#
sub Year2000 {
my $year = $_[0];
if ($year < 100) {
if ($year < 90)
{$_[0] = 2000 + $year;}
else
{$_[0] = 1900 + $year;}
}
}
#------------------------------------------------------------------#
sub matchfile {
local($_,$file);
local(@list);
FILE: while (defined ($file = shift(@_))) {
if (-d $file) {
if (!opendir(DIR, $file))
{next FILE;}
@list = ();
for (readdir(DIR)) {
push(@list, "$file/$_") unless /^\.{1,2}$/;
}
closedir(DIR);
&matchfile(@list);
next FILE;
}
if (!open(FILE, $file))
{next FILE;}
LINE: while (<FILE>) {
if ( /((<([^A-Za-z]|[!\/]){1}?[^<]*?)|(^|>)[^<]*?)$pattern/o ) {
if ($matches == 0) {
print "<br><center><h3>The pattern: \"$input{'SEARCH STRING'}\" was found on the following pages:</h3>";
print '<table border=1><tr><th>Page</th><th>Pattern</th><tr>';
}
s{<([A-Za-z]|[!\/]){1}?[^<]*?($|>)}{}gs; ### remove html tags
s/$pattern/${SO}$&${SE}/go; ### highlight all matches on line
$filename = substr($file, index($file, '/') + 1);
print "<tr><td><a href=\"http://$cgi_prog_location?ACTION=thispage\&thispage=$filename\&ORDER_ID=$unique_id\">$filename<a></td><td>$_</td></tr>";
$matches++;
}
else
{next LINE;}
if ($input{'MATCHALL'} ne 'TRUE')
{next FILE;}
}
} continue {
}
}
#------------------------------------------------------------------#
sub create_log {
my $logfile = shift(@_);
### open the logfile for exclusive use, use a lock file as a semaphore,
$locktitle = "$logfile.lock";
while (-e $locktitle) ### check if lock file is in currently in use,
{sleep 1;} ### (i.e. wait until lock file does not exist)
open (LOCKFILE, ">$locktitle"); ### if it doesn't exist, create it, thus locking the logfile exclusively.
open(log_file, ">>$log_directory/$logfile") || &err_trap("Cannot open $log_file_name for writing\n");
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$mon++;
while (defined ($loginfo = shift(@_)))
{print(log_file "\"$loginfo\",");}
print(log_file "\"$mon/$mday/$year\",");
print(log_file "\"$ENV{'REMOTE_ADDR'}\"\n");
close log_file;
close LOCKFILE;
unlink $locktitle; ### now release the lock on the logfile.
}
#------------------------------------------------------------------#
sub format_time {
my $nowtime = $_[0];
local $_ = $_[1];
my $timetype = $_[2];
$x = "%A, %d-%b-%y";
$X = "%H:%M:%S %Z";
$c = "%A, %d-%b-%y %H:%M:%S %Z";
s/%x/$x/;
s/%c/$c/;
s/%X/$X/;
@sday=('Mon','Tue','Wed','Thu','Fri','Sat','Sun');
@lday=('Monday','Tuesday','Wednesday',
'Thursday','Friday','Saturday','Sunday');
@smon=('Jan','Feb','Mar','Apr','May','Jun',
'Jul','Aug','Sep','Oct','Nov','Dec');
@lmon=('January','February','March','April','May','June',
'July','August','September','October','November','December');
if ($timetype == 0)
{($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=gmtime($nowtime);}
else
{($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime($nowtime);}
if ($hour > 12)
{
$ampm = 'pm';
$hour12 = $hour - 12;
}
else {
$ampm = 'am';
if ($hour == 0)
{$hour12 = 12;}
else
{$hour12 = $hour;}
}
$yr2000 = &Year2000($year);
$yr = substr($year, 2);
$dweek = $yday / 7;
$dweek = sprintf("%u", $dweek);
s/%a/$sday[$day]/;
s/%A/$lday[$day]/;
s/%b/$smon[$mon]/;
s/%B/$lmon[$mon]/;
s/%d/$mday/;
s/%H/$hour/;
s/%I/$hour12/;
s/%j/$yday/;
s/%m/$mon/;
s/%M/$min/;
s/%p/$ampm/;
s/%S/$sec/;
s/%w/$wday/;
s/(%U|%W)/$dweek/;
s/%y/$yr/;
if ($timetype == 0)
{s/%Z/GMT/;}
else
{s/%Z/$local_time/;}
s/%Y/$yr2000/;
return $_;
}
#------------------------------------------------------------------#
sub err_trap {
my $errmsg = $_[0];
print "<center><b>A serious error has occured.<br>Please contact: <a HREF=\"mailto:$company_email\">$company_email</a> and tell them ";
print "the error message below, and the exact sequence of events that led to the error.<br>Thank you.<br><br><i>$errmsg</i></b></center>";
exit;
}