--- loncom/homework/grades.pm 2001/07/30 22:21:20 1.11 +++ loncom/homework/grades.pm 2001/08/06 16:37:58 1.12 @@ -1,7 +1,14 @@ -# The LON-CAPA Grading handler -# 2/9,2/13 Guy Albertelli +# The LON-CAPA grading handler. +# +# Handles the viewing of grades. +# +# YEAR=2001 +# 2/7,2/9,2/13,4/16,4/17,5/1 Guy Albertelli # 6/8 Gerd Kortemeyer -# 7/26 H.K. Ng +# 7/26 Guy Albertelli +# 7/27 H.K. Ng +# 7/30 Guy Albertelli +# 8/6 Scott Harrison package Apache::grades; use strict; @@ -12,343 +19,413 @@ use Apache::loncommon; use Apache::lonhomework; use Apache::Constants qw(:common); +# ======================================================== Get more information sub moreinfo { - my ($request,$reason) = @_; - $request->print("Unable to process request: $reason"); - 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 ''; + my ($request,$reason) = @_; + $request->print("Unable to process request: $reason"); + 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 ''; } - +# ========================================= Displays the class list of students 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('
'); - } - } - + 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&middle'. + 'name',&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('
'); + } + } } - +# ========== Finds a user based on a name substring (returns a 2 element array) #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'}); - 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; } + my ($name) = @_; + 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'}); } - return ($name,$domain); - } else { - return ($ENV{'user.name'},$ENV{'user.domain'}); - } } +# ===================================== Gets a class list (returns a hash list) 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); + 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); } +# ============================== Get parts of a stored value (returns an array) 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); + 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; + return @parts; } +# =================================== Displays student grade (returns a string) 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; + 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 + +# ========================================================== Sets student grade +#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 = ''; + 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"; + } } - } 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; + } + 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; } + +# ========================================================== Attempt submission 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 ($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=&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; - return $result; + 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 $answer = &Apache::loncommon::get_previous_attempt($symb,$uname,$udom, + $ENV{'request.course.id'}); + my $result = "

Submission Record

$uname:$udom for $url
". + $answer; + return $result; } +# ================================================================= View grades sub viewgrades { - my ($request) = @_; - my $result=''; + 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 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.'
'; + #get list of parts for this problem + my (@parts) = &getpartlist($url); - return $result; + $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; } +# ================================================================= Edit grades sub editgrades { - my ($request) = @_; - my $result=''; + 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"; - 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); - } + foreach my $student ( sort(@{ $classlist{'allids'} }) ) { + $result .= &setstudentgrade($url,$symb,$ENV{'request.course.id'}, + $student,@parts); + } - $result.='
'; - return $result; + $result .= ''. + ''; + return $result; } +# ================================================================= Send header sub send_header { - my ($request)= @_; - $request->print(&Apache::lontexconvert::header()); + my ($request) = @_; + $request->print(&Apache::lontexconvert::header()); # $request->print(" #"); - $request->print(''); + $request->print(''); } +# ================================================================= Send footer sub send_footer { - my ($request)= @_; + my ($request) = @_; $request->print(''); $request->print(&Apache::lontexconvert::footer()); } +# ===================================================================== Handler 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; - my $url=$ENV{'form.url'}; - my $symb=$ENV{'form.symb'}; - my $command=$ENV{'form.command'}; - - &send_header($request); - if ($url eq '' && $symb eq '') { - $request->print("Non-Contextual Access Unsupported:$command:$url:"); - } else { - $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}); - if ($command eq 'submission') { - $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)); + 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->print("Unknown action:$command:"); + $request->content_type('text/html'); + } + $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 '' && $symb eq '') { + $request->print("Non-Contextual Access Unsupported:$command:$url:"); + } else { + $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr', + $ENV{'request.course.id'}); + if ($command eq 'submission') { + $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:"); + } } - } - &send_footer($request); - return OK; + &send_footer($request); + return OK; } 1; -__END__; +__END__