#!/usr/bin/perl
# cart.pm - shopping cart support library
#
#  Dave Stoddard - 5/19/2004
#  dgs@accelix.com
#
#  Copyright
#  ---------
#  Copyright(c) 2004, Accelix LLC.  All Rights Reserved.
#
#  Description
#  -----------
#  This file contains library routines that are used to support shopping
#  cart functionality in the programs that use it.
#
#  RCS Information
#  ---------------
#  $Id$
#  $Log$
#
package cart;
use strict 'vars';
use strict 'subs';
#use warnings;
#use diagnostics;

# perl modules
use DBI;
use CGI;
use Exporter;
use Digest::MD5 qw(md5 md5_hex md5_base64);
use Crypt::CBC;

# debugging
use CGI::Carp qw(fatalsToBrowser);

# declare export arrays
use vars qw(@ISA @EXPORT @EXPORT_OK);

# export symbols to calling namespace
@ISA = qw(Exporter);

@EXPORT = qw(
  AddCartItem
  UpdateCartItem
  DeleteCartItem
  ClearCart
  DisplayCart
  GetSession
  MySessionID
  NewSessionID
  CreateSessionCookie
  DecodeSessionCookie
  ComputeHash
  GetCartRecord
  GetCartRecords
  DecodeCartRecord
  GetItemByItemno
  AddCartRecord
  ChangeCartRecord
  DeleteCartRecord
  ExitProgram
  GetDatabaseInfo
  ConnectDatabase
  DisconnectDatabase
  ReadForm
  RemoveScripts
  GetState
  GetCookies
  SetCookie
  EncodeHTML
  ErrorMsg
  CheckError
  DisplayError
  EmailError
  SetPageSize
  SetPageName
  OutputPageTop
  OutputPageBottom
  Redirect
  DisplayHeaders
);

@EXPORT_OK = qw(
  @errmsg
);

# configuration elements
my $debug	= 0;			# enable debug if 1
my $https	= 1;			# if 1, https support is enabled
my $lookup	= 0;			# use database for item info
my $expdays	= 3;			# number of days before cookie expires
my $scriptchk	= 1;			# remove cross-site scripts from forms
my $secret	= "changeme";		# md5 encryption secret
my $cryptkey	= "changeme";		# cipher encryption key
my $admin	= "nospam\@opencart.org"; # system admin email address
my $errto	= "nospam\@opencart.org"; # email to send errors to
my $sendmail	= "/usr/sbin/sendmail"; # path to sendmail program

# local data
my %db1         = ();			# database attributes
my %ck1         = ();			# cookie return hash
my %ck2         = ();			# cookies to set hash
my @errmsg	= ();			# error message table
my $sep		= chr(1);		# separator character
my $cipher	= "";			# cipher computation seed
my $pagesize	= "";			# page size from SetPageSize()
my $pagename	= "";			# window name from SetPageName()

# initialize database elements
$db1{dbh}	= "";			# database handle
$db1{sth}	= "";			# statement handle
$db1{type}	= "mysql";		# database type
$db1{name}	= "cartdb";		# database name
$db1{host}	= "localhost";		# database host name
$db1{user}	= "cart";		# database userid
$db1{pass}	= "buyme";		# database password

# function prototypes
sub AddCartItem (\%\%);			# add item to shopping cart
sub UpdateCartItem (\%\%);		# update quantities in shopping cart
sub DeleteCartItem (\%\%);		# delete item from shopping cart
sub ClearCart (\%\%);			# delete existing shopping cart
sub DisplayCart ($);			# display cart contents
sub GetSession (\%\%);			# create a shopping cart using cookies
sub MySessionID (\%);			# retrieve and decode existing cookie
sub NewSessionID ();			# create a new session id
sub CreateSessionCookie ($);		# create cookie for shopping cart
sub DecodeSessionCookie ($);		# decode encrypted shopping cart cookie
sub ComputeHash ($);			# compute md5 security hash for cookie
sub GetCartRecord ($);			# retrieve a shopping cart record
sub GetCartRecords ($);			# retrieve all records in shopping cart
sub DecodeCartRecord ($);		# decode cart record string into hash
sub InitCartRecord ();			# create a blank cart record hash
sub AddCartRecord (\%);			# add item to cart table
sub ChangeCartRecord ($$);		# change quantity in cart record
sub DeleteCartRecord ($);		# delete a cart record
sub GetItemByItemno ($);		# get an item record by item number
sub ExitProgram ();			# shutdown and exit the program
sub GetDatabaseInfo ();			# retrieve the database connection hash
sub ConnectDatabase ();			# connect to the database
sub DisconnectDatabase ();		# disconnect from the database
sub ReadForm ();			# read the data from the existing form
sub RemoveScripts ($);			# remove malicious scripts from form
sub GetState (\%);			# get internal state data
sub GetCookies ();			# get existing cookies
sub SetCookie ($$$$$$);			# set cookie in page
sub EncodeHTML ($);			# encode string for HTML encoding
sub ErrorMsg ($);			# store and error message
sub CheckError;				# check if error messages exist
sub DisplayError ();			# display existing error messages
sub EmailError ();			# email error messages
sub SetPageSize ($$);			# set the size of the current page
sub SetPageName ($);			# set the name of the current page
sub OutputPageTop ($);			# display the top portion of the page
sub OutputPageBottom ();		# display the lower portion of the page
sub Redirect ($);			# redirect to another URL
sub DisplayHeaders ();			# issue web headers to server

### Library Routines Start Here ###


###
###  AddCartItem() will add an item to a shopping cart.  If the customer does
###  not have a shopping cart already, one will be created for them.  The
###  shopping cart is displayed after the item is added to the shopping cart.
###

sub
AddCartItem (\%\%) {
  my ($fref,$sref) = @_;		# receive hash references
  my %form     = %$fref;		# form hash
  my %state    = %$sref;		# state hash
  my %sess     = ();			# session cookie hash
  my %cart     = ();			# cart record hash
  my %item     = ();			# item record hash

  # get the session id
  %sess = GetSession (%$fref,%$sref);

  # setup initial cart elements
  %cart           = InitCartRecord ();
  $cart{sessid}   = $sess{sessid};
  $cart{itemno}   = $form{itemno};
  $cart{quantity} = $form{quantity};

  # check for options
  $cart{optname1} = $form{optname1} if (defined $form{optname1});
  $cart{optval1}  = $form{optval1}  if (defined $form{optval1});
  $cart{optname2} = $form{optname2} if (defined $form{optname2});
  $cart{optval2}  = $form{optval2}  if (defined $form{optval2});
  $cart{optname3} = $form{optname3} if (defined $form{optname3});
  $cart{optval3}  = $form{optval3}  if (defined $form{optval3});

  # check for item lookup in database
  if ($lookup) {

    # get the item data from the database
    %item = GetItemByItemno ($form{itemno});
    if (CheckError()) {
      ErrorMsg ("error: can not retrieve item number $form{itemno}.");
      DisplayError();
      ExitProgram();
    }

    # make sure we received data
    unless (%item) {
      ErrorMsg ("error: item number $form{itemno} does not exist.");
      DisplayError();
      ExitProgram();
    }

    # set the cart variables
    $cart{itemid} = $item{itemid};
    $cart{price}  = $item{price};
    $cart{title}  = $item{title};
  } else {
    # set the cart variables
    $cart{itemid} = 0;
    $cart{price}  = sprintf ("%4.2f",$form{price});
    $cart{title}  = $form{title};
  }

  # edit the data for minimal values before posting it
  unless ($cart{quantity} =~ /^\d+$/) {
    ErrorMsg ("error: quantity is not numeric");
  }

  unless ($cart{price} =~ /^\d*\.\d\d$/) {
    ErrorMsg ("error: price is not a dollar value");
  }

  unless ($cart{itemno}) {
    ErrorMsg ("error: item number is missing");
  }

  if (CheckError()) {
    ErrorMsg ("error: update stopped due to input errors.");
    DisplayError();
    ExitProgram();
  }

  # add the item to the cart
  AddCartRecord (%cart);
  if (CheckError()) {
    DisplayError();
    ExitProgram();
  }

  # display the current cart
  DisplayCart ($sess{sessid}); 
  ExitProgram ();
}


###
###  UpdateCartItem() will read the contents of the form and update the items
###  in the shopping cart based on quantities.  The shopping cart is redisplayed
###  after the items are updated.
###

sub
UpdateCartItem (\%\%) {
  my ($fref,$sref) = @_;		# receive hash references
  my %form         = %$fref;		# form hash
  my %state        = %$sref;		# state hash
  my %sess         = ();		# session hash
  my %cart         = ();		# cart record hash
  my %qty          = ();		# quantity value hash
  my @recs         = ();		# record array of current cart
  my $cartid       = "";		# current cart record cart id
  my $f            = "";		# loop iteration variable

  # get the session id
  %sess = GetSession (%$fref,%$sref);

  # loop through the form and verify qantities are numeric
  foreach $f (keys %form) {
    next unless ($f =~ /^q-\d+$/);
    unless ($form{$f} =~ /^\d+$/) {
      ErrorMsg ("error: \"$form{$f}\" is not a valid whole number quantity.");
    }
  }

  # if we have errors, show them
  if (CheckError()) {
    DisplayError ();
    ExitProgram();
  }


  # get the data for the cart
  @recs = GetCartRecords ($sess{sessid});

  # process each item in the shopping cart
  foreach $f (@recs) {
    # convert the record into a hash and build a quantity table
    %cart = DecodeCartRecord ($f);
    $qty{$cart{cartid}} = $cart{quantity};
  }

  # loop through each field and determine changes
  foreach $f (keys %form) {

    # find the quantity fields
    if ($f =~ /^q-(\d+)$/) {
      $cartid = $1;
    } else {
      next;
    }

    # look for quantity changes
    if ($form{$f} == 0) {
      # the quantity is zero -- delete the item
      DeleteCartRecord ($cartid);
      if (CheckError()) {
        ErrorMsg ("error: can not delete 0 quantity item for cartid = $cartid");
        DisplayError ();
        ExitProgram();
      }
    } elsif ($form{$f} == $qty{$cartid}) {
      # the quantity is unchanged
      next;
    } elsif ($form{$f} > 0) {
      # update the non-zero quantity
      ChangeCartRecord ($cartid,$form{$f});
      if (CheckError()) {
        ErrorMsg ("error: can not modify quantity for cartid = $cartid");
        DisplayError ();
        ExitProgram();
      }
    } else {
      # negative quantitiy - we should never get here
      ErrorMsg ("error: negative quantity $form{$f} in UpdateCartItem()");
      DisplayError ();
      ExitProgram();
    }
  }

  # display the current cart
  DisplayCart ($sess{sessid}); 
  ExitProgram ();
}


###
###  DeleteCartItem() is responsible for removing and item from the shopping
###  cart.  The shooping cart is redisplayed after the item is removed.
###

sub
DeleteCartItem (\%\%) {
  my ($fref,$sref) = @_;		# receive hash references
  my %form         = %$fref;		# form hash
  my %state        = %$sref;		# state hash
  my %cart         = ();		# cart record hash
  my %sess         = ();		# session hash
  my $cartid       = "";		# current cart record cart id
  my $f            = "";		# loop iteration variable

  # get the session id
  %sess = GetSession (%$fref,%$sref);

  # check for the cartid field
  unless (defined $form{cartid}) {
    ErrorMsg ("error: no cartid specified to delete");
    DisplayError ();
    ExitProgram();
  }

  # convert the cartid field into a real cartid
  if ($form{cartid} =~ /^q-(\d+)$/) {
    $cartid = $1;
  } else {
    ErrorMsg ("error: cartid specified is not a valid value: $form{cartid}");
    DisplayError ();
    ExitProgram();
  }

  # attempt to delete the item
  DeleteCartRecord ($cartid);
  if (CheckError()) {
    ErrorMsg ("error: can not delete item for cartid = $cartid");
    DisplayError ();
    ExitProgram();
  }

  # display the current cart
  DisplayCart ($sess{sessid}); 
  ExitProgram ();
}


###
###  ClearCart() is responsible for clearing the contents of an existing
###  shopping cart.
###

sub
ClearCart (\%\%) {
  my ($fref,$sref) = @_;		# receive hash references
  my %form         = %$fref;		# form hash
  my %state        = %$sref;		# state hash
  my %sess         = ();		# session hash
  my $rows         = 0;			# row counter

  # get the session id
  %sess = GetSession (%$fref,%$sref);
 
  # make sure we are connected to the database
  unless (ConnectDatabase()) {
    return 0;
  }
 
  # execute the delete
  $rows = $db1{dbh}->do (qq{
    DELETE
    FROM cart
    WHERE
      sessid  = "$sess{sessid}"
  });
 
  # check for error
  if ($DBI::err) {
    ErrorMsg ("error: unable to perform delete: $DBI::err : $DBI::errstr");
    return 0;
  }
 
  return 1;
}


###
###  DisplayCart() is responsible for displaying the contents of the
###  shopping cart.
###

sub
DisplayCart ($) {
  my $sessid	= shift;		# session id
  my @recs	= ();			# shopping cart records
  my %cart	= ();			# shopping cart record
  my $line	= 1;			# line format control element
  my $opt	= "";			# format option
  my $que	= "";			# formatted record number
  my $i		= "";			# current record
  my $co	= "";			# check out url
  my $tot	= 0;			# total price
  my $itot	= 0;			# item total price

  # build the checkout URL
  if ($https) {
    $co = "https://$ENV{SERVER_NAME}/cgi-bin/checkout.pl";
  } else {
    $co = "/cgi-bin/checkout.pl";
  }

  # get the data for the cart
  @recs = GetCartRecords ($sessid);

  # output the top part of the page
  SetPageSize (560,560);
  # SetPageName ("paypal");
  OutputPageTop("Shopping Cart");

  # put a heading on the page
  print <<EOF;
<form action="/cgi-bin/update.pl" method="post">
<table valign="top" width="500" cellpadding="0" cellspacing="0">
<tr>
  <td width="300" align="left">
  <img src="/cart/opencart-165x39.gif" border="0" width="165" height="39"><br>
  </td>
  <td width="200" align="left" valign="baseline" class="head">
  Shopping Cart<br>
  </td>
</tr>
<tr>
  <td colspan="2">
  <hr size="2" noshade>
  </td>
</tr>
</table>

EOF

  # handle the display based on existing cart data
  if (@recs) {

    # we have items in the shopping cart
    # display column headings
    print <<EOF;
<table valign="top" width="500" cellpadding="0" cellspacing="0">
<tr>
  <td width="40" align="center" class="title">
  Qty
  </td>
  <td width="70" align="center" class="title">
  Remove
  </td>
  <td width="250" align="left" class="title">
  &nbsp;Item Description
  </td>
  <td width="70" align="right" class="title">
  Each&nbsp;&nbsp;
  </td>
  <td width="70" align="right" class="title">
  Total&nbsp;&nbsp;
  </td>
</tr>

EOF

    # process each item in the shopping cart
    foreach $i (@recs) {

      # decode the record into a hash
      %cart = DecodeCartRecord ($i);

      # compute totals
      $itot = ($cart{price} * $cart{quantity});
      $itot = sprintf ("%4.2f",$itot);
      $tot  = $itot + $tot;

      # determine the record id
      $que  = "q-$cart{cartid}";

      # handle line format control
      $opt  = ($line ? "a" : "b");
      $line = 1 - $line;

      # output the row
      print <<EOF;
<tr>
  <td width="40" align="center" class="qty${opt}">
  <input type="text" name="$que" value="$cart{quantity}" size="1">
  </td>
  <td width="70" align="center" class="line${opt}">
  <a href="/cgi-bin/remove.pl?cartid=$que">Remove</a>
  </td>
  <td width="250" align="left" class="line${opt}">
  &nbsp;$cart{title}
  </td>
  <td width="70" align="right" class="line${opt}">
  $cart{price}&nbsp;&nbsp;
  </td>
  <td width="70" align="right" class="line${opt}">
  $itot&nbsp;&nbsp;
  </td>
</tr>

EOF
    } # foreach

    # format the total line
    $tot = sprintf ("%4.2f",$tot);

    # now print the total line and buttons
    print <<EOF;
<tr>
  <td width="40" align="center" class="total">
  &nbsp;
  </td>
  <td width="70" align="center" class="total">
  &nbsp;
  </td>
  <td width="320" align="right" class="total" colspan="2">
  Cart Subtotal:&nbsp;
  </td>
  <td width="70" align="right" class="total">
  \$${tot}&nbsp;&nbsp;
  </td>
</tr>
</table>
 
<table valign="top" width="500" cellpadding="0" cellspacing="0">
<tr>
  <td width="500" align="center" class="text">
  Sales tax, shipping, and handling charges will be calculated upon
  checkout.<br>
  &nbsp;<br>
  </td>
</tr>
</table>
 
<table valign="top" width="500" cellpadding="0" cellspacing="0">
<tr>
  <td width="150" align="left" class="text">
  <input type="image" src="/cart/update-cart-100x23.gif" border="0"
  width="100" height="23"><br>
  </td>
  <td width="200" align="center" class="text">
  <img src="/cart/cont-shop-120x23.gif" border="0" onclick="closeWin();"
  width="120" height="23"><br>
  </td>
  <td width="150" align="right" class="text">
  <a href="$co" class="text">
  <img src="/cart/checkout-100x23.gif" border="0"
  width="100" height="23"></a><br>
  </td>
</tr>
</table>
</form>
 
EOF
  } else {
    # no items in shopping cart
    print <<EOF;
<table valign="top" width="500" cellpadding="0" cellspacing="0">
<tr>
  <td width="500" align="center" class="text">
  &nbsp;<br>
  There are no items in your shopping cart.<br>
  &nbsp;<br>
  <img src="/cart/cont-shop-120x23.gif" border="0" onclick="closeWin();"
  width="120" height="23"><br>
  </td>
</tr>
</table>
</form>

EOF
  }

  # print the bottom part of the page
  OutputPageBottom();
  return 1;
}


###
###  GetSession() does cookie handling for the shopping cart.  If a cookie
###  exists, it retrieves it and returns a hash.  If the cookie does not exist,
###  it creates the cookie and returns a hash.  Note that this routine may
###  force the program to reload again in order to set a new cookie value
###  for the shopping cart.
###

sub
GetSession (\%\%) {
  my ($fref,$sref) = @_;		# receive hash references
  my %form     = %$fref;		# form hash
  my %state    = %$sref;		# state hash
  my %sess     = ();			# session cookie hash
  my $url      = "";			# reload url
  my $val      = "";			# url parameter
  my $vsep     = "?";			# url value separator
  my $x        = "";			# loop iteration element

  # get the session id
  %sess = MySessionID (%$sref);

  # if we have no session data, we must create it
  unless (%sess) {

    # see if this is a reload
    if (defined $form{reload}) {
      ErrorMsg ("You must have cookies enabled to use the shopping cart.");
      DisplayError();
      ExitProgram();
    }

    # create a new session id and cookie
    $sess{sessid} = NewSessionID ();

    # force a redirect to load the cookie into the browser
    $url = "/cgi-bin/redirect.pl";
    foreach $x (keys %form) {
      $val  = EncodeHTML ($form{$x});
      $url  = "${url}${vsep}${x}=${val}";
      $vsep = "&";
    }

    # add a reload parameter and reload the script
    $url  = "${url}${vsep}reload=1";
    Redirect ($url);
    ExitProgram();
  }

  return %sess;
}


###
###  MySessionID() will retrieve and decode the session cookie for the
###  shopping cart.  If there is no session id, the routine returns an
###  empty hash.
###

sub
MySessionID (\%) {
  my $sref     = shift;			# reference to state hash
  my %state    = %$sref;		# local copy of state hash
  my %sess     = ();			# session hash (returned)

  # get the cookie
  return %sess unless defined $state{cart};
  %sess = DecodeSessionCookie ($state{cart});
  return %sess;
}


###
###  NewSessionID() creates a new session id and invokes a function to
###  load the session id into a cookie.
###

sub
NewSessionID () {
  my $sessid   = "";			# new session id

  # obtain a new session id
  $sessid = GetSessionID ();
  unless ($sessid) {
    ErrorMsg ("error: can not obtain a session id.");
    DisplayError();
    ExitProgram();
  }

  # create a cookie
  CreateSessionCookie ($sessid);

  return $sessid;
}


###
###  CreateSessionCookie() takes a session id and creates a cookie for use
###  with the shopping cart software.
###

sub
CreateSessionCookie ($) {
  my $sessid    = shift;		# session id
  my $contents  = "";			# cookie contents
  my $md5hash   = "";			# md5 hash computation on contents
  my $encdata   = "";			# encrypted contents
  my $expires   = time;			# expiration date

  # determine the cookie expiration date
  $expires += (86400 * $expdays);
 
  # combine the data into one string
  $contents = join ($sep,$sessid,$expires);
 
  # add a md5 computation to the string
  $md5hash  = ComputeHash ($contents);
  $contents = join ($sep,$contents,$md5hash);
 
  # if required, create the cipher seed value and encrypt
  $cipher ||= Crypt::CBC->new ($cryptkey,"Blowfish");
  $encdata = $cipher->encrypt_hex ($contents);
 
  # set a cookie and redirect
  SetCookie ("cart",$encdata,$expires,"","","");
}

 
###
###  DecodeSessionCookie() is responsible for decoding the encrypted cookie
###  data and validating that its contents have not been modified.
###
 
sub
DecodeSessionCookie ($) {
  my ($str)   = @_;			# string to decode
  my $result  = "";			# decoded result with hash
  my $usrinfo = "";			# decoded data string
  my $hash    = "";			# passed checksum hash value
  my $chkhash = "";			# computed checksum hash value
  my @values  = ();			# security data array
  my %data    = ();			# security data hash
 
  # check to see we have something
  return undef unless ($str);
 
  # get the string and decode it
  $cipher ||= Crypt::CBC->new ($cryptkey,"Blowfish");
  $result   = $cipher->decrypt_hex ($str);
 
  # split the data apart, remove the checksum, and validate it
  @values   = split (/$sep/,$result);
  $hash     = pop (@values);
  $usrinfo  = join ($sep,@values);
  $chkhash  = ComputeHash ($usrinfo);
 
  if ($hash ne $chkhash) {
    return %data;
  }
 
  # build the result hash
  $data{sessid}  = $values[0];
  $data{expires} = $values[1];
 
  return %data;
}

 
###
###  ComputeHash() will take a string of data, compute an MD5 hash (with an
###  embeded secret value), and return the value to the caller.
###
 
sub
ComputeHash ($) {
  my $data = shift;			# input data
  my $hash = "";			# hash result value
 
  $hash = md5_hex ($data . $secret);
  $hash = md5_hex ($hash . $secret);
  return ($hash);
}
 

###
###  GetSessionID() is responsible for obtaining a session id for the shopping
###  cart.  The value returned is stored in a cookie and used to identify the
###  shopping cart when items are added, updated, or removed from the cart.
###

sub
GetSessionID () {
  my $rows     = 0;			# row counter
  my $period   = 3;			# shopping cart valid period
  my $attrib   = 0;			# attribute (not currently used)
  my $rc       = 1;			# return value
 
  # make sure we are connected to the database
  unless (ConnectDatabase()) {
    return 0;
  }
 
  # execute the insert
  $rows = $db1{dbh}->do (qq{
    INSERT
      INTO session
    SET
      sessid     = NULL,
      period     = "$period",
      attrib     = "$attrib",
      createdate = NOW()
  });
 
  # check for error
  if ($DBI::err) {
    ErrorMsg ("error: unable to perform insert: $DBI::err : $DBI::errstr");
    return 0;
  }
 
  # prepare a statement to retrieve the last sequence r
  $db1{sth} = $db1{dbh}->prepare (qq{
    SELECT LAST_INSERT_ID()
  });
 
  # check for error
  unless ($db1{sth}) {
    ErrorMsg ("Unable to prepare select: $DBI::err : $DBI::errstr");
    return 0;
  }
 
  # execute the statement
  $db1{sth}->execute ();
  $rc = ($db1{sth}->fetchrow_array())[0];
  $db1{sth}->finish ();
 
  unless ($rc) {
    ErrorMsg ("Unable to retrieve last insert id from session table.");
    return 0;
  }
 
  return $rc;
}

 
###
###  GetCartRecord() retrieves a single record from the database.  It returns
###  a hash of the fields returned, or undef if an error occurs.  Error
###  messages are returned through the application error table.  This function
###  requires the cartid as a parameter.
###
 
sub
GetCartRecord ($) {
  my $cartid   = shift;			# cart id of shopping cart record
  my %out      = ();			# result output hash
  my $ref      = "";			# hash reference
 
  # make sure we are connected to the database
  unless (ConnectDatabase()) {
    return %out;
  }
 
  # prepare the select statement
  $db1{sth} = $db1{dbh}->prepare (qq{
    SELECT *
    FROM cart
    WHERE
      cartid = "$cartid"
  });
 
  # check for error
  if ($DBI::err) {
    ErrorMsg ("Unable to prepare select: $DBI::err : $DBI::errstr");
    return %out;
  }
 
  # execute the statement
  $db1{sth}->execute ();
 
  # check for error
  if ($DBI::err) {
    ErrorMsg ("Unable to execute select: $DBI::err : $DBI::errstr");
    return %out;
  }
 
  # retrieve a pointer to the record hash
  $ref = $db1{sth}->fetchrow_hashref;
 
  # check for record not found
  if (!defined $ref) {
    return %out;
  }
 
  %out = %{$ref};
  $db1{sth}->finish (); 
 
  return %out;
}
 
 
###
###  GetCartRecords() retrieves the records for the shopping cart from the
###  database in a standard array.  If an error occurs, an empty array is
###  returned and the error message is available through the application
###  error table.  This function requires the session id as a parameter.
###
 
sub
GetCartRecords ($) {
  my $sessid   = shift;			# session id for shopping cart
  my @out      = ();			# output array
  my @res      = ();			# result array
  my $rec      = "";			# concatenated cart record
 
  # make sure we are connected to the database
  unless (ConnectDatabase()) {
    return @out;
  }
 
  # prepare the select statement
  $db1{sth} = $db1{dbh}->prepare (qq{
    SELECT *
    FROM cart
    WHERE
      sessid = "$sessid"
  });
 
  # check for error
  if ($DBI::err) {
    ErrorMsg ("Unable to prepare select: $DBI::err : $DBI::errstr");
    return @out;
  }
 
  # execute the statement
  $db1{sth}->execute ();
 
  # check for error
  if ($DBI::err) {
    ErrorMsg ("Unable to execute select: $DBI::err : $DBI::errstr");
    return @out;
  }

  # fetch the record(s)
  while (@res = $db1{sth}->fetchrow_array()) {
    $rec = join ($sep,@res);
    push (@out,$rec);
  }
 
  $db1{sth}->finish (); 
  return @out;
}
 
 
###
###  DecodeCartRecord() will decode a shopping cart record from the format
###  returned by the GetCartRecords() routine.  The result is a hash that
###  contains all of the fields by field name.
###

sub
DecodeCartRecord ($) {
  my $rec	= shift;			# cart record with separators
  my @data	= ();				# receiving array for split
  my %hash	= ();				# output hash

  # make sure we have data to split
  return %hash unless ($rec);

  # break the record into fields
  @data = split (/$sep/,$rec);

  $hash{cartid}     = $data[0];
  $hash{sessid}     = $data[1];
  $hash{itemid}     = $data[2];
  $hash{itemno}     = $data[3];
  $hash{title}      = $data[4];
  $hash{optname1}   = $data[5];
  $hash{optval1}    = $data[6];
  $hash{optname2}   = $data[7];
  $hash{optval2}    = $data[8];
  $hash{optname3}   = $data[9];
  $hash{optval3}    = $data[10];
  $hash{quantity}   = $data[11];
  $hash{price}      = $data[12];
  $hash{updatedate} = $data[13];

  return %hash;
}

 
###
###  InitCartRecord() initializes a shopping cart record before it is loaded
###  with values.
###

sub
InitCartRecord () {
  my %rec = ();				# record hash (returned)

  $rec{cartid}     = 0;
  $rec{sessid}     = 0;
  $rec{itemid}     = 0;
  $rec{itemno}     = "";
  $rec{title}      = "";
  $rec{optname1}   = "";
  $rec{optval1}    = "";
  $rec{optname2}   = "";
  $rec{optval2}    = "";
  $rec{optname3}   = "";
  $rec{optval3}    = "";
  $rec{quantity}   = "";
  $rec{price}      = "";
  $rec{updatedate} = "";

  return %rec;
}


###
###
###  AddCartRecord() will add a new record to the database.  If an error is
###  detected during the request, it is returned in the error table.  This
###  routine returns the cartid of the inserted record, or 0 if an error
###  occurred.
###
 
sub
AddCartRecord (\%) {
  my ($arg1)   = @_;                    # tables passed by reference
  my %fields   = %{$arg1};              # field name and value hash
  my $rows     = 0;                     # row counter
  my $rc       = 1;                     # return value
 
  # make sure we are connected to the database
  unless (ConnectDatabase()) {
    return 0;
  }
 
  # preformat the data for entry into the database
  foreach (keys %fields) {
    unless (defined $fields{$_}) {
      $fields{$_} = "";
    }
    $fields{$_} = $db1{dbh}->quote($fields{$_});
  }
 
  # execute the insert
  $rows = $db1{dbh}->do (qq{
    INSERT
      INTO cart
    SET
      cartid     = NULL,
      sessid     = $fields{sessid},
      itemid     = $fields{itemid},
      itemno     = $fields{itemno},
      title      = $fields{title},
      optname1   = $fields{optname1},
      optval1    = $fields{optval1},
      optname2   = $fields{optname2},
      optval2    = $fields{optval2},
      optname3   = $fields{optname3},
      optval3    = $fields{optval3},
      quantity   = $fields{quantity},
      price      = $fields{price},
      updatedate = NULL
  });
 
  # check for error
  if ($DBI::err) {
    ErrorMsg ("error: unable to perform insert: $DBI::err : $DBI::errstr");
    return 0;
  }
 
  # prepare a statement to retrieve the last sequence r
  $db1{sth} = $db1{dbh}->prepare (qq{
    SELECT LAST_INSERT_ID()
  });
 
  # check for error
  if ($DBI::err) {
    ErrorMsg ("Prepare for select on cart last insert id failed: $DBI::err : $DBI::errstr");
    return 0;
  }
 
  # execute the statement
  $db1{sth}->execute ();
  $rc = ($db1{sth}->fetchrow_array())[0];
  $db1{sth}->finish ();
 
  unless ($rc) {
    ErrorMsg ("Unable to retrieve last insert id from cart table.");
    return 0;
  }
 
  return $rc;
}
 
 
###
###  ChangeCartRecord() will modify quantity data for an existing shopping
###  cart item in the cart table.  It returns 1 if the update was successful,
###  or 0 if it failed.  If an error does occur, the error message can be
###  found in the application error table.  This routine expects the cartid
###  and the quantity to be passed to the routine.
###
 
sub
ChangeCartRecord ($$) {
  my $cartid   = shift;			# cart id parameter
  my $quantity = shift;			# item quantity parameter
  my $rows     = 0;                     # row counter
 
  # make sure we are connected to the database
  unless (ConnectDatabase()) {
    return 0;
  }
 
  # execute the update
  $rows = $db1{dbh}->do (qq{
    UPDATE
      cart
    SET
      quantity = "$quantity"
    WHERE
      cartid   = "$cartid"
  });
 
  # check for error
  if ($DBI::err) {
    ErrorMsg ("error: unable to perform update: $DBI::err : $DBI::errstr");
    return 0;
  }
 
  return 1;
}
 
 
###
###  DeleteCartRecord() will delete a row from the cart table.  It
###  returns 1 if the delete request was successful, or 0 if it failed.  If
###  an error does occur, the error message can be found in the application
###  error table.  This routine expects the cart id to be passed as a
###  parameter.
###
 
sub
DeleteCartRecord ($) {
  my $cartid   = shift;			# cart id parameter
  my $rows     = 0;                     # row counter
 
  # make sure we are connected to the database
  unless (ConnectDatabase()) {
    return 0;
  }
 
  # execute the delete
  $rows = $db1{dbh}->do (qq{
    DELETE
    FROM cart
    WHERE
      cartid = "$cartid"
  });
 
  # check for error
  if ($DBI::err) {
    ErrorMsg ("error: unable to perform delete: $DBI::err : $DBI::errstr");
    return 0;
  }
 
  return 1;
}

 
###
###  GetItemByItemno() retrieves a single item record from the database.  It
###  returns a hash of the fields returned, or undef if an error occurs.  Error
###  messages are returned through the application error table.  This function
###  requires the itemno (not itemid) as a parameter.
###
 
sub
GetItemByItemno ($) {
  my $itemno   = shift;			# cart id of shopping cart record
  my %out      = ();			# result output hash
  my $ref      = "";			# hash reference
 
  # make sure we are connected to the database
  unless (ConnectDatabase()) {
    return %out;
  }

  # quote the field to prevent sql injection attacks 
  $itemno = $db1{dbh}->quote($itemno);

  # prepare the select statement
  $db1{sth} = $db1{dbh}->prepare (qq{
    SELECT *
    FROM item
    WHERE itemno = $itemno
  });
 
  # check for error
  if ($DBI::err) {
    ErrorMsg ("Unable to prepare select: $DBI::err : $DBI::errstr");
    return %out;
  }
 
  # execute the statement
  $db1{sth}->execute ();
 
  # check for error
  if ($DBI::err) {
    ErrorMsg ("Unable to execute select: $DBI::err : $DBI::errstr");
    return %out;
  }
 
  # retrieve a pointer to the record hash
  $ref = $db1{sth}->fetchrow_hashref;
 
  # check for record not found
  if (!defined $ref) {
    return %out;
  }
 
  %out = %{$ref};
  $db1{sth}->finish (); 
 
  return %out;
}
 

###
###  ExitProgram() exits the program and performs any required shutdown
###  processing, such as disconnecting the database.
###

sub
ExitProgram () {
  DisconnectDatabase ();
  exit 0;
}


###
###  GetDatabaseInfo() returns the current database connection hash to the
###  caller.  It is used to access the database from code outside the cart.pm
###  module.
###

sub
GetDatabaseInfo () {
  return %db1;
}


###
###  ConnectDatabase() handles connections to the database.  It is called by
###  all database i/o routines to ensure we have a valid connection to the
###  database.  This routine returns 1 if the request is successful, or 0 if
###  the request fails.  If an error does occur, an error message indicating
###  the reason for the error can be found in the application error table.
###
###  NOTE:  This routine relies on global elements defined at the top of
###  this program module.
###
 
sub
ConnectDatabase () {
  my $dsn1  = "";                       # data source name
 
  # check to see if we are already connected
  if ($db1{dbh}) {
    return 1;
  }
 
  # handle the connection
  $dsn1 = "DBI:${db1{type}}:${db1{name}}:${db1{host}}";
  $db1{dbh} = DBI->connect (
    $dsn1,
    $db1{user},
    $db1{pass},
    { RaiseError => 0, PrintError => 0 });
 
  # check for error
  if ($DBI::err) {
    ErrorMsg ("Unable to connect to database: $DBI::err : $DBI::errstr");
    return 0;
  }
 
  return 1;
}
 
 
###
###  DisonnectDatabase() handles disconnections from the database.  It is
###  called by the mainline code just before the program exits.  The routine
###  returns 1 if the request is successful, or 0 if the request fails.  If
###  an error does occur, an error message indicating the reason for the error
###  can be found in the application error table.
###
###  NOTE:  This routine relies on global elements defined at the top of
###  this program module.
###
 
sub
DisconnectDatabase () {
  # check to see if we are connected
  unless ($db1{dbh}) {
    return 1;
  }
 
  # handle the disconnection
  $db1{dbh}->disconnect;
 
  # check for error
  if ($DBI::err) {
    ErrorMsg ("Unable to disconnect from database: $DBI::err : $DBI::errstr");
    return 0;
  }
 
  return 1;
}

# --- the remaining code comes from the Momentum API library ---
 

###
###  ReadForm() reads the values from and HTML form and converts the data on
###  the form to its appropriate internal representation.
###

sub
ReadForm () {
  my %form   = ();			# form field hash
  my @list   = ();			# list of field names
  my $q      = "";			# query handle
  my $i      = 0;			# form field index
  my $key    = "";			# field name
  my $val    = "";			# field value
  my $multi  = 0;			# if 1, handle multiple values

  # get the from object
  $q    = new CGI;
  @list = $q->param();

  # retrieve all of the field=value parameters
  foreach $i (@list) {
    $key = lc $i;
    $val = $q->param($i);

    # eliminate cross-site scripting hacks
    if ($scriptchk) {
      $key = RemoveScripts ($key);
      $val = RemoveScripts ($val);
    }

    # check if we support multiple values
    if ($multi) {
      $form{$key} .= "\0" if (form{$key});
      $form{$key} .= $val;
    } else {
      # last field wins
      $form{$key}  = $val;
    }
  }

  return (%form); 
}


###
###  RemoveScripts() will remove HTML scripts from form data, preventing
###  possible cross-site scripting attacks.
###

sub
RemoveScripts ($) {
  my ($item)   = shift;			# item to be edited

  # remove client-side scripts
  $item =~ s/(<[\s\/]*)(script\b[^>]*>)/$1x$2/gi;

  # remove HTML tags
  while ($item =~ s/(<[^>]*?)\b(on\w+\s*=)/$1x$2/gi) {}

  return $item;
}


###
###  GetState() obtains pertinent information that is required in order to
###  maintain state between connections.  This data is carried between pages
###  as hidden fields.
###
###  Input to this routine is through the form field hash returned from
###  ReadForm().  Output returned is a hash of state variables.
###

sub
GetState (\%) {
  my ($arg1)   = @_;			# tables passed by reference
  my (%fields) = %{$arg1};		# field name and value hash
  my %state    = ();			# state hash
  my $pfx      = "";			# URI prefix
  my $sfx      = "";			# URI suffix

  # determine the name of this URL
  if ($ENV{"SERVER_PORT"} eq "443") {
    $pfx = "https://";
    $sfx = "";
  } elsif ($ENV{"SERVER_PORT"} eq "80") {
    $pfx = "http://";
    $sfx = "";
  } else {
    $pfx = "http://";
    $sfx = ":" . $ENV{"SERVER_PORT"};
  }

  # set application state items:
  #  ur1 - used to build href= parameters in generated html
  #  ur2 - shows how this program was invoked, including parameters
  $state{"home"} = $pfx . $ENV{"HTTP_HOST"} . $sfx . "/";
  $state{"ur1"}  = $pfx . $ENV{"HTTP_HOST"} . $sfx . $ENV{"SCRIPT_NAME"};
  $state{"ur2"}  = $pfx . $ENV{"HTTP_HOST"} . $sfx . $ENV{"REQUEST_URI"};

  # save the IP address
  $state{"ip1"} = $ENV{REMOTE_ADDR};	# get the remote IP address

  # retrieve cookies into state data
  %ck1 = GetCookies();
  foreach (keys %ck1) {
    $state{$_} = $ck1{$_};
  }
  
  return (%state);
}


###
###  GetCookies() returns all of the cookies that are retunred by the client
###  browser.  The cookies are returned in a hash that can be used by the
###  calling routine.  This routine does not accept any parameters.
###
###  This routine will automatically decode and html encoded strings
###  in the cookie value.
###
###  If multiple cookies exist with the same name, but at different path
###  levels, the cookies will be concatenated onto the same key and
###  separated by a binary zero (in the same way fields are handled on
###  the ReadForm() routine).
###

sub
GetCookies () {
  my @data    = ();			# raw cookies
  my %cookies = ();			# cookie hash (returned)
  my $key     = "";			# cookie name
  my $val     = "";			# cookies value

  unless (defined $ENV{'HTTP_COOKIE'}) {
    return %cookies;
  }

  # each cookie is separated by a semicolon and a space
  @data = split (/; /,$ENV{'HTTP_COOKIE'});

  foreach (@data) {
    ($key, $val) = split (/=/,$_);	  # split key=value pairs
    $val =~ s/%(..)/pack("c",hex($1))/ge; # decode hex values
    $cookies{$key} .= "\0" if (defined($cookies{$key}));
    $cookies{$key} .= $val;
  }

  return %cookies;
}


###
###  SetCookie() is used to create a new cookie for the application.  Only
###  the cookie name and value parameters are required, all others can be
###  blank.  The time item should be provided as either a preformatted time
###  value, or as a UNIX timestamp value that will be converted to a proper
###  cookie time value.  The result is stored in the %ck2 lexical hash.  This
###  routine accepts the following parameters:
###
###  $name    : the name of the cookie
###  $value   : the cookie value string
###  $expires : the expiration date or timestamp (use 1 to delete a cookie)
###  $path    : the cookie path name
###  $domain  : the cookie domain name
###  $secure  : if true, adds the secure attribute to the cookie
###
###  Only $name and $value are required to contain values, all others are
###  completely optional.  For more info on cookies, see the Netscape info at
###  http://www.netscape.com/newsref/std/cookie_spec.html
###

sub
SetCookie ($$$$$$) {
  my ($name,$value,$expires,$path,$domain,$secure) = @_;
  my $cookie = "";			# the resulting cookie
  my $gmt    = "";			# time in GMT format
  my ($wday,$mon,$mday,$hms,$year);	# time work elements

  # make sure we have a name
  unless ($name) {
    return 0;
  }

  $value  = EncodeHTML($value);
  $cookie = "${name}=${value}";

  # handle expiration
  if ($expires) {

    # check if timestamp format
    if ($expires =~ /^\d+$/) {
      $gmt = scalar gmtime($expires);
      chomp ($gmt);
      ($wday,$mon,$mday,$hms,$year) = split (/ /,$gmt);
      if ($mday < 10) {
        $mday = "0" . $mday;
      }
      $expires = "${wday}, ${mday}-${mon}-${year} ${hms} GMT";
    }
    $cookie .= "; expires=${expires}";
  }

  # handle path
  unless ($path) {
    $path = "/";
  }
  $cookie .= "; path=${path}";

  # handle domain
  if ($domain) {
    $cookie .= "; domain=${domain}";
  }

  # handle secure
  if ($secure) {
    $cookie .= "; secure";
  }

  # save the cookie
  $ck2{$name} = $cookie;
  return 1;
}


###
###  EncodeHTML() will translate values into strings that can be passed as
###  parameter data via HTML.  This program receives one parameter (the data
###  to encode) and returns one parameter (the encoded data).
###

sub
EncodeHTML ($) {
  my ($text) = shift;
  my ($i,$j,@chr);

  # break apart the character string
  @chr = split (//,$text);
  $text = "";

  # convert unprintable characters into hex
  foreach $i (@chr) {
    $j = ord($i);

    if ($i eq " ") {
      # convert space
      $i = "+";
    } elsif ($j < 48) {
      # convert anything less than digit 0
      $i = sprintf "%%%1x", $j;
    } elsif ($j < 58) {
      # keep digits 0 thru 9
      1;
    } elsif ($j < 65) {
      # convert special characters
      $i = sprintf "%%%1x", $j;
    } elsif ($j < 91) {
      # keep capital letters A thru Z
      1;
    } elsif ($j < 97) {
      # convert more special characters
      $i = sprintf "%%%1x", $j;
    } elsif ($j < 123) {
      # keep lowercase letters a thru z
      1;
    } else {
      # convert everything greater than lowercase z
      $i = sprintf "%%%1x", $j;
    }
    $text .= $i;
  }

  return ($text);
}

 
###
###  ErrorMsg() will store error messages in the application error array for
###  subsequent reporting by the DisplayError() routine.
###
 
sub
ErrorMsg ($) {
  my $msg = shift;
  push (@errmsg,"$msg");
  return 1;
}
 
 
###
###  CheckError() will return true if there are any error messages in the
###  application error array, or false (0) if we do not have any messages
###  in the array.
###
 
sub
CheckError {
  return 1 if (@errmsg);
  return 0;
}
 

###
###  DisplayError() will display errors in the application error array to the
###  user.  If there are no errors, the routine returns with a value of 0.
###

sub
DisplayError () {
  my $msg = shift;

  # use global element @errmsg
  unless (@errmsg) {
    return 0;
  }

  # set the output page parameters
  SetPageSize (560,560);
  SetPageName ("_xerror");

  # print the top part of the page
  OutputPageTop("Application Error");

  # display the intro information
  print <<EOF;
<form>
<table valign="top" width="500" cellpadding="0" cellspacing="0">
<tr>
  <td width="500" align="center" class="ehead">
  Application Error<br>
  <hr size="1" noshade>
  </td>
</tr>
<tr>
  <td width="500" align="left" class="etext">
  &nbsp;<br>
  One or more errors were detected while the program attempted to perform
  your request.  Depending on the nature of the error, you may need the
  assistance of the system administrator.  A description of the problem is
  provided below:<br>
  <ul>
EOF

  # display the error messages
  foreach $_ (@errmsg) {
    print "    <li class=\"emsg\">$_</li>\n";
  }

  # finish the window
  print <<EOF;
  </ul>
  <hr size="1" noshade><br>
  </td>
</tr>
<tr>
  <td width="500" align="center" class="etext">
  <input type="image" src="/cart/close-100x23.gif" border="0"
  width="100" height="23" onClick="closeWin();"><br>
  </td>
</tr>
</table>
</form>
EOF

  # print the bottom part of the page
  OutputPageBottom();

  # let the system admin know about this
  EmailError ();

  # do not return
  ExitProgram();
}


###
###  EmailError() is a routine to email errors that are encountered
###  during various processing phases.  This routine is useful for obtaining
###  error information when normal online methods are not appropriate.
###

sub
EmailError () {
  my $ts = localtime;

  # open sendmail
  open (EM1,"|$sendmail -f${admin} ${errto}") || return 0;

  print EM1 <<EOF;
From: Shopping Cart <$admin>
To: System Admin <$errto>
Subject: Shopping Cart Application Error

Application Error
$ts

The following error(s) were detected while a request was being processed
by the shopping cart application:

EOF

  # display the error messages
  foreach $_ (@errmsg) {
    print EM1 "  *  $_\n";
  }

  # finish the error message
  print EM1 <<EOF;

** This Message Was Automatically Generated **
EOF

  close (EM1);
  return 1;
}


###
###  SetPageSize() will set the value of $pagesize to resize the window when
###  it is opened.  This variable is used in the OutputPageTop() function.
###  Two parameters are required -- the width and the height.  For example,
###  to set the page size to 640x480, use SetPageSize(640,480).
###

sub
SetPageSize ($$) {
  my $width	= shift;		# page width
  my $height	= shift;		# page height
  $pagesize = " onLoad=\"javascript:window.resizeTo($width,$height)\";";
  return 1;
}


###
###  SetPageName() will set the value of $pagename to rename the window when
###  it is opened.  This can force a new window to open when the name is
###  different from the base window.  This variable is used by the system
###  in the DisplayHeader() function.  One parameter is required -- the name
###  of the window.  For example, to set the name of the window to "form" you
###  would call SetPageName("form").
###

sub
SetPageName ($) {
  my $name  = shift;			# new page name
  $pagename = $name;
  return 1;
}


###
###  OutputPageTop() is used to generate the top half of the output form.
###

sub
OutputPageTop ($) {
  my $title  = shift;			# HTML page title
  my $rc1    = "";			# return code

  # start the HTML form (required statement)
  DisplayHeaders();

  # output the top of the HTML page
  print <<EOF;
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=us-ascii">
<title>$title</title>
<style type="text/css">
<!--

/* page top heading */ 
.head {
  font-family: tahoma,verdana,arial,helvetica,sans-serif;
  font-size: 25px;
  font-weight: bold;
  color: #006699;
}

/* error message heading */ 
.ehead {
  font-family: tahoma,verdana,arial,helvetica,sans-serif;
  font-size: 25px;
  font-weight: bold;
  color: #ff3300;
}

/* error message text */ 
.etext {
  font-family: tahoma,verdana,arial,helvetica,sans-serif;
  font-size: 12px;
  font-weight: normal;
  color: #000000;
}

/* error messages */ 
.emsg {
  font-family: tahoma,verdana,arial,helvetica,sans-serif;
  font-size: 12px;
  font-weight: bold;
  color: #cc0000;
}

/* title on cart columns */ 
.title {
  text-decoration: none;
  font-family: tahoma,verdana,arial,helvetica,sans-serif;
  font-size: 11px;
  font-weight: bold;
  height: 24px;
  background-color: #000099;
  color: #ffffff;
}

/* top line of form label column */ 
.fttext {
  text-decoration: none;
  font-family: tahoma,verdana,arial,helvetica,sans-serif;
  font-size: 11px;
  font-weight: bold;
  padding-top: 5px;
  padding-right: 8px;
  padding-bottom: 3px;
  padding-left: 3px;
  vertical-align: text-top;
  border-top: 1px solid #999999;
  border-bottom: 1px solid #999999;
  background-color: #ffffcc;
  color: #000000;
}
 
/* top line of form field column */ 
.ftdata {
  text-decoration: none;
  font-family: tahoma,verdana,arial,helvetica,sans-serif;
  font-size: 11px;
  font-weight: normal;
  padding-top: 5px;
  padding-bottom: 3px;
  padding-left: 8px;
  vertical-align: text-top;
  border-top: 1px solid #999999;
  border-bottom: 1px solid #999999;
  background-color: #ffffff;
  color: #000000;
}
 
/* line of form label column */ 
.ftext {
  text-decoration: none;
  font-family: tahoma,verdana,arial,helvetica,sans-serif;
  font-size: 11px;
  font-weight: bold;
  padding-top: 5px;
  padding-right: 8px;
  padding-bottom: 3px;
  padding-left: 3px;
  vertical-align: text-top;
  border-bottom: 1px solid #999999;
  background-color: #ffffcc;
  color: #000000;
}
 
/* line of form field column */ 
.fdata {
  text-decoration: none;
  font-family: tahoma,verdana,arial,helvetica,sans-serif;
  font-size: 11px;
  font-weight: normal;
  padding-top: 5px;
  padding-bottom: 3px;
  padding-left: 8px;
  vertical-align: text-top;
  border-bottom: 1px solid #999999;
  background-color: #ffffff;
  color: #000000;
}

/* qantity field in cart */ 
.qtya {
  text-decoration: none;
  font-family: tahoma,verdana,arial,helvetica,sans-serif;
  font-size: 11px;
  font-weight: normal;
  vertical-align: text-top;
  border-bottom: 1px solid #999999;
  background-color: #ffffff;
  color: #000000;
}
 
/* alternate qantity field in cart */ 
.qtyb {
  text-decoration: none;
  font-family: tahoma,verdana,arial,helvetica,sans-serif;
  font-size: 11px;
  font-weight: normal;
  vertical-align: text-top;
  border-bottom: 1px solid #999999;
  background-color: #ffffcc;
  color: #000000;
}

/* text field in cart */ 
.linea {
  text-decoration: none;
  font-family: tahoma,verdana,arial,helvetica,sans-serif;
  font-size: 11px;
  font-weight: normal;
  padding-top: 5px;
  padding-bottom: 3px;
  vertical-align: text-top;
  border-bottom: 1px solid #999999;
  background-color: #ffffff;
  color: #000000;
}
 
/* alternate text field in cart */ 
.lineb {
  text-decoration: none;
  font-family: tahoma,verdana,arial,helvetica,sans-serif;
  font-size: 11px;
  font-weight: normal;
  padding-top: 5px;
  padding-bottom: 3px;
  vertical-align: text-top;
  border-bottom: 1px solid #999999;
  background-color: #ffffcc;
  color: #000000;
}
 
.total {
  text-decoration: none;
  font-family: tahoma,verdana,arial,helvetica,sans-serif;
  font-size: 11px;
  font-weight: bold;
  height: 25px;
  border-top: 1px solid #999999;
  border-bottom: 3px double #999999;
  background-color: #eeeeff;
  color: #000000;
}
 
.head2 {
  text-decoration: none;
  font-family: tahoma,verdana,arial,helvetica,sans-serif;
  font-size: 16px;
  font-weight: bold;
}
 
.text {
  text-decoration: none;
  font-family: tahoma,verdana,arial,helvetica,sans-serif;
  font-size: 11px;
  font-weight: normal;
}
 
.btext {
  text-decoration: none;
  font-family: tahoma,verdana,arial,helvetica,sans-serif;
  font-size: 11px;
  font-weight: bold;
}
 
.ltext {
  text-decoration: none;
  font-family: tahoma,verdana,arial,helvetica,sans-serif;
  font-size: 12px;
  font-weight: normal;
}
 
.link {
  text-decoration: none;
  font-family: tahoma,verdana,arial,helvetica,sans-serif;
  font-size: 11px;
  font-weight: normal;
  color: #006699;
}
 
// -->
</style>

<script language="JavaScript" type="text/javascript">
window.focus();
var BaseWin = window.opener;
var cookieEnabled = (navigator.cookieEnabled)? true : false

//if not IE4+ nor NS6+
if (typeof navigator.cookieEnabled == "undefined" && !cookieEnabled){ 
  document.cookie = "testcookie"
  cookieEnabled = (document.cookie == "testcookie")? true : false
  document.cookie = ""
}

//if (cookieEnabled) //if cookies are enabled on client's browser
//do whatever

function closeWin() {
   top.opener = self;
   top.window.close();
}

</script>

</head>
 
<body bgcolor="#ffffff"${pagesize}>
EOF

  return 1;
}


###
###  OutputPageBottom() is used to generate the bottom half of the form.
###

sub
OutputPageBottom () {

  # output the remainder of the HTML page
  print <<EOF;
</body>
</html>
EOF

  return 1;
}


###
###  The Redirect() function is responsible for redirecting the web client to
###  another URL.  This can be useful for sending someone to another page,
###  setting the value of one or more cookies, or forcing the browser into
###  secure mode.  The routine uses one parameter -- the location to redirect
###  the web client to.
###

sub
Redirect ($) {
  my $loc = shift;			# get the location to redirect to

  # redirect
  print "Location: $loc\n";
  DisplayHeaders ();
  return 1;
}


###
###  DisplayHeaders() is responsible for sending transmission headers to the
###  browser before the actual html elements are sent.
###

sub
DisplayHeaders () {
  my $key     = "";

  print "Pragma: no-cache\n";
  print "Window-target: $pagename\n" if ($pagename);
  print "Content-type: text/html\n";
  if (%ck2) {
    foreach $key (sort keys %ck2) {
      print "Set-Cookie: $ck2{$key}\n";
    }
  }
  print "\n";
  return 1;
}

1;					# last line in module