--- loncom/homework/grades.pm 2002/06/27 21:34:18 1.33 +++ 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.33 2002/06/27 21:34:18 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('

Verifying Submission Receipt '.$receipt.'

'); my $matches=0; - my (%classlist) = &getclasslist($cdom,$cnum,'0'); - foreach my $student ( sort(@{ $classlist{'allids'} }) ) { + my ($classlist) = &getclasslist('all','0'); + foreach my $student ( sort(@{ $$classlist{'all'} }) ) { my ($uname,$udom)=split(/\:/,$student); if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb)) { @@ -92,31 +95,6 @@ sub verifyreceipt { 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(<Verify a Submission Receipt Issued by this Server -
-$hostver- - - -ENDHEADER - if ($ENV{'form.url'}) { - $request->print( - ''); - } - if ($ENV{'form.symb'}) { - $request->print( - ''); - } -# $request->print(<print(''); - return ''; -} - sub student_gradeStatus { my ($url,$udom,$uname) = @_; my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))); @@ -125,6 +103,7 @@ sub student_gradeStatus { my ($temp,$part,$type)=split(/_/,$part); if ($type eq 'solved') { my ($status,$foo)=split(/_/,$record{"resource.$part.$type"},2); + $status = 'partial' if ($foo =~ /^partially/); $status = 'nothing' if ($status eq ''); return $type,$status; } @@ -132,85 +111,123 @@ sub student_gradeStatus { return ''; } +sub get_fullname { + my ($sname,$sdom) = @_; + my %name=&Apache::lonnet::get('environment', ['lastname','generation', + 'firstname','middlename'], + $sdom,$sname); + my $fullname; + my ($tmp) = keys(%name); + if ($tmp !~ /^(con_lost|error|no_such_host)/i) { + $fullname=$name{'lastname'}.$name{'generation'}; + if ($fullname =~ /[^\s]+/) { $fullname.=', '; } + $fullname.=$name{'firstname'}.' '.$name{'middlename'}; + } + return $fullname; +} + sub listStudents { my ($request) = shift; - my $cdom=$ENV{"course.$ENV{'request.course.id'}.domain"}; - my $cnum=$ENV{"course.$ENV{'request.course.id'}.num"}; + my $cdom =$ENV{"course.$ENV{'request.course.id'}.domain"}; + my $cnum =$ENV{"course.$ENV{'request.course.id'}.num"}; + my $getsec =$ENV{'form.section'}; + my $submitonly=$ENV{'form.submitonly'}; $request->print(<Show Student Submissions on Assessment - +

 View Submissions for a Student or a Group of Students

+ Resource: $ENV{'form.url'}

+
 View Options
+ View Problem: no + yes
+ Submissions: + last sub only + last sub & parts info + all details + + + +
- - - - - +
Resource: $ENV{'form.url'}
UsernameNameDomainView ProblemSubmissionsGrade StatusAction
+ + + ENDTABLEST - my (%classlist) = &getclasslist($cdom,$cnum,'0'); - foreach my $student ( sort(@{ $classlist{'allids'} }) ) { + if ($ENV{'form.url'}) { + $request->print(''."\n"); + } + if ($ENV{'form.symb'}) { + $request->print(''."\n"); + } + $request->print(''."\n"); + + my $t0=&Time::HiRes::time(); + + my ($classlist) = &getclasslist($getsec,'0'); + my $t1=&Time::HiRes::time(); + print "getclasslist=",$t1-$t0,"
"; + + foreach my $student ( sort(@{ $$classlist{$getsec} }) ) { my ($sname,$sdom) = split(/:/,$student); + my ($type,$status) = &student_gradeStatus($ENV{'form.url'},$cdom,$sname); + next if ($status eq 'nothing' && $submitonly eq 'yes'); - my %name=&Apache::lonnet::get('environment', ['lastname','generation', - 'firstname','middlename'], - $sdom,$sname); - my $fullname; - my ($tmp) = keys(%name); - if ($tmp !~ /^(con_lost|error|no_such_host)/i) { - $fullname=$name{'lastname'}.$name{'generation'}; - if ($fullname =~ /[^\s]+/) { $fullname.=', '; } - $fullname.=$name{'firstname'}.' '.$name{'middlename'}; - } + my $fullname = &get_fullname($sname,$sdom); if ( $Apache::grades::viewgrades eq 'F' ) { - $request->print("\n".''."". - ''); - if ($ENV{'form.url'}) { - $request->print( - ''); - } - if ($ENV{'form.symb'}) { - $request->print( - ''); - } - $request->print( - ''); - $request->print( - ''); - $request->print( - ''); - $request->print( - ''); - $request->print(''); - $request->print(''); - my ($type,$status) = &student_gradeStatus($ENV{'form.url'},$cdom,$sname); - $request->print( - ''); - $request->print( - ''); -# $request->print(''); + $request->print("\n".''. + ''."\n". + ''."\n". + ''."\n". + ''."\n"); + $request->print(''."\n"); + + $request->print(''); } } + my $t2=&Time::HiRes::time(); + print "processclasslist=",$t2-$t1,"
"; $request->print('
 Select  Username  Fullname  Domain  Grade Status 
$sname$fullname$sdom'. - ' no '. - ' yes '. - ' last '. - ' all '.$status.' '); - $request->print('
 '.$sname.'  '.$fullname.'  '.$sdom.'  '.$status.' 
'); + $request->print('
'); +} + +sub processGroup { + my ($request) = shift; + my $ctr = 0; + my @stuchecked = (ref($ENV{'form.stuinfo'}) ? @{$ENV{'form.stuinfo'}} + : ($ENV{'form.stuinfo'})); + my $total = scalar(@stuchecked)-1; + if ($stuchecked[0] eq '') { + &userError($request,'No student was selected for viewing/grading.'); + return; + } + foreach (@stuchecked) { + my ($sname,$sdom,$fullname) = split(/:/); + $ENV{'form.student'} = $sname; + $ENV{'form.fullname'} = $fullname; + &submission($request,$ctr,$total); + $ctr++; + } + return 'The End'; } +sub userError { + my ($request, $reason, $step) = @_; + $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); @@ -220,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 { @@ -254,14 +279,9 @@ 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); @@ -280,7 +300,7 @@ sub viewstudentgrade { $result.="\n"; } } - $result.=''; + $result.=''; return $result; } @@ -288,7 +308,7 @@ sub viewstudentgrade { #interface based on that, also do that to above function. sub setstudentgrade { my ($url,$symb,$courseid,$student,@parts) = @_; - + print "set student grade parts=@parts
"; my $result =''; my ($stuname,$domain) = split(/:/,$student); my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname); @@ -309,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"; } @@ -328,11 +349,7 @@ sub setstudentgrade { } if ( scalar(keys(%newrecord)) > 0 ) { $newrecord{'resource.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; - print "grader=$newrecord{'resource.regrader'}:
records
"; - while (my ($k,$v) = each %newrecord) { - print "k=$k:v=$v:
\n"; - } - &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$stuname); +# &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$stuname); $result.="Stored away ".scalar(keys(%newrecord))." elements.
\n"; } @@ -342,225 +359,399 @@ sub setstudentgrade { # # --------------------------- show submissions of a student, option to grade -------- sub submission { - my ($request) = @_; - - $request->print(< - function updateRadio(radioButton,formtextbox,formsel,wgt) { - var pts = formtextbox.value; - var resetbox =false; - if (isNaN(pts) || pts < 0) { - alert("A number equal or greater than 0 is expected. Entered value = "+pts); - for (var i=0; i 0 && pts < wgt) { - formsel[4].selected = true; - } - if (pts == wgt) { - formsel[0].selected = true; - } - return; - } + my ($request,$counter,$total) = @_; - -JAVASCRIPT (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 ''; } - print "formstu=$ENV{'form.student'}:
"; + 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 ''; } + 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 ''; } -# -# header info - my $result='

Submission Record

'; - $result.=''; - $result.='
Username: '.$uname. - 'Fullname: '.$ENV{'form.fullname'}.'Domain: '.$udom.'
Resource: '.$url.'
'; -# -# option to display problem - 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'}); - $result.='
'; - $result.='
'; - $result.='Student\'s view of the problem
'.$rendered.'
'; - $result.='Correct answer:
'.$companswer; - $result.='
'; - $result.='

'; - } my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : ''); - my $answer=&Apache::loncommon::get_previous_attempt($symb,$uname,$udom, - $ENV{'request.course.id'},$last); - $result.=$answer; - my $wgt = &Apache::lonnet::EXT('resource.partid.weight',$symb,$udom,$uname); - my %record= &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); - my $score = $record{'resource.0.awarded'}*$wgt; + # 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.='
'; + $result.='
'; + $result.='Student\'s view of the problem
'.$rendered.'
'; + $result.='Correct answer:
'.$companswer; + $result.='
'; + $result.='

'; + $request->print($result); + } - $result.= ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n"; + # 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(''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n"); + + my ($cts,$prnmsg) = (1,''); + while ($cts <= $ENV{'form.savemsgN'}) { + $prnmsg.=''."\n"; + $cts++; + } + $request->print($prnmsg); + + if ($ENV{'form.handgrade'} eq 'yes') { + $request->print(<Keyword Options:  +List    +Paste Selection to List    +Highlight Attribute

+KEYWORDS + } + } + + # Student info + $request->print(($counter == 0 ? '' : '
')); + my $fullname = ($ENV{'form.fullname'} ne '' ? $ENV{'form.fullname'} : &get_fullname($uname,$udom)); + my $result.='
'. + '
'; + $result.=''; + if ($ENV{'form.handgrade'} eq 'yes') { +# my $subonly = &get_last_submission($symb,$uname,$udom,$ENV{'request.course.id'}); + my ($classlist) = &getclasslist('all','0'); + my @collaborators; +# foreach ( sort(@{ $$classlist{'all'} }) ) { +# my ($sname,$sdom) = split(/:/); +# push @collaborators,$sname if (grep /\b$sname(\b|\.)/i,$subonly); +# } +# push @collaborators,'leede','carlandmm','freyniks'; # as a test to display collaborators. + if (scalar(@collaborators) != 0) { + $result.=''."\n"; + $result.=''."\n"; + } + } + $result.='
Username: '.$uname. + 'Fullname: '.$fullname. + 'Domain: '.$udom.'
Collaborators: '; + foreach (@collaborators) { + $result.=$_.' ('.&get_fullname($_,$udom).')    '; + } + $result.='
'."\n"; + $request->print($result); + + # print student answer + if ($ENV{'form.lastSub'} eq 'lastonly') { + my ($string,$timestamp)=&get_last_submission ($symb,$uname,$udom,$ENV{'request.course.id'}); + $string=&keywords_highlight(join('::::',@$string)); + my $lastsubonly='
'; + $lastsubonly.=''; + $lastsubonly.=''; + $lastsubonly.='
Last Submission Only'. + ($timestamp eq '' ? '' : '    Date Submitted: '.@$timestamp).'
'; + $lastsubonly.=$string; + $lastsubonly.='
'."\n"; + $request->print($lastsubonly); + } else { + $request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom, + $ENV{'request.course.id'},$last, + '.submission','Apache::grades::keywords_highlight')); + } + + my $wgt = &Apache::lonnet::EXT('resource.partid.weight',$symb,$udom,$uname); + my $wgtmsg = ($wgt > 0 ? '(problem weight)' : 'problem weight assigned by computer'); + $wgt = ($wgt > 0 ? $wgt : '1'); + my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); + my $score = ($record{'resource.0.awarded'} eq '' ? '' : $record{'resource.0.awarded'}*$wgt); - my $counter = 0; - $result.=''. + # display grading options + $result=''. ''."\n"; + $result.=''."\n"; + $result.=''."\n"; $result.=''; $result.=''."\n"; - $result.='\n"; + $result.="  \n"; } } + $result.='Compose Message
Points'; + my $ctr = 0; + $result.=''; # display radio buttons in a nice table with 10 across while ($ctr<=$wgt) { - $result.= ' '.$ctr."\n"; + ',this.form.GRADE_SEL'.$counter.','.$ctr.','.$wgt.')" '. + ($score eq $ctr ? 'checked':'').' /> '.$ctr."\n"; + $result.=(($ctr+1)%10 == 0 ? '' : ''); $ctr++; } + $result.='
'; + $result.='		 or /'.($wgt > 0 ? $wgt.' (problem weight)' : 'invalid problem weight' ). - ' '; + $result.='/'.$wgt.' '.$wgtmsg.' '; foreach my $part (&getpartlist($url)) { + print "parts=$part
"; my ($temp,$part,$type)=split(/_/,$part); if ($type eq 'solved') { my ($status,$foo)=split(/_/,$record{"resource.$part.$type"},2); + $status = 'partial' if ($foo =~ /partially/); + $status = 'nothing' if ($status eq ''); $result.='
'."\n"; +# $result.='
'; + $result.='
'; + $request->print($result); + + # print end of form + if ($counter == $total) { + my $endform.='
'; + my $ntstu =''."\n"; + my $nsel = ($ENV{'form.NTSTU'} ne '' ? $ENV{'form.NTSTU'} : '1'); + $ntstu =~ s/
'; + $request->print($endform); + } - $result.=''; - my $ntstu =''."\n"; - my $nsel = ($ENV{'form.NTSTU'} ne '' ? $ENV{'form.NTSTU'} : '1'); - $ntstu =~ s/