--- loncom/homework/grades.pm 2003/02/27 21:05:58 1.68 +++ loncom/homework/grades.pm 2003/04/30 20:16:02 1.88 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.68 2003/02/27 21:05:58 ng Exp $ +# $Id: grades.pm,v 1.88 2003/04/30 20:16:02 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -32,7 +32,7 @@ # Year 2002 # June-August H.K. Ng # Year 2003 -# February H.K. Ng +# February, March H.K. Ng # package Apache::grades; @@ -46,6 +46,9 @@ use Apache::lonhomework; use Apache::loncoursedata; use Apache::lonmsg qw(:user_normal_msg); use Apache::Constants qw(:common); +use String::Similarity; + +my %oldessays=(); # ----- These first few routines are general use routines.---- # @@ -113,7 +116,7 @@ sub response_type { #--- Dumps the class list with usernames,list of sections, #--- section, ids and fullnames for each user. sub getclasslist { - my ($getsec,$hideexpired) = @_; + my ($getsec,$filterlist) = @_; my $classlist=&Apache::loncoursedata::get_classlist(); # Bail out if we were unable to get the classlist return if (! defined($classlist)); @@ -124,11 +127,13 @@ sub getclasslist { # the following undefs are for 'domain', and 'username' respectively. my (undef,undef,$end,$start,$id,$section,$fullname,$status)= @{$classlist->{$_}}; - # still a student? - if (($hideexpired) && ($status ne 'Active')) { - delete ($classlist->{$_}); - next; - } + # 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 ($getsec eq 'all' || $getsec eq $section) { $sections{$section}++; @@ -209,6 +214,8 @@ sub jscriptNform { $jscript.= '
'."\n". ''."\n". ''."\n". + ''."\n". + ''."\n". ''."\n". ''."\n". ''."\n". @@ -217,6 +224,50 @@ sub jscriptNform { } #------------------ 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 @@ -237,7 +288,7 @@ sub verifyreceipt { my $title.='

Verifying Submission Receipt '. $receipt.'

'."\n". - 'Resource: '.$ENV{'form.url'}.'

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

'."\n"; my ($string,$contents,$matches) = ('','',0); my (undef,undef,$fullname) = &getclasslist('all','0'); @@ -272,10 +323,6 @@ sub verifyreceipt { return $string.&show_grading_menu_form($symb,$url); } -# -# Pick student and page/sequence for manual grading - - #--- 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 @@ -283,7 +330,7 @@ sub verifyreceipt { sub listStudents { my ($request) = shift; - my ($symb,$url) = &get_symb_and_url(); + 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'}; @@ -298,15 +345,17 @@ sub listStudents { 'Type: '.$responsetype.''. 'Handgrade: '.$handgrade.''; } - $result.=''; + $result.=''."\n"; my $viewgrade = $ENV{'form.handgrade'} eq 'yes' ? 'View/Grade' : 'View'; + $ENV{'form.probTitle'} = $ENV{'form.probTitle'} eq '' ? + &Apache::lonnet::gettitle($symb) : $ENV{'form.probTitle'}; $result='

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

'. - ''.$result; + '
'. - 'Resource: '.$url.'
'.$result; $request->print(< @@ -341,8 +390,8 @@ LISTJAVASCRIPT my $checklastsub = $ENV{'form.handgrade'} eq 'yes' ? '' : 'checked'; my $gradeTable=''."\n". - ' View Problem: no '."\n". - ' one student '."\n". + ' View Problem: no '."\n". + ' one student '."\n". ' all students
'."\n". ' Submissions: '."\n"; if ($ENV{'form.handgrade'} eq 'yes') { @@ -356,6 +405,8 @@ LISTJAVASCRIPT ''."\n". '
'."\n". '
'."\n". + ''."\n". + ''."\n". ''."\n". ''."\n". 'To '.lc($viewgrade).' a submission, click on the check box next to the student\'s name. Then '."\n". @@ -366,7 +417,7 @@ LISTJAVASCRIPT 'onClick="javascript:checkSelect(this.form.stuinfo);" '."\n". 'value="'.$viewgrade.'" />'."\n"; - my (undef,undef,$fullname) = &getclasslist($getsec,'0'); + my (undef,undef,$fullname) = &getclasslist($getsec,$ENV{'form.showgrading'} eq 'yes' ? '1' : '0'); $gradeTable.='
'. + 'Problem: '.$ENV{'form.probTitle'}.'
'. ''. @@ -455,96 +506,182 @@ sub sub_page_js { my $request = shift; $request->print(< - function updateRadio(radioButton,formtextbox,formsel,scores,weight) { - var pts = formtextbox.value; - var resetbox =false; - if (isNaN(pts) || pts < 0) { - alert("A number equal or greater than 0 is expected. Entered value = "+pts); - for (var i=0; i weight) { + var resp = confirm("You entered a value ("+pts+ + ") greater than the weight for the part. Accept?"); + if (resp == false) { + gradeBox.value = ""; + return; + } } - return; - } - if (pts > weight) { - var resp = confirm("You entered a value ("+pts+ - ") greater than the weight for the part. Accept?"); - if (resp == false) { - formtextbox.value = ""; - return; - } + for (var i=0; i +SUBJAVASCRIPT +} - } - document.SCORE.submit(); - } +#--- javascript for essay type problem -- +sub sub_page_kw_js { + my $request = shift; + my $iconpath = $request->dir_config('lonIconsURL'); + $request->print(< //===================== Show list of keywords ==================== function keywords(keyform) { - var keywds = keyform.value; - var nret = prompt("Keywords list, separated by a space. Add/delete to list if desired.",keywds); + var nret = prompt("Keywords list, separated by a space. Add/delete to list if desired.",keyform.value); if (nret==null) return; keyform.value = nret; @@ -586,6 +723,12 @@ sub sub_page_js { } //====================== 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); @@ -613,91 +756,102 @@ sub sub_page_js { return; } +// var pWin = null; function savedMsgHeader(Nmsg,usrctr,fullname) { - var height = 30*Nmsg+250; + var height = 70*Nmsg+250; var scrollbar = "no"; if (height > 600) { height = 600; scrollbar = "yes"; } -/* if (window.pWin) - window.pWin.close(); */ +// if (window.pWin) {window.pWin.close(); window.pWin=null} pWin = window.open('', 'MessageCenter', 'toolbar=no,location=no,scrollbars='+scrollbar+',screenx=70,screeny=75,width=600,height='+height); - pWin.document.write(""); - pWin.document.write("Message Central"); - - pWin.document.write(" SUBJAVASCRIPT } +#--- 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.=''. + ''."\n"; + } + $result.="  \n"; + $result.=''."\n". + ''."\n". + ''."\n"; + $result.='
'."\n"; + return $result; +} sub show_problem { - my ($request,$symb,$uname,$udom,$removeform) = @_; + my ($request,$symb,$uname,$udom,$removeform,$viewon) = @_; my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, $ENV{'request.course.id'}); if ($removeform) { @@ -815,13 +1029,14 @@ sub show_problem { $rendered=~s|name="submit"|name="would_have_been_submit"|g; } my $result.='
'; - $result.='
'; - $result.=' View of the problem - '.$ENV{'form.fullname'}. - '
'.$rendered.'
'; + $result.=''; + $result.='' if ($viewon); + $result.='
View of the problem - '.$ENV{'form.fullname'}. + '
'.$rendered.'
'; $result.='Correct answer:
'.$companswer; $result.='
'; $result.='

'; - $request->print($result); + return $result; } # --------------------------- show submissions of a student, option to grade @@ -829,27 +1044,28 @@ sub submission { my ($request,$counter,$total) = @_; (my $url=$ENV{'form.url'})=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; -# if ($ENV{'form.student'} eq '') { &moreinfo($request,'Need student login id'); return ''; } my ($uname,$udom) = ($ENV{'form.student'},$ENV{'form.userdom'}); ($uname,$udom) = &finduser($uname) if $udom eq ''; $ENV{'form.fullname'} = &get_fullname ($uname,$udom) if $ENV{'form.fullname'} eq ''; -# if ($uname eq '') { &moreinfo($request,'Unable to find student'); return ''; } my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))); if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : ''); -# $ENV{'form.vProb'} = $ENV{'form.vProb'} ne '' ? $ENV{'form.vProb'} : 'yes'; # header info if ($counter == 0) { &sub_page_js($request); + &sub_page_kw_js($request); + $ENV{'form.probTitle'} = $ENV{'form.probTitle'} eq '' ? + &Apache::lonnet::gettitle($symb) : $ENV{'form.probTitle'}; + $request->print('

 Submission Record

'."\n". - ' Resource: '.$url.''."\n"); + ' Problem: '.$ENV{'form.probTitle'}.''."\n"); # 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'}) { - &show_problem($request,$symb,$uname,$udom,0); + $request->print(&show_problem($request,$symb,$uname,$udom,0,1)); } # kwclr is the only variable that is guaranteed to be non blank @@ -866,13 +1082,15 @@ sub submission { $ENV{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; $ENV{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; $ENV{'form.msgsub'} = $keyhash{$symb.'_subject'} ne '' ? - $keyhash{$symb.'_subject'} : &Apache::lonnet::metadata($url,'title'); + $keyhash{$symb.'_subject'} : $ENV{'form.probTitle'}; $ENV{'form.savemsgN'} = $keyhash{$symb.'_savemsgN'} ne '' ? $keyhash{$symb.'_savemsgN'} : '0'; } $request->print(''."\n". ''."\n". + ''."\n". + ''."\n". ''."\n". ''."\n". ''."\n". @@ -895,13 +1113,18 @@ sub submission { 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    @@ -909,12 +1132,20 @@ sub submission { CLASS="page">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('


'); - &show_problem($request,$symb,$uname,$udom,1); + $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); @@ -935,7 +1166,6 @@ KEYWORDS my @col_fullnames; my ($classlist,$fullname); if ($ENV{'form.handgrade'} eq 'yes') { - my @col_list; ($classlist,undef,$fullname) = &getclasslist('all','0'); for (keys (%$handgrade)) { my $ncol = &Apache::lonnet::EXT('resource.'.$_. @@ -944,50 +1174,46 @@ KEYWORDS next if ($ncol <= 0); s/\_/\./g; next if ($record{'resource.'.$_.'.collaborators'} eq ''); - my (@collaborators) = split(/,?\s+/, - $record{'resource.'.$_.'.collaborators'}); - my (@badcollaborators); - if (scalar(@collaborators) != 0) { + 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 my $collaborator (@collaborators) { - my ($co_name,$co_dom) = split /\@|:/,$collaborator; - $co_dom = $udom if (! defined($co_dom)); - 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,$collaborator; - next; - } - push @col_list, @Matches; - foreach (@Matches) { - my ($lastname,$givenn) = split(/,/,$$fullname{$_}); - push @col_fullnames, $givenn.' '.$lastname; - $result.=$$fullname{$_}.'     '; - } - } + foreach (@goodcollaborators) { + my ($lastname,$givenn) = split(/,/,$$fullname{$_}); + push @col_fullnames, $givenn.' '.$lastname; + $result.=$$fullname{$_}.'     '; + } $result.='
'."\n"; - if (scalar(@badcollaborators) > 0) { - $result.=''."\n" + 'Answer:
'. + &keywords_highlight($subval).'

 '.$similar.''."\n" if ($ENV{'form.lastSub'} eq 'lastonly' || ($ENV{'form.lastSub'} eq 'hdgrade' && $$handgrade{$part} =~ /:yes$/)); @@ -1050,6 +1285,9 @@ KEYWORDS # return if view submission with no grading option if ($ENV{'form.showgrading'} eq '') { $request->print('
'; - $result.='This student has submitted '; - if (scalar(@badcollaborators) == 1) { - $result .= 'an invalid collaborator'; - } else { - $result .= 'invalid collaborators'; - } - $result .= ': '.join(', ',@badcollaborators); - - } - if (scalar(@collaborators > $ncol)) { - $result .= '
'; - $result .= 'This student has sumbitted too many '. - 'collaborators. Maximum is '.$ncol; - $result .= '
'; - } - $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"); @@ -1010,7 +1236,7 @@ KEYWORDS } else { my ($string,$timestamp)= &get_last_submission (%record); - my $lastsubonly.=''. + my $lastsubonly=''. ($$timestamp eq '' ? '' : 'Date Submitted: '. $$timestamp).''; if ($$timestamp eq '') { @@ -1021,6 +1247,15 @@ KEYWORDS my ($partid,$respid) = /^resource\.(\d+)\.(\d+)\.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. ' )   '. @@ -1028,8 +1263,8 @@ KEYWORDS ' File uploaded by student Like all files provided by users, this file may contain virusses
':''). - 'Answer: '. - &keywords_highlight($subval).'
'."\n"); + $request->print(&show_grading_menu_form($symb,$url)) + if (($ENV{'form.command'} eq 'submission') || + ($ENV{'form.command'} eq 'processGroup' && $counter == $total)); return; } @@ -1064,10 +1302,13 @@ KEYWORDS my $lastone = pop @col_fullnames; $msgfor .= ', '.(join ', ',@col_fullnames).' and '.$lastone.'.'; } + $msgfor =~ s/\'/\\'/g; #\' $result.='
'."\n". ' '. - 'Compose Message to student'.(scalar(@col_fullnames) >= 1 ? 's' : '').''. + '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); @@ -1080,54 +1321,8 @@ KEYWORDS $seen{$partid}++; next if ($$handgrade{$_} =~ /:no$/); push @partlist,$partid; - my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname); - my $wgtmsg = ($wgt > 0 ? '(problem weight)' : - 'problem weight assigned by computer'); - $wgt = ($wgt > 0 ? $wgt : '1'); - my $score = ($record{'resource.'.$partid.'.awarded'} eq '' ? - '' : $record{'resource.'.$partid.'.awarded'}*$wgt); - $result=''; - $result.=''; - $result.=''."\n"; - $result.='
Part '.$partid.' Points: '; - - my $ctr = 0; - $result.=''; # display radio buttons in a nice table 10 across - while ($ctr<=$wgt) { - $result.= '\n"; - $result.=(($ctr+1)%10 == 0 ? '' : ''); - $ctr++; - } - $result.='
'.$ctr."
'; - $result.='		 or /'.$wgt.' '.$wgtmsg.' '; - - $result.=''; - } else { - $result.=''. - ''; - } - $result.="  \n"; - $result.=''; - $result.='
'."\n"; - $request->print($result); + $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record)); } $result=''."\n"; @@ -1145,7 +1340,7 @@ KEYWORDS ''."\n"; if ($ENV{'form.handgrade'} eq 'yes') { $endform.='  '."\n"; my $ntstu =''."\n"; } $endform.='  '."\n". + 'onClick="javascript:checksubmit(this.form,\'Next\');" TARGET=_self>  '."\n". '  '; + 'onClick="javascript:checksubmit(this.form,\'Previous\');" TARGET=_self>  '; $endform.='(Next and Previous do not save the scores.)'."\n" if ($ENV{'form.handgrade'} eq 'yes'); $endform.='
'; @@ -1180,9 +1375,7 @@ sub get_last_submission { for ($version=1;$version<=$returnhash{'version'};$version++) { foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) { $lasthash{$_}=$returnhash{$version.':'.$_}; -# if ($returnhash{$version.':'.$_} =~ /(SUBMITTED|DRAFT)$/) { $timestamp = scalar(localtime($returnhash{$version.':timestamp'})); -# } } } foreach ((keys %lasthash)) { @@ -1229,8 +1422,11 @@ sub processHandGrade { my $ctr = 0; while ($ctr < $ngrade) { my ($uname,$udom) = split(/:/,$ENV{'form.unamedom'.$ctr}); - my ($errorflag) = &saveHandGrade($request,$url,$symb,$uname,$udom,$ctr); - + my ($errorflag,$pts,$wgt) = &saveHandGrade($request,$url,$symb,$uname,$udom,$ctr); + if ($errorflag eq 'no_score') { + $ctr++; + next; + } my $includemsg = $ENV{'form.includemsg'.$ctr}; my ($subject,$message,$msgstatus) = ('','',''); if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) { @@ -1239,7 +1435,11 @@ sub processHandGrade { foreach (@msgnum) { $message.=$ENV{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne ''); } - $message =~ s/\s+/ /g; + $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); } @@ -1300,12 +1500,20 @@ sub processHandGrade { $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); # Called by Save & Refresh from Highlight Attribute Window + my (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'0'); if ($ENV{'form.refresh'} eq 'on') { - my $ctr = 0; - $ENV{'form.NTSTU'}=$ngrade; + my ($ctr,$total) = (0,0); while ($ctr < $ngrade) { - ($ENV{'form.student'},$ENV{'form.userdom'}) = split(/:/,$ENV{'form.unamedom'.$ctr}); - &submission($request,$ctr,$ngrade-1); + $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 ''; @@ -1321,7 +1529,6 @@ sub processHandGrade { $laststu = $firststu if ($ctr > $ngrade); } - my (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'0'); my (@parsedlist,@nextlist); my ($nextflg) = 0; foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { @@ -1361,8 +1568,6 @@ sub processHandGrade { $ENV{'form.student'} = $uname; $ENV{'form.userdom'} = $udom; $ENV{'form.fullname'} = $$fullname{$_}; -# $ENV{'form.'.$_.':submitted_by'} = $submitter; -# print "submitter=$ENV{'form.'.$_.':submitted_by'}= $submitter:
"; &submission($request,$ctr,$total); $ctr++; } @@ -1379,8 +1584,9 @@ sub processHandGrade { #---- Save the score and award for each student, if changed sub saveHandGrade { my ($request,$url,$symb,$stuname,$domain,$newflg,$submitter) = @_; - my %record=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},$domain,$stuname); - my %newrecord; + 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') { @@ -1390,10 +1596,11 @@ sub saveHandGrade { } } } else { - my $pts = ($ENV{'form.GD_BOX'.$newflg.'_'.$_} ne '' ? - $ENV{'form.GD_BOX'.$newflg.'_'.$_} : - $ENV{'form.RADVAL'.$newflg.'_'.$_}); - my $wgt = $ENV{'form.WGT'.$newflg.'_'.$_} eq '' ? 1 : + $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; $newrecord{'resource.'.$_.'.awarded'} = $partial @@ -1408,15 +1615,15 @@ sub saveHandGrade { } $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) { - $newrecord{'resource.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; &Apache::lonnet::cstore(\%newrecord,$symb, $ENV{'request.course.id'},$domain,$stuname); } - return ''; + return '',$pts,$wgt; } #-------------------------------------------------------------------------------------- @@ -1601,7 +1808,7 @@ sub viewgrades { my ($symb,$url) = ($ENV{'form.symb'},$ENV{'form.url'}); my $result='

Manual Grading

'; - $result.='Resource: '.$ENV{'form.url'}.''."\n"; + $result.='Problem: '.$ENV{'form.probTitle'}.''."\n"; #view individual student submission form - called using Javascript viewOneStudent $result.=&jscriptNform($url,$symb); @@ -1611,7 +1818,10 @@ sub viewgrades { ''."\n". ''."\n". ''."\n". - ''."\n"; + ''."\n". + ''."\n". + ''."\n"; + $result.='

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

'; @@ -1622,12 +1832,6 @@ sub viewgrades { } $result.= '
'."\n". '
'; -# $result.='To assign the same score for all the students use the radio buttons or '. -# 'text box below. To assign scores individually fill in the score boxes for '. -# 'each student in the table below. A part that has already '. -# 'been graded does not get changed using the radio buttons or text box. '. -# 'If needed, it has to be changed individually.'; -# $result.='
'; #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'}); @@ -1706,7 +1910,7 @@ sub viewgrades { #get info for each student #list all the students - with points and grade status - my (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'0'); + 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,$udom) = split(/:/); @@ -1777,9 +1981,8 @@ sub editgrades { my $symb=$ENV{'form.symb'}; my $url =$ENV{'form.url'}; my $title='

Current Grade Status

'; - $title.='Resource: '.$ENV{'form.url'}.'
'."\n"; + $title.='Problem: '.$ENV{'form.probTitle'}.'
'."\n"; $title.='Section: '.$ENV{'form.section'}.''."\n"; - $title.= &show_grading_menu_form ($symb,$url); my $result= '
'."\n"; $result.= ''. ''."\n"; @@ -1879,6 +2082,7 @@ sub editgrades { 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; } $result .= ''. @@ -1888,12 +2092,12 @@ sub editgrades { $result .= ''."\n"; if ($updateflag) { $count++; - $newrecord{'resource.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; &Apache::lonnet::cstore(\%newrecord,$symb,$ENV{'request.course.id'}, $udom,$user); } } - $result .= '
UsernameFullname'.$old_aw.' 
'."\n"; + $result .= '
'."\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'}.'
'; @@ -2001,7 +2205,7 @@ sub csvuploadmap_header { } my $result=''; - $result.=''; + $result.=''; my ($partlist,$handgrade) = &response_type($url); my ($resptype,$hdgrade)=('','no'); for (sort keys(%$handgrade)) { @@ -2032,6 +2236,8 @@ to this page if the data selected is ins value="$ENV{'form.upfile_associate'}" /> + +
+CSVFORMJS + $ENV{'form.probTitle'} = &Apache::lonnet::gettitle($symb); + $result.='
Resource: '.$url.'
Problem: '.$ENV{'form.probTitle'}.'
'."\n"; + $result.=''."\n"; + $result.='
'."\n"; + $result.=' Specify a file containing the class scores for problem - '.$ENV{'form.probTitle'}. + '.
'."\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); @@ -2100,6 +2349,8 @@ sub csvuploadmap { } } &csvuploadmap_footer($request,$i,$keyfields); + $request->print(&show_grading_menu_form($symb,$url)); + return ''; } @@ -2163,182 +2414,10 @@ sub csvuploadassign { #------------- end of section for handling csv file upload --------- # #------------------------------------------------------------------- - -#-------------------------- 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"; - return $result; -} - -#--- Displays the main menu page ------- -sub gradingmenu { - my ($request) = @_; - my ($symb,$url)=&get_symb_and_url($request); - if (!$symb) {return '';} - my $result='

 Select a Grading Method

'; - $result.=''; - $result.=''; - my ($partlist,$handgrade) = &response_type($url); - my ($resptype,$hdgrade)=('','no'); - for (sort keys(%$handgrade)) { - my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_}); - $resptype = $responsetype; - $hdgrade = $handgrade if ($handgrade eq 'yes'); - $result.=''. - ''. - ''; - } - $result.='
Resource: '.$url.'
Part '.(split(/_/))[0].'Type: '.$responsetype.'Handgrade: '.$handgrade.'
'; - $result.=&view_edit_entire_class_form($symb,$url).'
'; - $result.=&upcsvScores_form($symb,$url).'
'; - $result.=&viewGradeaStu_form($symb,$url,$resptype,$hdgrade).'
'; - $result.=&gradeByPage_form($symb,$url,$resptype,$hdgrade).'
'; - $result.=&verifyReceipt_form($symb,$url) - if ((&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) && ($symb)); - - return $result; -} - -#--- Menu for grading a section or the whole class --- -sub view_edit_entire_class_form { - my ($symb,$url)=@_; - my ($classlist,$sections,undef) = &getclasslist('all','0'); - my $result.='
'."\n"; - $result.=''."\n"; - $result.='
'."\n"; - $result.=' Grade Entire Section or Class
'."\n"; - $result.='
'."\n". - ''."\n". - ''."\n". - ''."\n"; - $result.=' Select section: '."
\n"; - $result.=' 
'."\n"; - $result.='
'."\n"; - $result.='
'."\n"; - return $result; -} - -#--- Menu to upload a csv scores --- -sub upcsvScores_form { - my ($symb,$url) = @_; - if (!$symb) {return '';} - my $result = ''."\n"; - - $result.='
'."\n"; - $result.=''."\n"; - $result.='
'."\n"; - $result.=' Specify a file containing the class scores for above resource
'."\n"; - my $upfile_select=&Apache::loncommon::upfile_select_html(); - $result.=< - - - -$upfile_select -
  - -ENDUPFORM - $result.='
'."\n"; - $result.='
'."\n"; - return $result; -} - -#--- Handgrading problems --- -sub viewGradeaStu_form { - my ($symb,$url,$response,$handgrade) = @_; - my ($classlist,$sections) = &getclasslist('all','0'); - my $result.='
'."\n"; - $result.=''."\n"; - $result.='
'."\n"; - $result.=' '; - $result.=($handgrade eq 'yes' ? 'View/Grade' : 'View').' an Individual Student\'s Submission
'."\n"; - $result.='
'."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n"; - - $result.=' Select section: '."\n"; - $result.='  Display students who has: '. - ' submitted'. - ' everybody
'; - if (ref($sections)) { - $result.=' (Section "no" implies the students were not assigned a section.)
' - if (grep /no/,@$sections); - } - - - $result.='
 '."\n"; - $result.='
'."\n"; - $result.='
'."\n"; - return $result; -} - -#--- Handgrading problems by page/sequence for each student --- -sub gradeByPage_form { - my ($symb,$url,$response,$handgrade) = @_; - my ($classlist,$sections) = &getclasslist('all','0'); - my $result.='
'."\n"; - $result.=''."\n"; - $result.='
'."\n"; - $result.=' '; - $result.='Handgrade an Individual Student\'s by Page/Sequence
'."\n"; - $result.=''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n"; - - $result.=' Select section: '."\n"; - - $result.='
 '."\n".''."\n"; - $result.='
'."\n"; - $result.='
'."\n"; - return $result; -} - - +#-------------- Next few routines handles grading by page/sequence +# +#--- Select a page/sequence and a student to grade sub pickStudentPage { my ($request) = shift; @@ -2346,28 +2425,46 @@ sub pickStudentPage { LISTJAVASCRIPT - my ($symb,$url) = &get_symb_and_url(); + 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'}; @@ -2375,32 +2472,49 @@ LISTJAVASCRIPT my $result='

 '. 'Manual Grading by Page or Sequence

'; - my ($pagepath,$pagename,$type,$mapId) = ($symb =~ /(.*\/)(.*?\.(page|sequence))___(\d+)___/); - my $curtitle = &Apache::lonnet::metadata($pagepath.$pagename,'title'); - - $result.='
'."
\n"; - $result.=' Problems from: '."\n"; + my ($titles,$symbx) = &getSymbMap($request); + my ($curpage,$type,$mapId) = ($symb =~ /(.*?\.(page|sequence))___(\d+)___/); + my $ctr=0; foreach (@$titles) { my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); - my $check_select = ($showtitle eq $curtitle ? 'selected="on"' : ''); - $result.=''."\n"; + $result.=''."\n"; + $ctr++; } $result.= ''."
\n"; + $ctr=0; + foreach (@$titles) { + my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); + $result.=''."\n"; + $result.=''."\n"; + $ctr++; + } + $result.=''."\n". + ''."\n"; + + $result.=' View Problems: no '."\n". + ' yes '."
\n"; + + $result.=' Submission Details: '. + ' none'."\n". + ' dates and submissions'."\n". + ' all details'."\n"; -# $result.=' View Problems: no '."\n". -# ' yes '."
\n"; -# $result.=' Submission Details: '. -# ' last sub only'."\n". -# ' all details'."\n"; $result.=''."\n". - ''."\n". - ''."\n". - ''."

\n"; + ''."\n". + ''."\n". + ''."\n". + ''."
\n"; + + $result.=' 
'."\n"; + $request->print($result); - my $studentTable.=' Select a Student you wish to grade
'. + my $studentTable.=' Select a student you wish to grade
'. '
'. ''. ''. @@ -2408,12 +2522,12 @@ LISTJAVASCRIPT ''. ''; - my (undef,undef,$fullname) = &getclasslist($getsec,'0'); + 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++; @@ -2422,7 +2536,8 @@ LISTJAVASCRIPT $studentTable.='
 Fullname (username) Fullname (username) Fullname (username)
' : ''); - $studentTable.=' '.$$fullname{$student}. + $studentTable.=' '.$$fullname{$student}. ' ('.$uname.($udom eq $cdom ? '':':'.$udom).')'."\n"; $studentTable.=($ptr%4 == 0 ? '
  ' if ($ptr%4 == 3); $studentTable.=' ' if ($ptr%4 == 0); $studentTable.='
'."\n"; - $studentTable.='
 
'."\n"; + $studentTable.='
 '."\n"; $studentTable.=&show_grading_menu_form($symb,$url); $request->print($studentTable); @@ -2431,8 +2546,8 @@ LISTJAVASCRIPT } sub getSymbMap { - my $navmap = Apache::lonnavmaps::navmap-> new( - $ENV{'request.course.fn'}.'.db', + my ($request) = @_; + my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', $ENV{'request.course.fn'}.'_parms.db',1, 1); my $res = $navmap->firstResource(); # temp resource to access constants @@ -2453,10 +2568,32 @@ sub getSymbMap { if ($curRes == $iterator->END_MAP()) { $depth--; } if (ref($curRes) && $curRes->is_map()) { - my $title = $curRes->compTitle(); - push @titles,$minder.'.'.$title; # minder, just in case two titles are identical - $symbx{$minder.'.'.$title} = $curRes->symb(); - $minder++; + my ($mapUrl, $id, $resUrl) = split(/___/, $curRes->symb()); # check map contains at least one problem + my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps + + my $mapiterator = $navmap->getIterator($map->map_start(), + $map->map_finish()); + + my $mapdepth = 1; + my $countProblems = 0; + $mapiterator->next(); # skip the first BEGIN_MAP + my $mapcurRes = $mapiterator->next(); # for "current resource" + my $ctr=0; + while ($mapdepth > 0 && $ctr < 100) { + if($mapcurRes == $mapiterator->BEGIN_MAP) { $mapdepth++; } + if($mapcurRes == $mapiterator->END_MAP) { $mapdepth++; } + + if (ref($mapcurRes) && $mapcurRes->is_problem() && !$mapcurRes->randomout) { + $countProblems++; + } + $ctr++; + } + if ($countProblems > 0) { + my $title = $curRes->compTitle(); + push @titles,$minder.'.'.$title; # minder, just in case two titles are identical + $symbx{$minder.'.'.$title} = $curRes->symb(); + $minder++; + } } $curRes = $iterator->next(); } @@ -2465,143 +2602,789 @@ sub getSymbMap { 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 (undef,undef,$fullname) = &getclasslist($getsec,'0'); - my ($uname,$udom) = split(/:/,$ENV{'form.pickOne'}); - my ($idx,$showtitle) = ($pageTitle =~ /(\d+)\.(.*)/); + my (undef,undef,$fullname) = &getclasslist($getsec,'1'); + my ($uname,$udom) = split(/:/,$ENV{'form.student'}); - my $result='

 '.$showtitle.'

'; - $result.='

 Student: '.$$fullname{$ENV{'form.pickOne'}}. + my $result='

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

'; + $result.='

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

'."\n"; - my ($pg_titles,$pg_symbx) = &getSymbMap(); + &sub_page_js($request); + $request->print($result); - my $navmap = Apache::lonnavmaps::navmap-> new( - $ENV{'request.course.fn'}.'.db', + my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', $ENV{'request.course.fn'}.'_parms.db',1, 1); - - my ($mapUrl, $id, $resUrl) = split(/___/, $$pg_symbx{$ENV{'form.page'}}); + 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 $depth = 1; + my $studentTable='
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n"; + + my $checkIcon = ''; + + $studentTable.=' Note: A problem graded correct ('.$checkIcon. + ') by the computer cannot be changed.'."\n". + '
'. + ''. + ''. + ''; + + my ($depth,$ctr,$question) = (1,0,1); $iterator->next(); # skip the first BEGIN_MAP my $curRes = $iterator->next(); # for "current resource" - my %symbx = (); - my @titles = (); - my %parts = (); - my $ctr=0; - my $minder=0; while ($depth > 0 && $ctr < 100) { # ctr, just in case it never gets out of loop if($curRes == $iterator->BEGIN_MAP) { $depth++; } if($curRes == $iterator->END_MAP) { $depth++; } if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) { my $parts = $curRes->parts(); + $parts = &temp_parts_fix($parts); # remove line when lonnavmap is fixed my $title = $curRes->compTitle(); - push @titles,$minder.'.'.$title; # minder, just in case two titles are identical - if (scalar(@{$parts}) > 1) { shift @{$parts}; } - for my $part (@$parts) { - $result.='title='.$title.'part='.$part.':
'; + my $symbx = $curRes->symb(); + $studentTable.=''; + $studentTable.=''; } $curRes = $iterator->next(); $ctr++; } - $navmap->init(); + $studentTable.='
 No  '.($ENV{'form.vProb'} eq 'no' ? 'Title' : 'Problem View').'/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) { #//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 { + $studentTable.='
'. + ''. + ''. + ''. + ''; + my ($version); + 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 ''); +# next if ($record{"$version:resource.$partid.award"} eq 'APPROX_ANS' && +# $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"}).'  '. + $record{$version.':'.$matchKey[0]}.'
' : ''; + $displaySub[1].=(exists $record{"$version:resource.$partid.award"}) ? + 'Part '.$partid.'  '. + $record{"$version:resource.$partid.award"}.'/'. + $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]).' 
'; + } + } 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'); + } - $parts{$minder.'.'.$title} = join '::',@$parts; - $symbx{$minder.'.'.$title} = $curRes->symb(); - $minder++; + foreach my $partid (@{$parts}) { + $studentTable.=&gradeBox($request,$symbx,$uname,$udom,$question,$partid,\%record); + $studentTable.=''."\n"; + $question++; + } + $studentTable.='
'."\n". + '  '. + ''."\n"; + $studentTable.=&show_grading_menu_form($symb,$url); + $request->print($studentTable); + + return ''; +} + +sub temp_parts_fix { #remove sub once lonnavmap is fixed + my $parts = shift; + my %seen = (); + my @correctParts = (); + foreach (@{$parts}) { + next if ($seen{$_} > 0); + $seen{$_}++; + push @correctParts,$_; + } + return \@correctParts; +} + +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 (undef,undef,$fullname) = &getclasslist($getsec,'1'); + my ($uname,$udom) = split(/:/,$ENV{'form.student'}); + + my $result='

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

'; + $result.='

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

'."\n"; + $request->print($result); - my $studentTable.= - ''; - $studentTable.=''; - $studentTable.=''; - - my $subresult=&Apache::lonnet::ssi($request->uri, - ('grade_target' => 'analyze'), - ('grade_domain' => $udom), - ('grade_user' => $uname), - ('grade_symb' => $symbx{$_}), - ('grade_courseid' => $ENV{'request.course.id'})); - (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); - my %analyze=&Apache::lonnet::str2hash($subresult); - - $studentTable.=''; - $question++; + $result.=''."\n"; + $ctr++; + } + $result.= ''; + return $result; +} +sub scantron_uploads { + if (!-e $Apache::lonnet::perlvar{'lonScansDir'}) { return ''}; + my $result= '"; + return $result; +} - $studentTable.='
'. + 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='
'. ''. - ''. - ''. - ''. - ''; - my $question=1; - foreach (@titles) { + ''. + ''. + ''. + ''; + + $iterator->next(); # skip the first BEGIN_MAP + my $curRes = $iterator->next(); # for "current resource" + my ($depth,$ctr,$question,$changeflag)= (1,0,1,0); + while ($depth > 0 && $ctr < 100) { # ctr, just in case it never gets out of loop + if($curRes == $iterator->BEGIN_MAP) { $depth++; } + if($curRes == $iterator->END_MAP) { $depth++; } + + if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) { + my $parts = $curRes->parts(); + $parts = &temp_parts_fix($parts); # remove line when lonnavmap is fixed + 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(); + $ctr++; + } + + $studentTable.='
 No  Title Answer Grade
 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='
'.$question.' '.$showtitle.'  '. - &Apache::loncommon::get_student_answers($symbx{$_},$uname,$udom,$ENV{'request.course.id'}).' '; - while (my($key,$value) = each (%analyze)){ - $studentTable.='key='.$key.'->value='.$value.'
'; - } - $studentTable.='
'; -# $result.='
'."
\n"; -# $result.='
'."\n"; +sub scantron_scantab { + my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); + my $result=''."\n"; - $request->print($studentTable); + 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 ''; + return $result; } -#--- Form to input a receipt number --- -sub verifyReceipt_form { - my ($symb,$url) = @_; - my $result = ''."\n"; +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; +} - my $hostver=unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}); +sub scantron_add_delay { +} - $result.='
'."\n"; - $result.=''."\n"; - $result.='
'."\n"; - $result.=' Verify a Submission Receipt Issued by this Server
'."\n"; - $result.='
'."\n"; - $result.=' '.$hostver.'-
'."\n"; - $result.=' '."\n"; - $result.=''."\n"; - if ($ENV{'form.url'}) { - $result.=''; +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}; } } - if ($ENV{'form.symb'}) { - $result.=''; + return undef; +} + +sub scantron_filter { + my ($curres)=@_; + if (ref($curres) && $curres->is_problem() && !$curres->randomout) { + return 1; } - $result.='
'; - $result.='
'."\n"; - $result.='
'."\n"; + 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) { + var cmd = formname.command; + formname.saveState.value = "saveCmd="+radioSelection(cmd)+":saveSec="+pullDownSelection(formname.section)+ + ":saveSub="+radioSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.status); + if (cmd[0].checked || cmd[1].checked || cmd[2].checked || cmd[3].checked || cmd[4].checked) formname.submit(); + if (cmd[5].checked) { + 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; + } + formname.command[5].checked = true; + return true; + } + + function radioSelection(radioButton) { + var selection=null; + if (radioButton.length > 1) { + for (var i=0; i 1) { + for (var i=0; i +GRADINGMENUJS + + my $result='

 Manual Grading/View Submission

'. + ''. + ''."\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.='
Problem: '.$probTitle.'
Part '.(split(/_/))[0].'Type: '.$responsetype.'Handgrade: '.$handgrade.'
'."\n"; + + my (undef,$sections) = &getclasslist('all','0'); + my $savedState = &savedState(); + my $saveCmd = ($$savedState{'saveCmd'} eq '' ? 'pickStudentPage' : $$savedState{'saveCmd'}); + my $saveSec = ($$savedState{'saveSec'} eq '' ? 'all' : $$savedState{'saveSec'}); + my $saveSub = ($$savedState{'saveSub'} eq '' ? 'yes' : $$savedState{'saveSub'}); + my $saveStatus = ($$savedState{'saveStatus'} eq '' ? 'Active' : $$savedState{'saveStatus'}); + + $result.='
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n"; + + $result.='
'."\n". + ''."\n". + '
'."\n". + ' Select a Grading/Viewing Option
'."\n"; + + $result.=''. + ''."\n". + + ''."\n". + + ''."\n". + ''."\n". + + ''."\n"; + + $result.=''."\n"; + + if ((&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) && ($symb)) { + $result.=''. + ''."\n"; + } + + $result.=''; + + $result.='
'. + ' '. + 'Handgrade/View Submission for a student by page/sequence
'. + ' '. + 'Grade by section or class
'. + ($hdgrade eq 'yes' ? 'View/Grade essay response of' : 'View'). + ' an individual student --> For students who has: '. + ' submitted'. + ' everybody
'. + ' '. + 'Upload scores from file
'. + ' '. + 'Grade scantron forms
'. + ' '. + 'Verify a submission receipt issued by this server--> Receipt no: '.unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}). + '-'. + '

'."\n". + ' Select section:   '; + + $result.='Student Status:'; + + $result.='   (Applies to the first three options only.)'."\n"; + + if (ref($sections)) { + $result.=' (Section "no" implies the students were not assigned a section.)
' + if (grep /no/,@$sections); + } + $result.='

'. + ''."\n". + '
'."\n". + '
'."\n". + '
'."\n"; return $result; } @@ -2656,13 +3439,12 @@ sub handler { $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}); if ($command eq 'submission') { ($ENV{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0)); -# if ($command eq 'submission') { -# &listStudents($request) if ($ENV{'form.student'} eq ''); -# &submission($request,0,0) if ($ENV{'form.student'} ne ''); } elsif ($command eq 'pickStudentPage') { &pickStudentPage($request); } elsif ($command eq 'displayPage') { &displayPage($request); + } elsif ($command eq 'gradeByPage') { + &updateGradeByPage($request); } elsif ($command eq 'processGroup') { &processGroup($request); } elsif ($command eq 'gradingmenu') { @@ -2675,6 +3457,8 @@ sub handler { $request->print(&editgrades($request)); } elsif ($command eq 'verify') { $request->print(&verifyreceipt($request)); + } elsif ($command eq 'csvform') { + $request->print(&upcsvScores_form($request)); } elsif ($command eq 'csvupload') { $request->print(&csvupload($request)); } elsif ($command eq 'viewclasslist') { @@ -2692,6 +3476,10 @@ sub handler { } $request->print(&csvuploadmap($request)); } + } elsif ($command eq 'scantron_selectphase') { + $request->print(&scantron_selectphase($request)); + } elsif ($command eq 'scantron_process') { + $request->print(&scantron_process_students($request)); } else { $request->print("Unknown action: $command:"); }