Reply-to: psf@npac.syr.edu To: kcicompute@worldkids.net Date: Sat, 14 Mar 1998 18:07:41 -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:42:21 -0500 From: irte To: psf@npac.syr.edu Subject: http://weber.u.washingt...mple_vote/vote_cgi.html This is a multi-part message in MIME format. - --------------676720756666 Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: 7bit http://weber.u.washington.edu/~rif/Simple_vote/vote_cgi.html - --------------676720756666 Content-Type: text/html; charset=us-ascii; name="vote_cgi.html" Content-Transfer-Encoding: 7bit Content-Disposition: inline; filename="vote_cgi.html" Content-Base: "http://weber.u.washington.edu/~rif/Sim ple_vote/vote_cgi.html"

Richard Ian-Frese
rif@u.washington.edu

#!/usr/local/bin/perl5 ########################################################################### # # Filename: vote.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, v.5003 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 TEXT-ENTRY 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. # Since the example in this script retrieves URLs from voters input, the # stats table is designed to output hyperlinks to the URLs recommended by # the poll participants. # # 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 # commenting/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 modifications # only where indicated in the comments throughout the script to reduce # the chance of initial 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 "vote.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 keep your "user" stats file # named "userdatabase". Uncomment the "$userdatabase" 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" --- # $userdatabase = "/www/d88/rif/Simple_vote/userdatabase"; # ------------ end uncomment and modification of directory path ---------- # The next variable should reflect where you will keep your "poll" stats # file, named "database". (See installation instruction e) above). # ------------------ modify path in next line --------------------- $database = "/www/d88/rif/Simple_vote/database"; # -------------- end of 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"). # ---- comment out "unreguserdatabase" directory path if not limiting # votes to 1 per person (otherwise modify path info) $unreguserdatabase = "/www/d88/rif/Simple_vote/unreguserdatabase"; # -- end uncomment/modification of "unreguserdatabase1" 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 "user" stats. Uncomment the next section only if you # are using ".htaccess" for user authentication and vote control. # -------- uncomment following section only if using ".htaccess" ---------- # $user = $ENV{"REMOTE_USER"}; # dbmopen(%keys,$userdatabase,0644); # if ($keys{$user}) { # $keys{$user}++; # } else { # $keys{$user} = 1; # } # if ($keys{$user} >= 2) { # die "Die dog, no ballot stuffing allowed in this poll!\n"; # dbmclose(%keys); # } # print "<HEAD><TITLE>USER STATS</TITLE></HEAD>\n"; # print "<body><center><h3>POLL STATISTICS</h3>\n"; # print "<table border cellpadding=6 cellspacing=1>"; # print "<caption><pre>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>USER</b></th></tr><p>\n"; # dbmopen(%user_database,$userdatabase,0644); # while (($user,$count) = each(%user_database)){ # $total = $total + $count; # } # foreach $name (reverse (sort by_count_user keys %user_database)) { # $percent = $user_database{$name} / $total * (100); # printf ("<tr><td align=right> %4.1f</td>",$percent); # printf ("<td align=right> %4d</td>",$user_database{$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"; # ------------------ end uncomment of section above -------------------- # Read URL entries from form and do a bit of text-entry # error checking. &check_the_syntax; # -- comment out next section if not limiting an unregistered vote to 1 -- $unreguser = $ENV{"REMOTE_HOST"}; dbmopen(%keys,$unreguserdatabase,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 "<b>Note:</b> \"Attempts\" shows total number of votes<br>\n"; print "attempted by user, however, only one vote per<br>\n"; print "user was validated.\n"; print "<table border cellpadding=6 cellspacing=1>"; print "<caption>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_database,$unreguserdatabase,0644); while (($unreguser,$count) = each(%unreguser_database)){ $unregusersubtotal = $unregusersubtotal + $count; } foreach $name (reverse (sort by_count_unreguser keys %unreguser_database)) { $percent = $unreguser_database{$name} / $unregusersubtotal * (100); $total = $unregusersubtotal; printf ("<tr><td align=right> %4.1f</td>",$percent); printf ("<td align=right> %4d</td>",$unreguser_database{$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 --------------- # Begin "poll" stats section (entry and update). URL variable follows. $url = $in{"url"}; # Initialize, store and update "database" poll stats. dbmopen(%keys,$database,0644); if ($keys{$url}) { $keys{$url}++ } else { $keys{$url} = 1; } dbmclose(%keys); # Return formatted HTML table output to Netscape and LYNX browsers. print "<HEAD><TITLE>TEXT-ENTRY POLL EXAMPLE</TITLE></HEAD>\n"; print "<body><center><p><h3>ELEGANT WWW URL STATISTICS</h3></center>\n"; # Disclaimer. print "<p><b>Note:</b> \"Elegant\" means different things to different\n"; print "people.<br> The particular URLs submitted have not been solicited,\n"; print "screened,<br> or censored for comments or\n"; print "referred URL content.\n"; print "<center><table border cellpadding=6 cellspacing=1>"; # ----- modify caption/poll start date (01-Jan-97) -------- print "<caption><pre>Poll start date: 01-Jan-97</caption><br>\n"; # ------- end modification of caption/poll start date --------- print "<tr><th align=right><b>PERCENT</b> </th>"; print "<th align=right><b>ENTRIES</b> <th align=left>"; print "<b>URLS</b></th></tr><p>\n"; dbmopen(%url_database,$database,0644); while (($url,$count) = each(%url_database)) { $subtotal = $subtotal + $count; } # Insure reversed numerical order of returned stats. # If numerical order is equal, return alpha order. foreach $entry (reverse (sort by_count_url keys %url_database)) { $percent = $url_database{$entry} / $subtotal * (100); $total = $subtotal; printf ("<tr><td align=right> %4.1f</td>",$percent); printf ("<td align=right> %4d</td>",$url_database{$entry}); printf ("<td align=left>%7-s<a href=\"$entry\">$entry</a> </td>"); 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 an administrator file named "viewvote.html", # this file is used for viewing stats, it bypasses the form. open(VIEW, ">viewvote.html"); # output stats to HTML print VIEW "<HEAD><TITLE>Elegant WWW Example URLS Poll</TITLE></HEAD>\n"; print VIEW "<BODY>\n"; print VIEW "<center><h3>ELEGANT WWW URL STATISTICS</h3>\n"; print VIEW "<table border cellpadding=6 cellspacing=1>"; # ----- modify caption title and poll start date (01-Jan-97) ------ print VIEW "<caption><pre>Poll start date: 01-Jan-97</caption><br>\n"; # ----------- end modification of poll start date --------------- print VIEW "<tr><th align=right><b>PERCENT</b> </th>"; print VIEW "<th align=right><b>ENTRIES</b> <th align=left>"; print VIEW "<b>URLS</b></th></tr><p>\n"; dbmopen(%url_database,$database,0644); foreach $entry (reverse (sort by_count_url keys %url_database)) { $percent = $url_database{$entry} / $subtotal * (100); $total = $subtotal; printf VIEW ("<tr><td align=right> %4.1f</td>",$percent); printf VIEW ("<td align=right> %4d</td>",$url_database{$entry}); printf VIEW ("<td align=left>%-7s<a href=\"$entry\">$entry</a> </td>"); print VIEW "</tr>\n"; } dbmclose(%keys); print VIEW "<br><tr><th align=right> TOTAL </th><th align=right>"; print VIEW "<b>$total</b></th></tr>\n"; print VIEW "</table></pre><p><hr>\n"; # --------------- modify link on next line ------------------ print VIEW "<p>[<a href=\"..\" target=_top>Richard Ian-Frese</a>]"; # ----------- end modification of link on above line ---------------- print "</center></body>\n"; close(VIEW); # Create a "comments" file named "vote.txt", # this file is used for viewing user comments. open(VOTE, ">>vote.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{"url"}) { print VOTE "URL Entry: $in{\"url\"}\n"; } if ($in{"comment"}) { print VOTE "Comment: $in{\"comment\"}\n"; } close(VOTE); # Reflect links to your comments page called "vote.txt" 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=\"vote.txt\">View the Comments</A>]"; print "[<a href=\"poll1.html\">Go to Multiple-choice \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"; # Subroutines. # Checking for empty string submissions, # return error message if found. sub check_the_syntax { if($in{"url"} eq "") { print "<head><title>Submit Entry Message</title></head><body>\n"; print "<center><h3>Your Entry Makes a Difference\n"; print "</h3><hr>\n"; print "Please submit a good URL entry.\n"; print "Your participation is appreciated! To view the current poll sta ts,\n"; print "please return to the previous page and enter the URL\n"; print "of your choice.\n"; print "<p><a href=\"poll.html\">Return to enter a URL</a></center></bod y>"; exit; } # Checking for "http://" at beginning of address string, # return error message if not found. if($in{"url"} !~ /^http:\/\/\w*/) { print "<head><title>Submit Valid URL Syntax Message</title></head><body >\n"; print "<center><h3>Your Entry Makes a Difference\n"; print "</h3><hr>\n"; print "Please check the syntax of the URL you submitted for errors. \n "; print "<br>For example, the URL string should begin with <b>http://</b> . \n"; print "<br>The address might look something like this:<p>\n"; print "<i><b>http://</b>weber.u.washington.edu/~rif</i>\n"; print "<p>To view the current poll stats please return to the previous< br>\n"; print "page and re-enter the URL of your choice.\n"; print "<p><a href=\"poll.html\">Return to re-enter a URL</a></center></ body>"; exit; } # Checking for a character string after the "http://", # return error message if not found. if($in{"url"} eq "http://") { print "<head><title>Submit Valid URL Syntax Message</title></head><body >\n"; print "<center><h3>Your Entry Makes a Difference\n"; print "</h3><hr>\n"; print "Please check the syntax of the URL you submitted for errors. \n "; print "<br>For example, the URL should contain a <b>domain and subdomai n</b>\n"; print "<br>following the http:// at the beginning of the line</b>. \n" ; print "<br>The address might look something like this:<p>\n"; print "<i>http://<b>weber.u.washington.edu/~rif</b></i>\n"; print "<p>To view the current poll stats please return to the previous< br>\n"; print "page and re-enter the URL of your choice.\n"; print "<p><a href=\"poll.html\">Return to re-enter a URL</a></center></ body>"; exit; } # Checking for empty spaces in URL string # return error message if found. if($in{"url"} =~ /\s+/) { print "<head><title>Submit Valid URL Syntax Message</title></head><body >\n"; print "<center><h3>Your Entry Makes a Difference\n"; print "</h3><hr>\n"; print "Please check the syntax of the URL you submitted for errors. \n "; print "<br>There should be <b>no spaces</b> in the URL address string\n "; print "<br>The address should look something like this:<p>\n"; print "<i>http://weber.u.washington.edu/~rif</i>\n"; print "<p>To view the current poll stats please return to the previous< br>\n"; print "page and re-enter the URL of your choice.\n"; print "<p><a href=\"poll.html\">Return to re-enter a URL</a></center></ body>"; exit; } # Checking for flaky characters in URL string, # return error message if found. if($in{"url"} =~ /[\\\`\!\@\$\^\*\|\}\{\]\[\"\;\>\<\,]/) { print "<head><title>Submit Valid URL Syntax Message</title></head><body >\n"; print "<center><h3>Your Entry Makes a Difference\n"; print "</h3><hr>\n"; print "Please check the syntax of the URL you submitted for errors. \n "; print "<br>Invalid characters should be removed from the URL address st ring\n"; print "<br>A few examples of characters which will generate an error me ssage are:<p>\n"; print "<br><b>\`\!\@\$\^\|\\\}\{\]\[\"\;\>\,\<\*</b><p>\n"; print "<br>The address should look something like this:<p>\n"; print "<i>http://weber.u.washington.edu/~rif</i>\n"; print "<p>To view the current poll stats please return to the previous< br>\n"; print "page and re-enter the URL of your choice.\n"; print "<p><a href=\"poll.html\">Return to re-enter a URL</a></center></ body>"; exit; } } # -- comment out next subroutine if not limiting unregistered votes to 1 -- # Insure numeric order of "unregistered" user stats. sub by_count_unreguser { ($unreguser_database{$a} <=> $unreguser_database{$b}); } # ------- end of uncomment for above section ---------- # -- uncomment next subroutine if using .htaccess/.htpasswd -- # Insure numeric order of "user" stats. # sub by_count_user { # ($userdatabase{$a} <=> $userdatabase{$b}); # } # ------- end of comment/uncomment for above subroutine ---------- # Insure numeric order of "url" stats. sub by_count_url { ($url_database{$a} <=> $url_database{$b}); } # End subroutines. That's it! exit 0; - --------------676720756666-- ------- End of Forwarded Message