# The LearningOnline Network with CAPA # The LON-CAPA Grading handler # # $Id: grades.pm,v 1.24 2002/05/15 23:47:49 albertel Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # # 2/9,2/13 Guy Albertelli # 6/8 Gerd Kortemeyer # 7/26 H.K. Ng # 8/20 Gerd Kortemeyer 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"); if ( $Apache::grades::viewgrades eq 'F' ) { $request->print('
'."\n"); if ($ENV{'form.url'}) { $request->print(''."\n"); } if ($ENV{'form.symb'}) { $request->print(''."\n"); } $request->print(''."\n"); $request->print("Student:".''."
\n"); $request->print("Domain:".''."
\n"); $request->print(''."
\n"); $request->print('
'); } return ''; } sub verifyreceipt { my $request=shift; my $courseid=$ENV{'request.course.id'}; my $cdom=$ENV{"course.$courseid.domain"}; my $cnum=$ENV{"course.$courseid.num"}; my $receipt=unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}).'-'. $ENV{'form.receipt'}; $receipt=~s/[^\-\d]//g; my $symb=$ENV{'form.symb'}; unless ($symb) { $symb=&Apache::lonnet::symbread($ENV{'form.url'}); } if ((&Apache::lonnet::allowed('mgr',$courseid)) && ($symb)) { $request->print('

Verifying Submission Receipt '.$receipt.'

'); my $matches=0; my (%classlist) = &getclasslist($cdom,$cnum,'0'); foreach my $student ( sort(@{ $classlist{'allids'} }) ) { my ($uname,$udom)=split(/\:/,$student); if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb)) { $request->print('Matching '.$student.'
'); $matches++; } } $request->print('

'.$matches.' match(es)

'); } return ''; } sub listStudents { my ($request) = shift; my $cdom=$ENV{"course.$ENV{'request.course.id'}.domain"}; my $cnum=$ENV{"course.$ENV{'request.course.id'}.num"}; my $hostver=unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}); $request->print(<Verify a Submission Receipt Issued by this Server
$hostver- ENDHEADER if ($ENV{'form.url'}) { $request->print( ''); } if ($ENV{'form.symb'}) { $request->print( ''); } $request->print(<

Show Student Submissions on Assessment

ENDTABLEST my (%classlist) = &getclasslist($cdom,$cnum,'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('
UsernameDomainName 
$sname$sdom@nameparts". ''); if ($ENV{'form.url'}) { $request->print( ''); } if ($ENV{'form.symb'}) { $request->print( ''); } $request->print( ''); $request->print( ''); $request->print( ''); $request->print( ''); $request->print('
'); } #FIXME - needs to handle multiple matches sub finduser { my ($name) = @_; my $domain = ''; if ( $Apache::grades::viewgrades eq 'F' ) { #get classlist my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); #print "Found $cdom:$cnum
"; my (%classlist) = &getclasslist($cdom,$cnum,'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,$hideexpired) = @_; my %classlist=&Apache::lonnet::dump('classlist',$coursedomain,$coursenum); my $now = time; foreach my $student (keys(%classlist)) { my ($end,$start)=split(/:/,$classlist{$student}); # still a student? if (($hideexpired) && ($end) && ($end < $now)) { #print "Skipping:$name:$end:$now
\n"; next; } #print "record=$record
"; push( @{ $classlist{'allids'} }, $student); } 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 { 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 ''; } # 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; if ($ENV{'form.symb'}) { $symb=$ENV{'form.symb'}; } else { $symb=&Apache::lonnet::symbread($url); } if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } my $answer=&Apache::loncommon::get_previous_attempt($symb,$uname,$udom, $ENV{'request.course.id'}); my $result="

Submission Record

$uname:$udom for $url
".$answer; my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, $ENV{'request.course.id'}); $result.="Student's view of the problem:
$rendered
Correct answer:
"; $answer=&Apache::loncommon::get_student_answers($symb,$uname,$udom, $ENV{'request.course.id'}); $result.=$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'}); #print "Found $cdom:$cnum
"; my (%classlist) = &getclasslist($cdom,$cnum,'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'}); #print "Found $cdom:$cnum
"; my (%classlist) = &getclasslist($cdom,$cnum,'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(''); } sub send_footer { my ($request)= @_; $request->print(''); $request->print(&Apache::lontexconvert::footer()); } sub handler { my $request=$_[0]; if ( $ENV{'user.name'} eq 'albertel' ) {$Apache::lonxml::debug=1;} else {$Apache::lonxml::debug=0;} if ($ENV{'browser.mathml'}) { $request->content_type('text/xml'); } else { $request->content_type('text/html'); } $request->send_http_header; return OK if $request->header_only; &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}); my $url=$ENV{'form.url'}; my $symb=$ENV{'form.symb'}; my $command=$ENV{'form.command'}; if (!$url) { my ($temp1,$temp2); ($temp1,$temp2,$ENV{'form.url'})=split(/___/,$symb); $url = $ENV{'form.url'}; } &send_header($request); if ($url eq '' && $symb eq '') { if ($ENV{'user.adv'}) { if (($ENV{'form.codeone'}) && ($ENV{'form.codetwo'}) && ($ENV{'form.codethree'})) { my $token=$ENV{'form.codeone'}.'*'.$ENV{'form.codetwo'}.'*'. $ENV{'form.codethree'}; my ($tsymb,$tuname,$tudom,$tcrsid)= &Apache::lonnet::checkin($token); if ($tsymb) { my ($map,$id,$url)=split(/\_\_\_/,$tsymb); if (&Apache::lonnet::allowed('mgr',$tcrsid)) { $request->print( &Apache::lonnet::ssi('/res/'.$url, ('grade_username' => $tuname, 'grade_domain' => $tudom, 'grade_courseid' => $tcrsid, 'grade_symb' => $tsymb))); } else { $request->print('

Not authorized: '.$token.'

'); } } else { $request->print('

Not a valid DocID: '.$token.'

'); } } else { $request->print(&Apache::lonxml::tokeninputfield()); } } } else { $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}); if ($command eq 'submission') { &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)); } elsif ($command eq 'verify') { $request->print(&verifyreceipt($request)); } else { $request->print("Unknown action: $command:"); } } &send_footer($request); return OK; } 1; __END__;