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

Verifying Submission Receipt '.$receipt.'

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

'.$matches." match%s

",$matches <= 1 ? '' : 'es'); # needs to print who is matched } 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 $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(<  View Problem: no yes
 Submissions: last sub only last sub & parts info all details ENDTABLEST 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='
'. ''. ''. ''; 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' ) { $result=''. ''."\n". ''."\n". ''."\n". ''."\n"; foreach (sort keys(%status)) { $result.=''."\n"; } $request->print($result.''."\n"); } } $request->print('
 Select  Username  Fullname  Domain  Part ID '.$_.' Status 
 '.$uname.'  '.$$fullname{$student}.'  '.$udom.'  '.$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 ($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' ) { my ($classlist) = &getclasslist('all','0'); foreach ( sort(@{ $$classlist{'all'} }) ) { my ($posname,$posdomain) = split(/:/); if ($posname =~ $name) { $name=$posname; $domain=$posdomain; last; } } return ($name,$domain); } else { return ($ENV{'user.name'},$ENV{'user.domain'}); } } sub getclasslist { 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 { my ($url) = @_; my @parts =(); my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); foreach my $key (@metakeys) { if ( $key =~ m/stores_([0-9]+)_.*/) { push(@parts,$key); } } return @parts; } sub viewstudentgrade { my ($url,$symb,$courseid,$student,@parts) = @_; my $cellclr = '"#ffffdd"'; my ($username,$domain) = split(/:/,$student); my $fullname = &get_fullname($username,$domain); my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$username); my $result="$username$fullname$domain\n"; foreach my $part (@parts) { my ($temp,$part,$type)=split(/_/,$part); my $score=$record{"resource.$part.$type"}; if ($type eq 'awarded' || $type eq 'tries') { $result.=''."\n"; } elsif ($type eq 'solved') { my ($status,$foo)=split(/_/,$score,2); $result.="\n"; } } $result.=''; return $result; } #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' ) { 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'; } # if ($newscore eq 'partial') { $newscore = 'correct_partially_by_override'; } } 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; } # # --------------------------- show submissions of a student, option to grade -------- sub submission { 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=($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.='
'; $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 @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"; } } $result.='
Fullname: '.$fullname. '   Username: '.$uname. '   Domain: '.$udom.'
Collaborators: '; foreach (@collaborators) { $result.=$_.' ('.&get_fullname($_,$udom).')    '; } $result.='
'."\n"; $request->print($result); my ($partlist,$handgrade) = &response_type($url); # print student answer if ($ENV{'form.lastSub'} eq 'lastonly') { my ($string,$timestamp)=&get_last_submission ($symb,$uname,$udom,$ENV{'request.course.id'}); my $lastsubonly='
'; $lastsubonly.=''; $lastsubonly.=''; 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.=''; } } } } $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; 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 %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); my $score = ($record{'resource.0.awarded'} eq '' ? '' : $record{'resource.0.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.='
'; $request->print($result); } $request->print(''."\n"); $request->print('
'."\n"); # 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 ''; } 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; } } 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; } 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; while ($ctr < $ntstu) { ($ENV{'form.student'},my $udom) = split(/:/,$ENV{'form.unamedom'.$ctr}); &submission($request,$ctr,$ntstu-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)}; my ($classlist) = &getclasslist($ENV{'form.section'},'0'); my (@nextlist,@prevlist); my ($nextflg,$ctr,$ctprev) = (0,0,0); my ($partlist,$handgrade) = &response_type($ENV{'form.url'}); foreach my $student ( sort(@{ $$classlist{$ENV{'form.section'}} }) ) { 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 '' && $ENV{'form.submitonly'} eq 'yes'); if ($nextflg == 1 && $button =~ /Next$/) { push @nextlist,$uname if ($ctr < $ntstu); $ctr++; last if ($ctr == $ntstu); } $nextflg = 1 if ($student eq $laststu); if ($button eq 'Previous') { last if ($student eq $firststu); push @prevlist,$uname; $ctprev++; } } if ($button eq 'Previous') { if ($ctprev <= $ntstu) { @nextlist = @prevlist; } else { my $idx = 0; my $start = $ctprev - $ntstu; while ($idx < $ntstu) { $nextlist[$idx] = $prevlist[$start+$idx]; $idx++; } } } $ctr = 0; my $total = scalar(@nextlist)-1; foreach my $student (@nextlist) { $ENV{'form.student'} = $student; &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 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 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 { my ($symb,$url)=@_; my $result.='
'."\n". ''."\n". ''."\n". ''."\n". ''."\n". '
'."\n"; return $result; } 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); return $result; } sub view_classlist_form { my ($symb,$url)=@_; my $result.='
'."\n"; $result.=''."\n"; $result.='
'."\n"; $result.=' View Class List
'."\n"; $result.='
'."\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"; $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"; $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; } sub viewgrades { my ($request) = @_; my $result=''; #get resource reference my ($symb,$url)=&get_symb_and_url($request); if (!$symb) {return '';} #get classlist my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); #print "Found $cdom:$cnum
"; my ($classlist) = &getclasslist('all','0'); my $headerclr = '"#ddffff"'; my $cellclr = '"#ffffdd"'; #get list of parts for this problem my (@parts) = sort(&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{'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.='
UsernameFullnameDomain'.$display.'
'; $result.='
'; $result.=&show_grading_menu_form($symb,$url); return $result; } sub editgrades { my ($request) = @_; my $result=''; my $symb=$ENV{'form.symb'}; if ($symb eq '') { $request->print("Unable to handle ambiguous references:$symb:$ENV{'form.url'}"); return ''; } my $url=$ENV{'form.url'}; #get classlist # my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); #print "Found $cdom:$cnum
"; my ($classlist) = &getclasslist('all','0'); #get list of parts for this problem my (@parts) = &getpartlist($url); $result.='
'."\n". ''."\n". ''."\n". ''."\n". '
'."\n"; foreach my $student ( sort(@{ $$classlist{'all'} }) ) { $result.=&setstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts); } $result.='
'; 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 { return(<2) { foundsomething=1; } } if (founduname==0 || founddomain==0) { alert('You need to specify at both the username and domain'); return; } if (foundsomething==0) { alert('You need to specify at least one grading field'); return; } vf.submit(); } function flip(vf,tf) { var nw=eval('vf.f'+tf+'.selectedIndex'); var i; //can not pick the same destination field twice for (i=0;i<=vf.nfields.value;i++) { if ((i!=tf) && (eval('vf.f'+i+'.selectedIndex')==nw)) { eval('vf.f'+i+'.selectedIndex=0;') } } } ENDPICK } sub csvuploadmap_header { my ($request,$symb,$url,$datatoken,$distotal)= @_; my $result; my $javascript; if ($ENV{'form.upfile_associate'} eq 'reverse') { $javascript=&csvupload_javascript_reverse_associate(); } else { $javascript=&csvupload_javascript_forward_associate(); } $request->print(<

Uploading Class Grades for resource $url


Identify fields

Total number of records found in file: $distotal
Enter as many fields as you can. The system will inform you and bring you back to this page if the data selected is insufficient to run your class.

ENDPICK return ''; } sub csvupload_fields { my ($url) = @_; my (@parts) = &getpartlist($url); my @fields=(['username','Student Username'],['domain','Student Domain']); foreach my $part (sort(@parts)) { my @datum; my $display=&Apache::lonnet::metadata($url,$part.'.display'); my $name=$part; if (!$display) { $display = $name; } @datum=($name,$display); push(@fields,\@datum); } return (@fields); } sub csvuploadmap_footer { my ($request,$i,$keyfields) =@_; $request->print(<
ENDPICK } sub csvuploadmap { my ($request)= @_; my ($symb,$url)=&get_symb_and_url($request); if (!$symb) {return '';} my $datatoken; if (!$ENV{'form.datatoken'}) { $datatoken=&Apache::loncommon::upfile_store($request); } else { $datatoken=$ENV{'form.datatoken'}; &Apache::loncommon::load_tmp_file($request); } my @records=&Apache::loncommon::upfile_record_sep(); &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1); my $i; my $keyfields; if (@records) { my @fields=&csvupload_fields($url); if ($ENV{'form.upfile_associate'} eq 'reverse') { &Apache::loncommon::csv_print_samples($request,\@records); $i=&Apache::loncommon::csv_print_select_table($request,\@records, \@fields); foreach (@fields) { $keyfields.=$_->[0].','; } chop($keyfields); } else { unshift(@fields,['none','']); $i=&Apache::loncommon::csv_samples_select_table($request,\@records, \@fields); my %sone=&Apache::loncommon::record_sep($records[0]); $keyfields=join(',',sort(keys(%sone))); } } &csvuploadmap_footer($request,$i,$keyfields); return ''; } sub csvuploadassign { my ($request)= @_; my ($symb,$url)=&get_symb_and_url($request); if (!$symb) {return '';} &Apache::loncommon::load_tmp_file($request); my @gradedata=&Apache::loncommon::upfile_record_sep(); my @keyfields = split(/\,/,$ENV{'form.keyfields'}); my %fields=(); for (my $i=0; $i<=$ENV{'form.nfields'}; $i++) { if ($ENV{'form.upfile_associate'} eq 'reverse') { if ($ENV{'form.f'.$i} ne 'none') { $fields{$keyfields[$i]}=$ENV{'form.f'.$i}; } } else { if ($ENV{'form.f'.$i} ne 'none') { $fields{$ENV{'form.f'.$i}}=$keyfields[$i]; } } } $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('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"})) { push(@skipped,"$username:$domain"); next; } my %grades; foreach my $dest (keys(%fields)) { if ($dest eq 'username' || $dest eq 'domain') { next; } if ($entries{$fields{$dest}} eq '') { next; } my $store_key=$dest; $store_key=~s/^stores/resource/; $store_key=~s/_/\./g; $grades{$store_key}=$entries{$fields{$dest}}; } $grades{"resource.regrader"}="$ENV{'user.name'}:$ENV{'user.domain'}"; &Apache::lonnet::cstore(\%grades,$symb,$ENV{'request.course.id'}, $domain,$username); $request->print('.'); $request->rflush(); $countdone++; } $request->print("
Stored $countdone students\n"); if (@skipped) { $request->print('
Skipped Students
'); foreach my $student (@skipped) { $request->print("
$student"); } } $request->print(&view_edit_entire_class_form($symb,$url)); $request->print(&show_grading_menu_form($symb,$url)); return ''; } sub send_header { my ($request)= @_; $request->print(&Apache::lontexconvert::header()); # $request->print(" #"); $request->print(''); } sub send_footer { my ($request)= @_; $request->print(''); $request->print(&Apache::lontexconvert::footer()); } sub handler { my $request=$_[0]; if ($ENV{'browser.mathml'}) { $request->content_type('text/xml'); } else { $request->content_type('text/html'); } $request->send_http_header; return OK if $request->header_only; &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}); my $url=$ENV{'form.url'}; my $symb=$ENV{'form.symb'}; my $command=$ENV{'form.command'}; if (!$url) { my ($temp1,$temp2); ($temp1,$temp2,$ENV{'form.url'})=split(/___/,$symb); $url = $ENV{'form.url'}; } &send_header($request); if ($url eq '' && $symb eq '') { if ($ENV{'user.adv'}) { if (($ENV{'form.codeone'}) && ($ENV{'form.codetwo'}) && ($ENV{'form.codethree'})) { my $token=$ENV{'form.codeone'}.'*'.$ENV{'form.codetwo'}.'*'. $ENV{'form.codethree'}; my ($tsymb,$tuname,$tudom,$tcrsid)= &Apache::lonnet::checkin($token); if ($tsymb) { my ($map,$id,$url)=split(/\_\_\_/,$tsymb); if (&Apache::lonnet::allowed('mgr',$tcrsid)) { $request->print( &Apache::lonnet::ssi('/res/'.$url, ('grade_username' => $tuname, 'grade_domain' => $tudom, 'grade_courseid' => $tcrsid, 'grade_symb' => $tsymb))); } else { $request->print('

Not authorized: '.$token.'

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

Not a valid DocID: '.$token.'

'); } } else { $request->print(&Apache::lonxml::tokeninputfield()); } } } else { #&Apache::lonhomework::showhashsubset(\%ENV,'^form'); $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}); if ($command eq 'submission') { &listStudents($request) if ($ENV{'form.student'} eq ''); &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 'csvuploadassign') { if ($ENV{'form.associate'} ne 'Reverse Association') { $request->print(&csvuploadassign($request)); } else { if ( $ENV{'form.upfile_associate'} ne 'reverse' ) { $ENV{'form.upfile_associate'} = 'reverse'; } else { $ENV{'form.upfile_associate'} = 'forward'; } $request->print(&csvuploadmap($request)); } } else { $request->print("Unknown action: $command:"); } } &send_footer($request); return OK; } 1; __END__;