#!/usr/local/bin/perl
#
# dcforms98.cgi
# Written By David S. Choi, dc@sitedeveloper.com
# 10 May 1998
#
# Copyright  ©1997-1998 DCScripts All Rights Reserved
# As part of the installation process, you will be asked
# to accept the terms of this Agreement. This Agreement is
# a legal contract, which specifies the terms of the license
# and warranty limitation between you and DCScripts and DCForms98.
# You should carefully read the following terms and conditions before
# installing or using this software.  Unless you have a different license
# agreement obtained from DCScripts, installation or use of this software
# indicates your acceptance of the license and warranty limitation terms
# contained in this Agreement. If you do not agree to the terms of this
# Agreement, promptly delete and destroy all copies of the Software.
#
# Versions of the Software 
# Only one copy of the registered version of DCForms98 may used on one web site.
# 
# License to Redistribute
# Distributing the software and/or documentation with other products
# (commercial or otherwise) or by other than electronic means without
# DCScripts's prior written permission is forbidden.
# All rights to the DCForms98 software and documentation not expressly
# granted under this Agreement are reserved to DCScripts.
#
# Disclaimer of Warranty
# THIS SOFTWARE AND ACCOMPANYING DOCUMENTATION ARE PROVIDED "AS IS" AND
# WITHOUT WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR ANY OTHER
# WARRANTIES WHETHER EXPRESSED OR IMPLIED.   BECAUSE OF THE VARIOUS HARDWARE
# AND SOFTWARE ENVIRONMENTS INTO WHICH DCFORMS98 MAY BE USED, NO WARRANTY OF
# FITNESS FOR A PARTICULAR PURPOSE IS OFFERED.  THE USER MUST ASSUME THE
# ENTIRE RISK OF USING THIS PROGRAM.  ANY LIABILITY OF DCSCRIPTS WILL BE
# LIMITED EXCLUSIVELY TO PRODUCT REPLACEMENT OR REFUND OF PURCHASE PRICE.
# IN NO CASE SHALL DCSCRIPTS BE LIABLE FOR ANY INCIDENTAL, SPECIAL OR
# CONSEQUENTIAL DAMAGES OR LOSS, INCLUDING, WITHOUT LIMITATION, LOST PROFITS
# OR THE INABILITY TO USE EQUIPMENT OR ACCESS DATA, WHETHER SUCH DAMAGES ARE
# BASED UPON A BREACH OF EXPRESS OR IMPLIED WARRANTIES, BREACH OF CONTRACT,
# NEGLIGENCE, STRICT TORT, OR ANY OTHER LEGAL THEORY. THIS IS TRUE EVEN IF
# DCSCRIPTS IS ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. IN NO CASE WILL
# DCSCRIPTS' LIABILITY EXCEED THE AMOUNT OF THE LICENSE FEE ACTUALLY PAID
# BY LICENSEE TO DCSCRIPTS.
#
# CREDITS:
#
# To All Pioneers of Perl and CGI, Thanks!
#------------------------------------------------------

# Location of Mail Program
$mailprog = '/usr/lib/sendmail';

# Location where database file will be kept
# This directory must be 777
$datadir = "../data";

# Your server's domain
# This ensures that the form is submitted from your server.
$url = "www.wildboar.net";

#--------- No Need to Edit anything Below ----------------#


# Check to make sure form submittion is valid
unless ($ENV{'HTTP_REFERER'} =~ /$url/) {
	print "Location: $ENV{'HTTP_REFERER'}\n\n";
	exit(0);
}

# Parse input form data
&parse_form(\%DATA);

# If env_report is not empty, save/send those too
if ($DATA{'param_env_report'}) {
	$DATA{'param_env_report'} =~ s/\s//g;
	@ENV = split(/\,/,$DATA{'param_env_report'});
	foreach (@ENV) {
		$DATA{$_} = $ENV{$_};
	}
}

# First check to make sure that all fields are filled
if ($DATA{'param_required'}) {
	&check_required(\%DATA);
}

# Send E-mail to All recipients
if ($DATA{'param_recipient'}) {
	$DATA{'param_recipient'} =~ s/\s//g;
	@recipient = split(/\,/,$DATA{'param_recipient'});
	foreach (@recipient) {
		&send_mail($mailprog,$_,\%DATA);
	}
}	

# Check to make sure that database exists
if ($DATA{'param_database'}) {
	&add_database("$datadir/$DATA{'param_database'}",\%DATA);
}

# If 'redirect' is not null, then redirect to the page
if ($DATA{'param_redirect'}) {
	print "Location: $DATA{'param_redirect'}\n\n";
}
else {
	&print_thankyou(\%DATA);
}

exit(0);

### subroutine check_required
sub check_required {

	my($r_DATA) = @_;
	my(@required, @ERROR);
	
	@required = split(",",$r_DATA->{'param_required'});
	foreach (@required) {
		if ($r_DATA->{$_} eq "") {
			push(@ERROR, $_);
		}
	}
	
	if (@ERROR) {
		print "Content-type: text/html\n\n";	
		print qq~
		<html>
		<head>
		</head>
		<body>
		<h1>Thank you, but...</h1>
		Thank you for taking the time to fill out this form.
		However, you didn't complete our form :-(  Please go back and
		complete the following fields<p>
		~;
		foreach (@ERROR) {
	            print "<li><b>$_</b></li>";
		}
		print qq~
		<!-- WiredMinds eMetrics tracking with Enterprise Edition V5.4 START -->
<script type='text/javascript' src='https://count.carrierzone.com/app/count_server/count.js'></script>
<script type='text/javascript'><!--
wm_custnum='27ac4df640cb160c';
wm_page_name='dcforms98.txt';
wm_group_name='/services/webpages/w/i/wildboar.net/public/blog/computers/webdesign/cgi/perl/forms/toemail-text/dcforms98';
wm_campaign_key='campaign_id';
wm_track_alt='';
wiredminds.count();
// -->
</script>
<!-- WiredMinds eMetrics tracking with Enterprise Edition V5.4 END -->
</body>
		<html>~; 
		exit(0);
	}

}

### subroutine print_thankyou
sub print_thankyou {

	my($r_DATA) = @_;

	print "Content-type: text/html\n\n";	
	print qq~
	<html>
	<head>
	</head>
	<body>
	<h1>Thank you!</h1>
	Thank you for taking the time to fill out this form.<p>
	Here is what you submitted...
	~;

	if ($r_DATA->{'param_order'}) {
		$r_DATA->{'param_order'} =~ s/\s//g;
		my @order = split(/\,/,$r_DATA->{'param_order'});
		foreach (@order) {
			print "<li><b>$_:</b> $r_DATA->{$_}</li>";
		}
	}
	else {
		foreach (keys %$r_DATA)	{
			unless ($_ =~ /^param/) {
				print "<li><b>$_:</b> $r_DATA->{$_}</li>";
			}
		}
	}	

	print qq~
	</body>
	<html>~;

}

### subroutine add_database
sub add_database {

	my($file,$r_DATA) = @_;
	my($data_in);


# First check and make sure the file exists
	if (!(-e "$file")) {

		foreach (keys %$r_DATA) {
			unless ($_ =~ /^param/) {
				$data_in .= "$_|";
			}
		}
		chop($data_in);
		open(DATA,">$file") || die $!;
			print DATA "$data_in\n";
		close(DATA);
	}
	
	$data_in = "";

	if ($r_DATA->{'param_order'}) {
		$r_DATA->{'param_order'} =~ s/\s//g;
		my @order = split(/\,/,$r_DATA->{'param_order'});
		foreach (@order)	{
				$r_DATA->{$_} =~ s/\cM//g;
		  	$r_DATA->{$_} =~ s/\n\n//g;
		   	$r_DATA->{$_} =~ s/\n//g;
				$r_DATA->{$_} =~ s/\|//g;
		   	$data_in .= "$r_DATA->{$_}|";
		}
	}
	else {
		foreach (keys %$r_DATA)	{
			unless ($_ =~ /^param/) {
				$r_DATA->{$_} =~ s/\cM//g;
		  	$r_DATA->{$_} =~ s/\n\n//g;
		   	$r_DATA->{$_} =~ s/\n//g;
				$r_DATA->{$_} =~ s/\|//g;
		   	$data_in .= "$r_DATA->{$_}|";
			}
		}
	}	

	chop($data_in);		

	open(DATA,">>$file") || die $!;
		print DATA "$data_in\n";
	close(DATA);

}


### subroutine parse_form
sub parse_form {

	my($r_DATA) = @_;

# Determine request method - take GET and POST Method
	if ($ENV{'REQUEST_METHOD'} eq "GET") {
   		$query_string = $ENV{'QUERY_STRING'};
	}
	elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
   		read(STDIN, $query_string, $ENV{'CONTENT_LENGTH'});
	}
	
# Split the name-value pairs
# Remembering that ampersand sign is our "delimiter"
   	my @pairs = split(/&/, $query_string);
	
# For each key-value pairs
	foreach (@pairs) {

# Split name and value pair ...
# Remembering that name (key) and value are separated by an equal sign
		($name, $value) = split(/=/, $_);

# Un-Webify plus signs and %-encoding
# Replaces "+" by a blank space
		$name =~ tr/+/ /;
		$value =~ tr/+/ /;

# Remove all unwanted tags
		$value =~ s/</&lt;/g;
		$value =~ s/>/&gt;/g;
		$value =~ s/\cM//g;
		$value =~ s/\n\n/<p>/g;
		$value =~ s/\n/<br>/g;

#Remove all HTML tags
		$value =~ s/<([^>]|\n)*>//g;

	  
# Replace Hexadecimal value to its equivalent character value
# Hexadecimal values begin with "%" sign
# Take any two alpha-numeric characters and convert it to its ASCII equivalent
# e option evaluates the second part of the substitute command
# The pack command takes the hex value stored in $1 and converts to an ASCII equivalent
# g option replaces them globally

		$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

# Assign to associative array FORM
# Use "\0" to join any multiple values

		if (defined($r_DATA->{$name})) {
			$r_DATA->{$name} = join("\0",$r_DATA->{$name},$value);
		}
		else {
			$r_DATA->{$name} = $value;
		}

	}

	return $r_DATA;

}

#### subroutine send_mail
sub send_mail {
	my ($mailprog,$recipient,$r_DATA) = @_;
	
	# Open The Mail Program
	open(MAIL,"|$mailprog -t");

	print MAIL "To: $recipient\n";
   	print MAIL "From: $r_DATA->{'param_subject'}\n";

	if ($r_DATA->{'param_subject'}) {
		print MAIL "Subject: $r_DATA->{'param_subject'}\n\n";
	} else {
		print MAIL "Subject: Formmail Feedback\n\n";
	}

	print MAIL "Below is a feedback from \"$r_DATA->{'param_subject'}\" form.\n";
	print MAIL "----------------------------------------------------------------\n\n";


	if ($r_DATA->{'param_order'}) {
		$r_DATA->{'param_order'} =~ s/\s//g;
		my @order = split(/\,/,$r_DATA->{'param_order'});
		foreach (@order) {
			print MAIL ("$_:","\t\t","$r_DATA->{$_}\n");
		}
	}
	else {
		foreach (keys %$r_DATA)	{
			unless ($_ =~ /^param/) {
				print MAIL ("$_:","\t\t","$r_DATA->{$_}\n");
			}
		}
	}	

	close (MAIL);

}