--- loncom/homework/grades.pm 2001/02/09 03:24:45 1.2 +++ loncom/homework/grades.pm 2001/04/16 23:34:11 1.5 @@ -1,50 +1,226 @@ # The LON-CAPA Grading handler -# Guy Albertelli -# 11/30 Gerd Kortemeyer -# 6/1 Gerd Kortemeyer +# 2/9,2/13 Guy Albertelli package Apache::grades; use strict; use Apache::style; use Apache::lonxml; use Apache::lonnet; +use Apache::loncommon; use Apache::lonhomework; 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 ''; } +#FIXME - needs to be much smarter sub finduser { my ($name) = @_; - + + if ( $Apache::grades::viewgrades eq 'F' ) { + return ($name,$ENV{'user.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; + } + 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 ($stuname,$domain) = split(/:/,$student); + + my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname, + &Apache::lonnet::homeserver($stuname,$domain)); + + $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; +} + +sub setstudentgrade { + my ($url,$symb,$courseid,$student,@parts) = @_; + + my $result ='Hi!'; + + my ($stuname,$domain) = split(/:/,$student); + + my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname, + &Apache::lonnet::homeserver($stuname,$domain)); + my %newrecord; + foreach my $part (@parts) { + my ($temp,$part,$type)=split(/_/,$part); + my $oldscore=$record{"resource.$part.$type"}; + my $newscore=$ENV{"GRADE.$stuname.$part.$type"}; + if ($oldscore != $newscore) { + $result.="$stuname:$part:$type:changed from $oldscore to $newscore:
\n"; + } else { + $result.="$stuname:$part:$type:changed same $oldscore to $newscore:
\n"; + } + } + return $result; } sub submission { my ($request) = @_; + 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 ''; } my ($uname,$udom) = &finduser($ENV{'form.student'}); if ($uname eq '') { &moreinfo($request,"Unable to find student"); return ''; } -# my $answer=&Apache::lonnet::reply( -# "restore:$udom:$uname:". -# $ENV{'request.course.id'}.':'. -# &Apache::lonnet::escape($symb), -# &Apache::lonnet::homeserver($uname,$udom)); - 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, + $ENV{'request.course.id'}); + 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'); + + + #get list of parts for this problem + my (@parts) = &getpartlist($url); + + #start the form + $result = '
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n"; + #get info for each student + foreach my $student ( sort(@{ $classlist{'allids'} }) ) { + $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts); + } + $result.='
UserIdDomainPortion CorrectStatusTries
'; + + 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(''); } @@ -67,15 +243,20 @@ 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') { - &submission($request); + $request->print(&submission($request)); + } elsif ($command eq 'viewgrades') { + $request->print(&viewgrades($request)); + } elsif ($command eq 'editgrades') { + $request->print(&editgrades($request)); } else { $request->print("Unknown action:$command:"); }