--- loncom/homework/grades.pm 2001/04/16 23:34:11 1.5 +++ loncom/homework/grades.pm 2003/07/19 15:11:27 1.120 @@ -1,5 +1,39 @@ +# The LearningOnline Network with CAPA # The LON-CAPA Grading handler +# +# $Id: grades.pm,v 1.120 2003/07/19 15:11:27 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-August H.K. Ng +# Year 2003 +# February, March H.K. Ng +# package Apache::grades; use strict; @@ -7,262 +41,3594 @@ use Apache::style; use Apache::lonxml; use Apache::lonnet; use Apache::loncommon; +use Apache::lonhtmlcommon; +use Apache::lonnavmaps; use Apache::lonhomework; +use Apache::loncoursedata; +use Apache::lonmsg qw(:user_normal_msg); use Apache::Constants qw(:common); +use String::Similarity; -sub moreinfo { - my ($request,$reason) = @_; - $request->print("Unable to process request: $reason"); - if ( $Apache::grades::viewgrades eq 'F' ) { - $request->print('
'."\n"); - $request->print(''."\n"); - $request->print(''."\n"); - $request->print("Student:".''."
\n"); - $request->print("Domain:".''."
\n"); - $request->print(''."
\n"); - $request->print('
'); - } - return ''; +my %oldessays=(); +my %perm=(); + +# ----- These first few routines are general use routines.---- +# +# --- Retrieve the parts that matches stores_\d+ from the metadata file.--- +sub getpartlist { + my ($url) = @_; + my @parts =(); + my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); + foreach my $key (@metakeys) { + if ( $key =~ m/stores_(\w+)_.*/) { + push(@parts,$key); + } + } + return @parts; } +# --- Get the symbolic name of a problem and the url +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); +} -#FIXME - needs to be much smarter -sub finduser { - my ($name) = @_; - - if ( $Apache::grades::viewgrades eq 'F' ) { - return ($name,$ENV{'user.domain'}); - } else { - return ($ENV{'user.name'},$ENV{'user.domain'}); - } +# --- Retrieve the fullname for a user. Return lastname, first middle --- +# --- Generation is attached next to the lastname if it exists. --- +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 = &Apache::loncoursedata::ProcessFullName + (@name{qw/lastname generation firstname middlename/}); + } else { + &Apache::lonnet::logthis('grades.pm: no name data for '.$uname. + '@'.$udom.':'.$tmp); + } + return $fullname; +} + +#--- Get the partlist and the response type for a given problem. --- +#--- Indicate if a response type is coded handgraded or not. --- +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_\w+.*/) { + my ($responsetype,$part) = split(/_/,$_,2); + my ($partid,$respid) = split(/_/,$part); + $responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!! + $handgrade{$part} = $responsetype.':'.($allkeys =~ /parameter_$part\_handgrade/ ? 'yes' : 'no'); + next if ($seen{$partid} > 0); + $seen{$partid}++; + push @partlist,$partid; + } + } + return \@partlist,\%handgrade; +} + +#--- Show resource title +#--- and parts and response type +sub showResourceInfo { + my ($url,$probTitle) = @_; + my $result =''. + ''."\n"; + 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.='
Current Resource: '.$probTitle.'
Part '.(split(/_/))[0].'Type: '.$responsetype.'
Handgrade: '.$handgrade.'
'."\n"; + return $result,$resptype,$hdgrade,$partlist,$handgrade; +} + +#--- Clean response type for display +#--- Currently filters option response type only. +sub cleanRecord { + my ($answer,$response) = @_; + if ($response eq 'option') { + my (@IDs,@ans); + foreach (split(/\&/,&Apache::lonnet::unescape($answer))) { + my ($optionID,$ans) = split(/=/); + push @IDs,$optionID.''; + push @ans,$ans; + } + my $grayFont = ''; + return ''. + ''. + ''. + '
Answer'. + (join '',@ans).'
'.$grayFont.'Option ID'.$grayFont. + (join ''.$grayFont,@IDs).'
'; + } + return $answer; } +#-- A couple of common js functions +sub commonJSfunctions { + my $request = shift; + $request->print(< + function radioSelection(radioButton) { + var selection=null; + if (radioButton.length > 1) { + for (var i=0; i 1) { + for (var i=0; i +COMMONJSFUNCTIONS +} + +#--- Dumps the class list with usernames,list of sections, +#--- section, ids and fullnames for each user. sub getclasslist { - my ($coursedomain,$coursenum,$coursehome,$hideexpired) = @_; - my $classlist=&Apache::lonnet::reply("dump:$coursedomain:$coursenum:classlist",$coursehome); - my %classlist=(); - my $now = time; - foreach my $record (split /&/, $classlist) { - my ($name,$value)=split(/=/,&Apache::lonnet::unescape($record)); - my ($end,$start)=split(/:/,$value); - # still a student? - if (($hideexpired) && ($end) && ($end < $now)) { - print "Skipping:$name:$end:$now
\n"; - next; + my ($getsec,$filterlist) = @_; + my $classlist=&Apache::loncoursedata::get_classlist(); + # Bail out if we were unable to get the classlist + return if (! defined($classlist)); + # + my %sections; + my %fullnames; + foreach (keys(%$classlist)) { + # the following undefs are for 'domain', and 'username' respectively. + my (undef,undef,$end,$start,$id,$section,$fullname,$status)= + @{$classlist->{$_}}; + # filter students according to status selected + if ($filterlist && $ENV{'form.Status'} ne 'Any') { + if ($ENV{'form.Status'} ne $status) { + delete ($classlist->{$_}); + next; + } + } + $section = ($section ne '' ? $section : 'no'); + if (&canview($section)) { + if ($getsec eq 'all' || $getsec eq $section) { + $sections{$section}++; + $fullnames{$_}=$fullname; + } else { + delete($classlist->{$_}); + } + } else { + delete($classlist->{$_}); + } } - push( @{ $classlist{'allids'} }, $name); - } - return (%classlist); + my %seen = (); + my @sections = sort(keys(%sections)); + return ($classlist,\@sections,\%fullnames); } -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 canmodify { + my ($sec)=@_; + if ($perm{'mgr'}) { + if (!defined($perm{'mgr_section'})) { + # can modify whole class + return 1; + } else { + if ($sec eq $perm{'mgr_section'}) { + #can modify the requested section + return 1; + } else { + # can't modify the request section + return 0; + } + } + } + #can't modify + return 0; } -sub viewstudentgrade { - my ($url,$symb,$courseid,$student,@parts) = @_; - my $result =''; +sub canview { + my ($sec)=@_; + if ($perm{'vgr'}) { + if (!defined($perm{'vgr_section'})) { + # can modify whole class + return 1; + } else { + if ($sec eq $perm{'vgr_section'}) { + #can modify the requested section + return 1; + } else { + # can't modify the request section + return 0; + } + } + } + #can't modify + return 0; +} - my ($stuname,$domain) = split(/:/,$student); +#--- Retrieve the grade status of a student for all the parts +sub student_gradeStatus { + my ($url,$symb,$udom,$uname,$partlist) = @_; + 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; + my $subkey = "resource.$_.submitted_by"; + $partstatus{$subkey} = $record{$subkey} if ($record{$subkey} ne ''); + } + return %partstatus; +} - my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname, - &Apache::lonnet::homeserver($stuname,$domain)); +# hidden form and javascript that calls the form +# Use by verifyscript and viewgrades +# Shows a student's view of problem and submission +sub jscriptNform { + my ($url,$symb) = @_; + my $jscript=''."\n"; + $jscript.= '
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + '
'."\n"; + return $jscript; +} - $result.="$stuname$domain\n"; - foreach my $part (@parts) { - my ($temp,$part,$type)=split(/_/,$part); - #print "resource.$part.$type = ".$record{"resource.$part.$type"}."
\n"; - if ($type eq 'awarded') { - my $score=$record{"resource.$part.$type"}; - $result.="\n"; - } elsif ($type eq 'tries') { - my $score=$record{"resource.$part.$type"}; - $result.="\n" - } elsif ($type eq 'solved') { - my $score=$record{"resource.$part.$type"}; - $result.="\n"; +#------------------ End of general use routines -------------------- + +# +# Find most similar essay +# + +sub most_similar { + my ($uname,$udom,$uessay)=@_; + +# ignore spaces and punctuation + + $uessay=~s/\W+/ /gs; + +# these will be returned. Do not care if not at least 50 percent similar + my $limit=0.6; + my $sname=''; + my $sdom=''; + my $scrsid=''; + my $sessay=''; +# go through all essays ... + foreach my $tkey (keys %oldessays) { + my ($tname,$tdom,$tcrsid)=split(/\./,$tkey); +# ... except the same student + if (($tname ne $uname) || ($tdom ne $udom)) { + my $tessay=$oldessays{$tkey}; + $tessay=~s/\W+/ /gs; +# String similarity gives up if not even limit + my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit); +# Found one + if ($tsimilar>$limit) { + $limit=$tsimilar; + $sname=$tname; + $sdom=$tdom; + $scrsid=$tcrsid; + $sessay=$oldessays{$tkey}; + } + } + } + if ($limit>0.6) { + return ($sname,$sdom,$scrsid,$sessay,$limit); + } else { + return ('','','','',0); + } +} + +#------------------------------------------------------------------- + +#------------------------------------ Receipt Verification Routines +# +#--- Check whether a receipt number is valid.--- +sub verifyreceipt { + my $request = shift; + + my $courseid = $ENV{'request.course.id'}; + my $receipt = unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}).'-'. + $ENV{'form.receipt'}; + $receipt =~ s/[^\-\d]//g; + my $url = $ENV{'form.url'}; + my $symb = $ENV{'form.symb'}; + unless ($symb) { + $symb = &Apache::lonnet::symbread($url); + } + + my $title.='

Verifying Submission Receipt '. + $receipt.'

'."\n". + 'Resource: '.$ENV{'form.probTitle'}.'

'."\n"; + + my ($string,$contents,$matches) = ('','',0); + my (undef,undef,$fullname) = &getclasslist('all','0'); + + foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { + my ($uname,$udom)=split(/\:/); + if ($receipt eq + &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb)) { + $contents.=' '."\n". + ''.$$fullname{$_}.' '."\n". + ' '.$uname.' '. + ' '.$udom.' '."\n"; + + $matches++; + } + } + if ($matches == 0) { + $string = $title.'No match found for the above receipt.'; + } else { + $string = &jscriptNform($url,$symb).$title. + 'The above receipt matches the following student'. + ($matches <= 1 ? '.' : 's.')."\n". + '
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + $contents. + '
 Fullname  Username  Domain 
'."\n"; + } + return $string.&show_grading_menu_form($symb,$url); +} + +#--- This is called by a number of programs. +#--- Called from the Grading Menu - View/Grade an individual student +#--- Also called directly when one clicks on the subm button +# on the problem page. +sub listStudents { + my ($request) = shift; + + my ($symb,$url) = &get_symb_and_url($request); + my $cdom = $ENV{"course.$ENV{'request.course.id'}.domain"}; + my $cnum = $ENV{"course.$ENV{'request.course.id'}.num"}; + my $getsec = $ENV{'form.section'} eq '' ? 'all' : $ENV{'form.section'}; + my $submitonly= $ENV{'form.submitonly'} eq '' ? 'all' : $ENV{'form.submitonly'}; + + my $viewgrade = $ENV{'form.showgrading'} eq 'yes' ? 'View/Grade/Regrade' : 'View'; + $ENV{'form.probTitle'} = $ENV{'form.probTitle'} eq '' ? + &Apache::lonnet::gettitle($symb) : $ENV{'form.probTitle'}; + + my $result='

 '.$viewgrade. + ' Submissions for a Student or a Group of Students

'; + + my ($table,$resptype,$hdgrade,$partlist,$handgrade) = &showResourceInfo($url,$ENV{'form.probTitle'}); + $result.=$table; + + $request->print(< + function checkSelect(checkBox) { + var ctr=0; + var sense=""; + if (checkBox.length > 1) { + for (var i=0; i +LISTJAVASCRIPT + + &commonJSfunctions($request); + $request->print($result); + + my $checkhdgrade = ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked' : ''; + my $checklastsub = $checkhdgrade eq '' ? 'checked' : ''; + my $gradeTable='
'."\n". + ' View Problem Text: no '."\n". + ' one student '."\n". + ' all students
'."\n". + ' Submissions: '."\n"; + if ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) { + $gradeTable.=' essay part only'."\n"; + } + + my $saveStatus = $ENV{'form.Status'} eq '' ? 'Active' : $ENV{'form.Status'}; + $ENV{'form.Status'} = $saveStatus; + + $gradeTable.=' last sub only'."\n". + ' last sub & parts info'."\n". + ' all details'."\n". + ''."\n". + ''."\n". + ''."\n". + '
'."\n". + '
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n"; + + $gradeTable.='Student Status: '. + &Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,'javascript:reLoadList(this.form);').'
'; + + $gradeTable.='To '.lc($viewgrade).' a submission, click on the check box next to the student\'s name. Then '."\n". + 'click on the '.$viewgrade.' button. To view the submissions for a group of students, click'."\n". + ' on the check boxes for the group of students.
'."\n". + ''."\n"; + $gradeTable.=''."\n"; + + my (undef, undef, $fullname) = &getclasslist($getsec,'1'); + $gradeTable.='
'. + ''; + my $loop = 0; + while ($loop < 2) { + $gradeTable.=''; + if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { + foreach (sort(@$partlist)) { + $gradeTable.=''; + } + } + $loop++; + } + $gradeTable.=''."\n"; + + my $ctr = 0; + foreach my $student (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { + my ($uname,$udom) = split(/:/,$student); + my %status = (); + if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { + (%status) =&student_gradeStatus($url,$symb,$udom,$uname,$partlist); + my $statusflg = ''; + foreach (keys(%status)) { + $statusflg = 1 if ($status{$_} ne 'nothing'); + my ($foo,$partid,$foo1) = split(/\./,$_); + if ($status{'resource.'.$partid.'.submitted_by'} ne '') { + $statusflg = ''; + $gradeTable.=''; + } + } + next if ($statusflg eq '' && $submitonly eq 'yes'); + } + + $ctr++; + if ( $perm{'vgr'} eq 'F' ) { + $gradeTable.='' if ($ctr%2 ==1); + $gradeTable.=''."\n". + ''."\n"; + + if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { + foreach (sort keys(%status)) { + next if (/^resource.*?submitted_by$/); + $gradeTable.=''."\n"; + } + } + $gradeTable.=''."\n" if ($ctr%2 ==0); + } + } + if ($ctr%2 ==1) { + $gradeTable.=''; + if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { + foreach (@$partlist) { + $gradeTable.=''; + } + } + $gradeTable.=''; + } + + $gradeTable.='
 Select  Fullname '. + '(Username)  Part '.(split(/_/))[0].' Status 
 '.$$fullname{$student}.' '."\n". + '('.$uname.') '.$status{$_}.' 
   
'. + '
'."\n"; + if ($ctr == 0) { + my $num_students=(scalar(keys(%$fullname))); + if ($num_students eq 0) { + $gradeTable='
 There are no students currently enrolled.'; + } else { + $gradeTable='
 '. + 'No submissions found for this resource for any students. ('.$num_students. + ' checked for submissions
'; + } + } elsif ($ctr == 1) { + $gradeTable =~ s/type=checkbox/type=checkbox checked/; + } + $gradeTable.=&show_grading_menu_form($symb,$url); + $request->print($gradeTable); + return ''; +} + +#---- Called from the listStudents routine +# Displays the submissions for one student or a group of students +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; + + foreach (@stuchecked) { + my ($uname,$udom,$fullname) = split(/:/); + $ENV{'form.student'} = $uname; + $ENV{'form.userdom'} = $udom; + $ENV{'form.fullname'} = $fullname; + &submission($request,$ctr,$total); + $ctr++; + } + return ''; +} + +#------------------------------------------------------------------------------------ +# +#-------------------------- Next few routines handles grading by student, essentially +# handles essay response type problem/part +# +#--- Javascript to handle the submission page functionality --- +sub sub_page_js { + my $request = shift; + $request->print(< + function updateRadio(formname,id,weight) { + var gradeBox = eval("formname.GD_BOX"+id); + var radioButton = eval("formname.RADVAL"+id); + var oldpts = eval("formname.oldpts"+id+".value"); + var pts = checkSolved(formname,id) == 'update' ? gradeBox.value : oldpts; + gradeBox.value = pts; + 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 weight) { + var resp = confirm("You entered a value ("+pts+ + ") greater than the weight for the part. Accept?"); + if (resp == false) { + gradeBox.value = ""; + return; + } + } + + for (var i=0; i +SUBJAVASCRIPT +} + +#--- javascript for essay type problem -- +sub sub_page_kw_js { + my $request = shift; + my $iconpath = $request->dir_config('lonIconsURL'); + &commonJSfunctions($request); + $request->print(< + +//===================== Show list of keywords ==================== + function keywords(keyform) { + var nret = prompt("Keywords list, separated by a space. Add/delete to list if desired.",keyform.value); + if (nret==null) return; + keyform.value = nret; + + document.SCORE.refresh.value = "on"; + if (document.SCORE.keywords.value != "") { + document.SCORE.submit(); + } + return; + } + +//===================== Script to view submitted by ================== + function viewSubmitter(submitter) { + document.SCORE.refresh.value = "on"; + document.SCORE.NCT.value = "1"; + document.SCORE.unamedom0.value = submitter; + document.SCORE.submit(); + 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("Please 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; + document.SCORE.refresh.value = "on"; + if (document.SCORE.keywords.value != "") { + document.SCORE.submit(); + } + return; } - $result.=''; - return $result; + +//====================== Script for composing message ============== + // preload images + img1 = new Image(); + img1.src = "$iconpath/mailbkgrd.gif"; + img2 = new Image(); + img2.src = "$iconpath/mailto.gif"; + + 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; + 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 = 70*Nmsg+250; + var scrollbar = "no"; + if (height > 600) { + height = 600; + scrollbar = "yes"; + } +// if (window.pWin) {window.pWin.close(); window.pWin=null} + var xpos = (screen.width-600)/2; + xpos = (xpos < 0) ? '0' : xpos; + var ypos = (screen.height-height)/2-30; + ypos = (ypos < 0) ? '0' : ypos; + + pWin = window.open('', 'MessageCenter', 'toolbar=no,location=no,scrollbars='+scrollbar+',screenx='+xpos+',screeny='+ypos+',width=600,height='+height); + pWin.focus(); + pDoc = pWin.document; + pDoc.write(""); + pDoc.write("Message Central"); + + pDoc.write(" +SUBJAVASCRIPT +} + +#--- displays the grading box, used in essay type problem and grading by page/sequence +sub gradeBox { + my ($request,$symb,$uname,$udom,$counter,$partid,$record) = @_; + + my $checkIcon = ''; + + 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); + my $result=''."\n"; + + $result.=''."\n"; + $result.=''."\n"; + $result.='
'. + 'Part '.$partid.' Points: '."\n"; + + my $ctr = 0; + $result.=''."\n"; # 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. + ($$record{'resource.'.$partid.'.solved'} eq 'correct_by_student' ? ' '.$checkIcon : ''). + ' '."\n"; + + $result.=''."\n"; } else { - $result.="$stuname:$part:$type:changed same $oldscore to $newscore:
\n"; + $result.=''. + ''."\n"; } - } - return $result; + $result.="  \n"; + $result.=''."\n". + ''."\n". + ''."\n"; + $result.='
'."\n"; + return $result; } -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 ''; } - my ($uname,$udom) = &finduser($ENV{'form.student'}); - if ($uname eq '') { &moreinfo($request,"Unable to find student"); return ''; } - my $symb=&Apache::lonnet::symbread($url); - if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } - my $home=&Apache::lonnet::homeserver($uname,$udom); - my $answer=&Apache::loncommon::get_previous_attempt($symb,$uname,$udom,$home, +sub show_problem { + my ($request,$symb,$uname,$udom,$removeform,$viewon) = @_; + my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, $ENV{'request.course.id'}); - my $result="

Submission Record

$uname:$udom for $url".$answer; - return $result; + if ($removeform) { + $rendered=~s|||g; + $rendered=~s|||g; + $rendered=~s|name="submit"|name="would_have_been_submit"|g; + } + my $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom, + $ENV{'request.course.id'}); + if ($removeform) { + $companswer=~s|||g; + $companswer=~s|||g; + $rendered=~s|name="submit"|name="would_have_been_submit"|g; + } + my $result.='
'; + $result.=''; + $result.='' if ($viewon); + $result.='
View of the problem - '.$ENV{'form.fullname'}. + '
'.$rendered.'
'; + $result.='Correct answer:
'.$companswer; + $result.='
'; + $result.='

'; + 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'})--; + my ($uname,$udom) = ($ENV{'form.student'},$ENV{'form.userdom'}); + $udom = ($udom eq '' ? $ENV{'user.domain'} : $udom); #has form.userdom changed for a student? + my $usec = &Apache::lonnet::getsection($udom,$uname,$ENV{'request.course.id'}); + $ENV{'form.fullname'} = &get_fullname ($uname,$udom) if $ENV{'form.fullname'} eq ''; + + 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 ''; } + + if (!&canview($usec)) { + $request->print('Unable to view requested student.('. + $uname.$udom.$usec.$ENV{'request.course.id'}.')'); + $request->print(&show_grading_menu_form($symb,$url)); + return; + } + + $ENV{'form.lastSub'} = ($ENV{'form.lastSub'} eq '' ? 'all' : $ENV{'form.lastSub'}); + my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : ''); + + # header info + if ($counter == 0) { + &sub_page_js($request); + &sub_page_kw_js($request) if ($ENV{'form.handgrade'} eq 'yes'); + $ENV{'form.probTitle'} = $ENV{'form.probTitle'} eq '' ? + &Apache::lonnet::gettitle($symb) : $ENV{'form.probTitle'}; + + $request->print('

 Submission Record

'."\n". + ' Resource: '.$ENV{'form.probTitle'}.''."\n"); + + if ($ENV{'form.handgrade'} eq 'no') { + my $checkIcon = ''; + my $checkMark='

 Note: Part(s) graded correct by the computer is marked with a '. + $checkIcon.' symbol.'."\n"; + $request->print($checkMark); + } + + # 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' or !$ENV{'form.vProb'}) { + $request->print(&show_problem($request,$symb,$uname,$udom,0,1)); + } + + # 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 '' && $ENV{'form.handgrade'} eq 'yes') { + %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'} : $ENV{'form.probTitle'}; + $ENV{'form.savemsgN'} = $keyhash{$symb.'_savemsgN'} ne '' ? $keyhash{$symb.'_savemsgN'} : '0'; + + } + my $overRideScore = $ENV{'form.overRideScore'} eq '' ? 'no' : $ENV{'form.overRideScore'}; + + $request->print('
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\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' && $ENV{'form.showgrading'} eq 'yes') { +# +# Print out the keyword options line +# + $request->print(<Keyword Options:  +List    +Paste Selection to List    +Highlight Attribute

+KEYWORDS +# +# Load the other essays for similarity check +# + my $essayurl=&Apache::lonnet::declutter($url); + my ($adom,$aname,$apath)=($essayurl=~/^(\w+)\/(\w+)\/(.*)$/); + $apath=&Apache::lonnet::escape($apath); + $apath=~s/\W/\_/gs; + %oldessays=&Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname); + } + } + + if ($ENV{'form.vProb'} eq 'all') { + $request->print('


') if ($counter > 0); + $request->print(&show_problem($request,$symb,$uname,$udom,1,1)); + } + my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); + my ($partlist,$handgrade) = &response_type($url); + + # Display student info + $request->print(($counter == 0 ? '' : '
')); + my $result='
'."\n". + '\n"; + if ($$timestamp eq '') { + $lastsubonly.='
'."\n"; + + $result.='Fullname: '.$ENV{'form.fullname'}. + '   Username: '.$uname. + ($ENV{'user.domain'} eq $udom ? '' : ' ('.$udom.')').'
'."\n"; + $result.=''."\n"; + + # If any part of the problem is an essay-response (handgraded), then check for collaborators + my @col_fullnames; + my ($classlist,$fullname); + if ($ENV{'form.handgrade'} eq 'yes') { + ($classlist,undef,$fullname) = &getclasslist('all','0'); + for (keys (%$handgrade)) { + my $ncol = &Apache::lonnet::EXT('resource.'.$_. + '.maxcollaborators', + $symb,$udom,$uname); + next if ($ncol <= 0); + s/\_/\./g; + next if ($record{'resource.'.$_.'.collaborators'} eq ''); + my @goodcollaborators = (); + my @badcollaborators = (); + foreach (split(/,?\s+/,$record{'resource.'.$_.'.collaborators'})) { + $_ =~ s/[\$\^\(\)]//g; + next if ($_ eq ''); + my ($co_name,$co_dom) = split /\@|:/,$_; + $co_dom = $udom if (! defined($co_dom) || $co_dom =~ /^domain$/i); + next if ($co_name eq $uname && $co_dom eq $udom); + # Doing this grep allows 'fuzzy' specification + my @Matches = grep /^$co_name:$co_dom$/i,keys %$classlist; + if (! scalar(@Matches)) { + push @badcollaborators,$_; + } else { + push @goodcollaborators, @Matches; + } + } + if (scalar(@goodcollaborators) != 0) { + $result.='Collaborators: '; + foreach (@goodcollaborators) { + my ($lastname,$givenn) = split(/,/,$$fullname{$_}); + push @col_fullnames, $givenn.' '.$lastname; + $result.=$$fullname{$_}.'     '; + } + $result.='
'."\n"; + $result.=''."\n"; + } + if (scalar(@badcollaborators) > 0) { + $result.='
'; + $result.='This student has submitted '; + $result.=(scalar(@badcollaborators) == 1) ? 'an invalid collaborator' : 'invalid collaborators'; + $result .= ': '.join(', ',@badcollaborators); + $result .= '
'; + } + if (scalar(@badcollaborators > $ncol)) { + $result .= '
'; + $result .= 'This student has submitted too many '. + 'collaborators. Maximum is '.$ncol.'.'; + $result .= '
'; + } + } + } + $request->print($result."\n"); + + # print student answer/submission + # Options are (1) Handgaded submission only + # (2) Last submission, includes submission that is not handgraded + # (for multi-response type part) + # (3) Last submission plus the parts info + # (4) The whole record for this student + if ($ENV{'form.lastSub'} =~ /^(lastonly|hdgrade)$/) { + if ($ENV{'form.'.$uname.':'.$udom.':submitted_by'}) { + my $submitby=''. + 'Collaborative submission by: '. + ''. + $$fullname{$ENV{'form.'.$uname.':'.$udom.':submitted_by'}}.''; + $request->print($submitby); + } else { + my ($string,$timestamp)= &get_last_submission (\%record); + my $lastsubonly=''. + ($$timestamp eq '' ? '' : 'Date Submitted: '. + $$timestamp)."
'.$$string[0]; + } else { + for my $part (sort keys(%$handgrade)) { + my ($responsetype,$foo) = split(/:/,$$handgrade{$part}); + my ($partid,$respid) = split(/_/,$part); + if (!exists($record{'resource.'.$partid.'.'.$respid.'.submission'})) { + $lastsubonly.='
Part '. + $partid.' ( ID '.$respid. + ' )   Nothing submitted

'; + } else { + foreach (@$string) { + my ($partid,$respid) = /^resource\.(\w+)\.(\w+)\.submission/; + if ($part eq ($partid.'_'.$respid)) { + my ($ressub,$subval) = split(/:/,$_,2); + # Similarity check + my $similar=''; + my ($oname,$odom,$ocrsid,$oessay,$osim)=&most_similar($uname,$udom,$subval); + if ($osim) { + $osim=int($osim*100.0); + $similar='

Essay is '.$osim. + '% similar to an essay by '.&Apache::loncommon::plainname($oname,$odom). + '

'. + &keywords_highlight($oessay).'
'; + } + $lastsubonly.='
Part '. + $partid.' ( ID '.$respid. + ' )   '. + ($record{"resource.$partid.$respid.uploadedurl"}? + ' File uploaded by student '. + 'Like all files provided by users, '. + 'this file may contain virusses
':''). + 'Submitted Answer: '.($responsetype =~ /^(essay|option)$/ ? + '
' : ''). + &cleanRecord(&keywords_highlight($subval),$responsetype). + ($responsetype =~ /^(essay|option)$/ ? '

' : + '

').$similar."\n" + if ($ENV{'form.lastSub'} eq 'lastonly' || + ($ENV{'form.lastSub'} eq 'hdgrade' && + $$handgrade{$part} =~ /:yes$/)); + } + } + } + } + } + $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')); + } + + $result=''."\n". + ''."\n". + ''."\n"; + $request->print($result); + + # return if view submission with no grading option + if ($ENV{'form.showgrading'} eq '' || (!&canmodify($usec))) { + my $toGrade.='  '."\n"; + $toGrade.='
'."\n"; + $toGrade.=&show_grading_menu_form($symb,$url) + if (($ENV{'form.command'} eq 'submission') || + ($ENV{'form.command'} eq 'processGroup' && $counter == $total)); + $request = print($toGrade); + return; + } + + # essay grading options + if ($ENV{'form.handgrade'} eq 'yes') { + my ($lastname,$givenn) = split(/,/,$ENV{'form.fullname'}); + my $msgfor = $givenn.' '.$lastname; + if (scalar(@col_fullnames) > 0) { + my $lastone = pop @col_fullnames; + $msgfor .= ', '.(join ', ',@col_fullnames).' and '.$lastone.'.'; + } + $msgfor =~ s/\'/\\'/g; #' stupid emacs - no! javascript +# $result.=''."\n". + $result=' '. + 'Compose Message to student'.(scalar(@col_fullnames) >= 1 ? 's' : '').'  '. + ''."\n". + '
 (Message will be sent when you click on Save & Next below.)'."\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$/ && $ENV{'form.lastSub'} =~ /^(hdgrade)$/); + push @partlist,$partid; + + $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record)); + } + $result=''."\n"; + my $ctr = 0; + while ($ctr < scalar(@partlist)) { + $result.=''."\n"; + $ctr++; + } + $request->print($result.''."\n"); + + # print end of form + if ($counter == $total) { + my $endform='
'."\n"; +# ''."\n"; + $endform.='  '."\n"; + my $ntstu =''."\n"; + my $nsel = ($ENV{'form.NTSTU'} ne '' ? $ENV{'form.NTSTU'} : '1'); + $ntstu =~ s/
'; + $endform.=&show_grading_menu_form($symb,$url); + $request->print($endform); + } + return ''; +} + +#--- Retrieve the last submission for all the parts +sub get_last_submission { + my ($returnhash)=@_; + my (@string,$timestamp); + if ($$returnhash{'version'}) { + my %lasthash=(); + my ($version); + for ($version=1;$version<=$$returnhash{'version'};$version++) { + foreach (sort(split(/\:/,$$returnhash{$version.':keys'}))) { + $lasthash{$_}=$$returnhash{$version.':'.$_}; + $timestamp = scalar(localtime($$returnhash{$version.':timestamp'})); + } + } + foreach ((keys %lasthash)) { + if ($_ =~ /\.submission$/) { + my ($partid,$foo) = split(/submission$/,$_); + my $draft = $lasthash{$partid.'awarddetail'} eq 'DRAFT' ? + 'Draft Copy ' : ''; + push @string, (join(':',$_,$draft.$lasthash{$_})); + } + } + } + @string = $string[0] eq '' ? 'Nothing submitted - no attempts.' : @string; + return \@string,\$timestamp; +} + +#--- High light keywords, with style choosen by user. +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; +} + +#--- Called from submission routine +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'}; + if ($button eq 'Save & Next') { + my $ctr = 0; + while ($ctr < $ngrade) { + my ($uname,$udom) = split(/:/,$ENV{'form.unamedom'.$ctr}); + my ($errorflag,$pts,$wgt) = &saveHandGrade($request,$url,$symb,$uname,$udom,$ctr); + if ($errorflag eq 'no_score') { + $ctr++; + next; + } + if ($errorflag eq 'not_allowed') { + $request->print("Not allowed to modify grades for $uname:$udom"); + $ctr++; + next; + } + my $includemsg = $ENV{'form.includemsg'.$ctr}; + my ($subject,$message,$msgstatus) = ('','',''); + if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) { + $subject = $ENV{'form.msgsub'} if ($includemsg =~ /^msgsub/); + my (@msgnum) = split(/,/,$includemsg); + foreach (@msgnum) { + $message.=$ENV{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne ''); + } + $message =&Apache::lonfeedback::clear_out_html($message); + $message.="\n\nPoint".($pts > 1 ? 's':'').' awarded = '.$pts.' out of '.$wgt; + $message.=" for $ENV{'form.probTitle'}"; + $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) { + my ($errorflag,$pts,$wgt) = + &saveHandGrade($request,$url,$symb,$_,$udom,$ctr,$ENV{'form.unamedom'.$ctr}); + if ($errorflag eq 'not_allowed') { + $request->print("Not allowed to modify grades for $_:$udom"); + next; + } else { + if ($message ne '') { + $msgstatus = &Apache::lonmsg::user_normal_msg ($_,$udom, + $ENV{'form.msgsub'}, + $message); + } + } + } + } + $ctr++; + } + } + + if ($ENV{'form.handgrade'} eq 'yes') { + # Keywords sorted in alphabatical order + my $loginuser = $ENV{'user.name'}.':'.$ENV{'user.domain'}; + my %keyhash = (); + $ENV{'form.keywords'} =~ s/,\s{0,}|\s+/ /g; + $ENV{'form.keywords'} =~ s/^\s+|\s+$//; + my (@keywords) = sort(split(/\s+/,$ENV{'form.keywords'})); + $ENV{'form.keywords'} = join(' ',@keywords); + $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'}; + + # message center - Order of message gets changed. Blank line is eliminated. + # New messages are saved in ENV for the next student. + # All messages are saved in nohist_handgrade.db + 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'}); + } + # Called by Save & Refresh from Highlight Attribute Window +# my (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'0'); + my (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'1'); + if ($ENV{'form.refresh'} eq 'on') { + my ($ctr,$total) = (0,0); + while ($ctr < $ngrade) { + $total++ if $ENV{'form.unamedom'.$ctr} ne ''; + $ctr++; + } + $ENV{'form.NTSTU'}=$ngrade; + $ctr = 0; + while ($ctr < $total) { + my $processUser = $ENV{'form.unamedom'.$ctr}; + ($ENV{'form.student'},$ENV{'form.userdom'}) = split(/:/,$processUser); + $ENV{'form.fullname'} = $$fullname{$processUser}; + &submission($request,$ctr,$total-1); + $ctr++; + } + return ''; + } + +# Go directly to grade student - from submission page + if ($button eq 'Grade Student') { + my $processUser = $ENV{'form.unamedom'.$ENV{'form.studentNo'}}; + ($ENV{'form.student'},$ENV{'form.userdom'}) = split(/:/,$processUser); + $ENV{'form.fullname'} = $$fullname{$processUser}; + &submission($request,0,0); + return ''; + } + + # Get the next/previous one or group of students + my $firststu = $ENV{'form.unamedom0'}; + my $laststu = $ENV{'form.unamedom'.($ngrade-1)}; + my $ctr = 2; + while ($laststu eq '') { + $laststu = $ENV{'form.unamedom'.($ngrade-$ctr)}; + $ctr++; + $laststu = $firststu if ($ctr > $ngrade); + } + + my (@parsedlist,@nextlist); + my ($nextflg) = 0; + foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { + 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'},$symb,$udom,$uname,$partlist) ; + my $statusflg = ''; + foreach (keys(%status)) { + $statusflg = 1 if ($status{$_} ne 'nothing'); + my ($foo,$partid,$foo1) = split(/\./); + $statusflg = '' if ($status{'resource.'.$partid.'.submitted_by'} ne ''); + } + next if ($statusflg eq ''); + } + push @nextlist,$student if ($ctr < $ntstu); + $ctr++; + } + + $ctr = 0; + my $total = scalar(@nextlist)-1; + + foreach (sort @nextlist) { + my ($uname,$udom,$submitter) = split(/:/); + $ENV{'form.student'} = $uname; + $ENV{'form.userdom'} = $udom; + $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 ''; +} + +#---- Save the score and award for each student, if changed +sub saveHandGrade { + my ($request,$url,$symb,$stuname,$domain,$newflg,$submitter) = @_; + my $usec = &Apache::lonnet::getsection($domain,$stuname, + $ENV{'request.course.id'}); + if (!&canmodify($usec)) { return('not_allowed'); } + my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$domain,$stuname); + my %newrecord = (); + my ($pts,$wgt) = ('',''); + foreach (split(/:/,$ENV{'form.partlist'.$newflg})) { + if ($ENV{'form.GD_SEL'.$newflg.'_'.$_} eq 'excused') { + if ($record{'resource.'.$_.'.solved'} ne 'excused') { + $newrecord{'resource.'.$_.'.solved'} = 'excused'; + if (exists($record{'resource.'.$_.'.awarded'})) { + $newrecord{'resource.'.$_.'.awarded'} = ''; + } + } + } else { + $pts = ($ENV{'form.GD_BOX'.$newflg.'_'.$_} ne '' ? + $ENV{'form.GD_BOX'.$newflg.'_'.$_} : + $ENV{'form.RADVAL'.$newflg.'_'.$_}); + return 'no_score' if ($pts eq '' && $ENV{'form.GD_SEL'.$newflg.'_'.$_} eq ''); + $wgt = $ENV{'form.WGT'.$newflg.'_'.$_} eq '' ? 1 : + $ENV{'form.WGT'.$newflg.'_'.$_}; + my $partial= $pts/$wgt; + next if ($partial eq $record{'resource.'.$_.'.awarded'}); #do not update score for part if not changed. + $newrecord{'resource.'.$_.'.awarded'} = $partial + if ($record{'resource.'.$_.'.awarded'} ne $partial); + my $reckey = 'resource.'.$_.'.solved'; + if ($partial == 0) { + $newrecord{$reckey} = 'incorrect_by_override' + if ($record{$reckey} ne 'incorrect_by_override'); + } else { + $newrecord{$reckey} = 'correct_by_override' + if ($record{$reckey} ne 'correct_by_override'); + } + $newrecord{'resource.'.$_.'.submitted_by'} = $submitter + if ($submitter && ($record{'resource.'.$_.'.submitted_by'} ne $submitter)); + $newrecord{'resource.'.$_.'regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; + } + } + + if (scalar(keys(%newrecord)) > 0) { + &Apache::lonnet::cstore(\%newrecord,$symb, + $ENV{'request.course.id'},$domain,$stuname); + } + return '',$pts,$wgt; +} + +#-------------------------------------------------------------------------------------- +# +#-------------------------- Next few routines handles grading by section or whole class +# +#--- Javascript to handle grading by section or whole class +sub viewgrades_js { + my ($request) = shift; + + $request->print(< + function writePoint(partid,weight,point) { + var radioButton = eval("document.classgrade.RADVAL_"+partid); + var textbox = eval("document.classgrade.TEXTVAL_"+partid); + if (point == "textval") { + var point = eval("document.classgrade.TEXTVAL_"+partid+".value"); + if (isNaN(point) || parseFloat(point) < 0) { + alert("A number equal or greater than 0 is expected. Entered value = "+parseFloat(point)); + var resetbox = false; + for (var i=0; i parseFloat(weight)) { + var resp = confirm("You entered a value ("+parseFloat(point)+ + ") greater than the weight for the part. Accept?"); + if (resp == false) { + textbox.value = ""; + return; + } + } + for (var i=0; i parseFloat(weight)) { + var resp = confirm("You entered a value ("+parseFloat(point)+ + ") greater than the weight of the part. Accept?"); + if (resp == false) { + textbox.value = ""; + return; + } + } + selval[0].selected = true; + } + + function changeOneScore(partid,user) { + var selval = eval("document.classgrade.GD_"+user+'_'+partid+"_solved"); + if (selval[1].selected) { + var boxval = eval("document.classgrade.GD_"+user+'_'+partid+"_awarded"); + boxval.value = ""; + } + } + + function resetEntry(numpart) { + for (ctpart=0;ctpart +VIEWJAVASCRIPT } +#--- show scores for a section or whole class w/ option to change/update a score sub viewgrades { - my ($request) = @_; - my $result=''; + my ($request) = shift; + &viewgrades_js($request); + + my ($symb,$url) = ($ENV{'form.symb'},$ENV{'form.url'}); + my $result='

Manual Grading

'; + + $result.='Current Resource: '.$ENV{'form.probTitle'}.''."\n"; - #get resource reference - 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 ''; } - - #get classlist - my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); - my $chome=$ENV{"course.$ENV{'request.course.id'}.home"}; - #print "Found $cdom:$cnum:$chome
"; - my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0'); - - - #get list of parts for this problem - my (@parts) = &getpartlist($url); - - #start the form - $result = '
'."\n". - ''."\n". - ''."\n". + #view individual student submission form - called using Javascript viewOneStudent + $result.=&jscriptNform($url,$symb); + + #beginning of class grading form + $result.= ''."\n". + ''."\n". + ''."\n". ''."\n". - ''."\n". - ''."\n". - ''."\n"; - #get info for each student - foreach my $student ( sort(@{ $classlist{'allids'} }) ) { - $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts); - } - $result.='
UserIdDomainPortion CorrectStatusTries
'; + ''."\n". + ''."\n". + ''."\n"; + + $result.='

Assign Common Grade To '; + if ($ENV{'form.section'} eq 'all') { + $result.='Class

'; + } elsif ($ENV{'form.section'} eq 'no') { + $result.='Students in no Section '; + } else { + $result.='Students in Section '.$ENV{'form.section'}.''; + } + $result.= '
'."\n". + '
'; + #radio buttons/text box for assigning points for a section or class. + #handles different parts of a problem + my ($partlist,$handgrade) = &response_type($ENV{'form.url'}); + my %weight = (); + my $ctsparts = 0; + $result.=''; + my %seen = (); + for (sort keys(%$handgrade)) { + my ($partid,$respid) = split (/_/,$_,2); + next if $seen{$partid}; + $seen{$partid}++; + my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_}); + my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb); + $weight{$partid} = $wgt eq '' ? '1' : $wgt; + + $result.=''."\n"; + $result.=''."\n"; + $result.=''."\n"; + $result.= ''."\n"; + $ctsparts++; + } + $result.='
Part '.$partid.'   Point: '; + $result.=''; + my $ctr = 0; + while ($ctr<=$weight{$partid}) { # display radio buttons in a nice table 10 across + $result.= '\n"; + $result.=(($ctr+1)%10 == 0 ? '' : ''); + $ctr++; + } + $result.='
'.$ctr."
'; + $result.= '		 or /'. + $weight{$partid}.' (problem weight)
'.'
'.'
'."\n". + ''; + $result.=''; + + #table listing all the students in a section/class + #header of table + $result.= '

Assign Grade to Specific Students in '; + if ($ENV{'form.section'} eq 'all') { + $result.='the Class

'; + } elsif ($ENV{'form.section'} eq 'no') { + $result.='no Section '; + } else { + $result.='Section '.$ENV{'form.section'}.''; + } + $result.= '
'."\n". + ''. + ''."\n"; + my (@parts) = sort(&getpartlist($url)); + foreach my $part (@parts) { + my $display=&Apache::lonnet::metadata($url,$part.'.display'); + next if ($display =~ /Number of Attempts/); + if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); } + if ($display =~ /^Partial Credit Factor/) { + my ($partid) = &split_part_type($part); + $result.=''."\n"; + next; + } + $display =~ s|Problem Status|Grade Status
|; + $result.=''."\n"; + } + $result.=''; - return $result; + #get info for each student + #list all the students - with points and grade status + my (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'1'); + my $ctr = 0; + foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { + my $uname = $_; + $uname=~s/:/_/; + $result.=''."\n"; + $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'}, + $_,$$fullname{$_},\@parts,\%weight); + $ctr++; + } + $result.='
Fullname (Username)Score Part '.$partid.'
(weight = '. + $weight{$partid}.')		'.$display.'
'; + $result.=''."\n"; + $result.=''."\n"; + if (scalar(%$fullname) eq 0) { + my $colspan=3+scalar(@parts); + $result='There are no students in section "'.$ENV{'form.section'}. + '" with enrollment status "'.$ENV{'form.Status'}.'" to modify or grade.'; + } + $result.=&show_grading_menu_form($symb,$url); + return $result; } +#--- call by previous routine to display each student +sub viewstudentgrade { + my ($url,$symb,$courseid,$student,$fullname,$parts,$weight) = @_; + my ($uname,$udom) = split(/:/,$student); + $student=~s/:/_/; + my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname); + my $result=''. + ''.$fullname.' '. + '('.$uname.($ENV{'user.domain'} eq $udom ? '' : ':'.$udom).')'."\n"; + foreach my $apart (@$parts) { + my ($part,$type) = &split_part_type($apart); + my $score=$record{"resource.$part.$type"}; + if ($type eq 'awarded') { + my $pts = $score eq '' ? '' : $score*$$weight{$part}; + $result.=''."\n"; + $result.=''."\n"; + } elsif ($type eq 'solved') { + my ($status,$foo)=split(/_/,$score,2); + $status = 'nothing' if ($status eq ''); + $result.=''."\n"; + $result.='\n"; +# } else { +# $result.=''. +# "\n"; +# $result.=''."\n"; + } + } + $result.=''; + return $result; +} + +#--- change scores for all the students in a section/class +# record does not get update if unchanged sub editgrades { - my ($request) = @_; - my $result=''; + my ($request) = @_; - 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'}); - my $chome=$ENV{"course.$ENV{'request.course.id'}.home"}; - #print "Found $cdom:$cnum:$chome
"; - my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0'); - - #get list of parts for this problem - my (@parts) = &getpartlist($url); - - $result.='
'."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n"; + my $symb=$ENV{'form.symb'}; + my $url =$ENV{'form.url'}; + my $title='

Current Grade Status

'; + $title.='Current Resource: '.$ENV{'form.probTitle'}.'
'."\n"; + $title.='Section: '.$ENV{'form.section'}.''."\n"; + my $result= '
'."\n"; + $result.= ''. + ''."\n"; + + my %scoreptr = ( + 'correct' =>'correct_by_override', + 'incorrect'=>'incorrect_by_override', + 'excused' =>'excused', + 'ungraded' =>'ungraded_attempted', + 'nothing' => '', + ); + my ($classlist,undef,$fullname) = &getclasslist($ENV{'form.section'},'0'); + + my (@partid); + my %weight = (); + my %columns = (); + my ($i,$ctr,$count,$rec_update) = (0,0,0,0); + + my (@parts) = sort(&getpartlist($url)); + my $header; + while ($ctr < $ENV{'form.totalparts'}) { + my $partid = $ENV{'form.partid_'.$ctr}; + push @partid,$partid; + $weight{$partid} = $ENV{'form.weight_'.$partid}; + $ctr++; + } + foreach my $partid (@partid) { + $header .= ''. + ''; + $columns{$partid}=2; + foreach my $stores (@parts) { + my ($part,$type) = &split_part_type($stores); + if ($part !~ m/^\Q$partid\E/) { next;} + if ($type eq 'awarded' || $type eq 'solved') { next; } + my $display=&Apache::lonnet::metadata($url,$stores.'.display'); + $display =~ s/\[Part: (\w)+\]//; + $header .= ''. + ''; + $columns{$partid}+=2; + } + } + foreach my $partid (@partid) { + $result .= ''; - foreach my $student ( sort(@{ $classlist{'allids'} }) ) { - $result.=&setstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts); + } + $result .= ''; + $result .= $header; + $result .= ''."\n"; + my $noupdate; + for ($i=0; $i<$ENV{'form.total'}; $i++) { + my $line; + my $user = $ENV{'form.ctr'.$i}; + my $usercolon = $user; + $usercolon =~s/_/:/; + my ($uname,$udom)=split(/_/,$user); + my %newrecord; + my $updateflag = 0; + $line .= ''; + my $usec=$classlist->{"$uname:$udom"}[5]; + if (!&canmodify($usec)) { + my $numcols=scalar(@partid)*(scalar(@parts)-1)*2; + $noupdate.=$line.""; + next; + } + foreach (@partid) { + my $old_aw = $ENV{'form.GD_'.$user.'_'.$_.'_awarded_s'}; + my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1); + my $old_part = $old_aw eq '' ? '' : $old_part_pcr; + my $old_score = $scoreptr{$ENV{'form.GD_'.$user.'_'.$_.'_solved_s'}}; + + my $awarded = $ENV{'form.GD_'.$user.'_'.$_.'_awarded'}; + my $pcr = $awarded/($weight{$_} ne '0' ? $weight{$_} : 1); + my $partial = $awarded eq '' ? '' : $pcr; + my $score; + if ($partial eq '') { + $score = $scoreptr{$ENV{'form.GD_'.$user.'_'.$_.'_solved_s'}}; + } elsif ($partial > 0) { + $score = 'correct_by_override'; + } elsif ($partial == 0) { + $score = 'incorrect_by_override'; + } + $score = 'excused' if (($ENV{'form.GD_'.$user.'_'.$_.'_solved'} eq 'excused') && + ($score ne 'excused')); + $line .= ''. + ''; + + if (!($old_part eq $partial && $old_score eq $score)) { + $updateflag = 1; + $newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne ''; + $newrecord{'resource.'.$_.'.solved'} = $score; + $rec_update++; + } + + my $partid=$_; + foreach my $stores (@parts) { + my ($part,$type) = &split_part_type($stores); + if ($part !~ m/^\Q$partid\E/) { next;} + if ($type eq 'awarded' || $type eq 'solved') { next; } + my $old_aw = $ENV{'form.GD_'.$user.'_'.$part.'_'.$type.'_s'}; + my $awarded = $ENV{'form.GD_'.$user.'_'.$part.'_'.$type}; + if ($awarded ne '' && $awarded ne $old_aw) { + $newrecord{'resource.'.$part.'.'.$type}= $awarded; + $newrecord{'resource.'.$part.'regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; + $updateflag=1; + } + $line .= ''. + ''; + } + } + $line.=''."\n"; + if ($updateflag) { + $count++; + &Apache::lonnet::cstore(\%newrecord,$symb,$ENV{'request.course.id'}, + $udom,$uname); + $result.=$line; + } else { + $noupdate.=$line; + } + } + if ($noupdate) { + my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3; + $result .= ''.$noupdate; + } + $result .= '
UsernameDomainFullname Old Score  New Score  Old '.$display.'  New '.$display.' Part '.$partid. + ' (Weight = '.$weight{$partid}.')
'.$uname.' '. + $udom.' '. + $$fullname{$usercolon}.' Not allowed to modify student
'.$old_aw.' '.$awarded. + ($score eq 'excused' ? $score : '').' '.$old_aw.' '.$awarded.' 
No Changes Occured For the Students Below
'."\n". + &show_grading_menu_form ($symb,$url); + my $msg = 'Number of records updated = '.$rec_update. + ' for '.$count.' student'.($count <= 1 ? '' : 's').'.
'. + 'Total number of students = '.$ENV{'form.total'}.'
'; + return $title.$msg.$result; +} + +sub split_part_type { + my ($partstr) = @_; + my ($temp,@allparts)=split(/_/,$partstr); + my $type=pop(@allparts); + my $part=join('.',@allparts); + return ($part,$type); +} + +#------------- end of section for handling grading by section/class --------- +# +#---------------------------------------------------------------------------- + + +#---------------------------------------------------------------------------- +# +#-------------------------- Next few routines handles grading by csv upload +# +#--- Javascript to handle csv upload +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 send_header { - my ($request)= @_; - $request->print(&Apache::lontexconvert::header()); - $request->print(" -"); - $request->print(''); +sub csvuploadmap_header { + my ($request,$symb,$url,$datatoken,$distotal)= @_; + my $javascript; + if ($ENV{'form.upfile_associate'} eq 'reverse') { + $javascript=&csvupload_javascript_reverse_associate(); + } else { + $javascript=&csvupload_javascript_forward_associate(); + } + + my ($result,$resptype,$hdgrade,$partlist,$handgrade) = &showResourceInfo($url,$ENV{'form.probTitle'}); + + $request->print(< +

Uploading Class Grades

+$result +
+

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 + $request->print(&show_grading_menu_form($symb,$url)); + return ''; + } -sub send_footer { - my ($request)= @_; - $request->print(''); - $request->print(&Apache::lontexconvert::footer()); +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 upcsvScores_form { + my ($request) = shift; + my ($symb,$url)=&get_symb_and_url($request); + if (!$symb) {return '';} + my $result =< + function checkUpload(formname) { + if (formname.upfile.value == "") { + alert("Please use the browse button to select a file from your local directory."); + return false; + } + formname.submit(); + } + +CSVFORMJS + $ENV{'form.probTitle'} = &Apache::lonnet::gettitle($symb); + my ($table) = &showResourceInfo($url,$ENV{'form.probTitle'}); + $result.=$table; + $result.='
'."\n"; + $result.=''."\n"; + $result.='
'."\n"; + $result.=' Specify a file containing the class scores for current resource'. + '.
'."\n"; + my $upfile_select=&Apache::loncommon::upfile_select_html(); + $result.=< + + + + + +$upfile_select +
+ + +ENDUPFORM + $result.='
'."\n"; + $result.='


'."\n"; + $result.=&show_grading_menu_form($symb,$url); + return $result; +} + + +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,$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); + $request->print(&show_grading_menu_form($symb,$url)); + + 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 ($classlist) = &getclasslist('all',0); + my @notallowed; + 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 $usec=$classlist->{"$username:$domain"}[5]; + if (!&canmodify($usec)) { + push(@notallowed,"$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
\n"); } + } + if (@notallowed) { + $request->print('

Students Not Allowed to Modify

'); + foreach my $student (@notallowed) { $request->print("$student
\n"); } + } + $request->print("
\n"); + $request->print(&show_grading_menu_form($symb,$url)); + return ''; +} +#------------- end of section for handling csv file upload --------- +# +#------------------------------------------------------------------- +# +#-------------- Next few routines handles grading by page/sequence +# +#--- Select a page/sequence and a student to grade +sub pickStudentPage { + my ($request) = shift; + + $request->print(< + +function checkPickOne(formname) { + if (radioSelection(formname.student) == null) { + alert("Please select the student you wish to grade."); + return; + } + var ptr = pullDownSelection(formname.selectpage); + formname.page.value = eval("formname.page"+ptr+".value"); + formname.title.value = eval("formname.title"+ptr+".value"); + formname.submit(); +} + + +LISTJAVASCRIPT + &commonJSfunctions($request); + my ($symb,$url) = &get_symb_and_url($request); + my $cdom = $ENV{"course.$ENV{'request.course.id'}.domain"}; + my $cnum = $ENV{"course.$ENV{'request.course.id'}.num"}; + my $getsec = $ENV{'form.section'} eq '' ? 'all' : $ENV{'form.section'}; + + my $result='

 '. + 'Manual Grading by Page or Sequence

'; + + $result.='
'."\n"; + $result.=' Problems from: '."
\n"; + $ctr=0; + foreach (@$titles) { + my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); + $result.=''."\n"; + $result.=''."\n"; + $ctr++; + } + $result.=''."\n". + ''."\n"; + + $result.=' View Problems Text: no '."\n". + ' yes '."
\n"; + + $result.=' Submission Details: '. + ' none'."\n". + ' dates and submissions'."\n". + ' all details'."\n"; + + $result.=''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."
\n"; + + $result.=' 
'."\n"; + + $request->print($result); + + my $studentTable.=' Select a student you wish to grade
'. + '
'. + ''. + ''. + ''. + ''. + ''; + + my (undef,undef,$fullname) = &getclasslist($getsec,'1'); + my $ptr = 1; + foreach my $student (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { + my ($uname,$udom) = split(/:/,$student); + $studentTable.=($ptr%4 == 1 ? '' : ''); + $ptr++; + } + $studentTable.='
 Fullname (username) Fullname (username) Fullname (username) Fullname (username)
' : ''); + $studentTable.=' '.$$fullname{$student}. + ' ('.$uname.($udom eq $cdom ? '':':'.$udom).')'."\n"; + $studentTable.=($ptr%4 == 0 ? '
   ' if ($ptr%4 == 2); + $studentTable.='  ' if ($ptr%4 == 3); + $studentTable.=' ' if ($ptr%4 == 0); + $studentTable.='
'."\n"; + $studentTable.='
 
'."\n"; + + $studentTable.=&show_grading_menu_form($symb,$url); + $request->print($studentTable); + + return ''; +} + +sub getSymbMap { + my ($request) = @_; + my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', + $ENV{'request.course.fn'}.'_parms.db'); + $navmap->init(); + + my %symbx = (); + my @titles = (); + my $minder = 0; + + # Gather every sequence that has problems. + my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); }, 1); + for my $sequence ($navmap->getById('0.0'), @sequences) { + if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) { + my $title = $minder.'.'.$sequence->compTitle(); + push @titles, $title; # minder in case two titles are identical + $symbx{$title} = $sequence->symb(); + $minder++; + } + } + + $navmap->untieHashes(); + return \@titles,\%symbx; +} + +# +#--- Displays a page/sequence w/wo problems, w/wo submissions +sub displayPage { + my ($request) = shift; + + my ($symb,$url) = &get_symb_and_url($request); + my $cdom = $ENV{"course.$ENV{'request.course.id'}.domain"}; + my $cnum = $ENV{"course.$ENV{'request.course.id'}.num"}; + my $getsec = $ENV{'form.section'} eq '' ? 'all' : $ENV{'form.section'}; + my $pageTitle = $ENV{'form.page'}; + my ($classlist,undef,$fullname) = &getclasslist($getsec,'1'); + my ($uname,$udom) = split(/:/,$ENV{'form.student'}); + my $usec=$classlist->{$ENV{'form.student'}}[5]; + if (!&canview($usec)) { + $request->print('Unable to view requested student.('.$ENV{'form.student'}.')'); + $request->print(&show_grading_menu_form($symb,$url)); + return; + } + my $result='

 '.$ENV{'form.title'}.'

'; + $result.='

 Student: '.$$fullname{$ENV{'form.student'}}. + ' ('.$uname.($udom eq $cdom ? '':':'.$udom).')

'."\n"; + + &sub_page_js($request); + $request->print($result); + + my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', + $ENV{'request.course.fn'}.'_parms.db',1, 1); + my ($mapUrl, $id, $resUrl) = split(/___/, $ENV{'form.page'}); + my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps + + my $iterator = $navmap->getIterator($map->map_start(), + $map->map_finish()); + + my $studentTable='
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n"; + + my $checkIcon = ''; + + $studentTable.=' Note: Problems graded correct by the computer are marked with a '.$checkIcon. + ' symbol.'."\n". + '
'. + ''. + ''. + ''; + + my ($depth,$question) = (1,1); + $iterator->next(); # skip the first BEGIN_MAP + my $curRes = $iterator->next(); # for "current resource" + while ($depth > 0) { + if($curRes == $iterator->BEGIN_MAP) { $depth++; } + if($curRes == $iterator->END_MAP) { $depth--; } + +# if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) { + if (ref($curRes) && $curRes->is_problem()) { + my $parts = $curRes->parts(); + my $title = $curRes->compTitle(); + my $symbx = $curRes->symb(); + $studentTable.=''; + $studentTable.='
 Prob.  '.($ENV{'form.vProb'} eq 'no' ? 'Title' : 'Problem Text').'/Grade
'.$question. + (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').'		'; + if ($ENV{'form.vProb'} eq 'yes') { + $studentTable.=&show_problem($request,$symbx,$uname,$udom,1); + } else { + my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$ENV{'request.course.id'}); + $companswer =~ s|||g; + $companswer =~ s|||g; +# while ($companswer =~ /()/s) { #\n"); +# } +# $companswer =~ s||
|g; + $studentTable.=' '.$title.' 
 Correct answer:
'.$companswer; + } + + my %record = &Apache::lonnet::restore($symbx,$ENV{'request.course.id'},$udom,$uname); + if ($ENV{'form.lastSub'} eq 'datesub') { + if ($record{'version'} eq '') { + $studentTable.='
 No recorded submission for this problem
'; + } else { + my %responseType = (); + foreach my $partid (@{$parts}) { + $responseType{$partid} = $curRes->responseType($partid); + } + $studentTable.= &displaySubByDates(\%record,$parts,\%responseType,$checkIcon); + } + } elsif ($ENV{'form.lastSub'} eq 'all') { + my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : ''); + $studentTable.=&Apache::loncommon::get_previous_attempt($symbx,$uname,$udom, + $ENV{'request.course.id'}, + '','.submission'); + + } + if (&canmodify($usec)) { + foreach my $partid (@{$parts}) { + $studentTable.=&gradeBox($request,$symbx,$uname,$udom,$question,$partid,\%record); + $studentTable.=''."\n"; + $question++; + } + } + $studentTable.=''; + + } + $curRes = $iterator->next(); + } + + $navmap->untieHashes(); + + $studentTable.='
'."\n". + '  '. + ''."\n"; + $studentTable.=&show_grading_menu_form($symb,$url); + $request->print($studentTable); + + return ''; +} + +sub displaySubByDates { + my ($record,$parts,$responseType,$checkIcon) = @_; + my $studentTable='
'. + ''. + ''. + ''. + ''; + my ($version); + my %mark; + $mark{'correct_by_student'} = $checkIcon; + for ($version=1;$version<=$$record{'version'};$version++) { + my $timestamp = scalar(localtime($$record{$version.':timestamp'})); + $studentTable.=''; + my @versionKeys = split(/\:/,$$record{$version.':keys'}); + my @displaySub = (); + foreach my $partid (@{$parts}) { + my @matchKey = grep /^resource\.$partid\..*?\.submission$/,@versionKeys; + next if ($$record{"$version:resource.$partid.solved"} eq ''); + $displaySub[0].=(exists $$record{$version.':'.$matchKey[0]}) ? + 'Part '.$partid.' '. + ($$record{"$version:resource.$partid.tries"} eq '' ? 'Trial not counted' : + 'Trial '.$$record{"$version:resource.$partid.tries"}).'  '. + &cleanRecord($$record{$version.':'.$matchKey[0]},$$responseType{$partid}).'
' : ''; + $displaySub[1].=(exists $$record{"$version:resource.$partid.award"}) ? + 'Part '.$partid.'  '. + lc($$record{"$version:resource.$partid.award"}).' '. + $mark{$$record{"$version:resource.$partid.solved"}}.'
' : ''; +# $$record{"$version:resource.$partid.solved"}.'
' : ''; + $displaySub[2].=(exists $$record{"$version:resource.$partid.regrader"}) ? + $$record{"$version:resource.$partid.regrader"}.' (Part: '.$partid.')' : ''; + } + $displaySub[2].=(exists $$record{"$version:resource.regrader"}) ? + $$record{"$version:resource.regrader"} : ''; + $studentTable.=''; + } + $studentTable.='
Date/TimeSubmissionStatus 
'.$timestamp.''.$displaySub[0].' '.$displaySub[1]. + ($displaySub[2] eq '' ? '' : 'Manually graded by '.$displaySub[2]).' 
'; + return $studentTable; +} + +sub updateGradeByPage { + 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'} eq '' ? 'all' : $ENV{'form.section'}; + my $pageTitle = $ENV{'form.page'}; + my ($classlist,undef,$fullname) = &getclasslist($getsec,'1'); + my ($uname,$udom) = split(/:/,$ENV{'form.student'}); + my $usec=$classlist->{$ENV{'form.student'}}[5]; + if (!&canmodify($usec)) { + $request->print('Unable to modify requested student.('.$ENV{'form.student'}.''); + $request->print(&show_grading_menu_form($ENV{'form.symb'},$ENV{'form.url'})); + return; + } + my $result='

 '.$ENV{'form.title'}.'

'; + $result.='

 Student: '.$$fullname{$ENV{'form.student'}}. + ' ('.$uname.($udom eq $cdom ? '':':'.$udom).')

'."\n"; + + $request->print($result); + + my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', + $ENV{'request.course.fn'}.'_parms.db',1, 1); + my ($mapUrl, $id, $resUrl) = split(/___/, $ENV{'form.page'}); + my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps + + my $iterator = $navmap->getIterator($map->map_start(), + $map->map_finish()); + + my $studentTable='
'. + ''. + ''. + ''. + ''. + ''; + + $iterator->next(); # skip the first BEGIN_MAP + my $curRes = $iterator->next(); # for "current resource" + my ($depth,$question,$changeflag)= (1,1,0); + while ($depth > 0) { + if($curRes == $iterator->BEGIN_MAP) { $depth++; } + if($curRes == $iterator->END_MAP) { $depth--; } + + if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) { + my $parts = $curRes->parts(); + my $title = $curRes->compTitle(); + my $symbx = $curRes->symb(); + $studentTable.=''; + $studentTable.=''; + + my %newrecord=(); + my @displayPts=(); + foreach my $partid (@{$parts}) { + my $newpts = $ENV{'form.GD_BOX'.$question.'_'.$partid}; + my $oldpts = $ENV{'form.oldpts'.$question.'_'.$partid}; + + my $wgt = $ENV{'form.WGT'.$question.'_'.$partid} != 0 ? + $ENV{'form.WGT'.$question.'_'.$partid} : 1; + my $partial = $newpts/$wgt; + my $score; + if ($partial > 0) { + $score = 'correct_by_override'; + } elsif ($partial == 0) { + $score = 'incorrect_by_override'; + } + if ($ENV{'form.GD_SEL'.$question.'_'.$partid} eq 'excused') { + $partial = ''; + $score = 'excused'; + } + my $oldstatus = $ENV{'form.solved'.$question.'_'.$partid}; + $displayPts[0].=' Part '.$partid.' = '. + (($oldstatus eq 'excused') ? 'excused' : $oldpts). + ' 
'; + $displayPts[1].=' Part '.$partid.' = '. + ($oldstatus eq 'correct_by_student' ? $oldpts : + (($score eq 'excused') ? 'excused' : $newpts)). + ' 
'; + + $question++; + if (($oldstatus eq 'correct_by_student') || + ($newpts eq $oldpts && $score eq $oldstatus)) + { + next; + } + $newrecord{'resource.'.$partid.'.awarded'} = $partial if $partial ne ''; + $newrecord{'resource.'.$partid.'.solved'} = $score; + $newrecord{'resource.'.$partid.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; + + $changeflag++; + } + if (scalar(keys(%newrecord)) > 0) { + &Apache::lonnet::cstore(\%newrecord,$symbx,$ENV{'request.course.id'}, + $udom,$uname); + } + $studentTable.=''. + ''. + ''; + + } + $curRes = $iterator->next(); + } + + $navmap->untieHashes(); + + $studentTable.='
 No  Title  Previous Score  New Score 
'.$question. + (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').'		 '.$title.' '.$displayPts[0].''.$displayPts[1].'
'; + $studentTable.=&show_grading_menu_form($ENV{'form.symb'},$ENV{'form.url'}); + my $grademsg=($changeflag == 0 ? 'No score was changed or updated.' : + 'The scores were changed for '. + $changeflag.' problem'.($changeflag == 1 ? '.' : 's.')); + $request->print($grademsg.$studentTable); + + return ''; +} + +#-------- end of section for handling grading by page/sequence --------- +# +#------------------------------------------------------------------- + +#--------------------Scantron Grading----------------------------------- +# +#------ start of section for handling grading by page/sequence --------- + +sub defaultFormData { + my ($symb,$url)=@_; + return ' + '."\n". + ''."\n". + ''."\n". + ''."\n"; +} + +sub getSequenceDropDown { + my ($request,$symb)=@_; + my $result=''; + return $result; +} + +sub scantron_uploads { + if (!-e $Apache::lonnet::perlvar{'lonScansDir'}) { return ''}; + my $result= '"; + return $result; +} + +sub scantron_scantab { + my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); + my $result=''."\n"; + + return $result; +} + +sub scantron_selectphase { + my ($r) = @_; + my ($symb,$url)=&get_symb_and_url($r); + if (!$symb) {return '';} + my $sequence_selector=&getSequenceDropDown($r,$symb); + my $default_form_data=&defaultFormData($symb,$url); + my $grading_menu_button=&show_grading_menu_form($symb,$url); + my $file_selector=&scantron_uploads(); + my $format_selector=&scantron_scantab(); + my $result; + $result.= < + + $default_form_data + + + + +
+ + + + + + + + + + + + + +
+  Specify file location and which Folder/Sequence to grade +
+ Sequence to grade: $sequence_selector +
+ Filename of scoring office file: $file_selector +
+ Format of data file: $format_selector +
+
+ + +$grading_menu_button +SCANTRONFORM + + return $result; +} + +sub get_scantron_config { + my ($which) = @_; + my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); + my %config; + foreach my $line (<$fh>) { + my ($name,$descrip)=split(/:/,$line); + if ($name ne $which ) { next; } + chomp($line); + my @config=split(/:/,$line); + $config{'name'}=$config[0]; + $config{'description'}=$config[1]; + $config{'CODElocation'}=$config[2]; + $config{'CODEstart'}=$config[3]; + $config{'CODElength'}=$config[4]; + $config{'IDstart'}=$config[5]; + $config{'IDlength'}=$config[6]; + $config{'Qstart'}=$config[7]; + $config{'Qlength'}=$config[8]; + $config{'Qoff'}=$config[9]; + $config{'Qon'}=$config[10]; + last; + } + return %config; +} + +sub username_to_idmap { + my ($classlist)= @_; + my %idmap; + foreach my $student (keys(%$classlist)) { + $idmap{$classlist->{$student}->[&Apache::loncoursedata::CL_ID]}= + $student; + } + return %idmap; +} + +sub scantron_parse_scanline { + my ($line,$scantron_config)=@_; + my %record; + my $questions=substr($line,$$scantron_config{'Qstart'}-1); + my $data=substr($line,0,$$scantron_config{'Qstart'}-1); + if ($$scantron_config{'CODElocation'} ne 0) { + if ($$scantron_config{'CODElocation'} < 0) { + $record{'scantron.CODE'}=substr($data,$$scantron_config{'CODEstart'}-1, + $$scantron_config{'CODElength'}); + } else { + #FIXME interpret first N questions + } + } + $record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1, + $$scantron_config{'IDlength'}); + my @alphabet=('A'..'Z'); + my $questnum=0; + while ($questions) { + $questnum++; + my $currentquest=substr($questions,0,$$scantron_config{'Qlength'}); + substr($questions,0,$$scantron_config{'Qlength'})=''; + if (length($currentquest) < $$scantron_config{'Qlength'}) { next; } + my (@array)=split(/$$scantron_config{'Qon'}/,$currentquest); + if (scalar(@array) gt 2) { + #FIXME do something intelligent with double bubbles + Apache->request->print("
Wha!!! 
".scalar(@array).
+				   '-'.$currentquest.'-'.$questnum.'

'); + } + if (length($array[0]) eq $$scantron_config{'Qlength'}) { + $record{"scantron.$questnum.answer"}=''; + } else { + $record{"scantron.$questnum.answer"}=$alphabet[length($array[0])]; + } + } + $record{'scantron.maxquest'}=$questnum; + return \%record; +} + +sub scantron_add_delay { +} + +sub scantron_find_student { + my ($scantron_record,$idmap)=@_; + my $scanID=$$scantron_record{'scantron.ID'}; + foreach my $id (keys(%$idmap)) { + Apache->request->print('
checking studnet -'.$id.'- againt -'.$scanID.'-
'); + if (lc($id) eq lc($scanID)) { Apache->request->print('success');return $$idmap{$id}; } + } + return undef; +} + +sub scantron_filter { + my ($curres)=@_; + if (ref($curres) && $curres->is_problem() && !$curres->randomout) { + return 1; + } + return 0; +} + +sub scantron_process_students { + my ($r) = @_; + my (undef,undef,$sequence)=split(/___/,$ENV{'form.selectpage'}); + my ($symb,$url)=&get_symb_and_url($r); + if (!$symb) {return '';} + my $default_form_data=&defaultFormData($symb,$url); + + my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); + my $scanlines=Apache::File->new($Apache::lonnet::perlvar{'lonScansDir'}."/$ENV{'form.scantron_selectfile'}"); + my @scanlines=<$scanlines>; + my $classlist=&Apache::loncoursedata::get_classlist(); + my %idmap=&username_to_idmap($classlist); + my $navmap=Apache::lonnavmaps::navmap->new($ENV{'request.course.fn'}.'.db',$ENV{'request.course.fn'}.'_parms.db',1, 1); + my $map=$navmap->getResourceByUrl($sequence); + my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); + $r->print("geto ".scalar(@resources)."
"); + my $result= < + + $default_form_data +SCANTRONFORM + $r->print($result); + + my @delayqueue; + my $totalcorrect; + my $totalincorrect; + + my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r, + 'Scantron Status','Scantron Progress',scalar(@scanlines)); + foreach my $line (@scanlines) { + my $studentcorrect; + my $studentincorrect; + + chomp($line); + my $scan_record=&scantron_parse_scanline($line,\%scantron_config); + my ($uname,$udom); + if ($uname=&scantron_find_student($scan_record,\%idmap)) { + &scantron_add_delay(\@delayqueue,$line, + 'Unable to find a student that matches'); + } + $r->print('
doing studnet'.$uname.'
'); + ($uname,$udom)=split(/:/,$uname); + &Apache::lonnet::delenv('form.counter'); + &Apache::lonnet::appenv(%$scan_record); +# &Apache::lonhomework::showhash(%ENV); + $Apache::lonxml::debug=1; + &Apache::lonxml::debug("line is $line"); + + my $i=0; + foreach my $resource (@resources) { + $i++; + my $result=&Apache::lonnet::ssi($resource->src(), + ('submitted' =>'scantron', + 'grade_target' =>'grade', + 'grade_username'=>$uname, + 'grade_domain' =>$udom, + 'grade_courseid'=>$ENV{'request.course.id'}, + 'grade_symb' =>$resource->symb())); + my %score=&Apache::lonnet::restore($resource->symb(), + $ENV{'request.course.id'}, + $udom,$uname); + foreach my $part ($resource->{PARTS}) { + if ($score{'resource.'.$part.'.solved'} =~ /^correct/) { + $studentcorrect++; + $totalcorrect++; + } else { + $studentincorrect++; + $totalincorrect++; + } + } + $r->print('
'.
+		      $resource->symb().'-'.
+		      $resource->src().'-'.'
result is'.$result); + &Apache::lonhomework::showhash(%score); + # if ($i eq 3) {last;} + } + &Apache::lonnet::delenv('form.counter'); + &Apache::lonnet::delenv('scantron\.'); + &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, + 'last student Who got a '.$studentcorrect.' correct and '. + $studentincorrect.' incorrect. The class has gotten '. + $totalcorrect.' correct and '.$totalincorrect.' incorrect'); + last; + #FIXME + #get iterator for $sequence + #foreach question 'submit' the students answer to the server + # through grade target { + # generate data to pass back that includes grade recevied + #} + } + $Apache::lonxml::debug=0; + foreach my $delay (@delayqueue) { + #FIXME + #print out each delayed student with interface to select how + # to repair student provided info + #Expected errors include + # 1 bad/no stuid/username + # 2 invalid bubblings + + } + #FIXME + # if delay queue exists 2 submits one to process delayed students one + # to ignore delayed students, possibly saving the delay queue for later + + $navmap->untieHashes(); +} +#-------- end of section for handling grading scantron forms ------- +# +#------------------------------------------------------------------- + + +#-------------------------- Menu interface ------------------------- +# +#--- Show a Grading Menu button - Calls the next routine --- +sub show_grading_menu_form { + my ($symb,$url)=@_; + my $result.='
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + '
'."\n"; + return $result; +} + +# -- Retrieve choices for grading form +sub savedState { + my %savedState = (); + if ($ENV{'form.saveState'}) { + foreach (split(/:/,$ENV{'form.saveState'})) { + my ($key,$value) = split(/=/,$_,2); + $savedState{$key} = $value; + } + } + return \%savedState; +} + +#--- Displays the main menu page ------- +sub gradingmenu { + my ($request) = @_; + my ($symb,$url)=&get_symb_and_url($request); + if (!$symb) {return '';} + my $probTitle = &Apache::lonnet::gettitle($symb); + + $request->print(< + function checkChoice(formname,val,cmdx) { + if (val <= 2) { + var cmd = radioSelection(formname.radioChoice); + var cmdsave = cmd; + } else { + cmd = cmdx; + cmdsave = 'submission'; + } + formname.command.value = cmd; + formname.saveState.value = "saveCmd="+cmdsave+":saveSec="+pullDownSelection(formname.section)+ + ":saveSub="+radioSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.Status); + if (val < 5) formname.submit(); + if (val == 5) { + if (!checkReceiptNo(formname,'notOK')) { return false;} + formname.submit(); + } + } + + function checkReceiptNo(formname,nospace) { + var receiptNo = formname.receipt.value; + var checkOpt = false; + if (nospace == "OK" && isNaN(receiptNo)) {checkOpt = true;} + if (nospace == "notOK" && (isNaN(receiptNo) || receiptNo == "")) {checkOpt = true;} + if (checkOpt) { + alert("Please enter a receipt number given by a student in the receipt box."); + formname.receipt.value = ""; + formname.receipt.focus(); + return false; + } + return true; + } + +GRADINGMENUJS + &commonJSfunctions($request); + my $result='

 Manual Grading/View Submission

'; + my ($table,$resptype,$hdgrade) = &showResourceInfo($url,$probTitle); + $result.=$table; + my (undef,$sections) = &getclasslist('all','0'); + my $savedState = &savedState(); + my $saveCmd = ($$savedState{'saveCmd'} eq '' ? 'submission' : $$savedState{'saveCmd'}); + my $saveSec = ($$savedState{'saveSec'} eq '' ? 'all' : $$savedState{'saveSec'}); + my $saveSub = ($$savedState{'saveSub'} eq '' ? 'all' : $$savedState{'saveSub'}); + my $saveStatus = ($$savedState{'saveStatus'} eq '' ? 'Active' : $$savedState{'saveStatus'}); + + $result.='
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n"; + + $result.='
'."\n". + ''."\n". + '
'."\n". + ' Select a Grading/Viewing Option
'."\n"; + + $result.=''; + $result.=''; + + $result.=''."\n"; + + $result.=''."\n"; + + $result.=''."\n"; + + $result.='
'."\n". + ' Select Section:   '; + + $result.='Student Status:'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef); + + if (ref($sections)) { + $result.=' (Section "no" implies the students were not assigned a section.)
' + if (grep /no/,@$sections); + } + $result.='
'. + ' '.'Current Resource: For one or more students'. + '
            -->For students with '. + ' submissions or '. + ' for all
'. + ' '. + 'Current Resource: For all students in selected section or course
'. + ' '. + 'The complete set/page/sequence: For one student

'. + ''. + '
'."\n"; + + $result.='		'; + + $result.=''; + $result.=''."\n"; + + $result.=''."\n"; + + if ((&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) && ($symb)) { + $result.=''."\n"; + } + + $result.='
'. + ''. + ' scores from file
'. + ' scantron forms
'. + ''. + ' submission Receipt no: '.unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}). + '-'. + '
'."\n". + '
'."\n". + '
'."\n"; + return $result; } sub handler { - my $request=$_[0]; + my $request=$_[0]; - if ( $ENV{'user.name'} eq 'albertel' ) {$Apache::lonxml::debug=1;} else {$Apache::lonxml::debug=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; - my $url=$ENV{'form.url'}; - my $symb=$ENV{'form.symb'}; - my $command=$ENV{'form.command'}; - - &send_header($request); - if ($url eq '' && $symb eq '') { - $request->print("Non-Contextual Access Unsupported:$command:$url:"); - } else { - $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}); - if ($command eq 'submission') { - $request->print(&submission($request)); - } elsif ($command eq 'viewgrades') { - $request->print(&viewgrades($request)); - } elsif ($command eq 'editgrades') { - $request->print(&editgrades($request)); + undef(%perm); + if ($ENV{'browser.mathml'}) { + $request->content_type('text/xml'); } else { - $request->print("Unknown action:$command:"); + $request->content_type('text/html'); } - } - &send_footer($request); - return OK; + $request->send_http_header; + return '' 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_body('/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 { + if (!($perm{'vgr'}=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}))) { + if ($perm{'vgr'}=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}.'/'.$ENV{'request.course.sec'})) { + $perm{'vgr_section'}=$ENV{'request.course.sec'}; + } else { + delete($perm{'vgr'}); + } + } + if (!($perm{'mgr'}=&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}))) { + if ($perm{'mgr'}=&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}.'/'.$ENV{'request.course.sec'})) { + $perm{'mgr_section'}=$ENV{'request.course.sec'}; + } else { + delete($perm{'mgr'}); + } + } + + if ($command eq 'submission' && $perm{'vgr'}) { + ($ENV{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0)); + } elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) { + &pickStudentPage($request); + } elsif ($command eq 'displayPage' && $perm{'vgr'}) { + &displayPage($request); + } elsif ($command eq 'gradeByPage' && $perm{'mgr'}) { + &updateGradeByPage($request); + } elsif ($command eq 'processGroup' && $perm{'vgr'}) { + &processGroup($request); + } elsif ($command eq 'gradingmenu' && $perm{'vgr'}) { + $request->print(&gradingmenu($request)); + } elsif ($command eq 'viewgrades' && $perm{'vgr'}) { + $request->print(&viewgrades($request)); + } elsif ($command eq 'handgrade' && $perm{'mgr'}) { + $request->print(&processHandGrade($request)); + } elsif ($command eq 'editgrades' && $perm{'mgr'}) { + $request->print(&editgrades($request)); + } elsif ($command eq 'verify' && $perm{'vgr'}) { + $request->print(&verifyreceipt($request)); + } elsif ($command eq 'csvform' && $perm{'mgr'}) { + $request->print(&upcsvScores_form($request)); + } elsif ($command eq 'csvupload' && $perm{'mgr'}) { + $request->print(&csvupload($request)); + } elsif ($command eq 'csvuploadmap' && $perm{'mgr'} ) { + $request->print(&csvuploadmap($request)); + } elsif ($command eq 'csvuploadassign' && $perm{'mgr'}) { + 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)); + } + } elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) { + $request->print(&scantron_selectphase($request)); + } elsif ($command eq 'scantron_process' && $perm{'mgr'}) { + $request->print(&scantron_process_students($request)); + } elsif ($command) { + $request->print("Access Denied"); + } + } + &send_footer($request); + return ''; +} + +sub send_header { + my ($request)= @_; + $request->print(&Apache::lontexconvert::header()); +# $request->print(" +#"); + $request->print(&Apache::loncommon::bodytag('Grading')); +} + +sub send_footer { + my ($request)= @_; + $request->print(''); + $request->print(&Apache::lontexconvert::footer()); } 1;