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; 

        }

}