Reply-to: psf@npac.syr.edu To: kcicompute@worldkids.net Date: Sat, 14 Mar 1998 22:56:23 -0500 From: Pamela Fox Pamela Fox psf@npac.syr.edu, http://www.npac.syr.edu http://www.npac.syr.edu/users/gcf/homepage/pamhomepage.html http://www.npac.syr.edu/users/gcf/familyphotos/summary0.html Phone 3156827945 Fax 3156823581(when computer offline) ------- Forwarded Message Date: Thu, 12 Mar 1998 22:41:34 -0500 From: irte To: psf@npac.syr.edu Subject: http://weber.u.washingt...ple_vote/vote1_cgi.html This is a multi-part message in MIME format. - --------------83B3EB47C00 Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: 7bit http://weber.u.washington.edu/~rif/Simple_vote/vote1_cgi.html - --------------83B3EB47C00 Content-Type: text/html; charset=us-ascii; name="vote1_cgi.html" Content-Transfer-Encoding: 7bit Content-Disposition: inline; filename="vote1_cgi.html" Content-Base: "http://weber.u.washington.edu/~rif/Sim ple_vote/vote1_cgi.html"

Richard Ian-Frese
rif@u.washington.edu

#!/usr/local/bin/perl5 ########################################################################### # # Filename: vote1.cgi # Version: 3.1 # Author: Richard Ian-Frese # e-mail: rif@u.washington.edu # www: http://weber.u.washington.edu/~rif # Date created: 17-Nov-95 # Last updated: 01-Jan-97 # Tested running: Perl v4.036, v5.003 with 'cgi-lib.pl' v1.8 # Server protocol: HTTP/1.0 # Server software: NCSA/1.4.2, Apache/1.1.1 # # Useage: This script receives and counts a MULTIPLE-CHOICE vote cast # from an HTML form (you may view the form source code with your Web # browser). It then returns to the voter, a simplified HTML table displaying # the updated poll results, on-the-fly. A number of support files will # automatically be created in the directory where this .cgi script resides. # # Comments: For heavy useage, filelocking may be desirable to insure a # stable database. However, for moderate useage the program appears to # function reasonably well without filelocking. Controls such as voter # authentication were not considered critical here, although there is a # provision for controlling the number of times a registered user can vote # (using .htaccess/.htpasswd). There is also a provision for limiting # unregistered voters to a one vote limit (based on identification of the # REMOTE_HOST). You can easily implement either of these controls by # uncommenting the code where indicated. Lastly, for simplicity and # quicker processing, each survey question maintains/updates it's own # DBM. Successive survey questions may be hyperlinked together for # continuity. # # Note: This program is intended primarily as an example for users # who want to run a simple, Perl CGI polling script. It remains # freely available for personal, noncommercial use as long as this header # remains in tact. Any modifications to this script should be noted and # appended to this header for future reference if you distribute this # code to someone else. For commercial useage, please contact the author. # # Installation instructions: a) Make certain the first line of code # reflects where Perl is located on the server you are using. If in # doubt, ask your Webmaster for configuration help. b) Make sure # that you are using the correct extension for your Perl scripts # (i.e., .pl or .cgi), and that the script is located in the directory # specified for executing CGI scripts on your Web server. c) Be # careful to set your UNIX permissions to 755 for executing the script. # All support files are created automatically when the program # initializes. You only need to place the "vote1.cgi" script and the # "poll1.html" in a directory of your choice. d) Make initial modifications # only where indicated in the comments throughout the script to reduce # the chance of installation/configuration errors. All key locations # where modifications are needed for customizing this script to your # site are specified in between the sets of dashed lines. For example, # if you are supposed to modify filename "foo", in the script, # to say, "foobar", then at the appropriate location you will see: # # # # -------- modify filename "foo" on next line to "foobar" ------- # # $variable = "foo"; # # ----------- end modification of filename "foo" ------------ # # # # e) Where modification of a directory "path" is indicated, you can # obtain the correct path info by typing "pwd" at the UNIX command line, # from within the directory where you intend to keep the files and/or # databases that will be automatically created. f) This script uses # Steve Brenner's "cgi-lib.pl" library routines for parsing array, %in, # input variables. This library is probably already installed on your # Web server if you are running Perl. If it isn't, however, do a net # search for "cgi-lib.pl", download the file, and install as indicated, # later in the script. # # Legalese: There are no expressed warranties implied or otherwise # stated. You may modify the code to suit your specific needs, however, # running or reconfiquring the code contained herein is solely at your # own risk, discretion, and consequently, responsibility. # # Copyright (c) 1995-97 Richard Ian-Frese -- All Rights Reserved # ############################################################################# # Put input variables into an array, %in, for parsing. # The "cgi-lib.pl" library routines should be installed in # @INC or the directory where you decide to keep "vote1.cgi". require 'cgi-lib.pl'; select STDOUT; # Force flushing of buffers upon write to insure reliable output # when forking processes. $| = 1; # The next variable should reflect where you will keep your poll stats # file, named "database1" (see installation instruction set above). # ------------------ modify path in next line --------------------- $database1 = "/www/d88/rif/Simple_vote/database1"; # -------------- end of modification of directory path ------------- # The next variable should reflect where you keep your user stats file # named "htuserdatabase1". Uncomment the "$htuserdatabase1" variable if # you plan to use ".htaccess" for user authentication and vote control. # For details on implementing .htaccess/.htpasswd visit NCSA's site and # read the short section on user authentication and password control. # After you have created your .htaccess/.htpasswd files (these are not # created automatically for you by this script) you can easily limit # access and voting privileges in your polls. For instance, you can set # the voting privileges to one vote per registered person. # --- uncomment and modify path of next line only if using ".htaccess" --- # $htuserdatabase1 = "/www/d88/rif/Simple_vote/htuserdatabase1"; # ------------ end uncomment and modification of directory path ---------- # To limit the unregistered vote to one per person (same as .htaccess above # only voters do not have to be registered, and you do not need to use # .htaccess/.htpasswd) uncomment and modify the path in the next variable # ("unregdatabase1"). # -------- uncomment and modify "unreguserdatabase1" directory path ------- # $unreguserdatabase1 = "/www/d88/rif/Simple_vote/unreguserdatabase1"; # -- end uncomment and modification of "unreguserdatabase1" directory path -- # If you do not want to track the browser/platform useage (what types # of browsers and operating systems people are using when they take your # surveys, comment out the "browserdatabase1" path. Otherwise, modify the # path info. # -- comment out "$browserdatabase1" path if not tracking browser use -- # (or modify path if you are tracking useage) $browserdatabase1 = "/www/d88/rif/Simple_vote/browserdatabase1"; # -- end comment and modification of "browserdatabase1" directory path -- $date=`date`; chop($date); # Print HTML output header. print "Content-type: text/html\n\n"; # Get input variables and environmental variables from httpd. &ReadParse; # Check and update "htaccess" user stats. Uncomment the next section # only if you are using ".htaccess" for user authentication and vote # control (.htaccess/.htpasswd is set at the system level -- check with # your Webmaster to be certain that you have permission to use it. # ------ uncomment following section only if using ".htaccess" ------- # $htuser = $ENV{"REMOTE_USER"}; # dbmopen(%keys,$htuserdatabase1,0644); # # if ($keys{$htuser}) { # $keys{$htuser}++; # } else { # $keys{$htuser} = 1; # } # if ($keys{$htuser} >= 2) { # die "Die dog, no ballot stuffing allowed in this poll!\n"; # # dbmclose(%keys); # } # print "<HEAD><TITLE>HTACCESS USER STATS</TITLE></HEAD>\n"; # print "<body><center><h3>HTACCESS USER STATISTICS</h3>\n"; # print "<table border cellpadding=6 cellspacing=1>"; # print "<caption><pre><i>htaccess</i> User Statistics</caption><br>\n"; # print "<tr><th align=right><b>PERCENT</b> </th>"; # print "<th align=right><b>ATTEMPTS</b> <th align=left>"; # print "<b>HTACCESS USER</b></th></tr><p>\n"; # dbmopen(%htuser_database1,$htuserdatabase1,0644); # while (($htuser,$count) = each(%htuser_database1)){ # $htusersubtotal = $htusersubtotal + $count; # } # foreach $name (reverse (sort by_count_htuser keys %htuser_database1)) { # $percent = $htuser_database1{$name} / $total * (100); # $total = $htusersubtotal; # printf ("<tr><td align=right> %4.1f</td>",$percent); # printf ("<td align=right> %4d</td>",$htuser_database1{$name}); # printf ("<td align=left> %7-s </td>",$name); # print "</tr>\n"; # } # dbmclose(%keys); # print "<br><tr><th align=right> TOTAL </th><th align=right>"; # print "<b>$total</b></th></tr>\n"; # print "</table></pre><p><hr><p>\n"; # ----------- end uncomment of section above --------------- # Input error checking &check_the_syntax; # -- uncomment following section if limiting an unregistered vote to 1 -- # $unreguser = $ENV{"REMOTE_HOST"}; # dbmopen(%keys,$unreguserdatabase1,0644); # if ($keys{$unreguser}) { # $keys{$unreguser}++; # } else { # $keys{$unreguser} = 1; # } # if ($keys{$unreguser} >= 2) { # die "Die dog, no ballot stuffing allowed in this poll!\n"; # dbmclose(%keys); # } # print "<HEAD><TITLE>UNREGISTERED USER STATS</TITLE></HEAD>\n"; # print "<body><center><h3>UNREGISTERED USER STATISTICS</h3>\n"; # print "<table border cellpadding=6 cellspacing=1>"; # print "<caption><pre>Poll start date: 01-Jan-97</caption><br>\n"; # print "<tr><th align=right><b>PERCENT</b> </th>"; # print "<th align=right><b>ATTEMPTS</b> <th align=left>"; # print "<b>UNREGISTERED USER</b></th></tr><p>\n"; # dbmopen(%unreguser_database1,$unreguserdatabase1,0644); # while (($unreguser,$count) = each(%unreguser_database1)){ # $unregusersubtotal = $unregusersubtotal + $count; # } # foreach $name (reverse (sort by_count_unreguser keys # %unreguser_database1)) { # $percent = $unreguser_database1{$name} / $unregusersubtotal * (100); # $total = $unregusersubtotal; # printf ("<tr><td align=right> %4.1f</td>",$percent); # printf ("<td align=right> %4d</td>",$unreguser_database1{$name}); # printf ("<td align=left> %7-s </td>",$name); # print "</tr>\n"; # } # dbmclose(%keys); # print "<br><tr><th align=right> TOTAL </th><th align=right>"; # print "<b>$total</b></th></tr>\n"; # print "</table></pre><p>\n"; # print "Note: \"Attempts\" shows total number of votes<br>\n"; # print "attempted by user, however, only one vote per<br>\n"; # print "user was validated.<p><hr><p>\n"; # ----------- end uncomment of section above --------------- # -- comment out the following section if not surveying browsers -- $browser = $ENV{"HTTP_USER_AGENT"}; dbmopen(%keys,$browserdatabase1,0644); if ($keys{$browser}) { $keys{$browser}++; } else { $keys{$browser} = 1; } dbmclose(%keys); print "<HEAD><TITLE>BROWSER/PLATFORM STATS</TITLE></HEAD>\n"; print "<body><center><h3>BROWSER/PLATFORM STATISTICS</h3>\n"; print "<table border cellpadding=6 cellspacing=1>"; print "<caption><pre>Poll start date: 01-Jan-97</caption><br>\n"; print "<tr><th align=right><b>PERCENT</b> </th>"; print "<th align=right><b>HITS</b> <th align=left>"; print "<b>BROWSER/PLATFORM</b></th></tr><p>\n"; dbmopen(%browser_database1,$browserdatabase1,0644); while (($browser,$count) = each(%browser_database1)){ $browsersubtotal = $browsersubtotal + $count; } foreach $name (reverse (sort by_count_browser keys %browser_database1)) { $percent = $browser_database1{$name} / $browsersubtotal * (100); $total = $browsersubtotal; printf ("<tr><td align=right> %4.1f</td>",$percent); printf ("<td align=right> %4d</td>",$browser_database1{$name}); printf ("<td align=left> %7-s </td>",$name); print "</tr>\n"; } dbmclose(%keys); print "<br><tr><th align=right> TOTAL </th><th align=right>"; print "<b>$total</b></th></tr>\n"; print "</table></pre><p><hr><p>\n"; # ----------- end uncomment of section above --------------- # Error checking (filter bad user supplied input, then process results # in main routine). # --- modify "input value" variables (athlete's names) for your script --- if ($in{"player"} eq "Nadia Comaneci") { &process_results; } elsif ($in{"player"} eq "Michael Johnson") { &process_results; } elsif ($in{"player"} eq "Michael Jordan") { &process_results; } elsif ($in{"player"} eq "Jackie Joyner-Kersee") { &process_results; } elsif ($in{"player"} eq "Arnold Schwarzenegger") { &process_results; } elsif ($in{"player"} eq "Other") { &process_results; # -------- end modification of variables above ----------- } else { die "Bad dog, no bone!\n"; } # Main routine. sub process_results { # Begin player/athelete stats section (entry and update). # Input variable follows. $player = $in{"player"}; # Insure that all entries are output to table as lower case. $player =~ tr/A-Z/a-z/; # Initialize, store and update "database1" poll stats. dbmopen(%keys,$database1,0644); if ($keys{$player}) { $keys{$player}++; } else { $keys{$player} = 1; } dbmclose(%keys); # Return formatted HTML table output to Netscape and LYNX browsers. print "<HEAD><TITLE>MULTIPLE-CHOICE POLL EXAMPLE</TITLE></HEAD>\n"; print "<body><center><p><h3>ATHLETE STATISTICS</h3>\n"; print "<table border cellpadding=6 cellspacing=1>"; # ----------- modify poll start date (01-Jan-97) ---------------- print "<caption><pre>Poll start date: 01-Jan-97</caption><br>\n"; # ----------- end modification of poll start date --------------- print "<tr><th align=right><b>PERCENT</b> </th>"; print "<th align=right><b>VOTES</b> <th align=left>"; print "<b>ATHLETE</b></th></tr><p>\n"; dbmopen(%player_database1,$database1,0644); while (($player,$count) = each(%player_database1)) { $subtotal = $subtotal + $count; } # Insure reversed numerical order of returned stats. # If numerical order is equal, return alpha order. foreach $name (reverse (sort by_count_player keys %player_database1)) { $percent = $player_database1{$name} / $subtotal * (100); $total = $subtotal; printf ("<tr><td align=right> %4.1f</td>",$percent); printf ("<td align=right> %4d</td>",$player_database1{$name}); printf ("<td align=left> %7-s </td>",$name); print "</tr>\n"; } dbmclose(%keys); print "<br><tr><th align=right> TOTAL </th><th align=right>"; print "<b>$total</b></th></tr>\n"; print "</table></pre>\n"; # Create a "comments" file named "vote1.txt", # this file is used for viewing user comments. open(VOTE, ">>vote1.txt"); print VOTE "\n$date\n"; print VOTE "Remote Host: $ENV{\"REMOTE_HOST\"}\n"; if ($ENV{"REMOTE_USER"}) { print VOTE "Remote User: $ENV{\"REMOTE_USER\"}\n "; } if ($in{"player"}) { print VOTE "Athlete: $in{\"player\"}\n"; } if ($in{"comment"}) { print VOTE "Comment: $in{\"comment\"}\n"; } close(VOTE); # Write to the administrator file named viewvote1.html. # This file is used for viewing poll stats without casting a vote. open(VIEWVOTE, ">viewvote1.html"); print VIEWVOTE "<HEAD><TITLE>MULTIPLE-CHOICE POLL EXAMPLE</TITLE></HEAD>\n"; print VIEWVOTE "<body><center><h3>ATHLETE STATISTICS</h3>\n"; print VIEWVOTE "<table border cellpadding=6 cellspacing=1>"; # ----------- modify poll start date (01-Jan-97) ---------------- print VIEWVOTE "<caption><pre>Poll start date: 01-Jan-97</caption><br>\n"; # ----------- end modification of poll start date --------------- print VIEWVOTE "<tr><th align=right><b>PERCENT</b> </th>"; print VIEWVOTE "<th align=right><b>VOTES</b> <th align=left>"; print VIEWVOTE "<b>ATHLETE</b></th></tr><p>\n"; dbmopen(%player_database1,$database1,0644); foreach $name (reverse (sort by_count_player keys %player_database1)) { $percent = $player_database1{$name} / $subtotal * (100); $total = $subtotal; printf VIEWVOTE ("<tr><td align=right> %4.1f</td>",$percent); printf VIEWVOTE ("<td align=right> %4d</td>",$player_database1{$name}); printf VIEWVOTE ("<td align=left> %7-s </td>",$name); print VIEWVOTE "</tr>\n"; } dbmclose(%keys); print VIEWVOTE "<br><tr><th align=right> TOTAL </th><th align=right>"; print VIEWVOTE "<b>$total</b></th></tr>\n"; print VIEWVOTE "</table></pre><p><hr><p>\n"; print VIEWVOTE "<center><h3>BROWSER/PLATFORM STATISTICS</h3>\n"; print VIEWVOTE "<table border cellpadding=6 cellspacing=1>"; print VIEWVOTE "<caption><pre>Poll start date: 01-Jan-97</caption><br>\n"; print VIEWVOTE "<tr><th align=right><b>PERCENT</b> </th>"; print VIEWVOTE "<th align=right><b>HITS</b> <th align=left>"; print VIEWVOTE "<b>BROWSER/PLATFORM</b></th></tr><p>\n"; dbmopen(%browser_database1,$browserdatabase1,0644); foreach $name (reverse (sort by_count_browser keys %browser_database1)) { $percent = $browser_database1{$name} / $browsersubtotal * (100); printf VIEWVOTE ("<tr><td align=right> %4.1f</td>",$percent); printf VIEWVOTE ("<td align=right> %4d</td>",$browser_database1{$name}); printf VIEWVOTE ("<td align=left> %7-s </td>",$name); print VIEWVOTE "</tr>\n"; } dbmclose(%keys); print VIEWVOTE "<br><tr><th align=right> TOTAL </th><th align=right>"; print VIEWVOTE "<b>$total</b></th></tr>\n"; print VIEWVOTE "</table></pre><p><hr><p>\n"; print VIEWVOTE "<center><p>[<a href=\"..\" target=_top>Richard Ian-Frese</a>]"; close(VIEWVOTE); # Reflect links to your comments page as well as any # additional survey queries, etc. # ----------- modify links where appropriate ---------------- print "<center><p>[<a href=\"..\" target=_top>Richard Ian-Frese</a>]"; print "[<a href=\"vote1.txt\">View the Comments</A>]"; print "[<a href=\"poll.html\">Go to Text-entry \n"; print "Example</a>]\n"; # -------------- end modification of links ----------------- # Close it out. print "<p><hr><center><h5>© 1995-97 Richard\n"; print "Ian-Frese \n"; print "|| <a href=\"mailto:rif\@u.washington.edu\">\n"; print "rif\@u.washington.edu</a> \n"; print "|| <a href=\"http://weber.u.washington.edu/~rif\">\n"; print "http://weber.u.washington.edu/~rif</a>\n"; print "</h5></center></body></html>\n"; } # Other subroutines. # Checking for empty string submissions, # return error message if found. sub check_the_syntax { if($in{"player"} eq "") { print "<head><title>Submit Entry Message</title></head><body>\n"; print "<center><h3>Your Vote Counts\n"; print "</h3><hr>\n"; print "Your participation is appreciated! To view the current poll\n"; print "stats, please return to the previous page and vote.\n"; print "<p><a href=\"poll1.html\">Return to vote!</a>\n"; print "</center></body>\n"; exit; } } # Insure numeric order of "player" stats. sub by_count_player { ($player_database1{$a} <=> $player_database1{$b}); } # ------- uncomment next subroutine if using ".htaccess" ---------- # Insure numeric order of "htaccess" user stats. # sub by_count_htuser { # ($htuser_database1{$a} <=> $htuser_database1{$b}); # } # ------- end of uncomment for above section ---------- # ---- uncomment next subroutine if limiting unregistered votes to 1 ---- # Insure numeric order of "unregistered" user stats. # sub by_count_unreguser { # ($unreguser_database1{$a} <=> $unreguser_database1{$b}); # } # ------- end of uncomment for above section ---------- # -- comment out next subroutine if not surveying browser useage -- # Insure numeric order of "browser/platform" stats. sub by_count_browser { ($browser_database1{$a} <=> $browser_database1{$b}); } # ------- end of comment for above section ---------- # End subroutines. That's it! exit 0; - --------------83B3EB47C00-- ------- End of Forwarded Message