#!/usr/local/bin/perl -w
# This is the program that records student number and date for quiz.
eval "use integer";
die "$0: REQUEST_METHOD is not POST\n"
unless (defined($ENV{'REQUEST_METHOD'}) && $ENV{'REQUEST_METHOD'} eq 'POST');
$request=" "x200;
read(STDIN,$request,$ENV{'CONTENT_LENGTH'});
@vars=split(/&/,$request);
$student="";
foreach $var (@vars)
{($v,$val)=split(/=/,$var);
$v =~ s/\+/ /g;
$v =~ s/%(..)/sprintf("%c",hex($1))/eg;
$v =~ s/^ +//; $v =~ s/ +$//;
next unless ($v eq "Studentnumber");
$val =~ s/\+/ /g;
$val =~ s/%(..)/sprintf("%c",hex($1))/eg;
$val =~ s/^ +//; $val =~ s/ +$//;
$val =~ tr/a-z/A-Z/;
$student=$val; last;
}
unless ($student =~ /^[A-Z0-9]{4-14}$/)
{print "Content-type: text/html\n\n";
print "\n";
print "[$student] IS NOT A VALID STUDENT NUMBER
\n";
print "At least it doesn't look like one to me. If it really is your\n";
print "student number please report this problem to someone.\n";
print "Now click on Back to continue.\n";
print "\n";
}
$dir="/tmp/david";
$file="$dir/quizrecord";
$newfile="$dir/quiztemp";
$lockfile="$dir/quizlock";
$locklink="$dir/quizlink";
mkdir($dir,0700) unless (-d $dir);
system("cp /dev/null $lockfile") unless (-f $lockfile);
$tries=10;
while ($tries>0)
{link($lockfile,$locklink) and last;
sleep(1); $tries--;
}
if ($tries<=0)
{print "Content-type: text/html\n\n";
print "\n";
print "NOT RECORDED
\n";
print "It didn't work. If this happens too often report it to someone.\n";
print "Now click on Back to continue.\n";
print "\n";
exit(0);
}
sub rm_lock {unlink($locklink); exit(1);}
$SIG{'INT'}="rm_lock"; $SIG{'QUIT'}="rm_lock"; $SIG{'HUP'}="rm_lock";
system("cp /dev/null $file") unless (-f $file);
open(OLD,"<$file") or crash("$0: can't read $file\n");
@records=;
close(OLD);
$s=$student;
@new=();
while ($r=shift(@records))
{$r =~ /^$student / and do {$s=$r; next;};
push(@new,$r);
}
# to shut up perl -w on variables used once.
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=()x9;
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time());
$date=sprintf(" %02d%02d%02d",$mday,$mon,$year%100);
$s.=$date;
push(@new,$s);
@new=sort(@new);
open(NEW,">$newfile") or crash("$0: can't write $newfile\n");
print NEW join("\n",@new)."\n";
close(NEW);
rename($newfile,$file) or crash("$0: can't rename $newfile $file\n");
print "Content-type: text/html\n\n";
print "\n";
print "RECORDED OK
\n";
print "Now click on Back to continue.\n";
print "\n";
sub crash
{my($message)=@_;
&rm_lock();
die($message);
}
&rm_lock(); # clean up on exit.