#!/usr/local/bin/perl 

# ======================================================================
# soho.pl  -   order form information 
#
# Original code by
# Carlos A. Pero (cpero@ncsa.uiuc.edu)
#
# Adapted for Soho Design by
# Marco Falcioni falcioni@npac.syr.edu  Aug 1995
#
########################################################################
########## Configurable variables ######################################
#
# here specify the destination of the email message
# and other variables
#
$TARGETEMAIL = "sohodes\@westnet.com,paulc\@npac.syr.edu";
$FROM = "webmaster\@npac.syr.edu (Infomall Web Server)";
$SUBJECT = "Customer Order";
$CGIURL = "http://deneb.npac.syr.edu:3768/cgi-bin/soho.pl?send"; 
$SENDMAIL = '/usr/lib/sendmail';
#                                   The location of your sendmail binary

## Also, make sure the first line of this script points
## to your PERL binary

########## Nothing else to change ######################################
########################################################################


$SCRIPT = $ENV{'SCRIPT_NAME'};

#### Do standard HTTP stuff ####
&cgi_receive;
&cgi_decode;
&cgi_header;

if ($ENV{'QUERY_STRING'} eq "send") {
    &sendmessage;
} else {
    &printmessage;
}
exit;

#####################################################################
#### SUBROUTINES ####################################################

#### Output confirmation message ####

sub printmessage {
    print qq|<HTML><HEAD><TITLE>Order Information</TITLE></HEAD><BODY>\n|;
    print qq|<H1>Customer Order</H1><HR>\n|;
    print qq|Please check that the information is correct.\n|;
    print qq|You can send the order or go <B>Back</B> and change it \n|;
    print qq| if you need to modify the order information. \n|;
    print qq|You may print this document for your records.\n|;
    print qq|<HR>\n|;
    print qq|<FORM ACTION=$CGIURL METHOD=POST>\n|;
    print qq|<INPUT TYPE="submit" VALUE="Send Order">\n|;
    print qq|<TEXTAREA NAME="OrderInfo" ROWS=30 COLS=70>\n|;
    &dump_values(FORM, STDOUT);
    print "</TEXTAREA>\n";
    print "\n";
    print "</FORM>\n";
    print "</BODY>\n";
}

sub error_blank_field {
    local($variable) = @_;
    print "\n" if ($FORM{'next-url'});
    print "<HTML><HEAD><TITLE>Soho Order Form Error</TITLE></HEAD><BODY>\n";
    print "<H1>Error!</H1>\n";
    print "You did not fill in $variable.\n";
    print "Please go back to the form and do so.\n";
    print "</BODY>\n";
    exit;
}

sub cgi_header {
    print "Content-type: text/html\n";
    print "\n" unless ($FORM{'next-url'});
}        

sub cgi_receive {
    if ($ENV{'REQUEST_METHOD'} eq "POST") {
        read(STDIN, $incoming, $ENV{'CONTENT_LENGTH'});
    }
    else {
        $incoming = $ENV{'QUERY_STRING'};
    }
}

sub cgi_decode {
    @pairs = split(/&/, $incoming);

    foreach (@pairs) {
        ($name, $value) = split(/=/, $_);

        $name  =~ tr/+/ /;
        $value =~ tr/+/ /;
        $name  =~ s/%([A-F0-9][A-F0-9])/pack("C", hex($1))/gie;
        $value =~ s/%([A-F0-9][A-F0-9])/pack("C", hex($1))/gie;

        #### Strip out semicolons unless for special character
        $value =~ s/;/$$/g;
        $value =~ s/&(\S{1,6})$$/&\1;/g;
        $value =~ s/$$/ /g;

        $value =~ s/\|/ /g;
        $value =~ s/^!/ /g; ## Allow exclamation points in sentences

        #### Skip blank text entry fields
        next if ($value eq "");

        #### Check for "assign-dynamic" field names
        #### Mainly for on-the-fly input names, especially checkboxes
        if ($name =~ /^assign-dynamic/) {
            $name = $value;
            $value = "on";
        }

	#### Allow for multiple values of a single name
        $FORM{$name} .= ", " if ($FORM{$name});

        $FORM{$name} .= $value;
    }
}

sub dump_values {
    local($env, $handle) = @_;
    local(%PAIRS);
    local($printcommand);
    local($value);
    local($subtot) = 0;

    %format = ('Item #',"%-7d ",
	       'Color',"%-14s ",
	       'Size',"%-4s ",
	       'Qty',"%3d @ ",
	       'Desc',"%-18s ",
	       'Price', "%s\n");
    
    %months = (Jan,"01",
	       Feb,"02",
	       Mar,"03",
	       Apr,"04",
	       May,"05",
	       Jun,"06",
	       Jul,"07",
	       Aug,"08",
	       Sep,"09",
	       Oct,"10",
	       Nov,"11",
	       Dec,"12");

    require "ctime.pl";

    ($day,$month,$num,$time,$year)= split(" ",&ctime(time));
    ($hour,$min,$sec)= split(":",$time);
    $year =~ s/19//;
    $mon = $months{$month};
    # if ($num < 10)  {$num = "0$num"};
#
# Here I build a unique reference number for the order in question
# it is composed by the year - month - day - hours - mins - sec 
# hence it has a very very small probability of not being unique 
#    
    $refkey = "$year$mon$num$hour$min$sec";

    eval "\@keys = keys \%$env";
    eval "\@values = values \%$env";
    while ($#keys >= 0) {
	$key = pop(@keys);
	$value = pop(@values);
	$PAIRS{$key}=$value;
    }

    print $handle "Customer Order","\n";
    print $handle "-" x 70,"\n";
    print $handle "Reference Key: ",$refkey,"\n";
    print $handle "-" x 70,"\n";

    $printcommand = q|printf $handle "%s:\t%s\n",$_,$value;|;

    foreach( sort keys(%PAIRS)){

	$value = $PAIRS{$_};
	$value =~ s/\$//g;	# strip dollar signs
	if(/^[A,B,C]/){		# print only interesting fields
	    $_ =~ s/^.*-//;	# strip the leading sort info

# this is executed once at the beginning of the item listings

	    if($value eq "BEGINS"){ # switch to listing format
		$printcommand = q|printf $handle $format{$_},$value;|;
		print $handle "-" x 70,"\n";	
		printf $handle 
	    "Item \#  Color         Size  Description        Qty   Price     Cost\n";   
		print $handle "-" x 70,"\n";

# this is also execuded once at the end of the listings

	    } elsif($value eq "ENDS") {	# switch back to regular format
		$printcommand = q|printf $handle "%s:\t%s\n",$_,$value;|;
		print $handle "-" x 70,"\n";
		printf $handle 
			 "%s%s%s%6.2f\n",
		         "Subtotal:"," " x 53,"\$",$subtot,"\n";
		$total += $subtot;

# this is executed all other times and hence it is crucial..

	    } else {
		($_ eq "Qty") && ($quantity = $value);
		($quantity < 0) && ($quantity = 0);
		if($_ eq "Price"){
		  $price = $value * $quantity;
		  $subtot += $price;
		  $value = sprintf("\$%-5.2f = \$%6.2f",$value,$price);
		}
		if ($_ eq "Gift Boxes") {
		    $gift = 4*$value;
		    $total += $gift;
		    $value = sprintf("%34d \@  \$4.00 = \$%6.2f", 
				     $value,$gift);
		}

		if ($_ eq "Gift Certificate") {
		    $_ .= " (no taxes or S&H)";
		    $giftcert = $value;
		    $value = sprintf("%21s \$%6.2f", " ", $giftcert);
		}
		

# here I compute the total...

		if ($_ eq "NYSResident") {
		    $total < 0 && ($total = -$total);

# you do not pay shipping and handling for the gift certificate

		    $shc = $total;
		    $sh = 0;
		    if($shc > 0 && $shc <= 24.99) { 
			$sh += 3.25;
		    } elsif ($shc >=25 && $shc <= 49.99) {
			$sh += 4.25;
		    } elsif ($shc >= 50) {
			$sh += 5.25;
		    }
		    $total += $sh;
		    printf $handle 
			 "%s%s%s%6.2f\n",
			"Shipping and Handling:"," " x 40,"\$",$sh,"\n"; # 
		    $tax = $total * .0675;
		    $value eq "Yes"  && ($total += $tax);
		    $value eq "Yes"  && 

# you do not pay taxes on the gift certificate...

                       printf $handle 			
			   "%s%s%s%6.2f\n",
			   "NYS Sales Tax:"," " x 48,"\$",$tax;
		    print $handle "-" x 70,"\n";
		    if ($giftcert) {
			$total += $giftcert;
		    }

		    printf $handle 
			"%s%s%s%6.2f\n",
			"Total Charge:"," " x 49,"\$",$total;
		} else {
		    eval ($printcommand);
		}
	    }
	}
    }
}

sub sendmessage {
    open (MAIL, "| $SENDMAIL $TARGETEMAIL") || die ("$SCRIPT: Can't open $mailprog: $!\n");
    print MAIL "From: $FROM\n";
    print MAIL "To: $TARGETEMAIL\n";
    print MAIL "Subject: $SUBJECT\n";
    print MAIL "\n";

    print MAIL "\n";
    if ($ENV{'QUERY_STRING'}) {
	print MAIL "$FORM{'OrderInfo'}\n";
    }
    print MAIL "\n";
    close (MAIL);

    print qq|<HTML>
<HEAD>

<TITLE>Soho Design Order Sent</TITLE>
<!-- Changed by: Marco Falcioni, Aug- 4-1995 -->
</HEAD>
<BODY>
<CENTER>
<FONT SIZE=7><A HREF="http://www.infomall.org/sohodesign">Soho Design</A></FONT><BR>
<FONT SIZE=5>Thank you for your Order!</FONT>
</CENTER>
<HR>
We will process your order as soon as we receive it.
Please keep a copy of your order reference key for your records 
and do not hesitate to contact us at the following addresses:
<ADDRESS><CENTER>
<B>Soho Design</B><BR>
EMail: sohodes\@westnet.com - Fax: (914) 478 4938 - Tel: (914) 478 7953
</CENTER>
</ADDRESS>
<HR>
<PRE>
|;
    print "$FORM{'OrderInfo'}\n";
print qq|
</PRE>
</BODY>
<HEAD>

|; 

}
