#!/usr/bin/perl # January 2003, add support for marks files with long userids # January 2002, changed first line to usr/bin for non xhier systems # Oct 25, 2002, changed to lowercase authenticated uwuserid # Note: make sure you run this under perl 5 &printhtmlheaders; $userid = lc($ENV{'REMOTE_USER'}); if ( ! $userid ) { print "Userid must be authenticated\n"; exit; } &parseinput; $marksfile = $PARM{'course'}; if ( ! -r "$marksfile" ) { print "Unable to find marks file for $marksfile\n"; exit; } &printdetails; &printhtmltrailers; exit; sub printhtmlheaders { print "Content-type: text/html\n\n"; print "\n"; print "\n"; print "\n"; } sub printdetails { open (MARKS, "$marksfile"); $linenumber=1; while () { if ( /\W($userid.*)\W/ ) { $suserid = substr($1,0,8); if ( $userid eq $suserid ) { print "\n"; print "\n"; }; $linenumber=$linenumber+1; } close(MARKS); } sub printhtmltrailers { print "
\n"; s/,//g; print $_, "\n"; }; } elsif ( $linenumber eq 2 ) { print "
\n"; s/,//g; print $_, "\n"; } elsif ( $linenumber eq 1 ) { @caption = split(/,/, $_ ); print "
 $caption[0]
\n"; print ""; print ""; } sub parseinput { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); # Split the name-value pairs if ($buffer) { @pairs = split(/&/, $buffer); } else { $buffer = $ENV{'QUERY_STRING'}; @pairs = split(/&/,$ENV{'QUERY_STRING'}); } foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); # Un-Webify plus signs and %-encoding $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s/<//g; # Stop people from using subshells to execute commands # Not a big deal when using sendmail, but very important # when using UCB mail (aka mailx). $value =~ s/~!/ ~!/g; $PARM{$name} = $value; } };