--- loncom/homework/grades.pm 2002/06/24 21:05:12 1.30
+++ loncom/homework/grades.pm 2002/07/10 21:08:38 1.38
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.30 2002/06/24 21:05:12 ng Exp $
+# $Id: grades.pm,v 1.38 2002/07/10 21:08:38 ng Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -30,7 +30,7 @@
# 7/26 H.K. Ng
# 8/20 Gerd Kortemeyer
# Year 2002
-# June 2002 H.K. Ng
+# June, July 2002 H.K. Ng
#
package Apache::grades;
@@ -40,7 +40,9 @@ use Apache::lonxml;
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonhomework;
+use Apache::lonmsg qw(:user_normal_msg);
use Apache::Constants qw(:common);
+use Time::HiRes qw( gettimeofday tv_interval );
sub moreinfo {
my ($request,$reason) = @_;
@@ -53,6 +55,7 @@ sub moreinfo {
if ($ENV{'form.symb'}) {
$request->print(''."\n");
}
+# $request->print(''."\n");
$request->print(''."\n");
$request->print("Student:".''."
\n");
$request->print("Domain:".''."
\n");
@@ -65,8 +68,8 @@ sub moreinfo {
sub verifyreceipt {
my $request=shift;
my $courseid=$ENV{'request.course.id'};
- my $cdom=$ENV{"course.$courseid.domain"};
- my $cnum=$ENV{"course.$courseid.num"};
+# 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;
@@ -77,8 +80,8 @@ sub verifyreceipt {
if ((&Apache::lonnet::allowed('mgr',$courseid)) && ($symb)) {
$request->print('
'.$matches." match%s
",$matches <= 1 ? '' : 'es'); +# needs to print who is matched } return ''; } -sub receiptInput { - 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(<
-
LON-CAPA User Error'."\n"); + $request->print('Reason: '.$reason.' '."\n"); + $request->print('Step: '.($step ne '' ? $step : 'Use your browser back button to correct') + .' '."\n"); + return ''; +} #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); + my ($classlist) = &getclasslist('all','0'); + foreach ( sort(@{ $$classlist{'all'} }) ) { + my ($posname,$posdomain) = split(/:/); if ($posname =~ $name) { $name=$posname; $domain=$posdomain; last; } } return ($name,$domain); @@ -200,20 +237,28 @@ sub finduser { } sub getclasslist { - my ($coursedomain,$coursenum,$hideexpired) = @_; + my ($getsec,$hideexpired) = @_; + my ($coursedomain,$coursenum) = split(/_/,$ENV{'request.course.id'}); my %classlist=&Apache::lonnet::dump('classlist',$coursedomain,$coursenum); my $now = time; + my (@holdsec,@sections); 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); + my ($unam,$udom) = split(/:/,$student,2); + my $section = &Apache::lonnet::usection($udom,$unam,$ENV{'request.course.id'}); + $section = ($section ne '-1' ? $section : 'no'); + push @holdsec,$section; + push (@{ $classlist{$getsec} }, $student) if ($getsec eq 'all' || $getsec eq $section); + } + my %seen = (); + foreach my $item (@holdsec) { + push (@sections, $item) unless $seen{$item}++; } - return (%classlist); + return (\%classlist,\@sections); } sub getpartlist { @@ -234,60 +279,46 @@ sub viewstudentgrade { my $cellclr = '"#ffffdd"'; my ($username,$domain) = split(/:/,$student); - my (@requests) = ('lastname','firstname','middlename','generation'); - my (%name) = &Apache::lonnet::get('environment',\@requests,$domain,$username); + my $fullname = &get_fullname($username,$domain); my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$username); - my $fullname=$name{'lastname'}.$name{'generation'}; - if ($fullname =~ /[^\s]+/) { $fullname.=', '; } - $fullname.=$name{'firstname'}.' '.$name{'middlename'}; $result.=" $username | $fullname | $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"
+ my $score=$record{"resource.$part.$type"};
+ if ($type eq 'awarded' || $type eq 'tries') {
+ $result.=' | '."\n";
} elsif ($type eq 'solved') {
- my $score=$record{"resource.$part.$type"};
+ my ($status,$foo)=split(/_/,$score,2);
$result.=" | \n";
}
}
- $result.=' | "; 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"}; + print "old=$oldscore:new=$newscore: "; if ($type eq 'solved') { my $update=0; if ($newscore eq 'nothing' ) { @@ -298,10 +329,11 @@ sub setstudentgrade { } elsif ($oldscore !~ m/^$newscore/) { $update=1; $result.="Updating $stuname to $newscore \n"; - if ($newscore eq 'correct') { $newscore = 'correct_by_override'; } + 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'; } + if ($newscore eq 'excused') { $newscore = 'excused'; } + if ($newscore eq 'ungraded') { $newscore = 'ungraded_attempted'; } + if ($newscore eq 'partial') { $newscore = 'correct_partially_by_override'; } } else { #$result.="$stuname:$part:$type:unchanged $oldscore to $newscore: \n"; } @@ -316,89 +348,448 @@ sub setstudentgrade { } } if ( scalar(keys(%newrecord)) > 0 ) { - $newrecord{"resource.regrader"}="$ENV{'user.name'}:$ENV{'user.domain'}"; - &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$stuname); + $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; } +# +# --------------------------- show submissions of a student, option to grade -------- 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 ($request,$counter,$total) = @_; + + (my $url=$ENV{'form.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 $symb; - if ($ENV{'form.symb'}) { - $symb=$ENV{'form.symb'}; + if ($uname eq '') { &moreinfo($request,'Unable to find student'); return ''; } + + my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))); + if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } + my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : ''); + + # header info + if ($counter == 0) { + &sub_page_js($request); + $request->print(' Submission Record'. + ' Resource: '.$url.''); + + # option to display problem, only once else it cause problems with the form later + # since the problem has a form. + if ($ENV{'form.vProb'} eq 'yes') { + my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, + $ENV{'request.course.id'}); + my $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom, + $ENV{'request.course.id'}); + my $result.='
'; + $request->print($result); + } + + # kwclr is the only variable that is non blank if this has been used once. + my %keyhash = (); + if ($ENV{'form.kwclr'} eq '') { + %keyhash = &Apache::lonnet::dump('nohist_handgrade', + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + + my $loginuser = $ENV{'user.name'}.':'.$ENV{'user.domain'}; + $ENV{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; + $ENV{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; + $ENV{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; + $ENV{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; + $ENV{'form.msgsub'} = $keyhash{$symb.'_subject'} ne '' ? + $keyhash{$symb.'_subject'} : &Apache::lonnet::metadata($url,'title'); + $ENV{'form.savemsgN'} = $keyhash{$symb.'_savemsgN'} ne '' ? $keyhash{$symb.'_savemsgN'} : '0'; + + } + $request->print('
Submission Record'; - $result.='
'; - } - my $last = ''; - $last = 'last' if ($ENV{'form.submission'} eq 'last'); - my $answer=&Apache::loncommon::get_previous_attempt($symb,$uname,$udom, - $ENV{'request.course.id'},$last); - $result.=$answer.' Needs an interface for inputting scores'; + return ''; +} + +sub get_last_submission { + my ($symb,$username,$domain,$course)=@_; + if ($symb) { + my (@string,@timestamp); + my (%returnhash)=&Apache::lonnet::restore($symb,$course,$domain,$username); + if ($returnhash{'version'}) { + my %lasthash=(); + my ($version); + for ($version=1;$version<=$returnhash{'version'};$version++) { + foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) { + $lasthash{$_}=$returnhash{$version.':'.$_}; + } + } + foreach ((keys %lasthash)) { + print "lasthash key=$_ "; + if ($_ =~ /\.submission$/) {push @string, $_,$lasthash{$_}} + if ($_ =~ /timestamp/) {push @timestamp, scalar(localtime($lasthash{$_}))}; +# if ($_ =~ /\.submission$/) {$string = $lasthash{$_}} +# if ($_ =~ /timestamp/) {$timestamp=scalar(localtime($lasthash{$_}))}; + } + } + @string = $string[0] eq '' ? 'Nothing submitted - no attempts.' : @string; + return \@string,\@timestamp; + } +} + +sub keywords_highlight { + my $string = shift; + my $size = $ENV{'form.kwsize'} eq '0' ? '' : 'size='.$ENV{'form.kwsize'}; + my $styleon = $ENV{'form.kwstyle'} eq '' ? '' : $ENV{'form.kwstyle'}; + (my $styleoff = $styleon) =~ s/\\<\//; + my @keylist = split(/[,\s+]/,$ENV{'form.keywords'}); + foreach (@keylist) { + # next if ($_ eq ''); + $string =~ s/\b$_(\b|\.)/\$styleon$_$styleoff\<\/font\>/gi; + } + return $string; +} + +sub processHandGrade { + my ($request) = shift; + my $url = $ENV{'form.url'}; + my $symb = $ENV{'form.symb'}; + my $button = $ENV{'form.gradeOpt'}; + my $ngrade = $ENV{'form.NCT'}; + my $ntstu = $ENV{'form.NTSTU'}; + + my $loginuser = $ENV{'user.name'}.':'.$ENV{'user.domain'}; + my %keyhash = (); + $ENV{'form.keywords'} =~ s/,\s{0,}|\s+/ /g; + $keyhash{$symb.'_handgrade'} = 'activated'; + $keyhash{$symb.'_keywords'} = $ENV{'form.keywords'}; + $keyhash{$symb.'_subject'} = $ENV{'form.msgsub'}; + $keyhash{$loginuser.'_kwclr'} = $ENV{'form.kwclr'}; + $keyhash{$loginuser.'_kwsize'} = $ENV{'form.kwsize'}; + $keyhash{$loginuser.'_kwstyle'} = $ENV{'form.kwstyle'}; + + my ($ctr,$idx) = (1,1); + while ($ctr <= $ENV{'form.savemsgN'}) { + if ($ENV{'form.savemsg'.$ctr} ne '') { + $keyhash{$symb.'_savemsg'.$idx} = $ENV{'form.savemsg'.$ctr}; + $idx++; + } + $ctr++; + } + $ctr = 0; + while ($ctr < $ngrade) { + if ($ENV{'form.newmsg'.$ctr} ne '') { + $keyhash{$symb.'_savemsg'.$idx} = $ENV{'form.newmsg'.$ctr}; + $ENV{'form.savemsg'.$idx} = $ENV{'form.newmsg'.$ctr}; + $idx++; + } + $ctr++; + } + $ENV{'form.savemsgN'} = --$idx; + $keyhash{$symb.'_savemsgN'} = $ENV{'form.savemsgN'}; + my $putresult = &Apache::lonnet::put + ('nohist_handgrade',\%keyhash, + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); my (@parts) = sort(&getpartlist($url)); - #start the form - $result.= ''; - return $result; +sub saveHandGrade { + my ($url,$symb,$stuname,$domain,$newflg,@parts) = @_; + my %record=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},$domain,$stuname); + my %newrecord; + + foreach my $part (@parts) { + my ($temp,$part,$type)=split(/_/,$part); + my $oldscore=$record{"resource.$part.$type"}; + my $newscore; + if ($type eq 'awarded' && $newflg >= 0) { + my $pts = ($ENV{'form.GRADE_BOX'.$newflg} ne '' ? + $ENV{'form.GRADE_BOX'.$newflg} : $ENV{'form.RADVAL'.$newflg}); + my $wgt = $ENV{'form.WGT'.$newflg}; +# my $sel = $ENV{'form.GRADE_SEL'.$newflg}; + $newscore = $pts/$wgt if ($wgt != 0); + } + if ($type eq 'solved') { + $newscore = $ENV{'form.GRADE_SEL'.$newflg} if ($newflg >= 0); + my $update=0; + if ($newscore eq 'nothing' ) { + if ($oldscore ne '') { + $update=1; + $newscore = ''; + } + } elsif ($oldscore !~ m/^$newscore/) { + $update=1; + 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'; } + if ($newscore eq 'partial') { $newscore = 'correct_partially_by_override'; } + } + if ($update) { $newrecord{"resource.$part.$type"}=$newscore; } + } else { + if ($oldscore ne $newscore) { + $newrecord{"resource.$part.$type"}=$newscore; + } + } + } + if ( scalar(keys(%newrecord)) > 0 ) { + $newrecord{'resource.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; +# while (my ($k,$v) = each %newrecord) { +# print "k=$k:v=$v: \n"; +# } +# print "symb=$symb,courseid=$ENV{'request.course.id'},dom=$domain,name=$stuname "; +# &Apache::lonnet::cstore(\%newrecord,$symb,$ENV{'request.course.id'},$domain,$stuname); + } + return ''; } sub get_symb_and_url { - my ($request) = @_; - 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); } + my ($request) = @_; + (my $url=$ENV{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; + my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))); if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } - return ($symb,$url); -} - -sub view_edit_entire_class_form { - my ($symb,$url)=@_; - my $result.=''."\n"; - return $result; + return ($symb,$url); } sub show_grading_menu_form { @@ -416,31 +807,142 @@ sub gradingmenu { my ($request) = @_; my ($symb,$url)=&get_symb_and_url($request); if (!$symb) {return '';} + my $allkeys = &Apache::lonnet::metadata($url,'keys'); + my $handgrade = ($allkeys =~ /parameter_.*?_handgrade/ ? 'yes' : 'no'); + my ($responsetype,$foo) = split(/_/,&Apache::lonnet::metadata($url,'packages')); + $allkeys=~s/,/\ /g; +# print "allkeys=$allkeys "; + $Apache::lonxml::debug=1; + &Apache::lonxml::debug(join(':',&Apache::lonnet::metadata($url,'packages'))); + $Apache::lonxml::debug=0; + + my $result=' Select a Grading Method'; + $result.='
'; + my $t1=&Time::HiRes::time(); + print "elapsed10=",$t1-$t0," "; + $result.=&upcsvScores_form($symb,$url).' '; + my $t2=&Time::HiRes::time(); + print "elapsed21=",$t2-$t1," "; + $result.=&viewGradeaStu_form($symb,$url,$responsetype,$handgrade).' '; + my $t3=&Time::HiRes::time(); + print "elapsed32=",$t3-$t2," "; + $result.=&verifyReceipt_form($symb,$url); + my $t4=&Time::HiRes::time(); + print "elapsed43=",$t4-$t3," "; + print "Total elapsed time=",$t4-$t0," "; + return $result; +} - my $result=' Select a Grading Method'; - $result.='
|