survey.pl Source Code
#!/usr/bin/perl
#
###########################################################################
# survey.pl by Mike Moxcey #
# called with METHOD="POST" #
# ACTION="http://url/path/survey.pl #
# and can pass in datafile to write to with #
# ACTION="http://url/path/survey.pl?/path/file.name" #
###########################################################################
# To modify, change: #
# @referers list to contain only those forms you want #
# $datafile Change the default #
# create both files (default and passed in) with proper permissions #
# #
# This will sort values based on the NAME of the form's field #
# It will also strip out SEPCHAR:
#
# the separation character it puts between fields #
###########################################################################
############################################
# Define legal addresses for calling forms #
############################################
#@referers = ('www.aphis.usda.gov','151.121.3.135');
@referers = ('www.aphis.usda.gov','151.121.3.135','file:///C|/_/WRK/survey/es1.html','file:///H|/MMOXCEY/survey/es1.html');
############################################
# Define include files #
############################################
require "cgi-lib.cgi";
require "ctime.pl";
##############################################
# Define character to separate data elements #
##############################################
#$sepchar=";";
$sepchar=" "; # a space is best for import into SAS
########
# main #
########
if (defined($ARGV[0])) {
$datafile=$ARGV[0];
}
else {
$datafile = "default.data";
}
open (DATAFILE, ">> $datafile") || &error('open_file');
&check_url; # possibly exit if coming from bad place
&parse_data; # dump it into array
close (DATAFILE);
&respond;
exit; #end of main program
###########################################################################
# parse_data #
# Splits input into pairs array [name1=val1 , name2=val2 , ...] #
# Then foreach of those pairs, it splits them into key,val variables #
# then strips the "bad" code (possible system calls from test fields)#
# then it loads all the data into the associated array: Datarray #
# Sorts and prints the data to the flat file #
# Prints other environment variables time and ip address #
###########################################################################
sub parse_data {
*in = @_ if @_;
local ($i, $key, $val, %Datarray); # declare vars
read(STDIN, $in, $ENV{'CONTENT_LENGTH'});
@pair = split(/[&;]/, $in); #split into pairs
foreach $i (0..$#pair){
($key, $val) = split(/=/,$pair[$i],2); #split pairs
$key =~ s/%(..)/pack("c",hex($1))/ge;
$val =~ s/%(..)/pack("c",hex($1))/ge;
$val =~ s/\+/ /g;
$Datarray{$key} = $val; #make assoc array
$Datarray{$key} =~ s/$sepchar/_/g; #strip sepchar
}
# print data structure
print (DATAFILE "DATA:");
foreach $ky (sort(keys %Datarray)) {
print (DATAFILE "$ky=$Datarray{$ky}$sepchar");
}
# Other info for analysis
print (DATAFILE "IP: $ENV{'REMOTE_ADDR'} $sepchar");
print (DATAFILE "Secs: $^T$sepchar");
print (DATAFILE "Date:");
print (DATAFILE &ctime(time));
# print (DATAFILE "\n"); # exclude because ctime has a cr/lf
}
###########################################################################
# check_url #
# To make sure other forms aren't writing data to this flatfile #
# If so, then exit. #
###########################################################################
sub check_url {
if ($ENV{'HTTP_REFERER'}) {
foreach $referer (@referers) {
if ($ENV{'HTTP_REFERER'} =~ /$referer/i) {
$check_referer = '1';
last;
}
}
}
else {
$check_referer = '1';
}
if ($check_referer != 1) {
&error('bad_referer');
}
}#end check_url
###########################################################################
# respond: sends html to user about the survey
###########################################################################
sub respond {
print &PrintHeader;
print &HtmlTop("Survey Response Thanks");
print <<EOM;
Thank you for the input.<P>
We will announce the results sometime in the summer of 1997.
<hr>
See what else
<ul>
<li><a href="http://www.usda.gov/">USDA</a>
US Dept of Agriculture
<li><a href="http://www.aphis.usda.gov/">APHIS</a>
Animal and Plant Health Inspection Service
<li><a href="http://www.aphis.usda.gov/vs/">VS</a>
Veterinary Services
<li> <a href="http://www.aphis.usda.gov/vs/ceah/">CEAH</a>
Centers For Epidemiology and Animal Health
<li> <a href="http://www.aphis.usda.gov/vs/ceah/cahm/">CAHM</a>
Center for Animal Health Monitoring
</ul>
has available on the web.
<hr>
For further questions or comments about this survey, contact
<ul>
<li>Josie Traub-Dargatz at
<a href="mailto:jtraub\@aphis.usda.gov">jtraub\@aphis.usda.gov</a>
or 970-221-4535
<br>or
<li>Nora Wineland at
<a href="mailto:nwineland\@aphis.usda.gov">nwineland\@aphis.usda.gov</a>
or 970-490-7937
</ul>
For questions or problems on the web page form itself, contact
<ul>
<li>Mike Moxcey at <a href="mailto:mmoxcey\@aphis.usda.gov">mmoxcey\@aphis.usda.gov</a>
or 970-490-7980
</ul>
EOM
print &HtmlBot;
}
###########################################################################
# error: sends html to user about errors
###########################################################################
sub error {
($error,@error_fields) = @_;
print &PrintHeader;
if ($error eq 'bad_referer') {
print &HtmlTop("Bad Referrer - Access Denied");
print "The form that is trying to use this survey script \n";
print "resides at: $ENV{'HTTP_REFERER'}, which is not allowed to access this cgi script.<p>\n";
print "Sorry. <p>\n";
}
elsif ($error eq 'open_file') {
print &HtmlTop("Can't Open Data File");
print "The script cannot open the file <strong>$datafile<</strong>. \n ";
print "Sorry. <p>\n";
}
print "Contact Mike Moxcey at <a href=\"mmoxcey\@aphis.usda.gov\">\n";
print "mmoxcey\@aphis.usda.gov</a> or 970-490-7980 \n";
print &HtmlBot;
exit;
}
Mike Moxcey Feb 1997