--- loncom/homework/grades.pm 2002/10/16 19:23:48 1.56 +++ loncom/homework/grades.pm 2003/02/27 21:05:58 1.68 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.56 2002/10/16 19:23:48 matthew Exp $ +# $Id: grades.pm,v 1.68 2003/02/27 21:05:58 ng Exp $ # # Copyright Michigan State University Board of Trustees # @@ -31,6 +31,8 @@ # 8/20 Gerd Kortemeyer # Year 2002 # June-August H.K. Ng +# Year 2003 +# February H.K. Ng # package Apache::grades; @@ -39,12 +41,13 @@ use Apache::style; use Apache::lonxml; use Apache::lonnet; use Apache::loncommon; +use Apache::lonnavmaps; use Apache::lonhomework; use Apache::loncoursedata; use Apache::lonmsg qw(:user_normal_msg); use Apache::Constants qw(:common); -# ----- These first few routines are general use routines.----- +# ----- These first few routines are general use routines.---- # # --- Retrieve the parts that matches stores_\d+ from the metadata file.--- sub getpartlist { @@ -269,6 +272,10 @@ 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 @@ -293,12 +300,7 @@ sub listStudents { } $result.=''; - my $viewgrade; - if ($ENV{'form.handgrade'} eq 'yes') { - $viewgrade = 'View/Grade'; - } else { - $viewgrade = 'View'; - } + my $viewgrade = $ENV{'form.handgrade'} eq 'yes' ? 'View/Grade' : 'View'; $result='

 '. $viewgrade. @@ -339,8 +341,9 @@ LISTJAVASCRIPT my $checklastsub = $ENV{'form.handgrade'} eq 'yes' ? '' : 'checked'; my $gradeTable='
'."\n". - ' View Problem: no '."\n". - ' yes
'."\n". + ' View Problem: no '."\n". + ' one student '."\n". + ' all students
'."\n". ' Submissions: '."\n"; if ($ENV{'form.handgrade'} eq 'yes') { $gradeTable.=' handgrade only'."\n"; @@ -671,21 +674,21 @@ sub sub_page_js { pWin.document.write(""); pWin.document.write("Subject"); pWin.document.write(""); - pWin.document.write(""); + pWin.document.write(""); } function displaySavedMsg(ctr,msg,shwsel) { pWin.document.write(""); pWin.document.write(""+ctr+""); pWin.document.write(""); - pWin.document.write(""); + pWin.document.write(""); } function newMsg(newmsg,shwsel) { pWin.document.write(""); pWin.document.write("New"); pWin.document.write(""); - pWin.document.write(""); + pWin.document.write(""); } function msgTail() { @@ -795,6 +798,32 @@ SUBJAVASCRIPT } +sub show_problem { + my ($request,$symb,$uname,$udom,$removeform) = @_; + my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, + $ENV{'request.course.id'}); + 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.=' View of the problem - '.$ENV{'form.fullname'}. + '
'.$rendered.'
'; + $result.='Correct answer:
'.$companswer; + $result.='
'; + $result.='

'; + $request->print($result); +} + # --------------------------- show submissions of a student, option to grade sub submission { my ($request,$counter,$total) = @_; @@ -809,7 +838,7 @@ sub submission { 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'; +# $ENV{'form.vProb'} = $ENV{'form.vProb'} ne '' ? $ENV{'form.vProb'} : 'yes'; # header info if ($counter == 0) { @@ -819,19 +848,8 @@ sub submission { # option to display problem, only once else it cause problems # with the form later since the problem has a form. - if ($ENV{'form.vProb'} eq 'yes') { - my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, - $ENV{'request.course.id'}); - my $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom, - $ENV{'request.course.id'}); - my $result.='
'; - $result.='
'; - $result.=' View of the problem - '.$ENV{'form.fullname'}. - '
'.$rendered.'
'; - $result.='Correct answer:
'.$companswer; - $result.='
'; - $result.='

'; - $request->print($result); + if ($ENV{'form.vProb'} eq 'yes' or !$ENV{'form.vProb'}) { + &show_problem($request,$symb,$uname,$udom,0); } # kwclr is the only variable that is guaranteed to be non blank @@ -894,6 +912,11 @@ KEYWORDS } } + if ($ENV{'form.vProb'} eq 'all') { + $request->print('


'); + &show_problem($request,$symb,$uname,$udom,1); + } + my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); my ($partlist,$handgrade) = &response_type($url); @@ -916,44 +939,55 @@ KEYWORDS ($classlist,undef,$fullname) = &getclasslist('all','0'); for (keys (%$handgrade)) { my $ncol = &Apache::lonnet::EXT('resource.'.$_. - '.maxcollaborators',$symb,$udom,$uname); - if ($ncol > 0) { - s/\_/\./g; - if ($record{'resource.'.$_.'.collaborators'} ne '') { - my (@collaborators) = split(/,?\s+/, - $record{'resource.'.$_.'.collaborators'}); - my (@badcollaborators); - if (scalar(@collaborators) != 0) { - $result.='Collaborators: '; - foreach my $collaborator (@collaborators) { - $collaborator = $collaborator =~ /\@|:/ ? - (split(/@|:/,$collaborator))[0] : $collaborator; - next if ($collaborator eq $uname); - if (!grep /^$collaborator:/i,keys %$classlist) { - push @badcollaborators,$collaborator; - next; - } - push @col_list, $collaborator; - my ($lastname,$givenn) = split(/,/,$$fullname{$collaborator.':'.$udom}); - push @col_fullnames, $givenn.' '.$lastname; - $result.=$$fullname{$collaborator.':'.$udom}.'     '; - } - $result.='
'."\n"; - $result.='
'. - 'This student has submitted '. - (scalar (@badcollaborators) > 1 ? '' : 'an'). - ' invalid collaborator'.(scalar (@badcollaborators) > 1 ? 's. ' : '. '). - (join ', ',@badcollaborators).'
' - if (scalar(@badcollaborators) > 0); - - $result.='
'. - 'This student has submitted too many collaborators. Maximum is '. - $ncol.'.
' if (scalar(@collaborators) > $ncol); - $result.=''."\n"; - } - } - } + '.maxcollaborators', + $symb,$udom,$uname); + 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) { + $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{$_}.'     '; + } + } + $result.='
'."\n"; + if (scalar(@badcollaborators) > 0) { + $result.=''."\n" if ($ENV{'form.lastSub'} eq 'lastonly' || ($ENV{'form.lastSub'} eq 'hdgrade' && @@ -1077,9 +1116,15 @@ KEYWORDS 'onChange="javascript:clearRadBox(this.form.RADVAL'.$counter.'_'.$partid. ',this.form.GD_BOX'.$counter.'_'.$partid. ',this.form.GD_SEL'.$counter.'_'.$partid. - ',this.form.stores'.$counter.'_'.$partid.')" />'."\n". - ''. - ''."  \n"; + ',this.form.stores'.$counter.'_'.$partid.')" >'."\n"; + if ($record{'resource.'.$partid.'.solved'} eq 'excused') { + $result.=''. + ''; + } else { + $result.=''. + ''; + } + $result.="  \n"; $result.=''; $result.='
'; + $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"; + } } } $request->print($result."\n"); @@ -989,7 +1023,12 @@ KEYWORDS my ($ressub,$subval) = split(/:/,$_,2); $lastsubonly.='
Part '. $partid.' ( ID '.$respid. - ' )   Answer: '. + ' )   '. + ($record{"resource.$partid.$respid.uploadedurl"}? + ' File uploaded by student Like all files provided by users, this file may contain virusses
':''). + 'Answer: '. &keywords_highlight($subval).'
'."\n"; $request->print($result); @@ -1135,9 +1180,9 @@ 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)$/) { +# if ($returnhash{$version.':'.$_} =~ /(SUBMITTED|DRAFT)$/) { $timestamp = scalar(localtime($returnhash{$version.':timestamp'})); - } +# } } } foreach ((keys %lasthash)) { @@ -1161,8 +1206,13 @@ sub keywords_highlight { (my $styleoff = $styleon) =~ s/\$styleon$_$styleoff\<\/font\>/gi; + $string =~ s/\b\Q$_\E(\b|\.)/\$styleon$_$styleoff\<\/font\>/gi; } + # This is not really the right place to do this, but I cannot find a + # better one at this time. So here we go - the m in the s:::mg causes + # ^ to match the beginning of a new line. So we replace(???) the beginning + # of the line with
to make things formatted a little better. + $string =~ s:^:
:mg; return $string; } @@ -1183,7 +1233,7 @@ sub processHandGrade { my $includemsg = $ENV{'form.includemsg'.$ctr}; my ($subject,$message,$msgstatus) = ('','',''); - if ($includemsg =~ /savemsg|new$ctr/) { + if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) { $subject = $ENV{'form.msgsub'} if ($includemsg =~ /^msgsub/); my (@msgnum) = split(/,/,$includemsg); foreach (@msgnum) { @@ -1333,8 +1383,12 @@ sub saveHandGrade { my %newrecord; foreach (split(/:/,$ENV{'form.partlist'.$newflg})) { if ($ENV{'form.GD_SEL'.$newflg.'_'.$_} eq 'excused') { - $newrecord{'resource.'.$_.'.solved'} = 'excused' - if ($record{'resource.'.$_.'.solved'} ne 'excused'); + if ($record{'resource.'.$_.'.solved'} ne 'excused') { + $newrecord{'resource.'.$_.'.solved'} = 'excused'; + if (exists($record{'resource.'.$_.'.awarded'})) { + $newrecord{'resource.'.$_.'.awarded'} = ''; + } + } } else { my $pts = ($ENV{'form.GD_BOX'.$newflg.'_'.$_} ne '' ? $ENV{'form.GD_BOX'.$newflg.'_'.$_} : @@ -1610,7 +1664,7 @@ sub viewgrades { $weight{$partid}.' (problem weight)'."\n"; $result.= ''."\n"; $ctsparts++; @@ -1678,8 +1732,8 @@ sub viewstudentgrade { ''.$fullname.''. ''.$uname.''.$udom.''."\n"; - foreach my $part (@$parts) { - my ($part,$type) = &split_part_type($part); + 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}; @@ -2146,6 +2200,7 @@ sub gradingmenu { $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)); @@ -2217,12 +2272,7 @@ sub viewGradeaStu_form { my $result.='
'."\n"; $result.=''."\n"; + $result.=($handgrade eq 'yes' ? 'View/Grade' : 'View').' an Individual Student\'s Submission'."\n"; $result.='
'."\n"; $result.=' '; - if ($handgrade eq 'yes') { - $result.="View/Grade "; - } else { - $result.="View "; - } - $result.='an Individual Student\'s Submission
'."\n"; $result.='
'."\n". ''."\n". @@ -2258,6 +2308,266 @@ sub viewGradeaStu_form { 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; +} + + +sub pickStudentPage { + my ($request) = shift; + + $request->print(< + +function checkPickOne(formname) { + var user = radioSelection(formname.pickOne); + if (user == null) { + alert("Please select the student you wish to grade."); + return; + } + formname.submit(); +} + +function radioSelection(radioButton) { + var selection=null; + for (var i=0; i +LISTJAVASCRIPT + + my ($symb,$url) = &get_symb_and_url(); + 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

'; + + my ($pagepath,$pagename,$type,$mapId) = ($symb =~ /(.*\/)(.*?\.(page|sequence))___(\d+)___/); + my $curtitle = &Apache::lonnet::metadata($pagepath.$pagename,'title'); + + $result.='
'."
\n"; + $result.=' Problems from: '."
\n"; + +# $result.=' View Problems: no '."\n". +# ' yes '."
\n"; +# $result.=' Submission Details: '. +# ' last sub only'."\n". +# ' all details'."\n"; + $result.=''."\n". + ''."\n". + ''."\n". + ''."

\n"; + $request->print($result); + + my $studentTable.=' Select a Student you wish to grade
'. + '
'. + ''. + ''. + ''. + ''. + ''; + + my (undef,undef,$fullname) = &getclasslist($getsec,'0'); + 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 $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 + $navmap->init(); + + # End navmap using boilerplate + + my $iterator = $navmap->getIterator(undef, undef, undef, 1); + my $depth = 1; + $iterator->next(); # ignore first BEGIN_MAP + my $curRes = $iterator->next(); + + my %symbx = (); + my @titles = (); + my $minder=0; + while ($depth > 0) { + if ($curRes == $iterator->BEGIN_MAP()) {$depth++;} + 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++; + } + $curRes = $iterator->next(); + } + + $navmap->untieHashes(); + return \@titles,\%symbx; +} + +sub displayPage { + 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,'0'); + my ($uname,$udom) = split(/:/,$ENV{'form.pickOne'}); + my ($idx,$showtitle) = ($pageTitle =~ /(\d+)\.(.*)/); + + my $result='

 '.$showtitle.'

'; + $result.='

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

'."\n"; + + my ($pg_titles,$pg_symbx) = &getSymbMap(); + + 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 $map = $navmap->getResourceByUrl($resUrl); # add to navmaps + + my $iterator = $navmap->getIterator($map->map_start(), + $map->map_finish()); + + my $depth = 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(); + 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.':
'; + } + $parts{$minder.'.'.$title} = join '::',@$parts; + + $symbx{$minder.'.'.$title} = $curRes->symb(); + $minder++; + + } + $curRes = $iterator->next(); + $ctr++; + } + + $navmap->init(); + $request->print($result); + + my $studentTable.= + '
'. + ''. + ''. + ''. + ''. + ''; + my $question=1; + foreach (@titles) { + my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); + $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++; + + } + + $studentTable.='
 No  Title Answer Grade
'.$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"; + + $request->print($studentTable); + + + return ''; +} + #--- Form to input a receipt number --- sub verifyReceipt_form { my ($symb,$url) = @_; @@ -2345,8 +2655,14 @@ sub handler { } else { $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}); if ($command eq 'submission') { - &listStudents($request) if ($ENV{'form.student'} eq ''); - &submission($request,0,0) if ($ENV{'form.student'} ne ''); + ($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 'processGroup') { &processGroup($request); } elsif ($command eq 'gradingmenu') {