# The LearningOnline Network with CAPA # The LON-CAPA Grading handler # # $Id: grades.pm,v 1.38 2002/07/10 21:08:38 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) = @_; 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); foreach my $part (&getpartlist($url)) { 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; } } 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 $getsec =$ENV{'form.section'}; my $submitonly=$ENV{'form.submitonly'}; $request->print(< 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
ENDTABLEST 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 $fullname = &get_fullname($sname,$sdom); if ( $Apache::grades::viewgrades eq 'F' ) { $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.'  '.$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' ) { 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 ($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)) { next; } 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,\@sections); } 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 $result =''; my $cellclr = '"#ffffdd"'; my ($username,$domain) = split(/:/,$student); my $fullname = &get_fullname($username,$domain); my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$username); $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 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); # display grading options $result=''. ''."\n"; $result.=''."\n"; $result.=''."\n"; $result.=''; $result.=''."\n"; $result.='
Points'; my $ctr = 0; $result.=''; # display radio buttons in a nice table with 10 across while ($ctr<=$wgt) { $result.= '\n"; $result.=(($ctr+1)%10 == 0 ? '' : ''); $ctr++; } $result.='
'.$ctr."
'; $result.='
 or /'.$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.='Compose Message
'."\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); } return ''; } sub get_last_submission { my ($symb,$username,$domain,$course)=@_; if ($symb) { my (@string,@timestamp); my (%returnhash)=&Apache::lonnet::restore($symb,$course,$domain,$username); if ($returnhash{'version'}) { my %lasthash=(); my ($version); for ($version=1;$version<=$returnhash{'version'};$version++) { foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) { $lasthash{$_}=$returnhash{$version.':'.$_}; } } foreach ((keys %lasthash)) { print "lasthash key=$_
"; if ($_ =~ /\.submission$/) {push @string, $_,$lasthash{$_}} if ($_ =~ /timestamp/) {push @timestamp, scalar(localtime($lasthash{$_}))}; # if ($_ =~ /\.submission$/) {$string = $lasthash{$_}} # if ($_ =~ /timestamp/) {$timestamp=scalar(localtime($lasthash{$_}))}; } } @string = $string[0] eq '' ? 'Nothing submitted - no attempts.' : @string; return \@string,\@timestamp; } } sub keywords_highlight { my $string = shift; my $size = $ENV{'form.kwsize'} eq '0' ? '' : 'size='.$ENV{'form.kwsize'}; my $styleon = $ENV{'form.kwstyle'} eq '' ? '' : $ENV{'form.kwstyle'}; (my $styleoff = $styleon) =~ s/\$styleon$_$styleoff\<\/font\>/gi; } return $string; } sub processHandGrade { my ($request) = shift; my $url = $ENV{'form.url'}; my $symb = $ENV{'form.symb'}; my $button = $ENV{'form.gradeOpt'}; my $ngrade = $ENV{'form.NCT'}; my $ntstu = $ENV{'form.NTSTU'}; my $loginuser = $ENV{'user.name'}.':'.$ENV{'user.domain'}; my %keyhash = (); $ENV{'form.keywords'} =~ s/,\s{0,}|\s+/ /g; $keyhash{$symb.'_handgrade'} = 'activated'; $keyhash{$symb.'_keywords'} = $ENV{'form.keywords'}; $keyhash{$symb.'_subject'} = $ENV{'form.msgsub'}; $keyhash{$loginuser.'_kwclr'} = $ENV{'form.kwclr'}; $keyhash{$loginuser.'_kwsize'} = $ENV{'form.kwsize'}; $keyhash{$loginuser.'_kwstyle'} = $ENV{'form.kwstyle'}; my ($ctr,$idx) = (1,1); while ($ctr <= $ENV{'form.savemsgN'}) { if ($ENV{'form.savemsg'.$ctr} ne '') { $keyhash{$symb.'_savemsg'.$idx} = $ENV{'form.savemsg'.$ctr}; $idx++; } $ctr++; } $ctr = 0; while ($ctr < $ngrade) { if ($ENV{'form.newmsg'.$ctr} ne '') { $keyhash{$symb.'_savemsg'.$idx} = $ENV{'form.newmsg'.$ctr}; $ENV{'form.savemsg'.$idx} = $ENV{'form.newmsg'.$ctr}; $idx++; } $ctr++; } $ENV{'form.savemsgN'} = --$idx; $keyhash{$symb.'_savemsgN'} = $ENV{'form.savemsgN'}; my $putresult = &Apache::lonnet::put ('nohist_handgrade',\%keyhash, $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); my (@parts) = sort(&getpartlist($url)); if ($button eq 'Save & Next') { my $ctr = 0; while ($ctr < $ngrade) { my ($uname,$udom) = split(/:/,$ENV{'form.unamedom'.$ctr}); &saveHandGrade($url,$symb,$uname,$udom,$ctr,@parts); 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($url,$symb,$_,$udom,$ctr,@parts); 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,$prevflg,$ctr,$ctprev) = (0,0,0,0); foreach my $student ( sort(@{ $$classlist{$ENV{'form.section'}} }) ) { my ($uname,$udom) = split(/:/,$student); my ($type,$status) = &student_gradeStatus($ENV{'form.url'},$udom,$uname); next if ($status eq 'nothing' && $ENV{'form.submitonly'} eq 'yes'); if ($nextflg == 1 && $button =~ /Next$/) { push @nextlist,$uname if ($ctr < $ntstu); $ctr++; } $nextflg = 1 if ($student eq $laststu); $prevflg = 1 if ($student eq $firststu); if ($prevflg == 0 && $button eq 'Previous') { 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 ($url,$symb,$stuname,$domain,$newflg,@parts) = @_; my %record=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},$domain,$stuname); my %newrecord; foreach my $part (@parts) { my ($temp,$part,$type)=split(/_/,$part); my $oldscore=$record{"resource.$part.$type"}; my $newscore; if ($type eq 'awarded' && $newflg >= 0) { my $pts = ($ENV{'form.GRADE_BOX'.$newflg} ne '' ? $ENV{'form.GRADE_BOX'.$newflg} : $ENV{'form.RADVAL'.$newflg}); my $wgt = $ENV{'form.WGT'.$newflg}; # my $sel = $ENV{'form.GRADE_SEL'.$newflg}; $newscore = $pts/$wgt if ($wgt != 0); } if ($type eq 'solved') { $newscore = $ENV{'form.GRADE_SEL'.$newflg} if ($newflg >= 0); my $update=0; if ($newscore eq 'nothing' ) { if ($oldscore ne '') { $update=1; $newscore = ''; } } elsif ($oldscore !~ m/^$newscore/) { $update=1; if ($newscore eq 'correct') { $newscore = 'correct_by_override'; } if ($newscore eq 'incorrect') { $newscore = 'incorrect_by_override'; } if ($newscore eq 'excused') { $newscore = 'excused'; } if ($newscore eq 'ungraded') { $newscore = 'ungraded_attempted'; } if ($newscore eq 'partial') { $newscore = 'correct_partially_by_override'; } } if ($update) { $newrecord{"resource.$part.$type"}=$newscore; } } else { if ($oldscore ne $newscore) { $newrecord{"resource.$part.$type"}=$newscore; } } } if ( scalar(keys(%newrecord)) > 0 ) { $newrecord{'resource.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; # while (my ($k,$v) = each %newrecord) { # print "k=$k:v=$v:
\n"; # } # print "symb=$symb,courseid=$ENV{'request.course.id'},dom=$domain,name=$stuname
"; # &Apache::lonnet::cstore(\%newrecord,$symb,$ENV{'request.course.id'},$domain,$stuname); } return ''; } sub get_symb_and_url { my ($request) = @_; (my $url=$ENV{'form.url'}) =~ 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 $allkeys = &Apache::lonnet::metadata($url,'keys'); my $handgrade = ($allkeys =~ /parameter_.*?_handgrade/ ? 'yes' : 'no'); my ($responsetype,$foo) = split(/_/,&Apache::lonnet::metadata($url,'packages')); $allkeys=~s/,/\/g; # print "allkeys=$allkeys

"; $Apache::lonxml::debug=1; &Apache::lonxml::debug(join(':',&Apache::lonnet::metadata($url,'packages'))); $Apache::lonxml::debug=0; my $result='

 Select a Grading Method

'; $result.=''; $result.=''. ''; $result.=''. ''; $result.='
Resource: '.$url.'
Type: '.$responsetype.'  Handgrade: '.$handgrade.'
'; my $t0=&Time::HiRes::time(); $result.=&view_edit_entire_class_form($symb,$url).'
'; my $t1=&Time::HiRes::time(); print "elapsed10=",$t1-$t0,"
"; $result.=&upcsvScores_form($symb,$url).'
'; my $t2=&Time::HiRes::time(); print "elapsed21=",$t2-$t1,"
"; $result.=&viewGradeaStu_form($symb,$url,$responsetype,$handgrade).'
'; my $t3=&Time::HiRes::time(); print "elapsed32=",$t3-$t2,"
"; $result.=&verifyReceipt_form($symb,$url); my $t4=&Time::HiRes::time(); print "elapsed43=",$t4-$t3,"
"; print "Total elapsed time=",$t4-$t0,"
"; return $result; } 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 $t3=&Time::HiRes::time(); my ($classlist,$sections) = &getclasslist('all','0'); my $t4=&Time::HiRes::time(); print "elapsed_getclasslist=",$t4-$t3,"
"; 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,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; } function keywords(keyform) { var keywds = keyform.value; var nret = prompt("Keywords list, separated by a space. Add/delete to list if desired.",keywds); if (nret==null) return; keyform.value = nret; return; } //===================== Script to add keyword(s) ================== function getSel() { if (document.getSelection) txt = document.getSelection(); else if (document.selection) txt = document.selection.createRange().text; else return; var cleantxt = txt.replace(new RegExp('([\\f\\n\\r\\t\\v ])+', 'g')," "); if (cleantxt=="") { alert("Select a word or group of words from document and then click this link."); return; } var nret = prompt("Add selection to keyword list? Edit if desired.",cleantxt); if (nret==null) return; var curlist = document.SCORE.keywords.value; document.SCORE.keywords.value = curlist+" "+nret; return; } //====================== Script for composing message ============== function msgCenter(msgform,usrctr,fullname) { var Nmsg = msgform.savemsgN.value; savedMsgHeader(Nmsg,usrctr,fullname); var subject = msgform.msgsub.value; var rtrchk = eval("document.SCORE.includemsg"+usrctr); var msgchk = rtrchk.value; // alert("checked=>"+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 '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__;