#!/usr/bin/perl # # surveyd2.cgi-- Processes submissions from: # http://www.coedu.usf.edu/jwhite/survey1/surveyd2.html # modified -- Mar 30, 1999 by J. White # Get the CGI input variables %in= &getcgivars ; open(LAST,">>surveyd2.dat"); # Print each CGI variable received by the script, one per column. foreach ('Gender', 'Field', 'Age') { print LAST $in{$_}; #puts no space between fields } # Handle the checkboxes foreach ('Status') { $Sum = 0; @CheckVal = split (/\0/, $in{$_}); foreach (@CheckVal) { $Sum += $_; } while(length($Sum)<3) { $Sum = '0'.$Sum; } print LAST $Sum; } foreach ('Date', 'SS', 'Comment') { print LAST $in{$_}; #puts no space between fields } print LAST "\n"; close (LAST); # Print an HTML response to the user print <

Your form has been successfully submitted.

EOF exit ; #-------------- start of &getcgivars() module, copied in ------------- # Read all CGI vars into an associative array. # If multiple input fields have the same name, they are concatenated into # one array element and delimited with the \0 character. # Currently only supports Content-Type of application/x-www-form-urlencoded. sub getcgivars { local($in, %in) ; local($name, $value) ; # First, read entire string of CGI vars into $in if ($ENV{'REQUEST_METHOD'} eq 'GET') { $in= $ENV{'QUERY_STRING'} ; } elsif ($ENV{'REQUEST_METHOD'} eq 'POST') { if ($ENV{'CONTENT_TYPE'}=~ m#^application/x-www-form-urlencoded$#i) { $ENV{'CONTENT_LENGTH'} || &HTMLdie("No Content-Length sent with the POST request.") ; read(STDIN, $in, $ENV{'CONTENT_LENGTH'}) ; } else { &HTMLdie("Unsupported Content-Type: $ENV{'CONTENT_TYPE'}") ; } } else { &HTMLdie("Script was called with unsupported REQUEST_METHOD.") ; } # Resolve and unencode name/value pairs into %in foreach (split('&', $in)) { s/\+/ /g ; ($name, $value)= split('=', $_, 2) ; $name=~ s/%(..)/sprintf("%c",hex($1))/ge ; $value=~ s/%(..)/sprintf("%c",hex($1))/ge ; $in{$name}.= "\0" if defined($in{$name}) ; # concatenate multiple vars $in{$name}.= $value ; } return %in ; } # Die, outputting HTML error page # If no $title, use a default title sub HTMLdie { local($msg,$title)= @_ ; $title || ($title= "CGI Error") ; print < $title

$title

$msg

EOF exit ; } #-------------- end of &getcgivars() module --------------------------