--- loncom/homework/grades.pm	2017/12/18 23:51:24	1.745
+++ loncom/homework/grades.pm	2017/12/31 14:00:41	1.749
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # The LON-CAPA Grading handler
 #
-# $Id: grades.pm,v 1.745 2017/12/18 23:51:24 raeburn Exp $
+# $Id: grades.pm,v 1.749 2017/12/31 14:00:41 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -856,7 +856,7 @@ sub verifyreceipt {
 sub listStudents {
     my ($request,$symb,$submitonly) = @_;
 
-    my ($is_tool) = ($symb =~ /ext\.tool$/);
+    my $is_tool   = ($symb =~ /ext\.tool$/);
     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'};
@@ -2021,7 +2021,7 @@ sub submission {
 
     my $probtitle=&Apache::lonnet::gettitle($symb); 
     if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; }
-    my ($is_tool) = ($symb =~ /ext\.tool$/);
+    my $is_tool = ($symb =~ /ext\.tool$/);
 
     if (!&canview($usec)) {
         $request->print(
@@ -2635,7 +2635,7 @@ sub get_last_submission {
     if (!@string) {
         my $msg;
         if ($is_tool) {
-            $msg = &mt('Nothing passed back - no attempts.');
+            $msg = &mt('No grade passed back.');
         } else {
             $msg = &mt('Nothing submitted - no attempts.');
         }
@@ -4090,6 +4090,7 @@ sub editgrades {
 	$ctr++;
     }
     my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
+    my $totcolspan = 0;
     foreach my $partid (@partid) {
 	$header .= '<th align="center">'.&mt('Old Score').'</th>'.
 	    '<th align="center">'.&mt('New Score').'</th>';
@@ -4106,6 +4107,7 @@ sub editgrades {
 		'<th align="center">'.&mt('New').' '.$display.'</th>';
 	    $columns{$partid}+=2;
 	}
+        $totcolspan += $columns{$partid};
     }
     foreach my $partid (@partid) {
 	my $display_part=&get_display_part($partid,$symb);
@@ -4121,18 +4123,18 @@ sub editgrades {
     my @noupdate;
     my ($updateCtr,$noupdateCtr) = (1,1);
     for ($i=0; $i<$env{'form.total'}; $i++) {
-	my $line;
 	my $user = $env{'form.ctr'.$i};
 	my ($uname,$udom)=split(/:/,$user);
 	my %newrecord;
 	my $updateflag = 0;
-	$line .= '<td>'.&nameUserString(undef,$$fullname{$user},$uname,$udom).'</td>';
 	my $usec=$classlist->{"$uname:$udom"}[5];
-	if (!&canmodify($usec)) {
-	    my $numcols=scalar(@partid)*4+2;
+	my $canmodify = &canmodify($usec);
+	my $line = '<td'.($canmodify?'':' colspan="2"').'>'.
+		   &nameUserString(undef,$$fullname{$user},$uname,$udom).'</td>';
+	if (!$canmodify) {
 	    push(@noupdate,
-		 $line."<td colspan=\"$numcols\"><span class=\"LC_warning\">".
-		 &mt('Not allowed to modify student')."</span></td></tr>");
+		 $line."<td colspan=\"$totcolspan\"><span class=\"LC_warning\">".
+		 &mt('Not allowed to modify student')."</span></td>");
 	    next;
 	}
         my %aggregate = ();
@@ -4249,8 +4251,7 @@ sub editgrades {
         }
     }
     if (@noupdate) {
-#	my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3;
-	my $numcols=scalar(@partid)*4+2;
+        my $numcols=$totcolspan+2;
 	$result .= &Apache::loncommon::start_data_table_row('LC_empty_row').
 	    '<td align="center" colspan="'.$numcols.'">'.
 	    &mt('No Changes Occurred For the Students Below').
@@ -5021,7 +5022,7 @@ sub displayPage {
 	    my $parts = $curRes->parts();
             my $title = $curRes->compTitle();
 	    my $symbx = $curRes->symb();
-            my ($is_tool) = ($symbx =~ /ext\.tool$/);
+            my $is_tool = ($symbx =~ /ext\.tool$/);
 	    $studentTable.=
 		&Apache::loncommon::start_data_table_row().
 		'<td align="center" valign="top" >'.$prob.
@@ -5032,7 +5033,9 @@ sub displayPage {
 		 '</td>';
 	    $studentTable.='<td valign="top">';
 	    my %form = ('CODE' => $env{'form.CODE'},);
-            unless ($is_tool) {
+            if ($is_tool) {
+                $studentTable.='&nbsp;<b>'.$title.'</b><br />';
+            } else {
 	        if ($env{'form.vProb'} eq 'yes' ) {
 		    $studentTable.=&show_problem($request,$symbx,$uname,$udom,1,
 					         undef,'both',\%form);
@@ -5110,13 +5113,14 @@ sub displaySubByDates {
     my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_;
     my $isCODE=0;
     my $isTask = ($symb =~/\.task$/);
+    my $is_tool = ($symb =~/\.tool$/);
     if (exists($record->{'resource.CODE'})) { $isCODE=1; }
     my $studentTable=&Apache::loncommon::start_data_table().
 	&Apache::loncommon::start_data_table_header_row().
 	'<th>'.&mt('Date/Time').'</th>'.
 	($isCODE?'<th>'.&mt('CODE').'</th>':'').
         ($isTask?'<th>'.&mt('Version').'</th>':'').
-	'<th>'.&mt('Submission').'</th>'.
+	'<th>'.($is_tool?&mt('Grade'):&mt('Submission')).'</th>'.
 	'<th>'.&mt('Status').'</th>'.
 	&Apache::loncommon::end_data_table_header_row();
     my ($version);
@@ -5124,7 +5128,11 @@ sub displaySubByDates {
     my %orders;
     $mark{'correct_by_student'} = $checkIcon;
     if (!exists($$record{'1:timestamp'})) {
-	return '<br />&nbsp;<span class="LC_warning">'.&mt('Nothing submitted - no attempts.').'</span><br />';
+        if ($is_tool) {
+            return '<br />&nbsp;<span class="LC_warning">'.&mt('No grade passed back.').'</span><br />';
+        } else {
+            return '<br />&nbsp;<span class="LC_warning">'.&mt('Nothing submitted - no attempts.').'</span><br />';
+        }
     }
 
     my $interaction;
@@ -5157,56 +5165,64 @@ sub displaySubByDates {
             if (($type eq 'anonsurvey') || ($type eq 'anonsurveycred')) {
                 $hidden = 1;
             }
-	    my @matchKey = ($isTask ? sort(grep /^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys)
-			            : sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys));
-	    
+            my @matchKey;
+            if ($isTask) {
+                @matchKey = sort(grep /^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys);
+            } elsif ($is_tool) {
+                @matchKey = sort(grep /^resource\.\Q$partid\E\.awarded$/,@versionKeys);
+            } else {
+                @matchKey = sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys);
+            }
 #	    next if ($$record{"$version:resource.$partid.solved"} eq '');
 	    my $display_part=&get_display_part($partid,$symb);
 	    foreach my $matchKey (@matchKey) {
 		if (exists($$record{$version.':'.$matchKey}) &&
 		    $$record{$version.':'.$matchKey} ne '') {
-                    
-		    my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/)
-				               : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/));
-                    $displaySub[0].='<span class="LC_nobreak">';
-                    $displaySub[0].='<b>'.&mt('Part: [_1]',$display_part).'</b>'
-                                   .' <span class="LC_internal_info">'
-                                   .'('.&mt('Response ID: [_1]',$responseId).')'
-                                   .'</span>'
-                                   .' <b>';
-                    if ($hidden) {
-                        $displaySub[0].= &mt('Anonymous Survey').'</b>';
+                    if ($is_tool) {
+                        $displaySub[0].=$$record{"$version:resource.$partid.awarded"};
                     } else {
-                        my ($trial,$rndseed,$newvariation);
-                        if ($type eq 'randomizetry') {
-                            $trial = $$record{"$where.$partid.tries"};
-                            $rndseed = $$record{"$where.$partid.rndseed"};
-                        }
-		        if ($$record{"$where.$partid.tries"} eq '') {
-			    $displaySub[0].=&mt('Trial not counted');
-		        } else {
-			    $displaySub[0].=&mt('Trial: [_1]',
-					    $$record{"$where.$partid.tries"});
-                            if (($rndseed ne '') && ($lastrndseed{$partid} ne '')) {
-                                if (($rndseed ne $lastrndseed{$partid}) &&
-                                    (($type eq 'randomizetry') || ($lasttype{$partid} eq 'randomizetry'))) {
-                                    $newvariation = '&nbsp;('.&mt('New variation this try').')';
-                                }
+		        my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/)
+				                   : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/));
+                        $displaySub[0].='<span class="LC_nobreak">';
+                        $displaySub[0].='<b>'.&mt('Part: [_1]',$display_part).'</b>'
+                                       .' <span class="LC_internal_info">'
+                                       .'('.&mt('Response ID: [_1]',$responseId).')'
+                                       .'</span>'
+                                       .' <b>';
+                        if ($hidden) {
+                            $displaySub[0].= &mt('Anonymous Survey').'</b>';
+                        } else {
+                            my ($trial,$rndseed,$newvariation);
+                            if ($type eq 'randomizetry') {
+                                $trial = $$record{"$where.$partid.tries"};
+                                $rndseed = $$record{"$where.$partid.rndseed"};
                             }
-                            $lastrndseed{$partid} = $rndseed;
-                            $lasttype{$partid} = $type;
-		        }
-		        my $responseType=($isTask ? 'Task'
+		            if ($$record{"$where.$partid.tries"} eq '') {
+			        $displaySub[0].=&mt('Trial not counted');
+		            } else {
+			        $displaySub[0].=&mt('Trial: [_1]',
+					        $$record{"$where.$partid.tries"});
+                                if (($rndseed ne '') && ($lastrndseed{$partid} ne '')) {
+                                    if (($rndseed ne $lastrndseed{$partid}) &&
+                                        (($type eq 'randomizetry') || ($lasttype{$partid} eq 'randomizetry'))) {
+                                        $newvariation = '&nbsp;('.&mt('New variation this try').')';
+                                    }
+                                }
+                                $lastrndseed{$partid} = $rndseed;
+                                $lasttype{$partid} = $type;
+		            }
+		            my $responseType=($isTask ? 'Task'
                                               : $responseType->{$partid}->{$responseId});
-		        if (!exists($orders{$partid})) { $orders{$partid}={}; }
-		        if ((!exists($orders{$partid}->{$responseId})) || ($trial)) {
-			    $orders{$partid}->{$responseId}=
-			        &get_order($partid,$responseId,$symb,$uname,$udom,
-                                           $no_increment,$type,$trial,$rndseed);
-		        }
-		        $displaySub[0].='</b>'.$newvariation.'</span>'; # /nobreak
-		        $displaySub[0].='&nbsp; '.
-			    &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom,$type,$trial,$rndseed).'<br />';
+		            if (!exists($orders{$partid})) { $orders{$partid}={}; }
+		            if ((!exists($orders{$partid}->{$responseId})) || ($trial)) {
+			        $orders{$partid}->{$responseId}=
+			            &get_order($partid,$responseId,$symb,$uname,$udom,
+                                               $no_increment,$type,$trial,$rndseed);
+		            }
+		            $displaySub[0].='</b>'.$newvariation.'</span>'; # /nobreak
+		            $displaySub[0].='&nbsp; '.
+			        &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom,$type,$trial,$rndseed).'<br />';
+                        }
                     }
 		}
 	    }
@@ -5221,14 +5237,22 @@ sub displaySubByDates {
 		    lc($$record{"$where.$partid.award"}).' '.
 		    $mark{$$record{"$where.$partid.solved"}}.
 		    '<br />';
+	    } elsif (($is_tool) && (exists($$record{"$version:resource.$partid.solved"}))) {
+		if ($$record{"$version:resource.$partid.solved"} =~ /^(in|)correct_by_passback$/) {
+		    $displaySub[1].=&mt('Grade passed back by external tool');
+		}
 	    }
 	    if (exists $$record{"$where.$partid.regrader"}) {
-		$displaySub[2].=$$record{"$where.$partid.regrader"}.
-		    ' (<b>'.&mt('Part').':</b> '.$display_part.')';
+		$displaySub[2].=$$record{"$where.$partid.regrader"};
+		unless ($is_tool) {
+		    $displaySub[2].=' (<b>'.&mt('Part').':</b> '.$display_part.')';
+		}
 	    } elsif ($$record{"$version:resource.$partid.regrader"} =~ /\S/) {
 		$displaySub[2].=
-		    $$record{"$version:resource.$partid.regrader"}.
-		    ' (<b>'.&mt('Part').':</b> '.$display_part.')';
+		    $$record{"$version:resource.$partid.regrader"};
+                unless ($is_tool) {
+		    $displaySub[2].=' (<b>'.&mt('Part').':</b> '.$display_part.')';
+                }
 	    }
 	}
 	# needed because old essay regrader has not parts info
@@ -9760,7 +9784,7 @@ sub submit_options_table {
     my ($request,$symb) = @_;
     if (!$symb) {return '';}
     &commonJSfunctions($request);
-    my ($is_tool) = ($symb =~ /ext\.tool$/);
+    my $is_tool = ($symb =~ /ext\.tool$/);
     my $result;
 
     $result.='<form action="/adm/grades" method="post" name="gradingMenu">'."\n".
@@ -9780,7 +9804,7 @@ sub submit_options_download {
     my ($request,$symb) = @_;
     if (!$symb) {return '';}
 
-    my ($is_tool) = ($symb =~ /ext\.tool$/);
+    my $is_tool = ($symb =~ /ext\.tool$/);
     &commonJSfunctions($request);
 
     my $result='<form action="/adm/grades" method="post" name="gradingMenu">'."\n".
@@ -9804,7 +9828,7 @@ sub submit_options {
     my ($request,$symb) = @_;
     if (!$symb) {return '';}
 
-    my ($is_tool) = ($symb =~ /ext\.tool$/);
+    my $is_tool = ($symb =~ /ext\.tool$/);
     &commonJSfunctions($request);
     my $result;