#!/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 = "falcioni\@npac.syr.edu,paulc\@npac.syr.edu";
$FROM = "webmaster\@infomall.com";
$SUBJECT = "Customer Order";
$CGIURL = "http://deneb.npac.syr.edu:3768/cgi-bin/marco.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 return to <A HREF="$FORM{'previous-url'}">to the order form</A>\n| if ($FORM{'previous-url'});
    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>Server-Email 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;
    
    %months = (Jan,1,
	       Feb,2,
	       Mar,3,
	       Apr,4,
	       May,5,
	       Jun,6,
	       Jul,7,
	       Aug,8,
	       Sep,9,
	       Oct,10,
	       Nov,11,
	       Dec,12);

    %format = ('Item #',"%-7d ",
	       'Color',"%-14s ",
	       'Size',"%-4s ",
	       'Qty',"%-3d ",
	       'Desc',"%-20s ",
	       'Price', "\$%-6.2f\n");

    require "ctime.pl";

    ($day,$month,$num,$time,$year)= split(" ",&ctime(time));
    ($hour,$min,$sec)= split(":",$time);
    $year =~ s/19//;
#
# 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$months{$month}$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
	    if($value eq "BEGINS"){ # switch to listing format
		$printcommand = q|printf $handle $format{$_},$value;|;
		print $handle "-" x 70,"\n";	
		printf $handle 
	    "Item \#  Color          Size Qty Description          Price\n";   
		print $handle "-" x 70,"\n";
	    } elsif($value eq "ENDS") {	# switch back to regular format
		$printcommand = q|printf $handle "%s:\t%s\n",$_,$value;|;
		print $handle "-" x 70,"\n";
		print $handle "Subtotal:"," " x 44,"\$",$subtot,"\n";
		$total += $subtot;
	    } else {
		($_ eq "Price") && ($subtot += $value);
		if ($_ eq "Gift Boxes") {
		    $gift = 4*$value;
		    $total += $gift;
		    $value .=
			" \@ \$4.00 each                       \$$gift.00";
		}
		if ($_ eq "NYSResident") {
		    $total < 0 && ($total = -$total); 
		    if($total <= 24.99) { 
			$sh += 2.95;
		    } elsif ($total >=25 && $total <= 49.99) {
			$sh += 3.95;
		    } else {
			$sh += 4.95;
		    }
		    $total += $sh;
		    print $handle 
			"Shipping and Handling:"," " x 31,"\$",$sh,"\n"; # 
		    $tax = $total * .0675;
		    $value eq "Yes"  && ($total += $tax);
		    $value eq "Yes"  && 
                       printf $handle 			
			   "%s%s%s%-6.2f\n",
			   "NYS Sales Tax:"," " x 39,"\$",$tax;
		    print $handle "-" x 70,"\n";
		    printf $handle 
			"%s%s%s%-6.2f\n",
			"Total Charge:"," " x 40,"\$",$total;
		} else {
		    eval ($printcommand);
		}
	    }
	}
    }
}

sub sendmessage {
    open (MAIL, "| $SENDMAIL $TARGETEMAIL") || die ("$SCRIPT: Can't open $mailprog: $!\n");
    print MAIL "Reply-to: $FROM\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>Soho Design</FONT><BR>
<FONT SIZE=5>Thanks you for you Order!</FONT>
</CENTER>
<HR>
We will process you order as soon as we receive it.
Please keep a copy of you 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: (714) 478 4938 - Tel: (714) 478 7953
</CENTER>
</ADDRESS>
<HR>
<PRE>
|;
    print "$FORM{'OrderInfo'}\n";
print qq|
</PRE>
</BODY>
<HEAD>

|; 

}
