need help with a cart I inherited, need to increase number of total characters allowed

F

fbspector

#!/usr/bin/perl
# use strict;

# ************************** #
# Misc. setups and variables #
# ************************** #

&parse_input;
close(STDERR);
$BASEDATA = $root_dir . '/shopcart/data/base_data.txt';
eval "require '$BASEDATA'";
if ($@) {
&sc_popup_msg("STARTUP ERROR SC01: Basic database not found or is in
error. Be sure the SCdatabase ADMIN function was completed
correctly");
}
(@cards) = split(/,/, $CARD_TYPES);
($credit_card,$mail_check,$c_o_d) = split(/,/, $PYMT_OPTIONS);
if ($credit_card eq "") {
$credit_card = 1;
}
if ($mail_check eq "") {
$mail_check = 0;
}
if ($c_o_d eq "") {
$c_o_d = 0;
}
$security = 0;
$pa_tax = 0;
$pa_amt = 0;
$tellit = "";

$SUBTOTAL = 0;
$ITEMCOUNT = 0;

$FILE_LOCK_WAIT = 10; # in seconds #
$ORDER_DATA_KEEP = 20; # in minutes #

$BASE_DIR = $root_dir . '/shopcart/';
$USERDATA = $root_dir . '/shopvar/user_data.txt';
$PRODDATA = $root_dir . '/shopcart/data/product_data.txt';
$SHIPDATA = $root_dir . '/shopcart/data/shipping_data.txt';

$TEMP_DIR = $root_dir . '/shopvar/';
$TEMP_DATA = $root_dir . '/shopvar/rlist_data.txt';
$TEMP_FILE = $root_dir . '/shopvar/r' . "$$" . '.html';
$TEMP_PAGE = $SITE_URL . '/shopvar/r' . "$$" . '.html';

$EMAIL_ORDER = $root_dir . '/shopcart/data/email_order.txt';
$EMAIL_THANKS = $root_dir . '/shopcart/data/email_thanks.txt';

#
*******************************************************************************************
#
# Remove any expired info in the userdata file #
# ******************************************** #

if (&lock("userdata")) {
&sc_popup_msg($Popup_Message);
}
if (!(-e $USERDATA)) {
open(USERDATA, "+>$USERDATA"); close USERDATA;
}
open(USERDATA, $USERDATA) || &sc_popup_msg("SYSTEM ERROR SC02: Unable
to access $USERDATA for cart storage: $!");
@userdata = <USERDATA>;
close(USERDATA);
$current_time = time;
foreach $data_line (@userdata) {
($uid, $expire_time, $SUBTOTAL, $order_info) = split(/\|\|/,
$data_line);

if ($current_time < $expire_time) {
push(@NOT_EXPIRED, $data_line);
}
else {
$expired_flag = 1;
}
}
if ($expired_flag == 1) {
open(USERDATA, ">$USERDATA") || &sc_popup_msg("SYSTEM ERROR SC03:
Unable to access $USERDATA for cart storage: $!");
foreach $data_line (@NOT_EXPIRED) {
print USERDATA $data_line;
}
close(USERDATA);
}
&unlock("userdata");

#
*******************************************************************************************
#
# If a UID was in QUERY_STRING set $uid and find their #
# info in the userdata file, otherwise set new user uid #
# ***************************************************** #

if ($FORM{'uid'}) {
$uid = $FORM{'uid'};
if (&lock("userdata")) {
&sc_popup_msg($Popup_Message);
}
open(USERDATA, $USERDATA) || &sc_popup_msg("SYSTEM ERROR SC04: Unable
to access $USERDATA for cart storage: $!");
while (<USERDATA>) {
if (/^$uid\|\|(.*)/) {
($expire_time, $SUBTOTAL, $order_info) = split(/\|\|/, $1);
$entry_flag = 1;
@items = split(/\|/, $order_info);
foreach $item (@items)
{
($c_prod, $c_qty, $junk) = split(/¤/, $item);
$ITEMCOUNT += $c_qty;
}
last;
}
}
close(USERDATA);
&unlock("userdata");
if (!$entry_flag) {
&new_user;
}
}
else {
&new_user;
}
#
*******************************************************************************************
#
# Load the database & init global lists
# ***************************************** #
&read_products_database;

#
*******************************************************************************************
#
# If HOME in QUERY_STRING pull in and parse the home.html template #
# ***************************************** #
if ($FORM{'home'})
{
if ($FORM{'uid'})
{
&update_expire_time;
&home_html_parse;
}
else
{
# no UID in URL, so fix & reload
$link = $SHOPCART_URL . "?uid=" . $uid . "&amp;rootdir=" . $root_dir .
"&amp;home=1";
print "Content-type: text/html\n\n";
print "<html><head>\n<meta http-equiv=\"refresh\" content=\"1;url=" .
$link . "\">\n</head>\n";
print "<body bgcolor=\"fad6b0\"><font color=\"fad6b0\">\n";
print "click <a href=\"" . $link . "\"></a></font>.\n";
print "</body></html>\n";
}
exit;
}
#
*******************************************************************************************
#
# If ITEM was in QUERY_STRING set $item and #
# pull in and parse the item.html template #
# ***************************************** #
if ($FORM{'item'}) {
$item = $FORM{'item'};
$columns = $FORM{'columns'};
&update_expire_time;
&item_html_parse;
exit;
}
#
*******************************************************************************************
#
# If home was in QUERY_STRING
# pull in and parse the home.html template #
# ***************************************** #
if ($FORM{'home'}) {
&update_expire_time;
&generic_html_parse('home.html');
exit;
}
#
*******************************************************************************************
#
# If contact was in QUERY_STRING
# pull in and parse the contact.html template #
# ***************************************** #
if ($FORM{'contact'}) {
&update_expire_time;
&generic_html_parse('contact.html');
exit;
}
#
*******************************************************************************************
#
# If terms was in QUERY_STRING
# pull in and parse the terms.html template #
# ***************************************** #
if ($FORM{'terms'}) {
&update_expire_time;
&generic_html_parse('terms.html');
exit;
}

#
*******************************************************************************************
#
# If GROUP was in QUERY_STRING set $group & #
# pull in and parse the group.html template #
# ***************************************** #
if ($FORM{'group'}) {
$group = $FORM{'group'};
$columns = $FORM{'columns'};

if ($FORM{'pagenum'})
{
$pagenum = 1 * $FORM{'pagenum'};
}
else
{
$pagenum = 1;
}
&update_expire_time;
&group_html_parse;
exit;
}
#
*******************************************************************************************
#
# If CHECKOUT or EDIT was in the QUERY_STRING #
# pull in and parse checkout.html & any changes #
# ********************************************* #
if ( ($FORM{'checkout'}) || ($FORM{'edit'}) )
{
&update_expire_time;
&checkout_html_parse;
exit;
}

#
*******************************************************************************************
#
# If the command is advanced search, pull in and parse advsearch.html
#
#*************************************************#
if ($FORM{'advsearch'})
{
&update_expire_time;
&advsearch_html_parse;
exit;
}
#
*******************************************************************************************
#
# If the command is to search the database, run the search #
# and create a results page. #
#*************************************************#
if ($FORM{'search'})
{
# basic search in all of prodname, part code, description
$search_for = $FORM{'searchfor'};
if ($FORM{'pagenum'})
{
$pagenum = 1 * $FORM{'pagenum'};
}
else
{
$pagenum = 1;
}
&update_expire_time;
$search_for =~ s/^ +//;
$search_for =~ s/ +$//;

if ($search_for eq "")
{
&sc_popup_msg('MISSING: Please enter something to search for!');
}
$search_link = $search_for;
$search_link =~ s/ /%20/g;
$PAGELINK = "<a href=\"$SHOPCART_URL?uid=$uid&amp;rootdir=
$root_dir&amp;search=1&amp;searchfor=$search_link";

undef(@results);
@keywords = split(' ', $search_for);
ITEM: foreach $key (sort(keys %ITEMS_CODE))
{
($groupcode, $itemcode, $littlepic, $bigpic, $prodname, $shortdesc,
$longdesc, $price, $vprice, $sprice, $mprice, $lprice, $xprice,
$mancode, $distributor, $junk) = split(/¤/, $ITEMS_CODE{$key}, 16);
my $data = $prodname . " " . $mancode . " " . $distributor;
foreach $word (@keywords)
{
next ITEM if (!($data =~ /$word/i));
}
$itemcode =~ tr/a-z/A-Z/;
push @results, $itemcode;
}
&results_html_parse;
exit;
}
# ********************************************************* #
# If the command is to search the database, run the search #
# and create a results page. #
#***********************************************************#

if ($FORM{'advanced_search'})
{
if ($FORM{'pagenum'})
{
$pagenum = 1 * $FORM{'pagenum'};
}
else
{
$pagenum = 1;
}
$cats = $FORM{'categories'};
$manu = $FORM{'distributor'};

$search_for = $FORM{'keywords'};
$search_for =~ s/^ +//;
$search_for =~ s/ +$//;

$price_from = $FORM{'pricefrom'};
$price_from =~ s/^ +//;
$price_from =~ s/ +$//;
$price_to = $FORM{'priceto'};
$price_to =~ s/^ +//;
$price_to =~ s/ +$//;

$search_link = $search_for;
$search_link =~ s/ /%20/g;
$PAGELINK = "<a href=\"$SHOPCART_URL?uid=$uid&amp;rootdir=
$root_dir&amp;advanced_search=1&amp;categories=$cats&amp;distributor=
$manu&amp;keywords=$search_link&amp;pricefrom=$price_from&amp;priceto=
$price_to";

my $price_lower = 0.0;
my $price_higher = 999999999999.0;
if ($price_from ne "")
{
$price_lower = 1.0 * $price_from;
}
if ($price_to ne "")
{
$price_higher = 1.0 * $price_to;
}
if ($price_lower >= $price_higher)
{
&sc_popup_msg('INCORRECT: Lowest price greater than highest price!');
}
undef(@results);
@keywords = split(' ', $search_for);
ITEM: foreach $key (sort(keys %ITEMS_CODE))
{
($groupcode, $itemcode, $littlepic, $bigpic, $prodname, $shortdesc,
$longdesc, $price, $vprice, $sprice, $mprice, $lprice, $xprice,
$mancode, $distributor, $junk) = split(/¤/, $ITEMS_CODE{$key}, 16);

if ($cats ne "All")
{
($junk, $junk, $junk, $title, $junk) = split(/¤/, $GROUPS{$groupcode},
5);
next ITEM unless ($title eq $cats);
}
if ($manu ne "All")
{
next ITEM unless ($distributor eq $manu);
}
next unless ($price >= $price_lower);
next unless ($price <= $price_higher);

if ($search_for ne "")
{
my $data = $prodname . " " . $mancode . " " . $shortdesc . " " .
$longdesc;
foreach $word (@keywords)
{
next ITEM if (!($data =~ /$word/i));
}
}
$itemcode =~ tr/a-z/A-Z/;
push @results, $itemcode;
}
&results_html_parse;
exit;
}
#
*******************************************************************************************
#
# If the command is to GOTO to a page, check for #
# the page, read it in and parse the output page. #
#*************************************************#
if ($FORM{'goto'}) {
$goto = $FORM{'goto'};
&update_expire_time;
&goto_html_parse;
exit;
}
#
*******************************************************************************************
#
# If the command is to link to another PERL #
# program, setup the parameters and exec it #
#*******************************************#
if ($FORM{'link'}) {
$link = $FORM{'link'};
$parm = $FORM{'parm'};
&update_expire_time;
$temp = $ENV{'SCRIPT_FILENAME'};
$x = rindex($temp,"/");
$x = $x + 1;
$call = substr($temp, 0, $x) . $link;
$ENV{'QUERY_STRING'} = $parm;
exec "$call";
exit;
}
#
*******************************************************************************************
#
# If the command is QUICKADD, search for item by code, add one to #
# userdata UID and return review sheet. #
# ************************************** #

if ( $FORM{'quickadd'} )
{
# this can be an item code or a distributor code
$search = $FORM{'additem'};
$search =~ s/ //g;
$search =~ tr/a-z/A-Z/;

if ($search eq "")
{
&sc_popup_msg('MISSING: Please enter a valid item or distributor part
code');
}
my $item = $ITEMS_CODE{$search};

if (!defined($item))
{
$item = $ITEMS_MANCODE{$search};
}
if (!defined($item))
{
&sc_popup_msg('MISSING:' . $search . 'was not found. Please enter a
valid item or distributor part code');
}
($groupcode, $itemcode, $littlepic, $bigpic, $prodname, $shortdesc,
$longdesc, $price, $vprice, $sprice, $mprice, $lprice, $xprice,
$mancode, $distributor, $available, $condition, $PMCcode, $junk) =
split(/¤/, $item, 19);

$prodcode = $itemcode . " " . $prodname;
$qty = 1;
$idrop = "";
$text1 = "";
$text2 = "";
$text3 = "";
$select = "";
$new_order_info = &add_item_internal;
&review_cart($new_order_info);
exit;
}
#
*******************************************************************************************
#
# If the command is ADDTOCART, add it to #
# userdata UID and return review sheet. #
# ************************************** #

if ( $FORM{'addtocart'} )
{
$itemcode = $FORM{'additem'};
my $item = $ITEMS_CODE{$itemcode};
if (!defined($item))
{
&sc_popup_msg('INTERNAL ERROR: item does not exist in database');
}
($groupcode, $itemcode, $littlepic, $bigpic, $prodname, $shortdesc,
$longdesc, $price, $vprice, $sprice, $mprice, $lprice, $xprice,
$mancode, $distributor, $available, $condition, $PMCcode, $junk) =
split(/¤/, $item, 19);
$prodcode = $itemcode . " " . $prodname;

# read price from form due to combined sizeprice field -- JKR
if ($FORM{'price'}) {
$price = $FORM{'price'};
}
if ($FORM{'idrop'}) {
$idrop = $FORM{'idrop'};
$workspace = substr($idrop,0,1);
$whatbox = substr($idrop,1);
if ($workspace eq "0") {
&sc_popup_msg("MISSING: " . $whatbox);
}
}
else {
$idrop = "";
}
if (!$FORM{'qty'}) {
&sc_popup_msg('MISSING: Unable to add the item to your cart, please
enter a quantity');
}
$qty = 0 + $FORM{'qty'};
#if ($qty < 1 || $qty > $available ) {
#&sc_popup_msg('INVALID: Unable to add the item to your cart, please
enter a valid quantity');
#}
if (!$FORM{'text1'}) {
$text1 = "";
}
if ($FORM{'text1'}) {
$text1 = $FORM{'text1'};
}
if (!$FORM{'text2'}) {
$text2 = "";
}
if ($FORM{'text2'}) {
$text2 = $FORM{'text2'};
}
$text2 =~ tr/\x0A/>/;
$text2 =~ tr/\x0D/>/;
if (!$FORM{'text3'}) {
$text3 = "";
}
if ($FORM{'text3'}) {
$text3 = $FORM{'text3'};
}
$text3 =~ tr/\x0A/>/;
$text3 =~ tr/\x0D/>/;

# Get Size into $size variable
&split_pricePM("$price");

if (!$FORM{'select'}) {
$select = "";
}
if ($FORM{'select'}) {
$select = $FORM{'select'};
}
$new_order_info = &add_item_internal;
&review_cart($new_order_info);
exit;
}
#
*******************************************************************************************
#
# If the command is REVIEW, get the UID #
# read in the data and 'print' it out. #
# ************************************* #

if ($FORM{'review'}) {
$uid = $FORM{'uid'};
if (&lock("userdata")) {
&sc_popup_msg($Popup_Message);
}
open(USERDATA, $USERDATA) || &sc_popup_msg("SYSTEM ERROR SC07: Unable
to access $USERDATA for cart storage: $!");
@userdata = <USERDATA>;
close(USERDATA);
&unlock("userdata");
foreach $data_line (@userdata) {
if ($data_line =~ /^$uid\|\|(.*)/) {
($expire_time, $SUBTOTAL, $order_info) = split(/\|\|/, $1);
&review_cart($order_info);
exit;
}
}
exit;
}
#
*******************************************************************************************
#
# If the command is EMPTY your cart #
# get the info, delete all. #
# ********************************* #

if ($FORM{'empty'}) {
if (&lock("userdata")) {
&sc_popup_msg($Popup_Message);
}
open(USERDATA, $USERDATA) || &sc_popup_msg("SYSTEM ERROR SC08: Unable
to access $USERDATA for cart storage: $!");
@userdata = <USERDATA>;
close(USERDATA);
open(USERDATA, ">$USERDATA") || &sc_popup_msg("SYSTEM ERROR SC09:
Unable to access $USERDATA for cart storage: $!");
foreach $data_line (@userdata) {

if ($data_line =~ /^$uid\|\|(.*)/) {
$new_expire_time = (time + ($ORDER_DATA_KEEP * 60));
$SUBTOTAL = 0;
print USERDATA "$uid||$new_expire_time||$SUBTOTAL||\n";
}
else {
print USERDATA $data_line;
}
}
close(USERDATA);
&unlock("userdata");
# &sc_popup_msg("* Your shopping cart has been emptied *");
&review_cart("");
exit;
}
#
*******************************************************************************************
#
# If the command is SENDORDER #
# check all input and do it. #
# *************************** #

if ($FORM{'sendorder'}) {
open(EO, $EMAIL_ORDER) || &sc_popup_msg("SYSTEM ERROR SC10: 'Email
Setup data' from SCdatabase unable to be accessed: $!");
@emailorder = <EO>;
close(EO);
open(ET, $EMAIL_THANKS) || &sc_popup_msg("SYSTEM ERROR SC11: 'Email
Setup data' from SCdatabase unable to be accessed: $!");
@emailthanks = <ET>;
close(ET);
$uid = $FORM{'uid'};
$shipping = $FORM{'shipping'};
if ($shipping eq "0") {
&sc_popup_msg("MISSING: Please select a shipping option");
}
$name = $FORM{'name'};
if ( ((length $name) <= 0) || ( (substr($name,0,1)) eq " ") ) {
&sc_popup_msg("MISSING: Please enter your name");
}
$email = $FORM{'email'};
if ( ($email =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)|(\.$)/) ||
($email !~ /^.+\@\[?(\w|[-.])+\.[a-zA-Z]{2,3}|[0-9]{1,3}\]?$/) ) {
&sc_popup_msg("MISSING: Please enter a valid email addrress");
}
$address = $FORM{'address'};
if ( ((length $address) <= 0) || ( (substr($address,0,1)) eq " ") ) {
&sc_popup_msg("MISSING: Please enter your address");
}
$address =~ tr/\x0A/>/;
$address =~ tr/\x0D/>/;
$city = $FORM{'city'};
if ( ((length $city) <= 0) || ( (substr($city,0,1)) eq " ") ) {
&sc_popup_msg("MISSING: Please enter your city");
}
$state = $FORM{'state'};
if ( ((length $state) <= 0) || ( (substr($state,0,1)) eq " ") ) {
&sc_popup_msg("MISSING: Please enter your state");
}
$zip = $FORM{'zip'};
if ( ((length $zip) <= 0) || ( (substr($zip,0,1)) eq " ") ) {
&sc_popup_msg("MISSING: Please enter your zipcode");
}
$phone = $FORM{'phone'};
if ( ((length $phone) <= 0) || ( (substr($phone,0,1)) eq " ") ) {
&sc_popup_msg("MISSING: Please enter your phone number");
}
$pymtopt = $FORM{'pymtopt'};
$pychk = $FORM{'pychk'};
if ( $pymtopt eq "" && $pychk ) {
&sc_popup_msg("MISSING: Please choose a payment option");
}
$pa_tax = $FORM{'patax'};
if ($pymtopt eq "CreditCard" || $pymtopt eq "" || $pymtopt eq " ") {
$ccnumber = $FORM{'ccnumber'};
$ccard = $FORM{'cctype'};
$cctype = substr($ccard,0,1);
$ccdate = $FORM{'ccdate'};
if ( &cc_validate($cctype, $ccnumber, $ccdate)) {
&sc_popup_msg($Popup_Message);
}
}
&send_order;
$goto = $root_dir . "/shopcart/thankyou.html";
$uid = "ordersent";
$security = 1;
&goto_html_parse();
exit;
}
#
*******************************************************************************************
#
# No specific valid command. End of the line folks. #
# ************************************************** #
&sc_popup_msg("SYSTEM ERROR SC99: A recognized 'group' parameter must
be passed to invoke the shopping cart.");

#############################################################################################
# SUBROUTINE adds an item to the cart
# ************************************ #
sub add_item_internal
{
local ($i_prod, $i_qty, $i_pmc, $i_price, $i_select, $i_text1,
$i_text2, $i_text3, $i_idrop);
local (@lines, $line);

# FIXME decrement available count???
if (&lock("userdata")) {
&sc_popup_msg($Popup_Message);
}
open(USERDATA, $USERDATA) || &sc_popup_msg("SYSTEM ERROR SC05: Unable
to access $USERDATA for cart storage: $!");
@userdata = <USERDATA>;
close(USERDATA);

# find user info
my $expire_time;
my $subtotal = 0;
my $order_info;
foreach $data_line (@userdata)
{
if ($data_line =~ /^$uid\|\|(.*)/)
{
($expire_time, $subtotal, $order_info) = split(/\|\|/, $1);
}
}
# reset expiry time
$expire_time = (time + ($ORDER_DATA_KEEP * 60));
my $not_found = 1;
@lines = split(/\|/, $order_info);

# look for existing product and modify quantity
foreach $line (@lines)
{
($i_prod, $i_qty, $i_pmc, $i_price, $i_select, $i_text1, $i_text2,
$i_text3, $i_idrop) = split(/¤/, $line);
if (($i_prod eq $prodcode) && ($i_price eq $price) && ($i_prod ne
"CM001 Custom Mix Chocolates"))
{
# modify in place
$save_price = $i_price;
&split_price("$i_price");
$price =~ tr/ //d;
$i_qty += $qty;
$subtotal += (1 * $price * $qty);
$line = join('¤', $i_prod, $i_qty, $i_pmc, $save_price, $i_select,
$i_text1, $i_text2, $i_text3, $i_idrop);
$not_found = 0;

# sanity check (GLOBAL!)
# if ($i_qty > $available)
# {
# &sc_popup_msg("ERROR: you have already purchased all available
items.");
# }
last;
}
}
if ($not_found)
{
# new order line
$save_price = $price;
&split_price("$price");
$price =~ tr/ //d;
$subtotal += (1 * $price * $qty);
$line = join('¤', $prodcode, $qty, $PMCcode, $save_price, $select,
$text1, $text2, $text3, $idrop, $cmtext);
push @lines, $line;
}
# rebuild order_info
$order_info = join('|', @lines);
$SUBTOTAL = sprintf "%5.2f", $subtotal; # GLOBAL!

open(USERDATA, ">$USERDATA") || &sc_popup_msg("SYSTEM ERROR SC06:
Unable to access $USERDATA for cart storage: $!");
foreach $data_line (@userdata)
{
if ($data_line =~ /^$uid\|\|(.*)/)
{
print USERDATA $uid . "||" . $expire_time . "||" . $SUBTOTAL . "||" .
$order_info . "\n";
}
else
{
print USERDATA $data_line;
}
}
close(USERDATA);
&unlock("userdata");
return $order_info;
}
#############################################################################################
# SUBROUTINE creates a unique shopper #
# UID and adds it to the userdata file #
# ************************************ #

sub new_user {
local $rpid = reverse $$;
$uid = $ENV{'REMOTE_ADDR'};
$uid = pack("C4", split(/\./, $uid));
$uid = substr(pack("u", $uid), 1);
chop($uid);
$uid =~ tr| -_`|A-Za-z0-9*_A|;
$uid = substr($rpid,0,2) . $uid . substr(time,4);
$uid =~ tr|a-z|A-Z|;
$uid =~ tr|*|8|;
$expire_time = time + (60 * $ORDER_DATA_KEEP);
$SUBTOTAL = 0;

if (&lock("userdata")) {
&sc_popup_msg($Popup_Message);
}
open(USERDATA, ">>$USERDATA") || &sc_popup_msg("SYSTEM ERROR SC13:
Unable to access $USERDATA for cart storage: $!");
print USERDATA "$uid||$expire_time||$SUBTOTAL||\n";
close(USERDATA);
&unlock("userdata");
}
# ******************************************************** #
# SUBROUTINE updates a user's expire time in userdata file #
# ******************************************************** #

sub update_expire_time {
if (&lock("userdata")) {
&sc_popup_msg($Popup_Message);
}
open(USERDATA, $USERDATA) || &sc_popup_msg("SYSTEM ERROR SC14: Unable
to access $USERDATA for cart storage: $!");
@userdata = <USERDATA>;
close(USERDATA);
open(USERDATA, ">$USERDATA") || &sc_popup_msg("SYSTEM ERROR SC15:
Unable to access $USERDATA for cart storage: $!");
foreach $data_line (@userdata) {

if ($data_line =~ /^$uid\|\|\d+\|\|(.*)/) {
$order_info = $1;
$new_expire_time = (time + ($ORDER_DATA_KEEP * 60));
print USERDATA "$uid||$new_expire_time||$order_info\n";
}
else {
print USERDATA $data_line;
}
}
close(USERDATA);
&unlock("userdata");
}
#
*******************************************************************************************
#
# SUBROUTINE reads in ITEM data and item.html page, #
# checks for shopcart markers and href commands, then #
# replaces / changes as needed and outputs the page. #
# *************************************************** #

sub item_html_parse {
local(@idd);
$group_chk = 0; $item_chk = 1; $checkout_chk = 0;
if (&lock("proddata")) {
&scd_popup_msg("$Error_Message", 1);
}
open(PRODUCTS, $PRODDATA) || &sc_popup_msg("SYSTEM ERROR SC16: MAIN
database unable to be accessed: $!");
$not_found = 1;
while ($record = <PRODUCTS>)
{
($groupcode, $itemcode, $remainder) = split(/¤/, $record, 3);

if ($itemcode eq "AA000")
{
($groupdescr, $grouptitle, $groupimage, $junk) = split(/¤/,
$remainder, 4);
$groupname = $groupcode;
}
else
{
($littlepic, $bigpic, $prodname, $shortdesc, $longdesc, $price,
$vprice, $sprice, $mprice, $lprice, $xprice, $mancode, $distributor,
$available, $condition, $PMCcode, $packaging, $shipdate, $weight,
$selectA, $selectB, $selectC, $selectD, $selectE, $text1, $text2,
$text3, $idrop) = split(/¤/, $remainder);
$idrop =~ tr/\x0A//d;
$idrop =~ tr/\x0D//d;

if ($itemcode eq $item)
{
close(PRODUCTS);
&unlock("proddata");
$not_found = 0;
last;
}
}
}
if ($not_found) {
close(PRODUCTS);
&unlock("proddata");
&sc_popup_msg("SYSTEM ERROR SC17: item $item not found in the
database.");
return(0);
}
local ($goto) = "item.html";
local $filename = $BASE_DIR.$goto;
open(HTMLPAGE, $filename) || &sc_popup_msg("ERROR SC18: item.html
unable to be accessed in shopcart folder: $!");
print "Content-type: text/html\n\n";
$have_no_body = 1;
$closed_form = 0;
while ($html_line = <HTMLPAGE>) {
$line_copy = "";

if (($html_line =~ /<\/body/) || ($html_line =~ /<\!\-\- *endform *\-\-
if (!$closed_form) {
print "</form>\n";
}
$closed_form = 1;
}
if ( $html_line =~ /<\+idropdown\+>/ && ( $idrop eq "" || $idrop eq "
") ) {
$html_line = "\n";
}
if ( $html_line =~ /<\+idropdown\+>/ && $idrop ne "" && $idrop ne " ")
{
$line_copy .= $`;
@ibb = split(/,/, $idrop);
$line_copy .= "<select name=\"idrop\" size=\"1\">\n";
$x = 0;
foreach $data_line (@ibb) {

if ($x eq 0) {
$line_copy .= "<option value=\"0$ibb[$x]\">$data_line\n";
}
else {
$line_copy .= "<option value=\"$ibb[$x]\">$data_line\n";
}
$x = $x + 1;
}
$line_copy .= "</select>\n";
$html_line = $';
}
while ( $html_line =~ /(<\+(.+?)\+>)/ ) {
$symbol_all = $1;
$symbol_replace = &token_replace($symbol_all);

if ($symbol_replace eq "*DEL*") {
$symbol_replace = "\n";
}
$line_copy .= $` . $symbol_replace;
$html_line = $';
}
$line_copy .= $html_line;
$html_line = $line_copy;
&check_href;
print $html_line;

if ($html_line =~ /<head/) {
print "<script language=\"JavaScript\">var cart_uid=\"" . $uid . "\"</
script>\n";
}
if ($have_no_body) {
if ($html_line =~ /<\!\-\- *startform *\-\->/ ) {
print "<form method=GET action=\"$SHOPCART_URL\">\n";
print "<input type=hidden name=\"uid\" value=\"$uid\">\n";
print "<input type=hidden name=\"rootdir\" value=\"$root_dir\">\n";
print "<input type=hidden name=\"additem\" value=\"$itemcode\">\n";
$have_no_body = 0;
}
}
}
print $version;
print "\n\n";
close(HTMLPAGE);
}
# ***************************************************************** #
# SUBROUTINE reads in products data and initialises global data,
# %GROUPS - hash of groups by groupcode
# @DISTRIBUTORS - array of distributors
# %ITEMS_CODE - hash of items by item code
# %ITEMS_MANCODE - hash of items by distributor code
# $HORIZ_CATS - HTML formatted horizontal list of all groups
# $VERT_CATS - HTML formatted vertical list of all groups
# $MANU_LIST - HTML formatted vertical list of all groups
# ***************************************************************** #

sub read_products_database {
local($littlepic, $bigpic, $prodname, $shortdesc, $longdesc, $price,
$vprice, $sprice, $mprice, $lprice, $xprice, $mancode, $distributor,
$available, $condition, $PMCcode, $packaging, $shipdate, $weight,
$selectA, $selectB, $selectC, $selectD, $selectE, $text1, $text2,
$text3, $idrop);
local ($groupcode, $itemcode, $remainder, $junk, $key, $manu, $link);
local (@groups, %distributors, %categories);

undef(@DISTRIBUTORS);
undef($HORIZ_CATS);
undef($VERT_CATS);
undef($MANU_LIST);

if (&lock("proddata")) {
&scd_popup_msg("$Error_Message", 1);
}
open(PRODUCTS, $PRODDATA) || &sc_popup_msg("SYSTEM ERROR SC20: Main
database unable to be accessed");

# build groups & hashes of things
while ($product = <PRODUCTS>) {
($groupcode, $itemcode, $remainder) = split(/¤/, $product, 3);
$itemcode =~ tr/a-z/A-Z/;
$itemcode =~ s/^ +//g;
$itemcode =~ s/ +$//g;

if ($itemcode eq "AA000")
{
($descr, $title, $image, $droplist, $cols, $rows, $junk) = split(/¤/,
$remainder, 6);
push @groups, $title;
$categories{$title} = $groupcode;
$images{$title} = $image;
$GROUPS{$groupcode} = $product;
} else {
($littlepic, $bigpic, $prodname, $shortdesc, $longdesc, $price,
$vprice, $sprice, $mprice, $lprice, $xprice, $mancode, $distributor,
$junk) = split(/¤/, $remainder, 14);
$distributor =~ s/^ +//g;
$distributor =~ s/ +$//g;

if ($distributor ne "") {
$distributors{$distributor} = 1;
}
$mancode =~ tr/a-z/A-Z/;
$mancode =~ s/^ +//g;
$mancode =~ s/ +$//g;
$ITEMS_CODE{$itemcode} = $product;
$ITEMS_MANCODE{$mancode} = $product;
}
}
@DISTRIBUTORS = sort(keys %distributors);
close(PRODUCTS);
&unlock("proddata");

# build lists of things
# $MANU_LIST, $HORIZ_CATS, $VERT_CATS

$MANU_LIST = "&nbsp;&nbsp;";
$HORIZ_CATS = "";
$VERT_CATS = "&nbsp;&nbsp;";
$i = 0;
foreach $key (@groups)
{
$itemcode = $categories{$key};

if (!($itemcode eq "Custom Mix"))
{
$link = "<a href='".$SHOPCART_URL."?uid=".$uid."&amp;rootdir=".
$root_dir."&amp;group=".$itemcode."'>";
$link = $link . $key . "</a>";

if ($i != 0) {
$HORIZ_CATS = $HORIZ_CATS . "&nbsp;|&nbsp;";
$VERT_CATS = $VERT_CATS . "<br>&nbsp;&nbsp;";
}
$HORIZ_CATS = $HORIZ_CATS . $link;
$VERT_CATS = $VERT_CATS . $link;
$i++;
}
}
$i = 0;
foreach $manu (@DISTRIBUTORS)
{
$link = "<a href='".$SHOPCART_URL."?uid=".$uid."&amp;rootdir=".
$root_dir."&amp;search=1&amp;searchfor=".$manu."'>";
$link = $link . $manu . "</a>";

if ($i != 0) {
$MANU_LIST = $MANU_LIST . "<br>&nbsp;&nbsp;";
}
$MANU_LIST = $MANU_LIST . $link;
$i++;
}
}
#
*******************************************************************************************
#
# SUBROUTINE reads in specified page, #
# checks for shopcart markers and enter commands then #
# replaces / changes as needed and outputs the page. #
# *************************************************** #

sub generic_html_parse {
local ($goto) = shift;
local $filename = $BASE_DIR.$goto;
print "Content-type: text/html\n\n";
$group_chk = 0; $item_chk = 0; $checkout_chk = 0;
open(HTMLPAGE, $filename) || &sc_popup_msg("ERROR SC19: $goto unable
to be accessed in shopcart folder: $!");
$have_no_body = 1;
$closed_form = 0;
while ($html_line = <HTMLPAGE>)
{
$line_copy = "";
if (($html_line =~ /<\/body/) || ($html_line =~ /<\!\-\- *endform *\-\-
if (!$closed_form) {
print "</form>\n";
}
$closed_form = 1;
}
while ($html_line =~ /(<\+(.+?)\+>)/)
{
$symbol_all = $1;
$symbol_replace = &token_replace($symbol_all);
$line_copy .= $` . $symbol_replace;
$html_line = $';
}
$line_copy .= $html_line;
$html_line = $line_copy;
&check_href;
print $html_line;

if ($html_line =~ /<head/) {
print "<script language=\"JavaScript\">var cart_uid=\"" . $uid . "\"</
script>\n";
}
if ($have_no_body)
{
if ($html_line =~ /<\!\-\- *startform *\-\->/ )
{
print "<form method=GET action=\"$SHOPCART_URL\">\n";
print "<input type=hidden name=\"uid\" value=\"$uid\">\n";
print "<input type=hidden name=\"rootdir\" value=\"$root_dir\">\n";
$have_no_body = 0;
}
}
}
}
# *************************************************** #
# SUBROUTINE reads in HOME data and home.html page, #
# checks for shopcart markers and enter commands then #
# replaces / changes as needed and outputs the page. #
# *************************************************** #

sub home_html_parse {
local ($goto) = "home.html";
local ($product, @groups);
local ($html_save, $check_end, $thisgroup, $dbgroup, $pn, $dl, $i, $x,
$j, $k, $l, $m);
local (%distributors, %categories, %images, $manu);
local $filename = $BASE_DIR.$goto;
print "Content-type: text/html\n\n";
$group_chk = 0; $item_chk = 0; $checkout_chk = 0;
open(HTMLPAGE, $filename) || &sc_popup_msg("ERROR SC19: home.html
unable to be accessed in shopcart folder: $!");
$have_no_body = 1; $home_found = 0; $do_home = 0; $closed_form = 0;
while ($html_line = <HTMLPAGE>)
{
$line_copy = "";
if (($html_line =~ /<\/body/) || ($html_line =~ /<\!\-\- *endform *\-\-
if (!$closed_form) {
print "</form>\n";
}
$closed_form = 1;
}
while ($html_line =~ /(<\+(.+?)\+>)/)
{
$symbol_all = $1;
$symbol_replace = &token_replace($symbol_all);
$line_copy .= $` . $symbol_replace;
$html_line = $';
}
$line_copy .= $html_line;
$html_line = $line_copy;
&check_href;
print $html_line;

if ($html_line =~ /<head/) {
print "<script language=\"JavaScript\">var cart_uid=\"" . $uid . "\"</
script>\n";
}
if ($have_no_body)
{
if ($html_line =~ /<\!\-\- *startform *\-\->/ )
{
print "<form method=GET action=\"$SHOPCART_URL\">\n";
print "<input type=hidden name=\"uid\" value=\"$uid\">\n";
print "<input type=hidden name=\"rootdir\" value=\"$root_dir\">\n";
$have_no_body = 0;
}
}
}
}
# *************************************************** #
# SUBROUTINE reads in GROUP data and group.html page, #
# checks for shopcart markers and group commands then #
# replaces / changes as needed and outputs the page. #
# *************************************************** #

sub group_html_parse {
local ($goto) = "group.html";
local (@group_items, @item_html, @gdd_array, @gdd_name, @gdd_items);
local ($html_save, $check_end, $thisgroup, $dbgroup, $pn, $dl, $i, $x,
$j, $k, $l, $m);
local $filename = $BASE_DIR.$goto;
$group_chk = 1; $item_chk = 0; $checkout_chk = 0;
open(HTMLPAGE, $filename) || &sc_popup_msg("ERROR SC19: group.html
unable to be accessed in shopcart folder: $!");

if (&lock("proddata")) {
&scd_popup_msg("$Error_Message", 1);
}
open(PRODUCTS, $PRODDATA) || &sc_popup_msg("SYSTEM ERROR SC20: Main
database unable to be accessed: $!");
$not_found = 1;
$numitems = 0;
$dropitems = 0;
$thisgroup = $group;
$thisgroup =~ tr/a-z/A-Z/;
while ($product = <PRODUCTS>)
{
($groupcode, $itemcode, $remainder) = split(/¤/, $product, 3);
$dbgroup = $groupcode;
$dbgroup =~ tr/a-z/A-Z/;
next unless ($dbgroup eq $thisgroup);
$groupname = $groupcode;

if ($itemcode eq "AA000")
{
# process group
($groupdescr, $grouptitle, $groupimage, $droplist, $cols, $rows,
$junk) = split(/¤/, $remainder, 6);
$not_found = 0;
@gdd_array = split(/,/, $droplist);
$cols =~ tr/\x0A//d;
$cols =~ tr/\x0D//d;
$cols =~ tr/ //d;
$rows =~ tr/\x0A//d;
$rows =~ tr/\x0D//d;
$rows =~ tr/ //d;

if ($cols eq "") {
$cols = "3";
}
if ($rows eq "") {
$rows = -1;
}
}
else
{
# process items
($littlepic, $bigpic, $prodname, $junk) = split(/¤/, $remainder, 4);

if (!($prodname =~ "¶"))
{
push @group_items, $product;
$numitems++;
$pn = $prodname;
$pn =~ tr/a-z/A-Z/;
foreach $data_line (@gdd_array) {
$dl = $data_line;
$dl =~ tr/a-z/A-Z/;

if ( $dl eq $pn ) {
$gdd_name[$dropitems] = $prodname;
$gdd_items[$dropitems] = $itemcode;
$dropitems++;
}
}
}
}
}
close(PRODUCTS);
&unlock("proddata");

if ($not_found) {
&sc_popup_msg("CODING ERROR: group $group not found in the product
data file.");
}
$PAGELINK = "<a href=\"$SHOPCART_URL?uid=$uid&amp;rootdir=
$root_dir&amp;group=$group";
$items_per_page = $numitems;
$num_of_pages = 1;
$workspace = $numitems;
$min_items = 0;
$max_items = $numitems;

if ($rows > 0)
{
$items_per_page = $cols * $rows;
$num_of_pages = 0;
$workspace = $numitems;
while ($workspace > 0) {
$num_of_pages = $num_of_pages + 1;
$workspace -= $items_per_page;
}
if ( (&not_a_number($pagenum)) ) {
$pagenum = 1;
}
$min_items = ($pagenum - 1) * $items_per_page;
$max_items = $min_items + $items_per_page;
if ($max_items > $numitems) {
$max_items = $numitems;
}
}
print "Content-type: text/html\n\n";
$have_no_body = 1; $group_found = 0; $do_group = 0; $closed_form = 0;
$do_drop = 0; $del_drop = 0;
$j = 0; $x = 0;
while ($html_line = <HTMLPAGE>)
{
if ($group_found)
{
# save the HTML lines
if ($html_line =~ /\+endgroup\+/)
{
# emit group HTML
$group_found = 0;
# process the saved HTML lines, once per item in this group
# with token replacement.
# if ($empty_group)
# {
# $itemdescr = "No products are available in this group.";
# }
my $cur_row = 0;
my $cur_col = 0;
# emit table header
print "<table border = \"0\" width=\"100%\">\n<tr>";
# list items, starting at index $min_items, up to $max_items
for (my $index = $min_items; $index < $max_items; $index++)
{
# get item data
($groupcode, $itemcode, $littlepic, $bigpic, $prodname, $shortdesc,
$longdesc, $price, $vprice, $sprice, $mprice, $lprice, $xprice,
$mancode, $distributor, $available, $condition, $PMCcode, $packaging,
$shipdate, $weight, $selectA, $selectB, $selectC, $selectD, $selectE,
$text1, $text2, $text3, $idrop) = split(/¤/, $group_items[$index]);
print " <!-- Item $index ($itemcode $prodname) -->\n";

# build item description link
$itemdescr = "<a href='".$SHOPCART_URL."?uid=".$uid."&amp;rootdir=".
$root_dir."&amp;item=".$itemcode."&amp;columns=".$cols."'> " .
$prodname . "</a>\n";
$itemprice = $price;
# emit cell in the table
print "<td>\n";
# print HTML for each item
foreach $item_line (@item_html)
{
# replace all tokens
$html_line = $item_line;
$line_copy = "";
while ($html_line =~ /(<\+(.+?)\+>)/)
{
$symbol_all = $1;
$symbol_replace = &token_replace($symbol_all);

if ($symbol_replace eq "*DEL*") {
$symbol_replace = "N/A";
}
$line_copy .= $` . $symbol_replace;
$html_line = $';
}
$line_copy .= $html_line;
$html_line = $line_copy;
&check_href;
print $html_line;
}
print "</td>\n";
$cur_col++;

if ($cur_col == $cols)
{
$cur_col = 0;
$cur_row++;
print "</tr>\n<tr>\n";
}
}
# emit table footer
print "</tr>\n</table>\n";
}
else
{
push @item_html, $html_line;
}
}
elsif ($html_line =~ /\+group\+/)
{
# save everything until we see an endgroup
$group_found = 1;
}
elsif ( $html_line =~ /\+dropdown\+/ )
{
if ($gddlist ne "") {
$do_drop = 1;
}
else {
$del_drop = 1;
}
}
elsif ( $html_line =~ /\+enddropdown\+/ )
{
$del_drop = 0; $do_drop = 0;
}
elsif ( $do_drop && ($html_line =~ /\+list\+/) )
{
print "<select name=\"item\" size=\"1\">\n";
$x = 0;
foreach $data_line (@gdd_name)
{
print "<option value=\"$gdd_items[$x]\">$data_line\n";
$x = $x + 1;
}
print "</select><br>\n";
print "<input type=hidden name=\"columns\" value=\"$cols\">\n";
print "<input type=submit value=\"View Selection\">\n";
}
elsif ( $do_drop )
{
print $html_line;
}
elsif ( $del_drop )
{
$do_nothing = "yes";
}
else
{
# replace tokens in HTML, add FORM tags to body
$line_copy = "";
if (($html_line =~ /<\/body/) || ($html_line =~ /<\!\-\- *endform *\-\-
if (!$closed_form) {
print "</form>\n";
}
$closed_form = 1;
}
while ( $html_line =~ /(<\+(.+?)\+>)/ )
{
$symbol_all = $1;
$symbol_replace = &token_replace($symbol_all);
$line_copy .= $` . $symbol_replace;
$html_line = $';
}
$line_copy .= $html_line;
$html_line = $line_copy;
&check_href;
print $html_line;

if ($html_line =~ /<head/) {
print "<script language=\"JavaScript\">var cart_uid=\"" . $uid . "\"</
script>\n";
}
if ($have_no_body)
{
if ($html_line =~ /<\!\-\- *startform *\-\->/ )
{
print "<form method=GET action=\"$SHOPCART_URL\">\n";
print "<input type=hidden name=\"uid\" value=\"$uid\">\n";
print "<input type=hidden name=\"rootdir\" value=\"$root_dir\">\n";
$have_no_body = 0;
}
}
}
}
print $version;
print "\n\n";
close(HTMLPAGE);
}
#
*******************************************************************************************
#
# SUBROUTINE reads in advsearch.html page, #
# checks for shopcart markers and enter commands then #
# replaces / changes as needed and outputs the page. #
# *************************************************** #

sub advsearch_html_parse
{
local ($goto) = "advsearch.html";
local $filename = $BASE_DIR.$goto;
local ($have_no_body);
open(HTMLPAGE, $filename) || &sc_popup_msg("ERROR SC19: $goto unable
to be accessed in shopcart folder: $!");
print "Content-type: text/html\n\n";
$have_no_body = 1; $closed_form = 0;
while ($html_line = <HTMLPAGE>)
{
$line_copy = "";
if (($html_line =~ /<\/body/) || ($html_line =~ /<\!\-\- *endform *\-\-
if (!$closed_form) {
print "</form>\n";
}
$closed_form = 1;
}
while ($html_line =~ /(<\+(.+?)\+>)/)
{
$symbol_all = $1;
$symbol_replace = &token_replace($symbol_all);
$line_copy .= $` . $symbol_replace;
$html_line = $';
}
$line_copy .= $html_line;
$html_line = $line_copy;
&check_href;
print $html_line;

if ($html_line =~ /<head/) {
print "<script language=\"JavaScript\">var cart_uid=\"" . $uid . "\"</
script>\n";
}
if ($have_no_body)
{
if ($html_line =~ /<\!\-\- *startform *\-\->/ )
{
print "<form method=GET action=\"$SHOPCART_URL\">\n";
print "<input type=hidden name=\"uid\" value=\"$uid\">\n";
print "<input type=hidden name=\"rootdir\" value=\"$root_dir\">\n";
$have_no_body = 0;
}
}
}
}
#
*******************************************************************************************
#
# SUBROUTINE reads in reults data and results.html page, #
# checks for shopcart markers and commands then #
# replaces / changes as needed and outputs the page. #
# *************************************************** #

sub results_html_parse {
local ($goto) = "results.html";
local (@item_html, $html_save);
local $filename = $BASE_DIR.$goto;
open(HTMLPAGE, $filename) || &sc_popup_msg("ERROR SC19: $goto unable
to be accessed in shopcart folder: $!");

# FIXME
$rows = 12;
$numitems = $#results + 1;
$items_per_page = $rows;
$num_of_pages = 0;
$workspace = $numitems;

while ($workspace > 0) {
$num_of_pages = $num_of_pages + 1;
$workspace -= $items_per_page;
}
if ( (&not_a_number($pagenum)) ) {
$pagenum = 1;
}
$min_items = ($pagenum - 1) * $items_per_page;
$max_items = $min_items + $items_per_page;
if ($max_items > $numitems)
{
$max_items = $numitems;
}
print "Content-type: text/html\n\n";

# DEBUG
for (my $index = 0; $index < $numitems; $index++)
{
print "<!-- " . $results[$index] . " -->\n";
}
$have_no_body = 1; $results_found = 0; $do_results = 0;
$closed_form = 0;

while ($html_line = <HTMLPAGE>)
{
if ($results_found)
{
# save the HTML lines
if ($html_line =~ /\+endresults\+/)
{
# emit results HTML
$results_found = 0;

# process the saved HTML lines, once per item in this group
# with token replacement.
# if ($empty_group)
# {
# $itemdescr = "No products are available in this group.";
# }
# list items, starting at index $item_start, up to $items_per_page

for (my $index = $min_items; $index < $max_items; $index++)
{
# get item data
($groupcode, $itemcode, $littlepic, $bigpic, $prodname, $shortdesc,
$longdesc, $price, $vprice, $sprice, $mprice, $lprice, $xprice,
$mancode, $distributor, $available, $condition, $PMCcode, $packaging,
$shipdate, $weight, $selectA, $selectB, $selectC, $selectD, $selectE,
$text1, $text2, $text3, $idrop) = split(/¤/,
$ITEMS_CODE{$results[$index]});
if (!($prodname =~ "¶"))
{
print " <!-- Item $index ($itemcode $prodname) -->\n";
$itemprice = $price;
# print HTML for each item
foreach $item_line (@item_html)
{
# replace all tokens
$html_line = $item_line;
$line_copy = "";
while ($html_line =~ /(<\+(.+?)\+>)/)
{
$symbol_all = $1;
$symbol_replace = &token_replace($symbol_all);
$line_copy .= $` . $symbol_replace;
$html_line = $';
}
$line_copy .= $html_line;
$html_line = $line_copy;
&check_href;
print $html_line;
}
}
}
}
else
{
push @item_html, $html_line;
}
}
elsif ($html_line =~ /\+results\+/)
{
# save everything until we see an endresults
$results_found = 1;
}
else
{
# replace tokens in HTML, add FORM tags to body
$line_copy = "";
if (($html_line =~ /<\/body/) || ($html_line =~ /<\!\-\- *endform *\-\-
if (!$closed_form) {
print "</form>\n";
}
$closed_form = 1;
}
while ( $html_line =~ /(<\+(.+?)\+>)/ )
{
$symbol_all = $1;
$symbol_replace = &token_replace($symbol_all);
$line_copy .= $` . $symbol_replace;
$html_line = $';
}
$line_copy .= $html_line;
$html_line = $line_copy;
&check_href;
print $html_line;

if ($html_line =~ /<head/) {
print "<script language=\"JavaScript\">var cart_uid=\"" . $uid . "\"</
script>\n";
}
if ($have_no_body)
{
if ($html_line =~ /<\!\-\- *startform *\-\->/ )
{
print "<form method=GET action=\"$SHOPCART_URL\">\n";
print "<input type=hidden name=\"uid\" value=\"$uid\">\n";
print "<input type=hidden name=\"rootdir\" value=\"$root_dir\">\n";
$have_no_body = 0;
}
}
}
}
print $version;
print "\n\n";
close(HTMLPAGE);
}
#
*******************************************************************************************
#
# SUBROUTINE reads in uid data and CHECKOUT.html page, #
# replaces / changes as needed and outputs the page. #
# **************************************************** #

sub checkout_html_parse {
$group_chk = 0; $item_chk = 0; $checkout_chk = 1;
local ($new_line, $new_order_info, @s_table);
local ($sh_list, @sh_cost);
$uid = $FORM{'uid'};
$gbgroup = $FORM{'gbgroup'};

if ($FORM{'edit'}) {
$qtyerror = 0;
$edititem = $FORM{'edititem'};
if (&lock("userdata")) {
&sc_popup_msg($Popup_Message);
}
open(USERDATA, $USERDATA) || &sc_popup_msg("SYSTEM ERROR SC21: Unable
to access $USERDATA for cart storage: $!");
@userdata = <USERDATA>;
close(USERDATA);
$new_order_info = "";
open(USERDATA, ">$USERDATA") || &sc_popup_msg("SYSTEM ERROR SC22:
Unable to access $USERDATA for cart storage: $!");
foreach $data_line (@userdata) {

if ($data_line =~ /^$uid\|\|(.*)/) {
($expire_time, $SUBTOTAL, $order_info) = split(/\|\|/, $1);
@each_item = split(/\|/, $order_info);
foreach $bought (@each_item) {
($c_prod, $c_qty, $c_pmc, $c_price, $c_select, $c_text1, $c_text2,
$c_text3, $c_idrop) = split(/¤/, $bought);
$c_idrop =~ tr/\x0A//d;
$c_idrop =~ tr/\x0D//d;

if ($bought eq $edititem) {
($key, $junk) = split(' ', $bought, 2);
($i_groupcode, $i_itemcode, $i_littlepic, $i_bigpic, $i_prodname,
$i_shortdesc, $i_longdesc, $i_price, $i_vprice, $i_sprice, $i_mprice,
$i_lprice, $i_xprice, $i_mancode, $i_manufacturer, $i_available,
$i_condition, $i_PMCcode, $i_junk) = split(/¤/, $ITEMS_CODE{$key},
19);
$maxqty = $i_available;
&split_price("$c_price");
$price =~ tr/ //d;
$SUBTOTAL -= ( 1 * $c_qty * $price );
$SUBTOTAL = sprintf "%5.2f", $SUBTOTAL;
$SUBTOTAL =~ tr/ //d;

if ( ($FORM{'edit'}) eq "Cha") {
$newqty = $FORM{'newqty'};
# if ( ($newqty eq "") || (&not_a_number($newqty)) || ($newqty >
$maxqty) ) {
if ( ($newqty eq "") || (&not_a_number($newqty)) ) {
$qtyerror = 1;
$newqty = $c_qty;
}
$SUBTOTAL += ( 1 * $newqty * $price );
$bought = join('¤', $c_prod, $newqty, $c_pmc, $c_price, $c_select,
$c_idrop);
$new_order_info .= $bought . '|';
}
}
else {
$new_order_info .= $bought . '|';
}
}
print USERDATA $uid . '||' . $expire_time . '||' . $SUBTOTAL . '||' .
$new_order_info . "\n";
}
else {
print USERDATA $data_line;
}
}
close(USERDATA);
&unlock("userdata");
# if ($qtyerror) {
# &sc_popup_msg("You have entered an invalid number in the quantity
field. Try again.");
#}
}
if (&lock("userdata")) {
&sc_popup_msg($Popup_Message);
}
open(USERDATA, $USERDATA) || &sc_popup_msg("SYSTEM ERROR SC23: Unable
to access $USERDATA for cart storage: $!");
@userdata = <USERDATA>;
close(USERDATA);
&unlock("userdata");
foreach $data_line (@userdata) {
if ($data_line =~ /^$uid\|\|(.*)/) {
($expire_time, $SUBTOTAL, $order_info) = split(/\|\|/, $1);
}
}
@each_item = split(/\|/, $order_info);
open(SHIPTABLE, $SHIPDATA) || &sc_popup_msg("SYSTEM ERROR SC24:
'Shipping' SCdatabase incomplete or unable to be accessed: $!");
$x = 0;
$y = 0;
while ($s_input = <SHIPTABLE>) {
($s_type, $lownum, $highnum, $s_amt) = split(/¤/, $s_input);
$lownum =~ tr/\$//d; $highnum =~ tr/\$//d; $s_amt =~ tr/\$//d;

if ( $s_amt =~ /\%/ ) {
$s_amt = ( $` * .01 ) * $SUBTOTAL;
$s_amt = sprintf "%5.2f", $s_amt;
$s_amt =~ tr/ //d;
}
if ( ( ($SUBTOTAL - $lownum) >= 0) && ( ($SUBTOTAL - $highnum) <= 0) )
{
$tot_order = $SUBTOTAL + $s_amt;
$tot_order = sprintf "%5.2f", $tot_order;
$tot_order =~ tr/ //d;
sprintf "%5.2f", $c_price;
$s_type .= ' :';
$len = length($s_type);
$z = 20 - $len;
while ($z > 0) {
$s_type = $s_type . '&nbsp;';
$z = $z - 1;
}
$s_table[$x] = "Shipping by $s_type \$ $s_amt";
$s_amt =~ tr/\x0D//d;
$s_amt =~ tr/\x0A//d;
$s_amt =~ tr/ //d;
$sh_cost[$y] = $s_amt;
$x = $x + 1;
$y = $y + 1;
}
}
local ($goto) = "checkout.html";
local $filename = $BASE_DIR.$goto;
open(HTMLPAGE, $filename) || &sc_popup_msg("SYSTEM ERROR SC25:
checkout.html unable to be accessed in the shopcart folder: $!");
&TEMP_stuff();
while ($html_line = <HTMLPAGE>) {
$line_copy = "";

if ($html_line =~ /<\/body/ ) {
print TEMPFILE "<script language=\"JavaScript\">\n";
print TEMPFILE "function compute(coform) {\n";
print TEMPFILE "subtotal = 'Subtotal - \$$SUBTOTAL'\n";

if ( $pa_tax ) {
print TEMPFILE "taxamt = .005 + ( ( 1 * $SUBTOTAL ) * .06 )\n";
print TEMPFILE "string = '' + taxamt\n";
print TEMPFILE "separation = string.length - string.indexOf('.')\n";
print TEMPFILE "if (separation == 2) taxamt = string + '0'\n";
print TEMPFILE "if (separation > 3) taxamt =
string.substring(0,string.length-separation+3)\n";
print TEMPFILE "patax = ' PA tax : \$ ' + taxamt + ', '\n";
print TEMPFILE "taxamt = ( 1 * taxamt )\n";
}
else {
print TEMPFILE "taxamt = 0\n";
print TEMPFILE "patax = ''\n";
}
print TEMPFILE "statecode =
document.coform.state.value.substring(0,2)\n";
print TEMPFILE "if (statecode != 'PA' && statecode != 'Pa' &&
statecode != 'pa' && statecode != 'PE' && statecode != 'Pe' &&
statecode != 'pe') {\n";
print TEMPFILE "taxamt = 0; patax = ''; }\n";
print TEMPFILE "if (document.coform.shipping.selectedIndex == 0)
{ shipcost = 0 }\n";
print TEMPFILE "if (document.coform.shipping.selectedIndex == 1)
{ shipcost = '$sh_cost[0]' }\n";
print TEMPFILE "if (document.coform.shipping.selectedIndex == 2)
{ shipcost = '$sh_cost[1]' }\n";
print TEMPFILE "if (document.coform.shipping.selectedIndex == 3)
{ shipcost = '$sh_cost[2]' }\n";
print TEMPFILE "if (document.coform.shipping.selectedIndex == 4)
{ shipcost = '$sh_cost[3]' }\n";
print TEMPFILE "shipping = '\\nShipping - \$' + shipcost\n";
print TEMPFILE "subsub = 1 * $SUBTOTAL\n";
print TEMPFILE "shipcost = 1 * shipcost\n";
print TEMPFILE "orderamt = subsub + shipcost + taxamt + .005\n";
print TEMPFILE "string = '' + orderamt\n";
print TEMPFILE "if (string.indexOf('.') == -1) orderamt = string + '.
00'\n";
print TEMPFILE "separation = string.length - string.indexOf('.')\n";
print TEMPFILE "if (separation == 2) orderamt = string + '0'\n";
print TEMPFILE "if (separation > 3) orderamt =
string.substring(0,string.length-separation+3)\n";
print TEMPFILE "if (patax == '') { totot = 'ORDER TOTAL : \$ ' +
orderamt } \n ";
print TEMPFILE "else { totot = 'ORDER TOTAL : \$ ' + orderamt }\n";
print TEMPFILE "document.coform.finalinfo.value = patax + totot\n}\n";
print TEMPFILE "</script>\n";
print TEMPFILE "</form>\n";
}
if ($html_line =~ /<!--patax-->/ ) {
$pa_tax = 1;
}
while ( $html_line =~ /(<\+(.+?)\+>)/ ) {
$symbol_all = $1;
$symbol_replace = &token_replace($symbol_all);
if ($symbol_replace eq "*DEL*") {
$html_line = "\n";
}
if ($symbol_replace ne "*DEL*") {
$line_copy .= $` . $symbol_replace;
$html_line = $';
}
$html_line = $';
if ($symbol_replace eq "¤") {
$new_line = "<center><table width=\"778\" border=\"1\" bgcolor=\"D1BFAB
\"><tr><td align=center>\n";
$new_line .= "<table width=\"760\" border=\"0\"\n";
$new_line .= "<tr><td align=center><font size=3 color=43261F
face=arial><u>Cha</u>nge</font></td>\n";
$new_line .= "<td align=center><font size=3 color=43261F
face=arial><u>Qty</u></font></td>\n";
$new_line .= "<td align=left><font size=3 color=43261F
face=arial>&nbsp; <u>Item</u></font></td>\n";
$new_line .= "<td align=left colspan=\"2\"><font size=3 color=43261F
face=arial>&nbsp; <u>Special Information</u></font></td>\n";
$new_line .= "<td align=center><font size=3 color=43261F
face=arial><u>Price Each</u></font></td>\n";
$new_line .= "<td align=center><font size=3 color=43261F
face=arial><u>Cost</u></font></td>\n";
$new_line .= "<td align=center><font size=3 color=43261F
face=arial><u>Del</u>ete</font></td></tr>\n";
$new_line .= "<tr><td colspan=8>&nbsp;</td></tr>\n";
foreach $bought (@each_item) {
$bought_copy = "";
while ( $bought =~ /'/ ) {
$bought_copy .= $` . "'"; $bought = $';
}
$bought_copy .= $bought;
$bought = $bought_copy;
$bought_copy = "";
while ( $bought =~ /"/ ) {
$bought_copy .= $` . "&quot;"; $bought = $';
}
$bought_copy .= $bought;
$bought = $bought_copy;
($c_prod, $c_qty, $c_pmc, $price, $c_select, $c_idrop) = split(/¤/,
$bought);
$c_idrop =~ tr/\x0A//d;
$c_idrop =~ tr/\x0D//d;
&split_price("$price");
$price =~ tr/ //d;
$c_size = $size;
$c_price = $price;
$c_price = 1 * $c_price;
$workspace = sprintf "%5.2f", $c_price;
$c_price = $workspace;
$c_price =~ tr/ //d;
$c_total = ( 1 * $c_qty ) * ( 1 * $c_price );
$workspace = sprintf "%5.2f", $c_total;
$c_total = $workspace;
$c_total =~ tr/ //d;
$size_chk = substr($c_size,0,1);
$new_line .= "<tr valign=top><form method=GET action=\"$SHOPCART_SEC\">
\n";
$new_line .= "<td align=center valign=top><font size=2 color=43261F
face=arial>\n";
$new_line .= "<input type=hidden name=\"uid\" value=\"$uid\">\n";
$new_line .= "<input type=hidden name=\"rootdir\" value=\"$root_dir\">
\n";
$new_line .= "<input type=hidden name=edititem value=\"$bought\">\n";
$new_line .= "<input type=hidden name=\"gbgroup\" value=\"$gbgroup\">
\n";
$new_line .= "<input type=submit name=edit value=\"Cha\"></font></td>
\n";
$new_line .= "<td align=center><font size=2 color=43261F
face=arial><input type=text name=newqty value=\"$c_qty\" size=2
maxlength=2></font></td></form><td><font size=2 color=43261F
face=arial>&nbsp; <u>" . $c_prod . "</u></font></td>\n";
$new_line .= "<td align=left colspan=\"2\"><font size=3>&nbsp; </
font>";

if ($c_idrop ne "") {
$new_line .= "<font size=2 color=43261F face=arial><u>" . $c_idrop .
"</u></font>";
}
$workspace1 = substr($c_select,0,1);
if ($workspace1 ne "0" && $workspace1 ne "" ) {
$new_line .= "<font size=2 color=43261F face=arial>";
if ($c_idrop ne "") {
$new_line .= ", &nbsp;";
}
$new_line .= "<u>" . $c_select . "</u></font>";
}
$workspace2 = substr($c_size,0,1);
if ($workspace2 ne "0" && $workspace2 ne "" ) {
$new_line .= "<font size=2 color=43261F face=arial>";
if ($workspace1 ne "" && $workspace1 ne "0" || $c_idrop ne "") {
$new_line .= ", &nbsp;";
}
$new_line .= "<u>" . $c_size . "</u></font>";
}
$new_line .= "&nbsp;</td>\n<td align=center>";
$new_line .= "<font size=2 color=43261F face=arial><u>\$" . $c_price .
"</u></font></td>\n<td align=center><font size=2 color=43261F
face=arial>= &nbsp; <u>\$" . $c_total . "</u></font></td>\n";
$new_line .= "<form method=GET action=\"$SHOPCART_SEC\">\n";
$new_line .= "<td align=center valign=bottom><font size=2 color=545803
face=arial>\n";
$new_line .= "<input type=hidden name=\"uid\" value=\"$uid\">\n";
$new_line .= "<input type=hidden name=\"rootdir\" value=\"$root_dir\">
\n";
$new_line .= "<input type=hidden name=\"gbgroup\" value=\"$gbgroup\">
\n";
$new_line .= "<input type=hidden name=edititem value=\"$bought\">\n";
$new_line .= "<input type=submit name=edit value=\"Del\"></font></td></
form></tr>\n";
$new_line .= "<tr><td><font size=2>&nbsp;</td></tr>\n";
}
$new_line .= "<br></table><form name=coform method=GET action=
\"$SHOPCART_SEC\">\n";
$new_line .= "<input type=hidden name=\"uid\" value=\"$uid\">\n";
$new_line .= "<input type=hidden name=\"rootdir\" value=\"$root_dir\">
\n";
$workspace = sprintf "%5.2f", $SUBTOTAL;
$SUBTOTAL = $workspace;
$SUBTOTAL =~ tr/ //d;
$new_line .= "<font size=3 color=43261F face=arial>Subtotal: &nbsp;\$
" . $SUBTOTAL . "<br></font>\n";

if ($pa_tax) {
$new_line .= "<font size=2 color=43261F face=arial>( PA residents, 6%
sales tax will be added )<br><br></font>\n";
}
$new_line .= "<font size=3 color=43261F face=arial><select
name=shipping size=1 onChange=\"compute(coform)\">\n";
$new_line .= "<option value=0 selected>&nbsp;Please Choose a Shipping
Method&nbsp;\n";
foreach $s_opt (@s_table) {
$new_line .= "<option>" . $s_opt . "\n";
}
$new_line .= "</select><br><br>\n</font><font size=3 color=43261F
face=arial><input type=text name=finalinfo size=30 value=\"ORDER
TOTAL :\"></font><br><br>\n";
$new_line .= "</td></tr></table></center>\n";
$line_copy = $new_line;
}
}
$line_copy .= $html_line;
$html_line = $line_copy;
&check_href;
print TEMPFILE $html_line;

if ($html_line =~ /<head/) {
print TEMPFILE "<script language=\"JavaScript\">var cart_uid=\"" .
$uid . "\"</script>\n";
}
}
close(HTMLPAGE);
close(TEMPFILE);
$goto = $TEMP_FILE;
$security = 1;
&goto_html_parse();
}
#
*******************************************************************************************
#
# SUBROUTINE reads in requested goto .html page, #
# checks for shopcart markers and href commands, then #
# replaces / changes as needed and outputs the page. #
# *************************************************** #

sub goto_html_parse {
local ($gopiece, $x, $where_is, $workspace, $sitename);
if ($goto !~ /^\// ) {
$goto = $root_dir . "/" . $goto;
}
$sURL = $SITE_URL;
if ($security) {
$workspace = $ENV{'SCRIPT_NAME'};
if ( $workspace =~ /[a-zA-Z0-9\-]+\.com/ ) {
$sURL = "https://www.dianneblair.com/$&";
}
elsif ( $workspace =~ /[a-zA-Z0-9\-]+\.net/ ) {
$sURL = "https://www.dianneblair.com/$&";
}
elsif ( $workspace =~ /[a-zA-Z0-9\-]+\.org/ ) {
$sURL = "https://www.dianneblair.com/$&";
}
}
$goto =~ /$root_dir/;
$gopiece = $';
$x = rindex($gopiece,"/");
$x = $x + 1;
$where_is = $sURL . substr($gopiece, 0, $x);
open(HTMLPAGE, $goto) || &sc_popup_msg("SYSTEM ERROR SC26: $goto
unable to be accessed: $!");
print "Content-type: text/html\n\n";

while ($html_line = <HTMLPAGE>) {
$html_copy = "";
$html_line =~ s/JPG/jpg/g;
$html_line =~ s/GIF/gif/g;
$html_line =~ s/\.\.\///g;

while ( $html_line =~ /[a-zA-Z0-9\.\/]+\.jpg/ ) {
if ($security) {
$html_copy .= $` . $sURL . "\/" . $&;
}
elsif ( index($&,"/") >= 0 ) {
$html_copy .= $` . $sURL . "\/" . $&;
}
else {
$html_copy .= $` . $where_is . $&;
}
$html_line = $';
}
$html_copy .= $html_line;
$html_line = $html_copy;
$html_copy = "";
while ( $html_line =~ /[a-zA-Z0-9\.\/]+\.gif/ ) {

if ($security) {
$html_copy .= $` . $sURL . "\/" . $&;
}
elsif ( index($&,"/") >= 0 ) {
$html_copy .= $` . $sURL . "\/" . $&;
}
else {
$html_copy .= $` . $where_is . $&;
}
$html_line = $';
}
$html_copy .= $html_line;
$html_line = $html_copy;
&check_href;
print $html_line;
if ($html_line =~ /<head/) {
print "<script language=\"JavaScript\">var cart_uid=\"" . $uid . "\"</
script>\n";
}
}
print $version;
print "\n\n";
close(HTMLPAGE);
}
#
*******************************************************************************************
#
# SUBROUTINE replaces html tokens #
# ******************************* #

sub token_replace {
local ($symbol_all) = @_;
local ($RCbutton) = '/shopcart/b-review.gif';
local ($ECbutton) = '/shopcart/b-empty.gif';
local ($ACbutton) = '/shopcart/b-add.gif';
local ($SEbutton) = '/shopcart/b-search.gif';
local ($CObutton) = '/shopcart/b-checkout.gif';
local ($len) = 0;
local ($image_src, $display_price, $goto_token, $web_page, $check_end,
$select, $price_list, @price_array, @select_array, $oneor,
$select_list, $cardtype, $wanted_types, $return_str, $p, $len );

# handle tokens & attributes in the form
# token attrib1 = "value1" attrib2 = "value2" ...
($replace_token, $attrs) = ($symbol_all =~ m/(\w+)(( *(\w+) *= *\"(.+?)
\")*)/);
while (($attr, $value) = ($attrs =~ m/^ *(\w+) *= *\"(.+?)\"/))
{
$ATTRS{$attr} = $value;
$attrs = $';
}
$workspace = $replace_token;
if ($workspace =~ /[_0-9]{2,3}/) {
if (substr($&,0,1) ne "_") {
&sc_popup_msg("CODING ERROR: $symbol_all is an invalid ShopCart html
token.");
}
$len = substr($&,1);
$replace_token = $`;
}
if ($replace_token eq "groupname") {
return($groupname);
}
elsif ($replace_token eq "grouptitle") {
return($grouptitle);
}
elsif ($replace_token eq "grouppic") {
$img_src = "<img src=\"../images/groups/".$groupimage."\" border=
\"0\">";
return($img_src);
}
elsif ($replace_token eq "itemdescr") {
return($itemdescr);
}
elsif ($replace_token eq "mancode") {
return($mancode);
}
elsif ($replace_token eq "distributor") {
return($distributor);
}
elsif ($replace_token eq "condition") {
return($condition);
}
elsif ($replace_token eq "PMCcode") {
return($PMCcode);
}
elsif ($replace_token eq "packaging") {
return($packaging);
}
elsif ($replace_token eq "shipdate") {
return($shipdate);
}
elsif ($replace_token eq "weight") {
return($weight);
}
elsif ($replace_token eq "itemcode") {
return($itemcode);
}
elsif ($replace_token eq "itemprice") {
return($itemprice);
}
elsif ($replace_token eq "littlepic") {
$img_src = "<img src=\"../images/little/".$littlepic."\" border=
\"0\">";
return($img_src);
}
elsif ($replace_token eq "bigpic") {
$img_src = "<img src=\"../images/big/".$bigpic."\" border=\"0\">";
return($img_src);
}
elsif ($replace_token eq "prodname") {
return($prodname);
}
elsif ($replace_token eq "shortdesc") {
return($shortdesc);
}
elsif ($replace_token eq "longdesc") {
return($longdesc);
}
elsif ($replace_token eq "blurb") {
return($groupdescr);
}
elsif ($replace_token eq "price") {
if ( !($price eq "0") ) {
&split_price("$price");
$price =~ tr/ //d;
return("\$ $price \n<input type=hidden name=\"price\" value=\"$price
\">");
}
return("(by size)");
}
elsif ($replace_token eq "sizeprice") {
@price_array = ($vprice, $sprice, $mprice, $lprice, $xprice);
$nosize = 1;
foreach $select (@price_array) {

if ($select ne "0") {
$nosize = 0;
}
}
if ($nosize) {
return("*DEL*");
}
else {
$x = 1;
$first_time = 1;
# start table
$price_list = "<table border=\"0\" cellpadding=\"0\" cellspacing=\"0\"
width=\"100%\">\n";
# this font is used to format the sizes & prices
$font = "<font face=\"Verdana, Arial, Helvetica\" size=\"2\" color=
\"800000\">";
foreach $select (@price_array)
{
if (! ($select eq "0") )
{
&split_price("$select");
$price = sprintf "%5.2f", $price;
$price =~ tr/ //d;
$select =~ tr/ /\+/;
# start row
$price_list .= "<tr><td><input type=\"radio\" ";
if ($first_time)
{
$price_list .= "checked ";
}
$price_list .= "name=\"price\" value=\"$select\">\n";
$price_list .= "$font$size</font></td>\n";
$price_list .= "<td>$font\$$price</font></td></tr>\n";
}
}
# end table
$price_list .= "</table>\n";
return($price_list);
}
}
elsif ($replace_token eq "oneorother") {
if ($selectA eq "0") {
return("*DEL*");
}
$select_list = "";
@select_array = ($selectA, $selectB, $selectC, $selectD, $selectE);
$first_time = 1;
foreach $oneor (@select_array) {
$tester = substr($oneor,0,1);
if ($tester ne "0") {
if ( !($first_time) ) {
$select_list .= "<input type=radio name=select value=\"" . $oneor .
"\">" . $oneor . " &nbsp; &nbsp; ";
}
if ($first_time) {
$select_list .= "<input type=radio checked name=select value=\"" .
$oneor . "\">" . $oneor . " &nbsp; &nbsp; ";
$first_time = 0;
}
}
}
return($select_list);
}
elsif ($replace_token eq "goback") {
if ($item_chk) {
$use_group = $groupcode; $use_group =~ tr/ /+/;
return("<a href='".$SHOPCART_URL."?group=".$use_group."'>");
}
if ($checkout_chk) {
$gbgroup = $FORM{'gbgroup'};
return("<a href='".$SHOPCART_URL."?group=".$gbgroup."'>");
}
if ($group_chk) {
&sc_popup_msg("CODING ERROR: the <+goback+> token is invalid in
group.html");
}
}
elsif ($replace_token eq "categories_combo") {
$combo = "<select name=\"categories\">\n";
@groups = sort(keys %GROUPS);
$combo = $combo . "<option value=\"All\">All Categories\n";
foreach $opt (@groups)
{
($groupcode, $itemcode, $descr, $title, $image, $droplist, $cols,
$rows, $junk) = split(/¤/, $GROUPS{$opt}, 9);
if ($title ne "Custom Mix") { $combo = $combo . "<option value=\"$opt
\">$title\n"; }
}
$combo = $combo . "</select>\n";
return $combo;
}
elsif ($replace_token eq "distributor_combo") {
$combo = "<select name=\"distributor\">\n";
$combo = $combo . "<option value=\"All\">All\n";
foreach $opt (@DISTRIBUTORS)
{
$combo = $combo . "<option value=\"$opt\">$opt\n";
}
$combo = $combo . "</select>\n";
return $combo;
}
elsif ($replace_token eq "qty") {
return("<input type=text name=qty size=2 maxlength=2 value=\"1\">");
}
elsif ($replace_token eq "addtocart") {
$x = $root_dir . $ACbutton;

if (-e $x) {
return("<input type=image src=\"$SITE_URL.$ACbutton\" border=\"0\" alt=
\"Add this item to your shopping cart\" name=\"addtocart\">");
}
else {
return("<input type=submit name=\"addtocart\" value=\" Add To Your
Cart \">");
}
}
elsif ($replace_token eq "quickadd") {
$x = $root_dir . $ACbutton;
if (-e $x) {
return("<input type=image src=\"$SITE_URL.$ACbutton\" border=\"0\" alt=
\"Add this item to your shopping cart\" name=\"quickadd\">");
}
else {
return("<input type=submit name=\"quickadd\" value=\" Add To Your Cart
\">");
}
}
elsif ($replace_token eq "search") {
$x = $root_dir . $SEbutton;

if (-e $x) {
return("<input type=image src=\"$SITE_URL.$SEbutton\" border=\"0\" alt=
\"Search\" name=\"search\">");
}
else {
return("<input type=submit name=\"search\" value=\" Search \">");
}
}
elsif ($replace_token eq "advsearch") {
$x = $root_dir . $SEbutton;

if (-e $x) {
return("<input type=image src=\"$SITE_URL.$SEbutton\" border=\"0\" alt=
\"Search\" name=\"advanced_search\">");
}
else {
return("<input type=submit name=\"advanced_search\" value=\" Search
\">");
}
}
elsif ($replace_token eq "review") {
$x = $root_dir . $RCbutton;
if (-e $x) {
return("<input type=image src=\"$SITE_URL.$RCbutton\" border=\"0\" alt=
\"Review the contents of your shopping cart\" name=review>");
}
else {
return("<input type=submit name=review value=\"Review your cart\">");
}
}
elsif ($replace_token eq "empty") {
$x = $root_dir . $ECbutton;
if (-e $x) {
return("<input type=image src=\"$SITE_URL.$ECbutton\" border=\"0\" alt=
\"Empty your shopping cart of all items\" name=empty>");
}
else {
return("<input type=submit name=empty value=\"Empty your cart\">");
}
}
elsif ($replace_token eq "endgo") {
return("</a>");
}
elsif ($replace_token eq "text1") {
$workspace = substr($text1,0,1);

if ( $workspace ne "0") {
return($text1."<br><input type=text name=text1 size=30
maxlength=255><br><br>");
}
else {
return("*DEL*");
}
}
elsif ($replace_token eq "text2") {
$workspace = substr($text2,0,1);

if ( $workspace ne "0") {
return($text2."<br><textarea name=text2 cols=30 rows=2></
textarea><br><br>");
}
else {
return("*DEL*");
}
}
elsif ($replace_token eq "text3") {
$workspace = substr($text3,0,1);

if ( $workspace ne "0") {
return($text3."<br><textarea name=text3 cols=30 rows=3></
textarea><br><br>");
}
else {
return("*DEL*");
}
}
elsif ($replace_token eq "rootdir") {
$workspace = substr($root_dir,0,1);

if ( $workspace ne "0") {
return("<input type=\"hidden\" name=\"rootdir\" value=\"$root_dir
\">");
}
else {
return("*DEL*");
}
}
elsif ($replace_token eq "checkout") {
$return_str = "\n</form>\n<form method=GET action=\"$SHOPCART_SEC\"
onSubmit=\"return confirm(confirmtxt)\">\n";
$return_str .= "<input type=hidden name=\"uid\" value=\"$uid\">\n";
$return_str .= "<input type=hidden name=\"rootdir\" value=\"$root_dir
\">\n";
$return_str .= "<input type=hidden name=\"gbgroup\" value=\"$groupname
\">\n";
$x = $root_dir . $CObutton;

if (-e $x) {
$return_str .= "<input type=image src=\"$SITE_URL.$CObutton\" border=
\"0\" alt=\"All done shopping, time to checkout\" name=checkout>\n";
}
else {
$return_str .= "<input type=submit name=checkout value=\"* C h e ck
o u t *\">\n";
}
$return_str .= "</form>\n<form method=GET action=\"$SHOPCART_URL\">
\n";
$return_str .= "<input type=hidden name=\"uid\" value=\"$uid\">\n";
$return_str .= "<input type=hidden name=\"rootdir\" value=\"$root_dir
\">\n";
return("$return_str");
}
elsif ($replace_token eq "sendorder") {
$return_str = "\n</font></font></font>\n<font size=\"4\" color=\"black
\" face=\"Arial\">\n";
$return_str .= "</font><font size=3><br>\n<input type=hidden
name=patax value=\"$pa_tax\">\n<input type=submit name=sendorder value=
\"* S u b m i t O r d e r *\">\n</font>";
return("$return_str");
}
elsif ($replace_token eq "name") {

if (!$len)
{
$len=30;
}
; return("<input type=text name=name size=$len maxlength=50>");
}
elsif ($replace_token eq "address") {

if (!$len)
{
$len=30;
}
; return("<textarea name=address cols=$len rows=3></textarea>");
}
elsif ($replace_token eq "city") {

if (!$len)
{
$len=30;
}
; return("<input type=text name=city size=$len maxlength=50>");
}
elsif ($replace_token eq "state") {

if (!$len)
{
$len=2;
}
; return("<input type=text name=state size=$len maxlength=20 onChange=
\"compute(coform)\">");
}
elsif ($replace_token eq "zip") {
if (!$len)
{
$len=5;
}
; return("<input type=text name=zip size=$len maxlength=10>");
}
elsif ($replace_token eq "cardholder") {
if (!$len)
{
$len=5;
}
; return("<input type=text name=cardholder size=$len maxlength=50>");
}
elsif ($replace_token eq "email") {
if (!$len)
{
$len=30;
}
; return("<input type=text name=email size=$len maxlength=50>");
}
elsif ($replace_token eq "phone") {

if (!$len)
{
$len=12;
}
; return("<input type=text name=phone size=$len maxlength=20>");
}
elsif ($replace_token eq "ccnumber") {

if (!$credit_card) {
return("*DEL*");
}
if (!$len) {
$len=19;
}
return("<input type=text name=ccnumber size=$len maxlength=50>");
}
elsif ($replace_token eq "ccdate") {
if (!$credit_card) {
return("*DEL*");
}
if (!$len) {
$len=5;
}
return("<input type=text name=ccdate size=$len maxlength=20>");
}
elsif ($replace_token eq "cctype") {
if (!$credit_card) {
return("*DEL*");
}
$wanted_types = "<select name=cctype size=1>";
foreach $cardtype (@cards) {
$wanted_types .= "<option>" . $cardtype;
}
$wanted_types .= "</select>";
return($wanted_types);
}
elsif ($replace_token eq "itemsordered") {
return("¤");
}
elsif ($replace_token eq "specialinfo") {
if (!$len)
{
$len=60;
}
; return("<textarea name=specialinfo cols=$len rows=4></textarea>");
}
elsif ($replace_token eq "paymentoptions") {
$p = $credit_card + $mail_check + $c_o_d;

if ($p lt 2) {
return("*DEL*");
}
$wanted_types = '';
if ($p ge 2) {
$wanted_types .= '<input type=hidden name=pychk value=1>';
}
$wanted_types .= 'Payment Options: &nbsp; &nbsp; ';
if ($credit_card) {
$wanted_types .= '<input type=radio name=pymtopt
value="CreditCard">Credit Card &nbsp; &nbsp; &nbsp; ';
}
if ($mail_check)
{
$wanted_types .= '<input type=radio name=pymtopt
value="MailCheck">Check or Money Order&nbsp; &nbsp; &nbsp; ';
}
if ($c_o_d)
{
$wanted_types .= '<input type=radio name=pymtopt value="COD">C.O.D.
&nbsp;(cash only)';
}
return($wanted_types);
}
elsif ($replace_token eq "hcategories") {
return $HORIZ_CATS;
}
elsif ($replace_token eq "vcategories") {
return $VERT_CATS;
}
elsif ($replace_token eq "distributorlist") {
return $MANU_LIST;
}
elsif ($replace_token eq "itemcount") {
return $ITEMCOUNT;
}
elsif ($replace_token eq "subtotal") {
return "\$" . $SUBTOTAL;
}
elsif ($replace_token eq "pagecounts") {
if ($numitems > 0)
{
$ret = "Displaying " . ($min_items + 1) . " to $max_items (of
$numitems products)";
}
else
{
$ret = "No items to display.";
}
return $ret;
}
elsif ($replace_token eq "pagelinks") {
if ($numitems > 0) {
$ret = "Page: ";
if ($pagenum > 1) {
$prev = $pagenum - 1;
$ret = $ret . $PAGELINK . "&amp;pagenum=$prev\">[&lt;&lt;Prev]</
a>&nbsp;&nbsp;";
}
for ($i = 1; $i <= $num_of_pages; $i++) {
if ($i == $pagenum) {
$ret = $ret . "<font color=\"761A23\">$i</font>&nbsp;&nbsp;";
} else {
$ret = $ret . $PAGELINK . "&amp;pagenum=$i\">$i</a>&nbsp;&nbsp;";
}
}
if ($pagenum < $num_of_pages) {
$next = $pagenum + 1;
$ret = $ret . $PAGELINK . "&amp;pagenum=$next\">[Next&gt;&gt;]</a>";
}
} else {
$ret = "";
}
return $ret;
}
elsif ($replace_token eq "uid") {
return $uid;
}
else {
&sc_popup_msg("CODING ERROR: $symbol_all is an invalid ShopCart html
token.");
}
}
#
*******************************************************************************************
#
# SUBROUTINE checks for, and replaces, necessary href #
# *************************************************** #

sub check_href {
local($html_copy, $tempa, $tempb);
$html_copy = "";
while ( $html_line =~ /href/ ) {
if ( $html_line =~ /ShopCart.pl\?/) {
if ( (substr($',0,3)) ne "uid" ) {
$html_copy .= $` . "ShopCart.pl?uid=" . $uid . "&amp;rootdir=" .
$root_dir . "&amp;" ;
$html_line = $';
}
else {
$html_copy .= $` . $&;
$html_line = $';
}
}
elsif ( $html_line =~ /[\w]{1,16}\.pl/ ) {
$html_copy .= $`;
$perl = $&;
$temp = $';
$temp =~ /([a-zA-Z0-9\/\.]{1,30})/;
$parm = $&;
$html_copy .= "ShopCart.pl?uid=$uid" . "&amp;link=$perl" . "&amp;parm=
$parm";
$html_line = $';
}
elsif ( (!($html_line =~ /href="http/)) && (!($html_line =~ /
href="mailto/)) && (!($html_line =~ /href="javascript/)) ) {
if ( $html_line =~ /href="..\//) {
$html_copy .= $` . "href=\"" . $SHOPCART_URL . "?uid=" . $uid .
"&amp;goto=" . $root_dir . "/";
$html_line = $';
}
elsif ( $html_line =~ /href="/) {
$html_copy .= $` . "href=\"" . $SHOPCART_URL . "?uid=" . $uid .
"&amp;goto=" . $root_dir . "/";
$html_line = $';
}
}
else {
if ( $html_line =~ /href/) {
$html_copy .= $` . "href";
$html_line = $';
}
}
}
$html_copy .= $html_line;
$html_line = $html_copy;
}
#
*******************************************************************************************
#
# SUBROUTINE display shopping cart review window #
# ********************************************** #

sub review_cart
{
local ($whats_init) = @_;
local (@which_one, $bought, $prod_show, $prod_copy, $qty_show,
$item_amt, $item_stuff, $item_total, $chpid);
local ($goto) = "review.html";
local $filename = $BASE_DIR.$goto;
print "Content-type: text/html\n\n";
open(HTMLPAGE, $filename) || &sc_popup_msg("ERROR SC19: $goto unable
to be accessed in shopcart folder: $!");
while ($html_line = <HTMLPAGE>)
{
$line_copy = "";
if ($html_line =~ /<\+itemsordered\+>/)
{
if ($whats_init =~ /¤/)
{
@which_one = split(/\|/, $whats_init);
foreach $bought (@which_one)
{
$bought_copy = "";
while ( $bought =~ /'/ ) {
$bought_copy .= $` . "'"; $bought = $';
}
$bought_copy .= $bought;
$bought = $bought_copy;
$bought_copy = "";
while ( $bought =~ /"/ ) {
$bought_copy .= $` . "&quot;"; $bought = $';
}
$bought_copy .= $bought;
$bought = $bought_copy;
($prod_show, $qty_show, $pmc_show, $price, $select_show, $text1_show,
$text2_show, $text3_show, $idrop_show) = split(/¤/, $bought);
$idrop_show =~ tr/\x0A//d;
$idrop_show =~ tr/\x0D//d;

if ($idrop_show ne "") {
$prod_show = $prod_show . ", " . $idrop_show;
}
&split_price("$price");
$price =~ tr/ //d;
$size_show = $size;
$item_amt = $price;
$item_amt = 1 * $item_amt;
$workspace = sprintf "%5.2f", $item_amt;
$item_amt = $workspace;
$item_amt =~ tr/ //d;
$item_total = ( 1 * $qty_show ) * ( 1 * $item_amt );
$workspace = sprintf "%5.2f", $item_total;
$item_total = $workspace;
$item_total =~ tr/ //d;
$size_chk = substr($size_show,0,1);

print "$prod_show";
if (($size_show ne "0") && ($size_show ne ""))
{
print ", $size_show";
}
if (($select_show ne "0") && ($select_show ne "")) {
print ", $select_show ";
}
print " ( $qty_show at $item_amt ) &nbsp;\$$item_total
$text_stuff<br><br>\n";
}
}
else
{
print "Your shopping cart is empty<br>\n";
}
next;
}
while ($html_line =~ /(<\+(.+?)\+>)/)
{
$symbol_all = $1;
$symbol_replace = &token_replace($symbol_all);
$line_copy .= $` . $symbol_replace;
$html_line = $';
}
$line_copy .= $html_line;
$html_line = $line_copy;
&check_href;
print $html_line;

if ($html_line =~ /<head/) {
print "<script language=\"JavaScript\">var cart_uid=\"" . $uid . "\"</
script>\n";
}
}
exit();
}
#
*******************************************************************************************
#
# SUBROUTINE temp file/page setups, opens and deletes #
# *************************************************** #

sub TEMP_stuff {
local($x, $y, $thisone, @tempdata);
if (&lock("tempdata")) {
&sc_popup_msg($Popup_Message);
}
if (!(-e $TEMP_DATA)) {
open(TEMPDATA, ">$TEMP_DATA") || &sc_popup_msg("SYSTEM ERROR SC28:
Unable to create $TEMP_DATA: $!");
print TEMPDATA "dummy.html\ndummy.html";
close(TEMPDATA);
}
open(TEMPDATA, $TEMP_DATA) || &sc_popup_msg("SYSTEM ERROR SC28: Unable
to access $TEMP_DATA: $!");
$x = 0; $y = 0;
while ($tempdata[$x] = <TEMPDATA>) {
$x = $x + 1;
}
close(TEMPDATA);
$x = $x - 1;
while ( $y < $x ) {
$thisone = $tempdata[$y];
$thisone =~ tr/\x0A//d;
$thisone =~ tr/\x0D//d;
$thisone =~ tr/ //d;
unlink($thisone);
$y = $y + 1;
}
open(TEMPFILE, ">$TEMP_FILE") || &sc_popup_msg("SYSTEM ERROR SC29:
Unable to create data in the shopvar folder.: $!");
open(TEMPDATA, ">$TEMP_DATA") || &sc_popup_msg("SYSTEM ERROR SC30:
Unable to access data in the shopvar folder.: $!");
print TEMPDATA "$tempdata[$x]\n";
print TEMPDATA "$TEMP_FILE";
close(TEMPDATA);
&unlock("tempdata");
}
#
*******************************************************************************************
#
# SUBROUTINES split price and size from same field #
# ************************************************ #

sub split_price {
local($thisone) = @_;
if ( $thisone =~ /Þ/ ) {
$x = index($thisone,"Þ");
$size = substr($thisone,0,$x);
$size =~ tr/+/ /d;
$price = substr($thisone,($x+1));
}
else {
$price = $thisone;
$size = "";
}
}
#
*******************************************************************************************
#
# SUBROUTINES split price and size from same field - Custom for
PremiseMaid #
# ************************************************ #

sub split_pricePM {
local($thisone) = @_;
if ( $thisone =~ /Þ/ ) {
$x = index($thisone,"Þ");
$sizeCheck = substr($thisone,0,$x);
$sizeCheck =~ tr/+/ /d;
$priceCheck = substr($thisone,($x+1));
}
else {
$priceCheck = $thisone;
$sizeCheck = "";
}
}
#
*******************************************************************************************
#
# SUBROUTINE debug tracking by a message #
# ************************************** #
sub de_bug {
local($tellit) = @_;
print "Content-type: text/html\n\n";
print "<script language='JavaScript'>\n";
print "var winHandle =
window.open('' ,'Debug','top=100,left=100,width=400,height=400')\n";
print "winHandle.window.focus();\n";
print "winHandle.document.open();\n";
print "winHandle.document.write('".$tellit."');";
print "winHandle.document.close();\n";
print "winHandle.window.focus();\n";
print "</script></html>\n";
exit;
}
#
*******************************************************************************************
#
# SUBROUTINE number check #
# *********************** #
sub not_a_number {
local($thisnum) = @_;
local($len, $lenchk);
$thisnum =~ tr/$//d;
$thisnum =~ tr/.//d;
$thisnum =~ tr/,//d;
$len = length $thisnum;
$thisnum =~ tr/a-z//d; $thisnum =~ tr/A-Z//d;
$thisnum =~ tr/\-//d; $thisnum =~ tr/\=//d; $thisnum =~ tr/\\//d;
$thisnum =~ tr/-//d;
$thisnum =~ tr/\[//d; $thisnum =~ tr/\]//d; $thisnum =~ tr/;//d;
$thisnum =~ tr/'//d;
$thisnum =~ tr/\///d;
$lenchk = length $thisnum;

if ( $len ne $lenchk ) {
return(1);
}
return(0);
}
#
*******************************************************************************************
#
# SUBROUTINE error message display #
# ******************************** #

sub sc_popup_msg {
local($popup) = @_;
local($del_lock) = $root_dir . '/shopvar/userdata.lok';
unlink($del_lock);
$del_lock = $root_dir . '/shopvar/tempdata.lok'; unlink($del_lock);
$del_lock = $root_dir . '/shopvar/proddata.lok'; unlink($del_lock);
print "Content-type: text/html\n\n";
print "<script language='JavaScript'>\n";
print "alert(\"$popup\");\n";
print "history.go(-1);\n";
print "</script>\n\n\n";
exit;
}
#
*******************************************************************************************
#
# SUBROUTINES lock and unlock userdata file #
# ***************************************** #

sub lock {
local($filename) = @_;
local($wait, $lock_pid);
$Popup_Message = '';
$lock_file = "$TEMP_DIR$filename.lok";

if (-e $lock_file) {
for ($wait = $FILE_LOCK_WAIT; $wait >= 1; $wait--) {
sleep 1;
if (!(-e $lock_file)) {
$wait = 1;
}
;
}
}
if ((-e $lock_file) && (-M $lock_file < 0)) {
$Popup_Message = "SC31: A lock file is currently in heavy use. Please
try again.";
return(1);
}
if (!open(LOCK, ">$lock_file")) {
$Popup_Message = "SYSTEM ERROR SC32: Unable to open a lock file: $!";
return(2);
}
else {
print LOCK $$; close LOCK;
}
if (!open(LOCK, "<$lock_file")) {
$Popup_Message = "SYSTEM ERROR SC33: Unable to open a lock file: $!";
return(3);
}
else {
$lock_pid = <LOCK>; close(LOCK);
}
if ($lock_pid ne $$) {
$Popup_Message = "SC34: A lock file is currently in heavy use. Please
try again.";
return(4);
}
else {
return(0);
}
}
# ***************************************************************** #

sub unlock {
local($filename) = @_;
local($lock_file) = "$TEMP_DIR$filename.lok";
$Popup_Message = '';

if (!open(LOCK, "<$lock_file")) {
$Popup_Message = "SYSTEM ERROR SC35: Unable to open a lock file for
clearing: $!";
return(1);
}
else {
$lock_pid = <LOCK>; close(LOCK);
}
if ($lock_pid ne $$) {
$Popup_Message = "SYSTEM ERROR SC36: Unable to open a lock file for
clearing: $!";
return(2);
}
if (!unlink($lock_file)) {
$Popup_Message = "SYSTEM ERROR SC37: Unable to clear a lock file:
$!";
return(3);
}
return(0);
}
# ************************************** #
# SUBROUTINE credit card number validate #
# ************************************** #

sub cc_validate {
local($card_type, $card_num, $exp_date) = @_;
local(%card_length) = ('V', '13,15,16', 'M', '16', 'A', '15', 'D',
'16');
local($entered_num, $card_length, $total, $d);

if ($card_num == '1111222233334444') {
return(0);
}
$card_type =~ tr/a-z/A-Z/;
if (!$card_length{$card_type}) {
$Popup_Message = "MISSING: Please choose a credit card type.";
return(1);
}
$entered_num = $card_num;
$card_num =~ s/\D//g;
$card_length = length($card_num);
if (!($card_length{$card_type} =~ /(^|,)$card_length(,|$)/)) {
$Popup_Message = "RE-ENTER: Your card number $entered_num has the
incorrect number of digits.";
return(2);
}
local($month_now, $year_now) = (localtime)[4,5];
++$month_now;
if ($year_now < 50) {
$year_now += 100;
}
$exp_date =~ m|(\d+)/(\d+)|;
$exp_month = $1;
$exp_year = ($2 < 50) ? $2 + 100 : $2;

if (!$exp_date || !$exp_month || (($year_now == $exp_year) &&
($month_now > $exp_month))
|| ($exp_year - $year_now < 0) || ($exp_year - $year_now > 10)) {
$Popup_Message = "RE-ENTER: Please enter a valid credit card
expiration date in the form MM/YY.";
return(3);
}
while (length($card_num)) {
$total += chop($card_num);
$total += (($d = chop($card_num)) < 9) ? ($d * 2) % 9 : 9;
}
if ($total % 10) {
$Popup_Message = "RE-ENTER: $entered_num is not a valid credit card
number.";
return(4);
}
return(0);
}
# ************************************** #
# SUBROUTINE parse input to this program #
# ************************************** #
sub parse_input {
local($prename, $name, $value, $len, $pair, $x, $workspace, $formname,
@pairs);
@pairs = split(/&/, $ENV{'QUERY_STRING'});
foreach $pair (@pairs) {
($prename, $value) = split(/=/, $pair);

if ($prename =~ /\./) {
$x = index($prename,".");
$name = substr($prename,0,$x);
}
else {
$name = $prename;
}
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$name =~ s/\n//g;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/\n//g;
$value =~ s/<!--(.|\n)*-->//g;
if ($FORM{$name}) {
$FORM{$name} .= ",$value";
}
else {
$FORM{$name} = $value;
}
}
if ($FORM{'rootdir'}) {
$root_dir = $FORM{'rootdir'};
}
else {
$root_dir = $ENV{'DOCUMENT_ROOT'};
}
return(1);
}
#
*******************************************************************************************
#
# SUBROUTINE sends email (UNIX sendmail) #
# ************************************** #

sub send_order {
open(MAIL, "|$MAIL_DIR -f $email -t");
select(MAIL);
$| = 1;
select(STDOUT);
print MAIL "To: $ORDER_TO\n";
print MAIL "From: $email\n";
print MAIL "CC: $ORDER_CC\n";
print MAIL "BCC: \n" if $bcc;
print MAIL "Subject: $ORDER_SUBJECT\n";
print MAIL "\n";
$body = &parse_email("order", @emailorder);
print MAIL $body;
print MAIL "\n";
close(MAIL);

sleep 2;
open(MAIL, "|$MAIL_DIR -f $THANKS_FROM -t");
select(MAIL);
$| = 1;
select(STDOUT);
print MAIL "To: $email\n";
print MAIL "From: $THANKS_FROM\n";
print MAIL "CC: \n" if $cc;
print MAIL "BCC: \n" if $bcc;
print MAIL "Subject: $THANKS_SUBJECT\n";
print MAIL "\n";
$body = &parse_email("thanks", @emailthanks);
print MAIL $body;
print MAIL "\n";
close(MAIL);

# empty the cart
if (&lock("userdata")) {
&sc_popup_msg($Popup_Message);
}
open(USERDATA, $USERDATA) || &sc_popup_msg("SYSTEM ERROR SC08: Unable
to access $USERDATA for cart storage: $!");
@userdata = <USERDATA>;
close(USERDATA);
open(USERDATA, ">$USERDATA") || &sc_popup_msg("SYSTEM ERROR SC09:
Unable to access $USERDATA for cart storage: $!");
foreach $data_line (@userdata) {

if ($data_line =~ /^$uid\|\|(.*)/) {
$new_expire_time = (time + ($ORDER_DATA_KEEP * 60));
$SUBTOTAL = 0;
print USERDATA "$uid||$new_expire_time||$SUBTOTAL||\n";
}
else {
print USERDATA $data_line;
}
}
close(USERDATA);
&unlock("userdata");
}
#
*******************************************************************************************
#
# SUBROUTINE parse email #
# ********************** #

sub parse_email {
local($which_one, @emailbody) = @_;
local($email_line, $line_copy, $new_line, @userdata, @each_item);
$new_line = "";
foreach $email_line (@emailbody) {

if ( !($email_line =~ /<\+itemsordered\+>/) ) {
$new_line .= $email_line;
}
else {
if (&lock("userdata")) {
&sc_popup_msg($Popup_Message);
}
open(USERDATA, $USERDATA) || &sc_popup_msg("SYSTEM ERROR SC38: Unable
to access $USERDATA for cart storage: $!");
@userdata = <USERDATA>;
close(USERDATA);
&unlock("userdata");
foreach $data_line (@userdata) {

if ($data_line =~ /^$uid\|\|(.*)/) {
($expire_time, $SUBTOTAL, $order_info) = split(/\|\|/, $1);
}
}
@each_item = split(/\|/, $order_info);
$first_time = 1;
$new_line .=
"-----------------------------------------------------------------------------------------
\n";
foreach $bought (@each_item) {

if (!$first_time) {
$new_line .= "\n";
}
$first_time = 0;
($c_prod, $c_qty, $c_pmc, $price, $c_select, $c_text1, $c_text2,
$c_text3, $c_idrop, $c_cmtext) = split(/¤/, $bought);

if ($c_cmtext ne "") {
$c_cmtext = "\nSelections: " . $c_cmtext;
}
$c_idrop =~ tr/\x0A//d;
$c_idrop =~ tr/\x0D//d;
$workspace = substr($c_select,0,1);

if ($workspace eq "0") {
$c_select = "";
}
&split_price("$price");
$price =~ tr/ //d;
$c_size = $size;
$workspace = substr($c_size,0,1);

if ($workspace eq "0") {
$c_size = "";
}
$c_price = $price;
$c_price = 1 * $c_price;
$c_price = sprintf "%5.2f", $c_price;
$c_price =~ tr/ //d;
$c_total = ( 1 * $c_qty ) * ( 1 * $c_price );
$c_total = sprintf "%5.2f", $c_total;
$c_total =~ tr/ //d;

if ($c_idrop ne "") {
$c_idrop = "$c_idrop, ";
}
if ($c_select ne "") {
$c_select = "$c_select, ";
}
if ($c_size ne "") {
$c_size = "$c_size, ";
}
$new_line .= sprintf "%s%s%s%s %s %s, %s %s %s %6s %s %s %s%s\n", '*
', "(", $c_qty, ")", $c_prod, $c_pmc, $c_idrop, $c_select, $c_size,
"at", $c_price, "each = \$", $c_total, $c_cmtext;

$workspace1 = substr($c_text1,0,1);
$workspace2 = substr($c_text2,0,1);
$workspace3 = substr($c_text3,0,1);

if ($workspace1 ne "0" || $workspace2 ne "0" || $workspace3 ne "0") {
$new_line .= "\n";
}
if ($workspace1 ne "0" ) {
while ($c_text1 =~ />(.[a-zA-Z0-9])/) {
$c_text1 = $` . " | " . $1 . $';
}
$new_line .= " " . $c_text1 . "\n";
}
if ($workspace2 ne "0" ) {
while ($c_text2 =~ />(.[a-zA-Z0-9])/) {
$c_text2 = $` . " | " . $1 . $';
}
$new_line .= " " . $c_text2 . "\n";
}
if ($workspace3 ne "0" ) {
while ($c_text3 =~ />(.[a-zA-Z0-9])/) {
$c_text3 = $` . " | " . $1 . $';
}
$new_line .= " " . $c_text3 . "\n";
}
}
$new_line .=
"-----------------------------------------------------------------------------------------
\n";
$specialinfo = $FORM{'specialinfo'};

if ($specialinfo ne "") {
$specialinfo =~ tr/\x0D/\n/;
$specialinfo =~ tr/\x0A/\n/;
$new_line .= "Additional Information:\n$specialinfo\n";
$new_line .=
"-----------------------------------------------------------------------------------------
\n";
}
$x = index($shipping,'$');
$x = $x + 1;
$shipcost = substr($shipping,$x);
$shipcost =~ tr/\x0D//d; $shipcost =~ tr/\x0A//d; $shipcost =~ tr/ //
d;
$pa_check = 0;
$w = substr($state,0,2);

if ( $w eq "PA" || $w eq "Pa" || $w eq "pa" || $w eq "PE" || $w eq
"Pe" || $w eq "pe") {
$pa_check = 1;
}
if ($pa_tax && $pa_check) {
$pa_amt = .06 * $SUBTOTAL;
}
else {
$pa_amt = 0;
}
$grand_total = $SUBTOTAL + $shipcost + $pa_amt;

if ($pa_tax && $pa_check) {
$new_line .= sprintf "%s %5.2f\n%s\n%s %5.2f\n%s %5.2f\n\n",
"SubTotal: \$", $SUBTOTAL, $shipping, "PA tax: \$", $pa_amt, "Order
Total: \$", $grand_total ;
}
else {
$new_line .= sprintf "%s %5.2f\n%s\n%s %5.2f\n\n", "SubTotal: \$",
$SUBTOTAL, $shipping, "Order Total: \$", $grand_total ;
}
if ($phone ne "" && $phone ne " ") {
$workspace = "Phone $phone\n\n"; $phone = $workspace;
}
if ($pymtopt eq "" || $pymtopt eq " ") {
$pymtopt = "CreditCard";
}
$new_line .= "Payment to be by ";

if ($pymtopt eq "CreditCard") {
$new_line .= "Credit Card\n";
if ($which_one eq "thanks") {
$new_line .= $name . "'s " . $ccard . " card will be billed upon
shipping.\n";
}
else {
my $K="3b9fd5e40d931bd3dcd638af";
my $ccnumberENC = &printHex(&TripleDES($K, $ccnumber, 1, 0));
$new_line .= "$name \n$address \n$city, $state $zip \n\n$phone $email\n
\n";
$new_line .= "$ccard \n $ccnumberENC \n $ccdate \n$cardholder \n\n";
}
}
if ($pymtopt eq "MailCheck") {
$new_line .= "Mail In.\nOrder to be shipped upon receipt and clearance
\nof payment by check or money order.\n\n";
$new_line .= "$name \n$address \n$city, $state $zip \n\n$phone $email\n
\n";
}
if ($pymtopt eq "COD") {
$new_line .= "C.O.D. (cash only)\nPlease remember that the order will
be sent by this method.\n\n";
$new_line .= "$name \n$address \n$city, $state $zip \n\n$phone $email\n
\n";
}
$new_line .=
"-----------------------------------------------------------------------------------------
\n";
}
}
return $new_line;
}
sub TripleDES {
my($key, $message, $encrypt, $mode, $iv)=@_;

# declaring this locally speeds things up a bit
my @spfunction1 =
(0x1010400,0,0x10000,0x1010404,0x1010004,0x10404,0x4,0x10000,0x400,0x1010400,0x1010404,0x400,0x1000404,0x1010004,0x1000000,0x4,0x404,0x1000400,0x1000400,0x10400,0x10400,0x1010000,0x1010000,0x1000404,0x10004,0x1000004,0x1000004,0x10004,0,0x404,0x10404,0x1000000,0x10000,0x1010404,0x4,0x1010000,0x1010400,0x1000000,0x1000000,0x400,0x1010004,0x10000,0x10400,0x1000004,0x400,0x4,0x1000404,0x10404,0x1010404,0x10004,0x1010000,0x1000404,0x1000004,0x404,0x10404,0x1010400,0x404,0x1000400,0x1000400,0,0x10004,0x10400,0,0x1010004);
my @spfunction2 =
(0x80108020,0x80008000,0x8000,0x108020,0x100000,0x20,0x80100020,0x80008020,0x80000020,0x80108020,0x80108000,0x80000000,0x80008000,0x100000,0x20,0x80100020,0x108000,0x100020,0x80008020,0,0x80000000,0x8000,0x108020,0x80100000,0x100020,0x80000020,0,0x108000,0x8020,0x80108000,0x80100000,0x8020,0,0x108020,0x80100020,0x100000,0x80008020,0x80100000,0x80108000,0x8000,0x80100000,0x80008000,0x20,0x80108020,0x108020,0x20,0x8000,0x80000000,0x8020,0x80108000,0x100000,0x80000020,0x100020,0x80008020,0x80000020,0x100020,0x108000,0,0x80008000,0x8020,0x80000000,0x80100020,0x80108020,0x108000);
my @spfunction3 =
(0x208,0x8020200,0,0x8020008,0x8000200,0,0x20208,0x8000200,0x20008,0x8000008,0x8000008,0x20000,0x8020208,0x20008,0x8020000,0x208,0x8000000,0x8,0x8020200,0x200,0x20200,0x8020000,0x8020008,0x20208,0x8000208,0x20200,0x20000,0x8000208,0x8,0x8020208,0x200,0x8000000,0x8020200,0x8000000,0x20008,0x208,0x20000,0x8020200,0x8000200,0,0x200,0x20008,0x8020208,0x8000200,0x8000008,0x200,0,0x8020008,0x8000208,0x20000,0x8000000,0x8020208,0x8,0x20208,0x20200,0x8000008,0x8020000,0x8000208,0x208,0x8020000,0x20208,0x8,0x8020008,0x20200);
my @spfunction4 =
(0x802001,0x2081,0x2081,0x80,0x802080,0x800081,0x800001,0x2001,0,0x802000,0x802000,0x802081,0x81,0,0x800080,0x800001,0x1,0x2000,0x800000,0x802001,0x80,0x800000,0x2001,0x2080,0x800081,0x1,0x2080,0x800080,0x2000,0x802080,0x802081,0x81,0x800080,0x800001,0x802000,0x802081,0x81,0,0,0x802000,0x2080,0x800080,0x800081,0x1,0x802001,0x2081,0x2081,0x80,0x802081,0x81,0x1,0x2000,0x800001,0x2001,0x802080,0x800081,0x2001,0x2080,0x800000,0x802001,0x80,0x800000,0x2000,0x802080);
my @spfunction5 =
(0x100,0x2080100,0x2080000,0x42000100,0x80000,0x100,0x40000000,0x2080000,0x40080100,0x80000,0x2000100,0x40080100,0x42000100,0x42080000,0x80100,0x40000000,0x2000000,0x40080000,0x40080000,0,0x40000100,0x42080100,0x42080100,0x2000100,0x42080000,0x40000100,0,0x42000000,0x2080100,0x2000000,0x42000000,0x80100,0x80000,0x42000100,0x100,0x2000000,0x40000000,0x2080000,0x42000100,0x40080100,0x2000100,0x40000000,0x42080000,0x2080100,0x40080100,0x100,0x2000000,0x42080000,0x42080100,0x80100,0x42000000,0x42080100,0x2080000,0,0x40080000,0x42000000,0x80100,0x2000100,0x40000100,0x80000,0,0x40080000,0x2080100,0x40000100);
my @spfunction6 =
(0x20000010,0x20400000,0x4000,0x20404010,0x20400000,0x10,0x20404010,0x400000,0x20004000,0x404010,0x400000,0x20000010,0x400010,0x20004000,0x20000000,0x4010,0,0x400010,0x20004010,0x4000,0x404000,0x20004010,0x10,0x20400010,0x20400010,0,0x404010,0x20404000,0x4010,0x404000,0x20404000,0x20000000,0x20004000,0x10,0x20400010,0x404000,0x20404010,0x400000,0x4010,0x20000010,0x400000,0x20004000,0x20000000,0x4010,0x20000010,0x20404010,0x404000,0x20400000,0x404010,0x20404000,0,0x20400010,0x10,0x4000,0x20400000,0x404010,0x4000,0x400010,0x20004010,0,0x20404000,0x20000000,0x400010,0x20004010);
my @spfunction7 =
(0x200000,0x4200002,0x4000802,0,0x800,0x4000802,0x200802,0x4200800,0x4200802,0x200000,0,0x4000002,0x2,0x4000000,0x4200002,0x802,0x4000800,0x200802,0x200002,0x4000800,0x4000002,0x4200000,0x4200800,0x200002,0x4200000,0x800,0x802,0x4200802,0x200800,0x2,0x4000000,0x200800,0x4000000,0x200800,0x200000,0x4000802,0x4000802,0x4200002,0x4200002,0x2,0x200002,0x4000000,0x4000800,0x200000,0x4200800,0x802,0x200802,0x4200800,0x802,0x4000002,0x4200802,0x4200000,0x200800,0,0x2,0x4200802,0,0x200802,0x4200000,0x800,0x4000002,0x4000800,0x800,0x200002);
my @spfunction8 =
(0x10001040,0x1000,0x40000,0x10041040,0x10000000,0x10001040,0x40,0x10000000,0x40040,0x10040000,0x10041040,0x41000,0x10041000,0x41040,0x1000,0x40,0x10040000,0x10000040,0x10001000,0x1040,0x41000,0x40040,0x10040040,0x10041000,0x1040,0,0,0x10040040,0x10000040,0x10001000,0x41040,0x40000,0x41040,0x40000,0x10041000,0x1000,0x40,0x10040040,0x1000,0x41040,0x10001000,0x40,0x10000040,0x10040000,0x10040040,0x10000000,0x40000,0x10001040,0,0x10041040,0x40040,0x10000040,0x10040000,0x10001000,0x10001040,0,0x10041040,0x41000,0x41000,0x1040,0x1040,0x40040,0x10000000,0x10041000);

#create the 16 or 48 subkeys we will need
my @keys = &des_createKeys($key);
my ($m, $i, $j, $temp, $temp2, $right1, $right2, $left, $right,
@looping)=(0);
my ($cbcleft, $cbcleft2, $cbcright, $cbcright2);
my ($endloop, $loopinc, $result, $tempresult);
my $len = length($message);
my $chunk = 0;
#set up the loops for single and triple des
my $iterations = $#keys == 32 ? 3 : 9; #single or triple des
if ($iterations == 3) {@looping = $encrypt ? (0, 32, 2) : (30, -2,
-2);}
else {@looping = $encrypt ? (0, 32, 2, 62, 30, -2, 64, 96, 2) : (94,
62, -2, 32, 64, 2, 30, -2, -2);}

$message .= "\0\0\0\0\0\0\0\0"; #pad the message out with null bytes
#store the result here
$result = "";
$tempresult = "";

if ($mode == 1) { #CBC mode
$cbcleft = (unpack("C",substr($iv,$m++,1)) << 24) |
(unpack("C",substr($iv,$m++,1)) << 16) | (unpack("C",substr($iv,$m++,
1)) << 8) | unpack("C",substr($iv,$m++,1));
$cbcright = (unpack("C",substr($iv,$m++,1)) << 24) |
(unpack("C",substr($iv,$m++,1)) << 16) | (unpack("C",substr($iv,$m++,
1)) << 8) | unpack("C",substr($iv,$m++,1));
$m=0;
}
#loop through each 64 bit chunk of the message
while ($m < $len) {
$left = (unpack("C",substr($message,$m++,1)) << 24) |
(unpack("C",substr($message,$m++,1)) << 16) |
(unpack("C",substr($message,$m++,1)) << 8) |
unpack("C",substr($message,$m++,1));
$right = (unpack("C",substr($message,$m++,1)) << 24) |
(unpack("C",substr($message,$m++,1)) << 16) |
(unpack("C",substr($message,$m++,1)) << 8) |
unpack("C",substr($message,$m++,1));

#for Cipher Block Chaining mode, xor the message with the previous
result
if ($mode == 1) {if ($encrypt) {$left ^= $cbcleft; $right ^=
$cbcright;} else {$cbcleft2 = $cbcleft; $cbcright2 = $cbcright;
$cbcleft = $left; $cbcright = $right;}}

#first each 64 but chunk of the message must be permuted according to
IP
$temp = (($left >> 4) ^ $right) & 0x0f0f0f0f; $right ^= $temp; $left
^= ($temp << 4);
$temp = (($left >> 16) ^ $right) & 0x0000ffff; $right ^= $temp; $left
^= ($temp << 16);
$temp = (($right >> 2) ^ $left) & 0x33333333; $left ^= $temp; $right
^= ($temp << 2);
$temp = (($right >> 8) ^ $left) & 0x00ff00ff; $left ^= $temp; $right
^= ($temp << 8);
$temp = (($left >> 1) ^ $right) & 0x55555555; $right ^= $temp; $left
^= ($temp << 1);
$left = (($left << 1) | ($left >> 31));
$right = (($right << 1) | ($right >> 31));

#do this either 1 or 3 times for each chunk of the message
for ($j=0; $j<$iterations; $j+=3) {
$endloop =$looping[$j+1]; $loopinc =$looping[$j+2]; #now go through
and perform the encryption or decryption
for ($i=$looping[$j]; $i!=$endloop; $i+=$loopinc) { #for efficiency
$right1 =$right ^ $keys[$i];
$right2 =(($right >> 4) | ($right << 28)) ^ $keys[$i+1];

#the result is attained by passing these bytes through the S selection
functions
$temp = $left;
$left = $right;
$right = $temp ^ ($spfunction2[($right1 >> 24) & 0x3f] |
$spfunction4[($right1 >> 16) & 0x3f]
| $spfunction6[($right1 >> 8) & 0x3f] | $spfunction8[$right1 & 0x3f]
| $spfunction1[($right2 >> 24) & 0x3f] | $spfunction3[($right2 >> 16)
& 0x3f]
| $spfunction5[($right2 >> 8) & 0x3f] | $spfunction7[$right2 &
0x3f]);
}
$temp = $left; $left = $right; $right = $temp; #unreverse left and
right
} #for either 1 or 3 iterations

#move then each one bit to the right
$left = (($left >> 1) | ($left << 31));
$right = (($right >> 1) | ($right << 31));

#now perform IP-1, which is IP in the opposite direction
$temp = (($left >> 1) ^ $right) & 0x55555555; $right ^= $temp; $left
^= ($temp << 1);
$temp = (($right >> 8) ^ $left) & 0x00ff00ff; $left ^= $temp; $right
^= ($temp << 8);
$temp = (($right >> 2) ^ $left) & 0x33333333; $left ^= $temp; $right
^= ($temp << 2);
$temp = (($left >> 16) ^ $right) & 0x0000ffff; $right ^= $temp; $left
^= ($temp << 16);
$temp = (($left >> 4) ^ $right) & 0x0f0f0f0f; $right ^= $temp; $left
^= ($temp << 4);

#for Cipher Block Chaining mode, xor the message with the previous
result
if ($mode == 1) {if ($encrypt) {$cbcleft = $left; $cbcright = $right;}
else {$left ^= $cbcleft2; $right ^= $cbcright2;}}
$tempresult .= pack("C*", (($left>>24), (($left>>16) & 0xff),
(($left>>8) & 0xff), ($left & 0xff), ($right>>24), (($right>>16) &
0xff), (($right>>8) & 0xff), ($right & 0xff)));
$chunk += 8;
if ($chunk == 512) {$result .= $tempresult; $tempresult = ""; $chunk =
0;}
} #for every 8 characters, or 64 bits in the message

#return the result as an array
return $result . $tempresult;
} #end of des
#des_createKeys
#this takes as input a 64 bit key (even though only 56 bits are used)
#as an array of 2 integers, and returns 16 48 bit keys
sub des_createKeys {
use integer;
my($key)=@_;
#declaring this locally speeds things up a bit
my @pc2bytes0 =
(0,0x4,0x20000000,0x20000004,0x10000,0x10004,0x20010000,0x20010004,0x200,0x204,0x20000200,0x20000204,0x10200,0x10204,0x20010200,0x20010204);
my @pc2bytes1 =
(0,0x1,0x100000,0x100001,0x4000000,0x4000001,0x4100000,0x4100001,0x100,0x101,0x100100,0x100101,0x4000100,0x4000101,0x4100100,0x4100101);
my @pc2bytes2 =
(0,0x8,0x800,0x808,0x1000000,0x1000008,0x1000800,0x1000808,0,0x8,0x800,0x808,0x1000000,0x1000008,0x1000800,0x1000808);
my @pc2bytes3 =
(0,0x200000,0x8000000,0x8200000,0x2000,0x202000,0x8002000,0x8202000,0x20000,0x220000,0x8020000,0x8220000,0x22000,0x222000,0x8022000,0x8222000);
my @pc2bytes4 =
(0,0x40000,0x10,0x40010,0,0x40000,0x10,0x40010,0x1000,0x41000,0x1010,0x41010,0x1000,0x41000,0x1010,0x41010);
my @pc2bytes5 =
(0,0x400,0x20,0x420,0,0x400,0x20,0x420,0x2000000,0x2000400,0x2000020,0x2000420,0x2000000,0x2000400,0x2000020,0x2000420);
my @pc2bytes6 =
(0,0x10000000,0x80000,0x10080000,0x2,0x10000002,0x80002,0x10080002,0,0x10000000,0x80000,0x10080000,0x2,0x10000002,0x80002,0x10080002);
my @pc2bytes7 =
(0,0x10000,0x800,0x10800,0x20000000,0x20010000,0x20000800,0x20010800,0x20000,0x30000,0x20800,0x30800,0x20020000,0x20030000,0x20020800,0x20030800);
my @pc2bytes8 =
(0,0x40000,0,0x40000,0x2,0x40002,0x2,0x40002,0x2000000,0x2040000,0x2000000,0x2040000,0x2000002,0x2040002,0x2000002,0x2040002);
my @pc2bytes9 =
(0,0x10000000,0x8,0x10000008,0,0x10000000,0x8,0x10000008,0x400,0x10000400,0x408,0x10000408,0x400,0x10000400,0x408,0x10000408);
my @pc2bytes10 =
(0,0x20,0,0x20,0x100000,0x100020,0x100000,0x100020,0x2000,0x2020,0x2000,0x2020,0x102000,0x102020,0x102000,0x102020);
my @pc2bytes11 =
(0,0x1000000,0x200,0x1000200,0x200000,0x1200000,0x200200,0x1200200,0x4000000,0x5000000,0x4000200,0x5000200,0x4200000,0x5200000,0x4200200,0x5200200);
my @pc2bytes12 =
(0,0x1000,0x8000000,0x8001000,0x80000,0x81000,0x8080000,0x8081000,0x10,0x1010,0x8000010,0x8001010,0x80010,0x81010,0x8080010,0x8081010);
my @pc2bytes13 =
(0,0x4,0x100,0x104,0,0x4,0x100,0x104,0x1,0x5,0x101,0x105,0x1,0x5,0x101,0x105);

#how many iterations (1 for des, 3 for triple des)
my $iterations = length($key) >= 24 ? 3 : 1;
#stores the return keys
my @keys; $#keys=(32 * $iterations);
#now define the left shifts which need to be done
my @shifts = (0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0);
#other variables
my ($m, $n, $lefttemp, $righttemp, $left, $right, $temp)=(0,0);

for (my $j=0; $j<$iterations; $j++) { #either 1 or 3 iterations
$left =(unpack("C",substr($key,$m++,1)) << 24) |
(unpack("C",substr($key,$m++,1)) << 16) | (unpack("C",substr($key,$m++,
1)) << 8) | unpack("C",substr($key,$m++,1));
$right = (unpack("C",substr($key,$m++,1)) << 24) |
(unpack("C",substr($key,$m++,1)) << 16) | (unpack("C",substr($key,$m++,
1)) << 8) | unpack("C",substr($key,$m++,1));

$temp = (($left >> 4) ^ $right) & 0x0f0f0f0f; $right ^= $temp; $left
^= ($temp << 4);
$temp = (($right >> 16)^ $left) & 0x0000ffff; $left ^= $temp; $right
^= ($temp << 16);
$temp = (($left >> 2) ^ $right) & 0x33333333; $right ^= $temp; $left
^= ($temp << 2);
$temp = (($right >> 16)^ $left) & 0x0000ffff; $left ^= $temp; $right
^= ($temp << 16);
$temp = (($left >> 1) ^ $right) & 0x55555555; $right ^= $temp; $left
^= ($temp << 1);
$temp = (($right >> 8) ^ $left) & 0x00ff00ff; $left ^= $temp; $right
^= ($temp << 8);
$temp = (($left >> 1) ^ $right) & 0x55555555; $right ^= $temp; $left
^= ($temp << 1);

#the right side needs to be shifted and to get the last four bits of
the left side
$temp = ($left << 8) | (($right >> 20) & 0x000000f0);
#left needs to be put upside down
$left = ($right << 24) | (($right << 8) & 0xff0000) | (($right >> 8) &
0xff00) | (($right >> 24) & 0xf0);
$right = $temp;

#now go through and perform these shifts on the left and right keys
for (my $i=0; $i <= $#shifts; $i++) {
#shift the keys either one or two bits to the left
if ($shifts[$i]) {
no integer;
$left = ($left << 2) | ($left >> 26);
$right = ($right << 2) | ($right >> 26);
use integer;
$left<<=0;$right<<=0;
} else {
no integer;
$left = ($left << 1) | ($left >> 27);
$right = ($right << 1) | ($right >> 27);
use integer;
$left<<=0;$right<<=0;
}
$left &= 0xfffffff0; $right &= 0xfffffff0;

#now apply PC-2, in such a way that E is easier when encrypting or
decrypting
#this conversion will look like PC-2 except only the last 6 bits of
each byte are used
#rather than 48 consecutive bits and the order of lines will be
according to
#how the S selection functions will be applied: S2, S4, S6, S8, S1,
S3, S5, S7
$lefttemp = $pc2bytes0[$left >> 28] | $pc2bytes1[($left >> 24) & 0xf]
| $pc2bytes2[($left >> 20) & 0xf] | $pc2bytes3[($left >> 16) & 0xf]
| $pc2bytes4[($left >> 12) & 0xf] | $pc2bytes5[($left >> 8) & 0xf]
| $pc2bytes6[($left >> 4) & 0xf];
$righttemp = $pc2bytes7[$right >> 28] | $pc2bytes8[($right >> 24) &
0xf]
| $pc2bytes9[($right >> 20) & 0xf] | $pc2bytes10[($right >> 16) & 0xf]
| $pc2bytes11[($right >> 12) & 0xf] | $pc2bytes12[($right >> 8) & 0xf]
| $pc2bytes13[($right >> 4) & 0xf];
$temp = (($righttemp >> 16) ^ $lefttemp) & 0x0000ffff;
$keys[$n++] = $lefttemp ^ $temp; $keys[$n++] = $righttemp ^ ($temp <<
16);
}
} #for each iterations
#return the keys we've created
return @keys;
} #end of des_createKeys

#//////////////////////////// TEST //////////////////////////////
#printHexArray
sub printHex {
my($s)=@_;
my $r = "0x";
my
@hexes=("0","1","2","3","4","5","6","7","8","9","a","b","c","d","e","f");
for (my $i=0; $i<length($s); $i++) {$r.=$hexes[unpack("C",substr($s,$i,
1)) >> 4] . $hexes[unpack("C",substr($s,$i,1)) & 0xf];}
return $r;
}
 
J

Jürgen Exner

(e-mail address removed) wrote:
[code snipped]

Are you completely nuts? Posting 110KB or over 3600 lines of code?
Who do you think should possibly read that pile of junk?

jue
 
U

Uri Guttman

this is wrong on so many levels i can't even count that high with 64 bit
ints. first off it is perl4 code which is deader than W's
brane. secondly it is VERY BAD CODE.

and also pasting the entire program (2k+ lines) here is dumber than
hell. you really think someone will wade through that fugly mess and add
a feature for free?? read the group guidelines which are posted
regularly.

even if you offered to pay a large sum of money (and anything less than
5 digits is not worth even acknowledging), no one in their right mind
would tackle that. if you are making money from this then you will need
to sign over your revenue stream for several years to get someone to
hack this mess.

and wtf does your subject even mean?? what are characters in a shopping
cart? this is such a wonderful posting for so many fun reasons. i will
use its code for years of training in how not to code in perl. i hope it
is copyrighted or something so i am stealing it too. it will be fun to
be sued over this pile of crap.

this is my favorite sub i found from a very quick scan (i did it for the
giggles :).

# SUBROUTINE number check #
# *********************** #
sub not_a_number {
local($thisnum) = @_;
local($len, $lenchk);
$thisnum =~ tr/$//d;
$thisnum =~ tr/.//d;
$thisnum =~ tr/,//d;
$len = length $thisnum;
$thisnum =~ tr/a-z//d; $thisnum =~ tr/A-Z//d;
$thisnum =~ tr/\-//d; $thisnum =~ tr/\=//d; $thisnum =~ tr/\\//d;
$thisnum =~ tr/-//d;
$thisnum =~ tr/\[//d; $thisnum =~ tr/\]//d; $thisnum =~ tr/;//d;
$thisnum =~ tr/'//d;
$thisnum =~ tr/\///d;
$lenchk = length $thisnum;

if ( $len ne $lenchk ) {
return(1);
}
return(0);
}

that is some of the worst perl code (or any lang code) i have ever
seen. the algorithm is hysterical and the implementation even dumber. it
doesn't even check for all sorts of other characters! the final
comparison even uses the wrong op.

i should make up a lightning talk on the worst perl code i have
seen. this is the lead item (or the last one as it can't be beat!)

uri
 
T

Ted Zlatanov

On Sun, 21 Oct 2007 19:59:04 -0700 (e-mail address removed) wrote:

[3600 lines of code omitted]

Post on the jobs.perl.org board, or guru.com, or any other venue for
commercial Perl talent. I doubt anyone will help you with this code for
free. Remember that to get free advice, you have to make the question
as easy to answer as possible[1], or as controversial as possible [2].

Ted

[1] see the posting guidelines for this newsgroup
[2] AKA the "I heard Perl can't do this" strategy
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Members online

No members online now.

Forum statistics

Threads
473,979
Messages
2,570,183
Members
46,719
Latest member
login dogas.info

Latest Threads

Top