--- loncom/homework/grades.pm 2002/06/24 21:05:12 1.30 +++ loncom/homework/grades.pm 2002/07/19 20:42:18 1.40 @@ -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.40 2002/07/19 20:42:18 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)) { @@ -87,110 +90,176 @@ sub verifyreceipt { } } $request->printf('

'.$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(<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,$partlist) = @_; + my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))); + my %record= &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); + my %partstatus = (); + foreach (@$partlist) { + my ($status,$foo)=split(/_/,$record{"resource.$_.solved"},2); + $status = 'nothing' if ($status eq ''); + $partstatus{$_} = $status; + } + return %partstatus; +} + +sub get_fullname { + my ($uname,$udom) = @_; + my %name=&Apache::lonnet::get('environment', ['lastname','generation', + 'firstname','middlename'], + $udom,$uname); + 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 response_type { + my ($url) = shift; + my $allkeys = &Apache::lonnet::metadata($url,'keys'); + my %seen = (); + my (@partlist,%handgrade); + foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) { + if (/^\w+response_\d{1,2}.*/) { + my ($responsetype,$part) = split(/_/,$_,2); + my ($partid,$respid) = split(/_/,$part); + $handgrade{$part} = $responsetype.':'.($allkeys =~ /parameter_$part\_handgrade/ ? 'yes' : 'no'); + next if ($seen{$partid} > 0); + $seen{$partid}++; + push @partlist,$partid; + } + } + return \@partlist,\%handgrade; } + 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'}; + + my $result='

 View Submissions for a Student or a Group of Students

'; + $result.=''; + $result.=''; + my ($partlist,$handgrade) = &response_type($ENV{'form.url'}); + for (sort keys(%$handgrade)) { + my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_}); + $result.=''. + ''. + ''; + } + $result.='
Resource: '.$ENV{'form.url'}.'
Part id: '.$_.'Type: '.$responsetype.'Handgrade: '.$handgrade.'
'; + $request->print($result); $request->print(<Show Student Submissions on Assessment - -\n"; + my $result="\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.=''; + $result.=''; return $result; } -#FIXME need to look at the meatdata spec on what type of data to accept and provide an + +#FIXME need to look at the metadata 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) = @_; - + print "set student grade parts=@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"}; + print "old=$oldscore:new=$newscore:
"; if ($type eq 'solved') { my $update=0; if ($newscore eq 'nothing' ) { @@ -298,10 +364,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 +383,471 @@ 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'}; - } else { - $symb=&Apache::lonnet::symbread($url); - } + 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.='
- - - - + + View Problem: no + yes
+ Submissions: + handgrade only + last sub only + last sub & parts info + all details + + + + + ENDTABLEST - my (%classlist) = &getclasslist($cdom,$cnum,'0'); - foreach my $student ( sort(@{ $classlist{'allids'} }) ) { - my ($sname,$sdom) = split(/:/,$student); - - 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'}; + if ($ENV{'form.url'}) { + $request->print(''."\n"); + } + if ($ENV{'form.symb'}) { + $request->print(''."\n"); + } + $request->print(''."\n"); + + my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist($getsec,'0'); + + $result='
Resource: $ENV{'form.url'}
UsernameNameDomainView ProblemSubmissionsAction
'. + ''. + ''. + ''; + foreach (sort(@$partlist)) { + $result.=''; + } + $request->print($result.''."\n"); + + foreach my $student (sort(@{ $$classlist{$getsec} }) ) { + my ($uname,$udom) = split(/:/,$student); + my (%status) = &student_gradeStatus($ENV{'form.url'},$udom,$uname,$partlist); + my $statusflg = ''; + foreach (keys(%status)) { + $statusflg = 1 if ($status{$_} ne 'nothing'); } + next if ($statusflg eq '' && $submitonly eq 'yes'); + if ( $Apache::grades::viewgrades eq 'F' ) { - $request->print("\n".''."". - ''); - if ($ENV{'form.url'}) { - $request->print( - ''); - } - if ($ENV{'form.symb'}) { - $request->print( - ''); + $result=''. + ''."\n". + ''."\n". + ''."\n". + ''."\n"; + + foreach (sort keys(%status)) { + $result.=''."\n"; } - $request->print( - ''); - $request->print( - ''); - $request->print( - ''); - $request->print( - ''); - $request->print(''); - $request->print(''); - $request->print( - ''); -# $request->print(''); + $request->print($result.''."\n"); } } $request->print('
 Select  Username  Fullname  Domain  Part ID '.$_.' Status 
$sname$fullname$sdom
 '.$uname.'  '.$$fullname{$student}.'  '.$udom.'  '.$status{$_}.' '. - ' no '. - ' yes '. - ' last '. - ' all '); - $request->print('
'); + $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 ($uname,$udom,$fullname) = split(/:/); + $ENV{'form.student'} = $uname; + $ENV{'form.fullname'} = $fullname; + &submission($request,$ctr,$total); + $ctr++; + } + return ''; +} + +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); @@ -200,20 +269,32 @@ sub finduser { } 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); + my ($getsec,$hideexpired) = @_; + my %classlist=&Apache::lonnet::dump('classlist', + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + my $now = time; + my (@holdsec,@sections,%allids,%stusec,%fullname); + foreach (keys(%classlist)) { + my ($end,$start,$id,$section,$fullname)=split(/:/,$classlist{$_}); + # still a student? + if (($hideexpired) && ($end) && ($end < $now)) { + next; + } + $section = ($section ne '' ? $section : 'no'); + push @holdsec,$section; + if ($getsec eq 'all' || $getsec eq $section) { + push (@{ $classlist{$getsec} }, $_); + $allids{$_}=$id; + $stusec{$_}=$section; + $fullname{$_}=$fullname; + } + } + my %seen = (); + foreach my $item (@holdsec) { + push (@sections, $item) unless $seen{$item}++; + } + return (\%classlist,\@sections,\%allids,\%stusec,\%fullname); } sub getpartlist { @@ -230,64 +311,49 @@ sub getpartlist { sub viewstudentgrade { my ($url,$symb,$courseid,$student,@parts) = @_; - my $result =''; 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
$username$fullname$domain
'; + $result.='
'; + $result.='Student\'s view of the problem
'.$rendered.'
'; + $result.='Correct answer:
'.$companswer; + $result.='
'; + $result.='

'; + $request->print($result); + } + + # kwclr is the only variable that is guaranteed to be non blank if this subroutine has been called 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". + ''."\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 ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist('all','0'); + my @collaborators; +# foreach ( sort(@{ $$classlist{'all'} }) ) { +# my ($uname,$udom) = split(/:/); +# push @collaborators,$uname if (grep /\b$uname(\b|\.)/i,$subonly); +# } +# push @collaborators,'leede','carlandmm','freyniks'; # as a test to display collaborators. + if (scalar(@collaborators) != 0) { + $result.=''."\n"; + $result.=''."\n"; + } + } + $request->print($result.'
Fullname: '.$fullname. + '   Username: '.$uname. + '   Domain: '.$udom.'
Collaborators: '; + foreach (@collaborators) { + $result.=$_.' ('.$$fullname{$_.':'.$udom}.')    '; +# $result.=$_.' ('.&get_fullname($_,$udom).')    '; + } + $result.='
'."\n"); - my $result='

Submission Record

'; - $result.=''; - $result.='
Username: '.$uname.'Fullname: '.$ENV{'form.fullname'}.'Domain: '.$udom.'
Resource: '.$url.'
'; - 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.=''; + if ($$timestamp eq '') { + $lastsubonly.=''; + } else { + for my $part (sort keys(%$handgrade)) { + foreach (@$string) { + my ($partid,$respid) = /^resource\.(\d{1,2})\.(\d{1,2})\.submission/; + if ($part eq ($partid.'_'.$respid)) { + my ($ressub,$subval) = split(/:/,$_,2); + $lastsubonly.='' + if ($ENV{'form.lastSub'} eq 'lastonly' || + ($ENV{'form.lastSub'} eq 'hdgrade' && $$handgrade{$part} =~ /:yes$/)); + } + } + } + } + $lastsubonly.='
'; - $result.='Student\'s view of the problem:
'.$rendered.'
'; - $result.='Correct answer:
'.$companswer; + my ($partlist,$handgrade) = &response_type($url); + + # print student answer + if ($ENV{'form.lastSub'} =~ /^(lastonly|hdgrade)$/) { + my ($string,$timestamp)=&get_last_submission ($symb,$uname,$udom,$ENV{'request.course.id'}); + my $lastsubonly.='
Last Submission Only'. + ($$timestamp eq '' ? '' : '    Date Submitted: '.$$timestamp).'
'.$$string[0].'
Part ID '. + $partid.' Response ID '.$respid. + ' Submission '.&keywords_highlight($subval).'
'."\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')); + } + + $result=''."\n". + ''."\n". + ''."\n"; + $result.=' Compose Message
'."\n" if ($ENV{'form.handgrade'} eq 'yes'); + $request->print($result); + + my %seen = (); + my @partlist; + my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); +# while (my ($k,$v) = each (%record)){ +# print "key=$k ==> value=$v
"; +# } + for (sort keys(%$handgrade)) { + my ($partid,$respid) = split(/_/); + next if ($seen{$partid} > 0); + $seen{$partid}++; + next if ($$handgrade{$_} =~ /:no$/); + push @partlist,$partid; + 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 $score = ($record{'resource.'.$partid.'.awarded'} eq '' ? '' : $record{'resource.'.$partid.'.awarded'}*$wgt); + + # display grading options + $result=''; + $result.=''; + $result.=''."\n"; + $result.='
Part '.$partid.' Points'; + + my $ctr = 0; + $result.=''; # display radio buttons in a nice table 10 across + while ($ctr<=$wgt) { + $result.= '\n"; + $result.=(($ctr+1)%10 == 0 ? '' : ''); + $ctr++; + } + $result.='
'.$ctr."
'; + + $result.='		 or /'.$wgt.' '.$wgtmsg.' '; + + $result.=''."  \n"; + $result.=''; $result.='
'; - $result.='

'; + $request->print($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'; + $request->print(''."\n"); + $request->print('
'."\n"); - my (@parts) = sort(&getpartlist($url)); + # 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); + } + return ''; +} - #start the form - $result.= '
'."\n". - ''."\n". - ''."\n". - ''."\n". - '
'."\n". - ''."\n". - ''; - #get info for each student - $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},$uname,@parts); +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/\$styleon$_$styleoff\<\/font\>/gi; + } + return $string; +} - $result.='
'."\n"; +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)) { + if ($_ =~ /\.submission$/) {push @string, (join(':',$_,$lasthash{$_}))} + if ($_ =~ /timestamp/) {$timestamp = scalar(localtime($lasthash{$_}))}; + } + } + @string = $string[0] eq '' ? 'Nothing submitted - no attempts.' : @string; + return \@string,\$timestamp; + } +} - $result.='
'; - return $result; +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; + $ENV{'form.keywords'} =~ s/^\s+|\s+$//; + $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'}); + + if ($ENV{'form.refresh'} eq 'on') { + my $ctr = 0; + $ENV{'form.NTSTU'}=$ngrade; + while ($ctr < $ngrade) { + ($ENV{'form.student'},my $udom) = split(/:/,$ENV{'form.unamedom'.$ctr}); + &submission($request,$ctr,$ngrade-1); + $ctr++; + } + return ''; + } + + if ($button eq 'Save & Next') { + my $ctr = 0; + while ($ctr < $ngrade) { + my ($uname,$udom) = split(/:/,$ENV{'form.unamedom'.$ctr}); + my ($errorflg) = &saveHandGrade($request,$url,$symb,$uname,$udom,$ctr); + return '' if ($errorflg eq 'error'); + + my $includemsg = $ENV{'form.includemsg'.$ctr}; + my ($subject,$message,$msgstatus) = ('','',''); + if ($includemsg =~ /savemsg|new$ctr/) { + $subject = $ENV{'form.msgsub'} if ($includemsg =~ /^msgsub/); + my (@msgnum) = split(/,/,$includemsg); + foreach (@msgnum) { + $message.=$ENV{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne ''); + } + $message =~ s/\s+/ /g; + $msgstatus = &Apache::lonmsg::user_normal_msg ($uname,$udom,$ENV{'form.msgsub'},$message); + } + if ($ENV{'form.collaborator'.$ctr}) { + my (@collaborators) = split(/:/,$ENV{'form.collaborator'.$ctr}); + foreach (@collaborators) { + &saveHandGrade($request,$url,$symb,$_,$udom,$ctr); + if ($message ne '') { + $msgstatus = &Apache::lonmsg::user_normal_msg ($uname,$udom,$ENV{'form.msgsub'},$message); + } + } + } + $ctr++; + } + } + my $firststu = $ENV{'form.unamedom0'}; + my $laststu = $ENV{'form.unamedom'.($ngrade-1)}; + $ctr = 2; + while ($laststu eq '') { + $laststu = $ENV{'form.unamedom'.($ngrade-$ctr)}; + $ctr++; + $laststu = $firststu if ($ctr > $ngrade); + } + my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist($ENV{'form.section'},'0'); + + my (@parsedlist,@nextlist); + my ($nextflg) = 0; + foreach ( sort(@{ $$classlist{$ENV{'form.section'}} }) ) { + if ($nextflg == 1 && $button =~ /Next$/) { + push @parsedlist,$_; + } + $nextflg = 1 if ($_ eq $laststu); + if ($button eq 'Previous') { + last if ($_ eq $firststu); + push @parsedlist,$_; + } + } + $ctr = 0; + my ($partlist,$handgrade) = &response_type($ENV{'form.url'}); + @parsedlist = reverse @parsedlist if ($button eq 'Previous'); + foreach my $student (@parsedlist) { + my ($uname,$udom) = split(/:/,$student); + if ($ENV{'form.submitonly'} eq 'yes') { + my (%status) = &student_gradeStatus($ENV{'form.url'},$udom,$uname,$partlist) ; + my $statusflg = ''; + foreach (keys(%status)) { + $statusflg = 1 if ($status{$_} ne 'nothing'); + } + next if ($statusflg eq ''); + } + push @nextlist,$student if ($ctr < $ntstu); + $ctr++; + } + + $ctr = 0; + my $total = scalar(@nextlist)-1; + foreach (sort @nextlist) { + my ($uname,$udom) = split(/:/); + $ENV{'form.student'} = $uname; + $ENV{'form.fullname'} = $$fullname{$_}; + &submission($request,$ctr,$total); + $ctr++; + } + if ($total < 0) { + my $the_end = '

LON-CAPA User Message


'."\n"; + $the_end.='Message: No more students for this section or class.

'."\n"; + $the_end.='Click on the button below to return to the grading menu.

'."\n"; + $the_end.=&show_grading_menu_form ($symb,$url); + $request->print($the_end); + } + 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); } - if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } - return ($symb,$url); +sub saveHandGrade { + my ($request,$url,$symb,$stuname,$domain,$newflg) = @_; +# my %record=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},$domain,$stuname); + my %newrecord; + foreach (split(/:/,$ENV{'form.partlist'.$newflg})) { + if ($ENV{'form.GRADE_SEL'.$newflg.'_'.$_} eq 'excused') { + $newrecord{'resource.'.$_.'.solved'} = 'excused'; + } else { + my $pts = ($ENV{'form.GRADE_BOX'.$newflg.'_'.$_} ne '' ? + $ENV{'form.GRADE_BOX'.$newflg.'_'.$_} : $ENV{'form.RADVAL'.$newflg.'_'.$_}); + if ($pts eq '') { + &userError($request,'No point was assigned for part id '.$_.' and for username '.$stuname.'.'); + return 'error'; + } + my $wgt = $ENV{'form.WGT'.$newflg.'_'.$_} eq '' ? 1 : $ENV{'form.WGT'.$newflg.'_'.$_}; + my $partial= $pts/$wgt; + $newrecord{'resource.'.$_.'.awarded'} = $partial; + if ($partial == 0) { + $newrecord{'resource.'.$_.'.solved'} = 'incorrect_by_override'; + } else { + $newrecord{'resource.'.$_.'.solved'} = 'correct_by_override'; + } + } + } + + 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"; +# } + &Apache::lonnet::cstore(\%newrecord,$symb,$ENV{'request.course.id'},$domain,$stuname); + } + return ''; } -sub view_edit_entire_class_form { - my ($symb,$url)=@_; - my $result.='
'."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - '
'."\n"; - return $result; +sub get_symb_and_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 show_grading_menu_form { @@ -416,31 +865,164 @@ sub gradingmenu { my ($request) = @_; my ($symb,$url)=&get_symb_and_url($request); if (!$symb) {return '';} + my $result='

 Select a Grading Method

'; + $result.=''; + $result.=''; + my ($partlist,$handgrade) = &response_type($url); + my ($resptype,$hdgrade)=('','no'); + for (sort keys(%$handgrade)) { + my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_}); + $resptype = $responsetype; + $hdgrade = $handgrade if ($handgrade eq 'yes'); + $result.=''. + ''. + ''; + } + $result.='
Resource: '.$url.'
Part id: '.$_.'Type: '.$responsetype.'Handgrade: '.$handgrade.'
'; + $result.=&view_edit_entire_class_form($symb,$url).'
'; + $result.=&upcsvScores_form($symb,$url).'
'; + $result.=&viewGradeaStu_form($symb,$url,$resptype,$hdgrade).'
'; + $result.=&verifyReceipt_form($symb,$url).'
'; + $result.=&view_classlist_form($symb,$url); - my $result='

 Select a Grading Method


'; - $result.='
'."\n"; - $result.=''."\n"; + return $result; +} + +sub view_classlist_form { + my ($symb,$url)=@_; + my $result.='
'."\n"; - $result.=' Resource : '.$url.'
'."\n"; + $result.=''."\n"; $result.='
'."\n"; + $result.=' View Class List
'."\n"; - $result.=&view_edit_entire_class_form($symb,$url); $result.='
'."\n". - ''."\n". + ''."\n". ''."\n". - ''."\n". - ''."\n". - '
'."\n"; + ''."\n"; + $result.=' '."\n"; + $result.='
'."\n"; + $result.='
'."\n"; + return $result; +} + +sub viewclasslist { + my ($request) = shift; + my ($coursedomain,$coursenum) = split(/_/,$ENV{'request.course.id'}); + my %classlist=&Apache::lonnet::dump('classlist',$coursedomain,$coursenum); + $request->print(''); + foreach (sort keys(%classlist)) { +# my ($unam,$udom) = split(/:/,$_,2); +# my $section = &Apache::lonnet::usection($udom,$unam,$ENV{'request.course.id'}); +# my $fullname = &get_fullname ($unam,$udom); +# my @uname; +# $uname[0]=$unam; +# my %userid=&Apache::lonnet::idrget($udom,@uname); +# my $value=$classlist{$_}.':'.$userid{$unam}.':'.$section.':'.$fullname; +# $classlist{$_}=$value; + $request->print(''); + } + $request->print('
'.$_.' 
 '.$classlist{$_}.'
'); +# my $putresult = &Apache::lonnet::put +# ('classlist',\%classlist, +# $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, +# $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + + return ''; +} + +sub view_edit_entire_class_form { + my ($symb,$url)=@_; + my $result.='
'."\n"; + $result.=''."\n"; + $result.='
'."\n"; + $result.=' View/Grade Entire Class
'."\n"; $result.='
'."\n". - ''."\n". + ''."\n". ''."\n". - ''."\n". - ''."\n". - '
'."\n"; + ''."\n"; + $result.=' Display students who has: '. + ' submitted'. + ' everybody

'; + $result.=' '."\n"; + $result.='
'."\n"; + $result.='
'."\n"; + return $result; +} + +sub upcsvScores_form { + my ($symb,$url) = @_; + if (!$symb) {return '';} + my $result.='
'."\n"; + $result.=''."\n"; + $result.='
'."\n"; + $result.=' Specify a file containing the class scores for above resource
'."\n"; + my $upfile_select=&Apache::loncommon::upfile_select_html(); + $result.=< + + + +$upfile_select +
  + +ENDUPFORM + $result.='
'."\n"; + $result.='
'."\n"; + return $result; +} + +sub viewGradeaStu_form { + my ($symb,$url,$response,$handgrade) = @_; + my ($classlist,$sections) = &getclasslist('all','0'); + my $result.='
'."\n"; + $result.=''."\n"; + $result.='
'."\n"; + $result.=' View/Grade an Individual Student\'s Submission
'."\n"; $result.='
'."\n". - ''."\n". + ''."\n". ''."\n". - ''."\n". - ''."\n". - '
'."\n"; + ''."\n". + ''."\n". + ''."\n"; + + $result.=' Select section: '."\n"; + $result.='  Display students who has: '. + ' submitted'. + ' everybody
'; + $result.=' (Section "no" implies the students were not assigned a section.)
' + if (grep /no/,@$sections); + + $result.='
 '."\n". + ''."\n"; + $result.='
'."\n"; + $result.='
'."\n"; + return $result; +} + +sub verifyReceipt_form { + my ($symb,$url) = @_; + 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'}); + + my $result.='
'."\n"; + $result.=''."\n"; + $result.='
'."\n"; + $result.=' Verify a Submission Receipt Issued by this Server
'."\n"; + $result.='
'."\n"; + $result.=' '.$hostver.'-
'."\n"; + $result.=' '."\n"; + $result.=''."\n"; + if ($ENV{'form.url'}) { + $result.=''; + } + if ($ENV{'form.symb'}) { + $result.=''; + } + $result.='
'; $result.='
'."\n"; $result.='
'."\n"; return $result; @@ -456,9 +1038,9 @@ sub viewgrades { #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"'; + my ($classlist) = &getclasslist('all','0'); + my $headerclr = '"#ddffff"'; + my $cellclr = '"#ffffdd"'; #get list of parts for this problem my (@parts) = sort(&getpartlist($url)); @@ -471,9 +1053,9 @@ sub viewgrades { ''."\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'); } @@ -481,10 +1063,13 @@ sub viewgrades { } $result.=''; #get info for each student - foreach my $student ( sort(@{ $classlist{'allids'} }) ) { + foreach my $student ( sort(@{ $$classlist{'all'} }) ) { +# my $display=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts); +# print "ID=$ENV{'request.course.id'}:STU=$student:DIS=$display:
\n"; $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts); } - $result.='
UsernameNameDomain
UsernameFullnameDomain
'; + $result.='
'; + $result.=''; $result.=&show_grading_menu_form($symb,$url); return $result; } @@ -497,9 +1082,9 @@ sub editgrades { 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 ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); #print "Found $cdom:$cnum
"; - my (%classlist) = &getclasslist($cdom,$cnum,'0'); + my ($classlist) = &getclasslist('all','0'); #get list of parts for this problem my (@parts) = &getpartlist($url); @@ -510,7 +1095,7 @@ sub editgrades { ''."\n". '
'."\n"; - foreach my $student ( sort(@{ $classlist{'allids'} }) ) { + foreach my $student ( sort(@{ $$classlist{'all'} }) ) { $result.=&setstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts); } @@ -518,23 +1103,307 @@ sub editgrades { return $result; } -sub csvupload { - my ($request)= @_; - my $result; - my ($symb,$url)=&get_symb_and_url($request); - if (!$symb) {return '';} - my $upfile_select=&Apache::loncommon::upfile_select_html(); - $result.=< - - - -
-

Specify a file containing the class grades for resource $url

-$upfile_select -

-ENDUPFORM - return $result; +sub sub_page_js { + my $request = shift; + $request->print(< + function updateRadio(radioButton,formtextbox,formsel,scores) { + 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"+msgchk); + re = /msgsub/; + var shwsel = ""; + if (re.test(msgchk)) { shwsel = "checked" } + displaySubject(subject,shwsel); + for (var i=1; i<=Nmsg; i++) { + var testpt = "savemsg"+i+","; + re = /testpt/; + shwsel = ""; + if (re.test(msgchk)) { shwsel = "checked" } + var message = eval("document.SCORE.savemsg"+i+".value"); + displaySavedMsg(i,message,shwsel); + } + newmsg = eval("document.SCORE.newmsg"+usrctr+".value"); + shwsel = ""; + re = /newmsg/; + if (re.test(msgchk)) { shwsel = "checked" } + newMsg(newmsg,shwsel); + msgTail(); + return; + } + + function savedMsgHeader(Nmsg,usrctr,fullname) { + var height = 30*Nmsg+250; + var scrollbar = "no"; + if (height > 600) { + height = 600; + scrollbar = "yes"; + } +/* if (window.pWin) + window.pWin.close(); */ + pWin = window.open('', 'MessageCenter', 'toolbar=no,location=no,scrollbars='+scrollbar+',screenx=70,screeny=75,width=600,height='+height); + pWin.document.write(""); + pWin.document.write("Message Central"); + + pWin.document.write(" +SUBJAVASCRIPT } sub csvupload_javascript_reverse_associate { @@ -729,16 +1598,16 @@ sub csvuploadassign { } $request->print('

Assigning Grades

'); my $courseid=$ENV{'request.course.id'}; - my $cdom=$ENV{"course.$courseid.domain"}; - my $cnum=$ENV{"course.$courseid.num"}; - my (%classlist) = &getclasslist($cdom,$cnum,'1'); +# my $cdom=$ENV{"course.$courseid.domain"}; +# my $cnum=$ENV{"course.$courseid.num"}; + my ($classlist) = &getclasslist('all','1'); my @skipped; my $countdone=0; foreach my $grade (@gradedata) { my %entries=&Apache::loncommon::record_sep($grade); my $username=$entries{$fields{'username'}}; my $domain=$entries{$fields{'domain'}}; - if (!exists($classlist{"$username:$domain"})) { + if (!exists($$classlist{"$username:$domain"})) { push(@skipped,"$username:$domain"); next; } @@ -837,21 +1706,27 @@ sub handler { $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 ''); + &submission($request,0,0) if ($ENV{'form.student'} ne ''); + } elsif ($command eq 'processGroup') { + &processGroup($request); } elsif ($command eq 'gradingmenu') { $request->print(&gradingmenu($request)); } elsif ($command eq 'viewgrades') { $request->print(&viewgrades($request)); + } elsif ($command eq 'handgrade') { + $request->print(&processHandGrade($request)); } elsif ($command eq 'editgrades') { $request->print(&editgrades($request)); } elsif ($command eq 'verify') { $request->print(&verifyreceipt($request)); } elsif ($command eq 'csvupload') { $request->print(&csvupload($request)); + } elsif ($command eq 'viewclasslist') { + $request->print(&viewclasslist($request)); } elsif ($command eq 'csvuploadmap') { $request->print(&csvuploadmap($request)); - } elsif ($command eq 'receiptInput') { - &receiptInput($request); +# } elsif ($command eq 'receiptInput') { +# &receiptInput($request); } elsif ($command eq 'csvuploadassign') { if ($ENV{'form.associate'} ne 'Reverse Association') { $request->print(&csvuploadassign($request));