--- loncom/homework/grades.pm 2001/02/13 19:43:44 1.4 +++ loncom/homework/grades.pm 2001/08/06 20:29:37 1.13 @@ -1,5 +1,7 @@ # The LON-CAPA Grading handler # 2/9,2/13 Guy Albertelli +# 6/8 Gerd Kortemeyer +# 7/26 H.K. Ng package Apache::grades; use strict; @@ -13,20 +15,191 @@ use Apache::Constants qw(:common); sub moreinfo { my ($request,$reason) = @_; $request->print("Unable to process request: $reason"); - $request->print('
'."\n"); - $request->print(''."\n"); - $request->print(''."\n"); - $request->print("Student:".''."
\n"); - $request->print("Domain:".''."
\n"); - $request->print(''."
\n"); - $request->print('
'); + if ( $Apache::grades::viewgrades eq 'F' ) { + $request->print('
'."\n"); + $request->print(''."\n"); + $request->print(''."\n"); + $request->print("Student:".''."
\n"); + $request->print("Domain:".''."
\n"); + $request->print(''."
\n"); + $request->print('
'); + } + return ''; +} + + +sub listStudents { + my ($request) = shift; + my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); + my $chome=$ENV{"course.$ENV{'request.course.id'}.home"}; + $request->print ("Found $cdom:$cnum:$chome
"); + my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0'); + foreach my $student ( sort(@{ $classlist{'allids'} }) ) { + my ($sname,$sdom) = split(/:/,$student); + + my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname. + ':environment:lastname&generation&firstname&middlename', + &Apache::lonnet::homeserver($sname,$sdom)); + print "reply=$reply
"; + my (@nameparts) = split /&/,$reply; +# my $sfullname = $Apache::lonnet::unescape($nameparts[0]); + + if ( $Apache::grades::viewgrades eq 'F' ) { + $request->print('
'."\n"); + $request->print("$sname @nameparts\n"); + $request->print(''."\n"); + $request->print(''."\n"); + $request->print(''."\n"); + $request->print(''."\n"); + $request->print(''."
\n"); + $request->print('
'); + } + } + } -#FIXME - needs to be much smarter +#FIXME - needs to handle multiple matches sub finduser { my ($name) = @_; - return ($name,$ENV{'user.domain'}); + my $domain = ''; + + if ( $Apache::grades::viewgrades eq 'F' ) { + #get classlist + my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); + my $chome=$ENV{"course.$ENV{'request.course.id'}.home"}; + #print "Found $cdom:$cnum:$chome
"; + my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0'); + foreach my $student ( sort(@{ $classlist{'allids'} }) ) { + my ($posname,$posdomain) = split(/:/,$student); + if ($posname =~ $name) { $name=$posname; $domain=$posdomain; last; } + } + return ($name,$domain); + } else { + return ($ENV{'user.name'},$ENV{'user.domain'}); + } +} + +sub getclasslist { + my ($coursedomain,$coursenum,$coursehome,$hideexpired) = @_; + my $classlist=&Apache::lonnet::reply("dump:$coursedomain:$coursenum:classlist",$coursehome); + my %classlist=(); + my $now = time; + foreach my $record (split /&/, $classlist) { + my ($name,$value)=split(/=/,&Apache::lonnet::unescape($record)); + my ($end,$start)=split(/:/,$value); + # still a student? + if (($hideexpired) && ($end) && ($end < $now)) { + print "Skipping:$name:$end:$now
\n"; + next; + } + print "record=$record
"; + push( @{ $classlist{'allids'} }, $name); + } + return (%classlist); +} + +sub getpartlist { + my ($url) = @_; + my @parts =(); + my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); + foreach my $key (@metakeys) { + if ( $key =~ m/stores_([0-9]+)_.*/ ) { + push(@parts,$key); + } + } + return @parts; +} + +sub viewstudentgrade { + my ($url,$symb,$courseid,$student,@parts) = @_; + my $result =''; + my $cellclr = '"#ffffdd"'; + my ($stuname,$domain) = split(/:/,$student); + + my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname); + + $result.="$stuname$domain\n"; + foreach my $part (@parts) { + my ($temp,$part,$type)=split(/_/,$part); + #print "resource.$part.$type = ".$record{"resource.$part.$type"}."
\n"; + if ($type eq 'awarded') { + my $score=$record{"resource.$part.$type"}; + $result.="\n"; + } elsif ($type eq 'tries') { + my $score=$record{"resource.$part.$type"}; + $result.="\n" + } elsif ($type eq 'solved') { + my $score=$record{"resource.$part.$type"}; + $result.="\n"; + } + } + $result.=''; + return $result; +} +#FIXME need to look at the meatdata spec on what type of data to accept and provide an +#interface based on that, also do that to above function. +sub setstudentgrade { + my ($url,$symb,$courseid,$student,@parts) = @_; + + my $result =''; + + my ($stuname,$domain) = split(/:/,$student); + + my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname); + + my %newrecord; + + foreach my $part (@parts) { + my ($temp,$part,$type)=split(/_/,$part); + my $oldscore=$record{"resource.$part.$type"}; + my $newscore=$ENV{"form.GRADE.$student.$part.$type"}; + if ($type eq 'solved') { + my $update=0; + if ($newscore eq 'nothing' ) { + if ($oldscore ne '') { + $update=1; + $newscore = ''; + } + } elsif ($oldscore !~ m/^$newscore/) { + $update=1; + $result.="Updating $stuname to $newscore
\n"; + if ($newscore eq 'correct') { $newscore = 'correct_by_override'; } + if ($newscore eq 'incorrect') { $newscore = 'incorrect_by_override'; } + if ($newscore eq 'excused') { $newscore = 'excused'; } + if ($newscore eq 'ungraded') { $newscore = 'ungraded_attempted'; } + } else { + #$result.="$stuname:$part:$type:unchanged $oldscore to $newscore:
\n"; + } + if ($update) { $newrecord{"resource.$part.$type"}=$newscore; } + } else { + if ($oldscore ne $newscore) { + $newrecord{"resource.$part.$type"}=$newscore; + $result.="Updating $student"."'s status for $part.$type to $newscore
\n"; + } else { + #$result.="$stuname:$part:$type:unchanged $oldscore to $newscore:
\n"; + } + } + } + if ( scalar(keys(%newrecord)) > 0 ) { + $newrecord{"resource.regrader"}="$ENV{'user.name'}:$ENV{'user.domain'}"; + &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$stuname); + + $result.="Stored away ".scalar(keys(%newrecord))." elements.
\n"; + } + return $result; } sub submission { @@ -34,25 +207,103 @@ sub submission { my $url=$ENV{'form.url'}; $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; if ($ENV{'form.student'} eq '') { &moreinfo($request,"Need student login id"); return ''; } +# if ($ENV{'form.student'} eq '') { &listStudents($request); return ''; } my ($uname,$udom) = &finduser($ENV{'form.student'}); if ($uname eq '') { &moreinfo($request,"Unable to find student"); return ''; } my $symb=&Apache::lonnet::symbread($url); if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } - my $home=&Apache::lonnet::homeserver($uname,$udom); - my $answer=&Apache::loncommon::get_previous_attempt($symb,$uname,$udom,$home, + my $answer=&Apache::loncommon::get_previous_attempt($symb,$uname,$udom, $ENV{'request.course.id'}); - my $result="

Submission Record

$uname:$udom for $url".$answer; + my $result="

Submission Record

$uname:$udom for $url
".$answer; + return $result; +} + +sub viewgrades { + my ($request) = @_; + my $result=''; + + #get resource reference + my $url=$ENV{'form.url'}; + $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; + my $symb=$ENV{'form.symb'}; + if (!$symb) { $symb=&Apache::lonnet::symbread($url); } + if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } + + #get classlist + my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); + my $chome=$ENV{"course.$ENV{'request.course.id'}.home"}; + #print "Found $cdom:$cnum:$chome
"; + my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0'); + my $headerclr = '"#ccffff"'; + my $cellclr = '"#ffffcc"'; + + #get list of parts for this problem + my (@parts) = &getpartlist($url); + + $request->print ("

Manual Grading

"); + + #start the form + $result = '
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + '
'."\n". + ''."\n". + ''."\n"; + foreach my $part (@parts) { + my $display=&Apache::lonnet::metadata($url,$part.'.display'); + if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); } + $result.=''."\n"; + } + $result.=""; + #get info for each student + foreach my $student ( sort(@{ $classlist{'allids'} }) ) { + $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts); + } + $result.='
UserIdDomain'.$display.'
'; + + return $result; +} + +sub editgrades { + my ($request) = @_; + my $result=''; + + my $symb=$ENV{'form.symb'}; + if ($symb eq '') { $request->print("Unable to handle ambiguous references:$symb:$ENV{'form.url'}"); return ''; } + my $url=$ENV{'form.url'}; + #get classlist + my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); + my $chome=$ENV{"course.$ENV{'request.course.id'}.home"}; + #print "Found $cdom:$cnum:$chome
"; + my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0'); + + #get list of parts for this problem + my (@parts) = &getpartlist($url); + + $result.='
'."\n". + ''."\n". + ''."\n". + ''."\n". + '
'."\n"; + + foreach my $student ( sort(@{ $classlist{'allids'} }) ) { + $result.=&setstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts); + } + + $result.='
'; return $result; } sub send_header { my ($request)= @_; $request->print(&Apache::lontexconvert::header()); - $request->print(" -"); +# $request->print(" +#"); $request->print(''); } @@ -75,15 +326,21 @@ sub handler { $request->send_http_header; return OK if $request->header_only; my $url=$ENV{'form.url'}; + my $symb=$ENV{'form.symb'}; my $command=$ENV{'form.command'}; &send_header($request); - if ($url eq '') { + if ($url eq '' && $symb eq '') { $request->print("Non-Contextual Access Unsupported:$command:$url:"); } else { - $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$url); + $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}); if ($command eq 'submission') { - $request->print(&submission($request)); + $request->print(&listStudents($request)) if ($ENV{'form.student'} eq ''); + $request->print(&submission($request)) if ($ENV{'form.student'} ne ''); + } elsif ($command eq 'viewgrades') { + $request->print(&viewgrades($request)); + } elsif ($command eq 'editgrades') { + $request->print(&editgrades($request)); } else { $request->print("Unknown action:$command:"); }