#!/usr/bin/perl -- -*-perl-*- # # ------------------------------------------------------------- # Feedback.cgi, by K. M. Nolan and C. Frey to receive information # from training materials. Program developed by modifying Form-mail.pl, # by Reuven M. Lerner (reuven@the-tech.mit.edu) after it was modified # for DG/UX by Robert Shvern 3/94 # # ------------------------------------------------------------ # # Define fairly-constants # get timezone variable open(FILEIN, "/etc/TIMEZONE"); while (chop($_ = ) && ("$blah" ne "TZ=")) { ($blah, $foundit) = $_ =~ /(TZ=)(.*)/; } $ENV{'TZ'} = "$foundit"; close(FILEIN); chop($date = `/usr/bin/date`); # $mailprog = "/usr/bin/mailx -s \"Urgent: WWW server ERROR!!! - $date\""; # could force recipient by using the line below and commenting out # line 54 #$recipient = "kmnolan@usgs.gov"; # Print out what we need print "Content-type: text/html\n\n"; print "Thank you"; #print "

Thank you

"; # Get the input read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); # print "$buffer"; # Split the name-value pairs received from the HTML form @pairs = split(/&/, $buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $name =~ tr/+/ /; $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # Stop people from using subshells to execute commands $value =~ s/~!/ ~!/g; $name =~ s/~!/ ~!/g; # Uncomment for debugging purposes # print " $name $value

"; # Search for null name allows multiple values for single question if($FORM{$name} eq ""){ $FORM{$name} = $value; } else { $FORM{$name}.="\n $value"; } } $mailprog = "/usr/bin/mailx -s \"$subject - $date\""; # Check if all questions are answered while (($name, $value) = each(%FORM)) { if ($value eq ""){ print "\n"; print "\n"; print "Missing answer:\n"; print "\n"; print "\n"; print "

Missing information.\n

"; print "

Answer to question $name is missing. Please go back and complete it.\n

"; print "\n"; exit; } elsif ($FORM{"Student e-mail"} eq "") { print "\n"; print "\n"; print "student e-mail missing:\n"; print "\n"; print "\n"; print "

Missing information:\n

"; print "

Your e-mail address is missing. Please go back and complete it.\n

"; print "\n"; exit; }elsif ($FORM{"Student name"} eq "") { print "\n"; print "\n"; print "Name missing:\n"; print "\n"; print "\n"; print "

Missing information:\n

"; print "Your name is missing. Please go back and complete it.\n"; print "\n"; exit; }elsif ($FORM{"Instructor e-mail"} eq "") { print "\n"; print "\n"; print "Instructor e-mail missing:\n"; print "\n"; print "\n"; print "

Missing information:\n

"; print "Your instructor's e-mail address is missing. Please go back and complete it.\n"; print "\n"; exit; } else { } } # Now send mail to $recipient open (MAIL, "|$mailprog $FORM{'Instructor e-mail'}") || die "Can't open $mailprog!\n"; while (($name, $value) = each(%FORM)) { if ($name eq "Student name") { print MAIL ("$value is currently taking the web-based Surface-Water Field-Methods training class. He/she has designated you as the person to review their test answers. Please take some time and review answers with the student. The feedback you provide is an important aspect of this training. If you have any questions please contact Mike Nolan (kmnolan@usgs.gov). You can also contact him if you would like copies of answers to test questions.s The class content, which includes the test questions, can be found at: http:wwwrcamnl.wr.usgs.gov/sws/fieldmethods/ Please complete training forms showing that the student has completed course SW4230, after tests have been completed for all eight sections of the class.\n\n"); } } while (($name, $value) = each(%FORM)) { if ($name eq "Student name") { print MAIL ("\n"); } elsif ($name eq "Student e-mail") { print MAIL ("Student e-mail = $value, \n"); } elsif ($value eq "Test") { print MAIL ("Results are from the $name Test, \n"); } elsif ($name eq "Instructor e-mail") { } else { $ANSWERS{$name} = $value; } } print MAIL "______________________________________________________________\n"; print MAIL "Question Answer\n"; #open (OUTPUT, "|cat >> /usr/opt/www/httpd/htdocs/uo/sws/test"); foreach $name (sort bynumber keys(%ANSWERS)){ print MAIL "$name - $ANSWERS{$name} \n"; } sub bynumber {$a<=>$b;} #close (OUTPUT); close (MAIL); print "\n"; print "\n"; print "Answer to completed test.\n"; print "\n"; print "\n"; print "

Thank you for submitting your test.

\n"; print "

Your instructor will contact you to discuss your answers.

\n"; print "

If you don't hear anything from your supervisor in the next few weeks, feel free to contact him or her.

\n"; print "\n"; exit;