Perl Receiving and Maintaining Poll Results
Provides an example script for taking and receiving a poll using Perl code.
#!/usr/bin/perl
#******************************************************
# This script creates and adds responses to a database
# of Operating Systems Characteristics survey responses.
#******************************************************
$database_file = "/home/httpd/data/oschar1.dat";
$ASCII_thirteen = pack("c", 13);
$space = " ";
#Check to see if a cookie with the name ospoll1 and value done or start are on the client
$rcvd_cookies = $ENV{'HTTP_COOKIE'};
@cookies = split /;/, $rcvd_cookies;
foreach $cookie (@cookies)
{
if ($cookie eq "ospoll1=done")
{
$polltaken=1; #Poll was previously taken
}
if ($cookie eq "ospoll1=start")
{
$pollready=1;
}
}
#If poll was not taken and this is not for display only as indicated by the query string
if (($ENV{'QUERY_STRING'} ne "display") && ($polltaken != 1) && ($pollready == 1))
{
$polltaken=2;
# Format the Web data received and make sure
# it does not contain any server-side includes
%data_received = &Get_Data();
&No_SSI(*data_received);
# Make sure all mandatory fields are full and
# truncate all strings to a maximum of 255 characters
# Also make sure no new-line characters.
foreach $key (keys(%data_received)) {
$data_received{$key} =~ s/$ASCII_ten//ge;
$data_received{$key} =~ s/$ASCII_thirteen/$space/ge;
}
if (%data_received)
{
open(DATABASE,">>$database_file") || die "Content-type: text/html\n\nCannot open database.";
# Because the Web server could receive several requests for a CGI script at the same time
# Lock the database file now.
# The second parameter to the flock function, which in this case is 2,
# is a code that determines the type of lock to be placed on the file.
# The number 2 designates setting a write lock on the specified file stream.
flock(DATABASE, 2);
# each element in the %data_received associative array is printed one at a time,
# surrounded by quotes and separated by commas
print DATABASE $data_received{"expertise"} . "," .
$data_received{"security"} . "," .
$data_received{"stability"} . "," .
$data_received{"ease"} . "," .
$data_received{"networking"} . "," .
$data_received{"monitoring"} . "," .
$data_received{"learning"} . "," .
$data_received{"documentation"} . "," .
$data_received{"cost"} . "," .
$data_received{"compatability"} . "," .
$data_received{"communication"} . "," .
$data_received{"speed"} . "," .
$data_received{"people"} . "," .
$data_received{"support"} . "," .
$data_received{"scalability"} . "," .
$data_received{"bugfix"} . "\n";
# The number 8 designates removing all locks from the specified file stream
flock(DATABASE, 8);
close(DATABASE);
} # end if data was received
} # end if the poll was not taken
# Place a cookie on the user's machine to show the poll was taken.
if ($polltaken == 2)
{
$fut_time=gmtime(time()+365*24*3600)." GMT"; # Add 12 months (365 days)
$cookie = "ospoll1=done; path=/; expires=$fut_time; $secure";
print "Set-Cookie: " . $cookie . "\n";
}
# Report statistics
# Generate database statistics for reporting
open(DATABASE,"<$database_file") || die "Content-type: text/html\n\nCannot open database.";
@lines = <DATABASE>
$responses = 0;
$expertise = 0;
$security = 0;
$stability = 0;
$ease = 0;
$networking = 0;
$monitoring = 0;
$learning = 0;
$documentation = 0;
$cost = 0;
$compatability = 0;
$communication = 0;
$speed = 0;
$people = 0;
$support = 0;
$scalability = 0;
$bugfix = 0;
foreach $line (@lines)
{
$responses++;
@entries = split(/,/, $line);
$security += $entries[1];
$stability += $entries[2];
$ease += $entries[3];
$networking += $entries[4];
$monitoring += $entries[5];
$learning += $entries[6];
$documentation += $entries[7];
$cost += $entries[8];
$compatability += $entries[9];
$communication += $entries[10];
$speed += $entries[11];
$people += $entries[12];
$support += $entries[13];
$scalability += $entries[14];
$bugfix += $entries[15];
}
$security = (10 * $security)/$responses;
$stability = (10 * $stability)/$responses;
$ease = (10 * $ease)/$responses;
$networking = (10 * $networking)/$responses;
$monitoring = (10 * $monitoring)/$responses;
$learning = (10 * $learning)/$responses;
$documentation = (10 * $documentation)/$responses;
$cost = (10 * $cost)/$responses;
$compatability = (10 * $compatability)/$responses;
$communication = (10 * $communication)/$responses;
$speed = (10 * $speed)/$responses;
$people = (10 * $people)/$responses;
$support = (10 * $support)/$responses;
$scalability = (10 * $scalability)/$responses;
$bugfix = (10 * $bugfix)/$responses;
close(DATABASE);
# Output success message
print "Content-type: text/html", "\n\n"; # MIME header.
print "<HTML>", "\n";
print "<HEAD>";
print "<TITLE>Poll Results.</TITLE>", "\n";
print "</HEAD>", "\n";
print '<BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#0000FF" VLINK="#51188E" ALINK="#FF0000" BACKGROUND="../gifs/clouds.gif">';
print "\n";
print '<center><A href="index.html" target="_top">Operating Systems Contents Page</A></center>' . "\n";
print "<center><H1>Current Poll Results</H1></center>\n";
print "<H2>Responses: $responses</H2>\n";
print "<B>Security:</B>\n";
print '<HR SIZE="15" ALIGN="left" width="' . $security . '%" color="ff0000">' . "\n";
print "<B>Stability:</B>\n";
print '<HR SIZE="15" ALIGN="left" width="' . $stability . '%" color="00ff00">' . "\n";
print "<B>Ease of Use:</B>\n";
print '<HR SIZE="15" ALIGN="left" width="' . $ease . '%" color="0000ff">' . "\n";
print "<B>Networking:</B>\n";
print '<HR SIZE="15" ALIGN="left" width="' . $networking . '%" color="800000">' . "\n";
print "<B>Monitoring and Auditing:</B>\n";
print '<HR SIZE="15" ALIGN="left" width="' . $monitoring . '%" color="008000">' . "\n";
print "<B>Learning:</B>\n";
print '<HR SIZE="15" ALIGN="left" width="' . $learning . '%" color="000080">' . "\n";
print "<B>Documentation:</B>\n";
print '<HR SIZE="15" ALIGN="left" width="' . $documentation . '%" color="800080">' . "\n";
print "<B>Cost:</B>\n";
print '<HR SIZE="15" ALIGN="left" width="' . $cost . '%" color="808000">' . "\n";
print "<B>Compatability:</B>\n";
print '<HR SIZE="15" ALIGN="left" width="' . $compatability . '%" color="008080">' ."\n";
print "<B>Communication with foreign OSs:</B>\n";
print '<HR SIZE="15" ALIGN="left" width="' . $communication . '%" color="ff0000">' . "\n";
print "<B>Speed:</B>\n";
print '<HR SIZE="15" ALIGN="left" width="' . $speed . '%" color="00ff00">' . "\n";
print "<B>Available IT people:</B>\n";
print '<HR SIZE="15" ALIGN="left" width="' . $people . '%" color="0000ff">' . "\n";
print "<B>Support:</B>\n";
print '<HR SIZE="15" ALIGN="left" width="' . $support . '%" color="800000">' . "\n";
print "<B>Scalability:</B>\n";
print '<HR SIZE="15" ALIGN="left" width="' . $scalability . '%" color="008000">' . "\n";
print "<B>Speed of getting bugs fixed:</B>\n";
print '<HR SIZE="15" ALIGN="left" width="' . $bugfix . '%" color="000080">' ."\n";
print "<BR>\n";
print '<center><A href="index.html" target="_top">Operating Systems Contents Page</A></center>' . "\n";
print "</BODY>", "\n";
print "</HTML>", "\n";
sub Get_Data {
local (%user_data, $input_string, $nv_pair,
@nv_pairs, $name, $value);
# If the data was sent via POST, then it is available
# from standard input. Otherwise, the data is in the
# QUERY_STRING environment variable.
if ( $ENV{'REQUEST_METHOD'} eq "POST" )
{
# $len = $ENV{`CONTENT_LENGTH`};
read(STDIN,$input_string,$ENV{'CONTENT_LENGTH'});
}
else {
$input_string = $ENV{'QUERY_STRING'};
}
# This line changes the + signs to spaces.
$input_string =~ s/\+/ /g;
# This line places each name/value pair as a separate
# element in the name_value_pairs array.
@nv_pairs = split(/&/, $input_string);
# This code loops over each element in the name_value_pairs
# array, splits it on the = sign, and places the value
# into the user_data associative array with the name as the
# key.
foreach $nv_pair (@nv_pairs) {
($name, $value) = split(/=/, $nv_pair);
# These two lines decode the values from any URL
# hexadecimal encoding. The first section searches for a
# hexadecimal number and the second part converts the
# hex number to decimal and returns the character
# equivalent.
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/ge;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/ge;
# If the name/value pair has already been given a value,
# as in the case of multiple items being selected, then
# separate the items with a ":".
if (defined($user_data{$name})) {
$user_data{$name} .= ":" . $value; }
else {
$user_data{$name} = $value;
}
}
return %user_data;
}
sub No_SSI {
local (*data) = @_;
foreach $key (sort keys(%data)) {
$data{$key} =~ s/<!--(.|\n)*-->//g;
}
}
|
|
