--- loncom/homework/grades.pm	2007/10/15 09:47:47	1.459
+++ loncom/homework/grades.pm	2007/10/25 20:05:52	1.464
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # The LON-CAPA Grading handler
 #
-# $Id: grades.pm,v 1.459 2007/10/15 09:47:47 foxr Exp $
+# $Id: grades.pm,v 1.464 2007/10/25 20:05:52 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -57,9 +57,7 @@ my %first_bubble_line = ();	# First bubb
 
 
 sub save_bubble_lines {
-    &Apache::lonnet::logthis("Saving bubble_lines...");
     foreach my $line (keys(%bubble_lines_per_response)) {
-	&Apache::lonnet::logthis("Saving form.scantron.bubblelines.$line value: $bubble_lines_per_response{$line}");
 	$env{"form.scantron.bubblelines.$line"}  = $bubble_lines_per_response{$line};
 	$env{"form.scantron.first_bubble_line.$line"} =
 	    $first_bubble_line{$line};
@@ -72,7 +70,6 @@ sub restore_bubble_lines {
     %bubble_lines_per_response = ();
     while ($env{"form.scantron.bubblelines.$line"}) {
 	my $value = $env{"form.scantron.bubblelines.$line"};
-	&Apache::lonnet::logthis("Restoring form.scantron.bubblelines.$line value: $value");
 	$bubble_lines_per_response{$line} = $value;
 	$first_bubble_line{$line}  =
 	    $env{"form.scantron.first_bubble_line.$line"};
@@ -87,12 +84,14 @@ sub restore_bubble_lines {
 sub get_response_bubbles {
     my ($parsed_line, $response)  = @_;
 
-    my $bubble_line = $first_bubble_line{$response};
-    my $bubble_lines= $bubble_lines_per_response{$response};
+
+    my $bubble_line = $first_bubble_line{$response-1} +1;
+    my $bubble_lines= $bubble_lines_per_response{$response-1};
+    
     my $selected = "";
 
     for (my $bline = 0; $bline < $bubble_lines; $bline++) {
-	$selected .= $$parsed_line{"scantron.$bubble_line.answer"};
+	$selected .= $$parsed_line{"scantron.$bubble_line.answer"}.":";
 	$bubble_line++;
     }
     return $selected;
@@ -1961,7 +1960,7 @@ KEYWORDS
 
 # This is where output for one specific student would start
     my $bgcolor='#DDEEDD';
-    if (int($counter/2) eq $counter) { $bgcolor='#DDDDEE'; }
+    if ($counter%2) { $bgcolor='#DDDDEE'; }
     $request->print("\n\n".
                     '<p><table border="2"><tr><th bgcolor="'.$bgcolor.'">'.$env{'form.fullname'}.'</th></tr><tr><td bgcolor="'.$bgcolor.'">');
 
@@ -1991,60 +1990,13 @@ KEYWORDS
 	'" value="'.$env{'form.fullname'}.'" />'."\n";
 
     # If any part of the problem is an essay-response (handgraded), then check for collaborators
-    my @col_fullnames;
-    my ($classlist,$fullname);
+    my $fullname;
+    my $col_fullnames = [];
     if ($env{'form.handgrade'} eq 'yes') {
-	($classlist,undef,$fullname) = &getclasslist('all','0');
-	for (keys (%$handgrade)) {
-	    my $ncol = &Apache::lonnet::EXT('resource.'.$_.
-					    '.maxcollaborators',
-                                            $symb,$udom,$uname);
-	    next if ($ncol <= 0);
-            s/\_/\./g;
-            next if ($record{'resource.'.$_.'.collaborators'} eq '');
-            my @goodcollaborators = ();
-            my @badcollaborators  = ();
-	    foreach (split(/,?\s+/,$record{'resource.'.$_.'.collaborators'})) { 
-		$_ =~ s/[\$\^\(\)]//g;
-		next if ($_ eq '');
-		my ($co_name,$co_dom) = split /\@|:/,$_;
-		$co_dom = $udom if (! defined($co_dom) || $co_dom =~ /^domain$/i);
-		next if ($co_name eq $uname && $co_dom eq $udom);
-		# Doing this grep allows 'fuzzy' specification
-		my @Matches = grep /^$co_name:$co_dom$/i,keys %$classlist;
-		if (! scalar(@Matches)) {
-		    push @badcollaborators,$_;
-		} else {
-		    push @goodcollaborators, @Matches;
-		}
-	    }
-            if (scalar(@goodcollaborators) != 0) {
-                $result.='<b>Collaborators: </b>';
-                foreach (@goodcollaborators) {
-		    my ($lastname,$givenn) = split(/,/,$$fullname{$_});
-		    push @col_fullnames, $givenn.' '.$lastname;
-		    $result.=$$fullname{$_}.'&nbsp; &nbsp; &nbsp;';
-		}
-                $result.='<br />'."\n";
-		my ($part)=split(/\./,$_);
-		$result.='<input type="hidden" name="collaborator'.$counter.
-		    '" value="'.$part.':'.(join ':',@goodcollaborators).'" />'.
-		    "\n";
-	    }
-	    if (scalar(@badcollaborators) > 0) {
-		$result.='<table border="0"><tr bgcolor="#ffbbbb"><td>';
-		$result.='This student has submitted ';
-		$result.=(scalar(@badcollaborators) == 1) ? 'an invalid collaborator' : 'invalid collaborators';
-		$result .= ': '.join(', ',@badcollaborators);
-		$result .= '</td></tr></table>';
-	    }         
-	    if (scalar(@badcollaborators > $ncol)) {
-		$result .= '<table border="0"><tr bgcolor="#ffbbbb"><td>';
-		$result .= 'This student has submitted too many '.
-		    'collaborators.  Maximum is '.$ncol.'.';
-		$result .= '</td></tr></table>';
-	    }
-	}
+	(my $sub_result,$fullname,$col_fullnames)=
+	    &check_collaborators($symb,$uname,$udom,\%record,$handgrade,
+				 $counter);
+	$result.=$sub_result;
     }
     $request->print($result."\n");
 
@@ -2180,16 +2132,16 @@ KEYWORDS
     if ($env{'form.handgrade'} eq 'yes') {
 	my ($lastname,$givenn) = split(/,/,$env{'form.fullname'});
 	my $msgfor = $givenn.' '.$lastname;
-	if (scalar(@col_fullnames) > 0) {
-	    my $lastone = pop @col_fullnames;
-	    $msgfor .= ', '.(join ', ',@col_fullnames).' and '.$lastone.'.';
+	if (scalar(@$col_fullnames) > 0) {
+	    my $lastone = pop(@$col_fullnames);
+	    $msgfor .= ', '.(join ', ',@$col_fullnames).' and '.$lastone.'.';
 	}
 	$msgfor =~ s/\'/\\'/g; #' stupid emacs - no! javascript
 	$result='<input type="hidden" name="includemsg'.$counter.'" value="" />'."\n".
 	    '<input type="hidden" name="newmsg'.$counter.'" value="" />'."\n";
 	$result.='&nbsp;<a href="javascript:msgCenter(document.SCORE,'.$counter.
 	    ',\''.$msgfor.'\');" target="_self">'.
-	    &mt('Compose message to student').(scalar(@col_fullnames) >= 1 ? 's' : '').'</a><label> ('.
+	    &mt('Compose message to student').(scalar(@$col_fullnames) >= 1 ? 's' : '').'</a><label> ('.
 	    &mt('incl. grades').' <input type="checkbox" name="withgrades'.$counter.'" /></label>)'.
 	    '<img src="'.$request->dir_config('lonIconsURL').
 	    '/mailbkgrd.gif" width="14" height="10" name="mailicon'.$counter.'" />'."\n".
@@ -2267,6 +2219,62 @@ KEYWORDS
     return '';
 }
 
+sub check_collaborators {
+    my ($symb,$uname,$udom,$record,$handgrade,$counter) = @_;
+    my ($result,@col_fullnames);
+    my ($classlist,undef,$fullname) = &getclasslist('all','0');
+    foreach my $part (keys(%$handgrade)) {
+	my $ncol = &Apache::lonnet::EXT('resource.'.$part.
+					'.maxcollaborators',
+					$symb,$udom,$uname);
+	next if ($ncol <= 0);
+	$part =~ s/\_/\./g;
+	next if ($record->{'resource.'.$part.'.collaborators'} eq '');
+	my (@good_collaborators, @bad_collaborators);
+	foreach my $possible_collaborator
+	    (split(/,?\s+/,$record->{'resource.'.$part.'.collaborators'})) { 
+	    $possible_collaborator =~ s/[\$\^\(\)]//g;
+	    next if ($possible_collaborator eq '');
+	    my ($co_name,$co_dom) = split(/\@|:/,$possible_collaborator);
+	    $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(/^\Q$co_name\E:\Q$co_dom\E$/i, 
+			       keys(%$classlist));
+	    if (! scalar(@matches)) {
+		push(@bad_collaborators, $possible_collaborator);
+	    } else {
+		push(@good_collaborators, @matches);
+	    }
+	}
+	if (scalar(@good_collaborators) != 0) {
+	    $result.='<b>Collaborators: </b>';
+	    foreach my $name (@good_collaborators) {
+		my ($lastname,$givenn) = split(/,/,$$fullname{$name});
+		push(@col_fullnames, $givenn.' '.$lastname);
+		$result.=$fullname->{$name}.'&nbsp; &nbsp; &nbsp;';
+	    }
+	    $result.='<br />'."\n";
+	    my ($part)=split(/\./,$_);
+	    $result.='<input type="hidden" name="collaborator'.$counter.
+		'" value="'.$part.':'.(join ':',@good_collaborators).'" />'.
+		"\n";
+	}
+	if (scalar(@bad_collaborators) > 0) {
+	    $result.='<div class="LC_error">';
+	    $result.=&mt('This student has submitted [quant,_1,invalid collaborator]: [_2]',scalar(@bad_collaborators),join(', ',@bad_collaborators));
+	    $result .= '</div>';
+	}         
+	if (scalar(@bad_collaborators > $ncol)) {
+	    $result .= '<div class="LC_error">';
+	    $result .= &mt('This student has submitted too many '.
+		'collaborators.  Maximum is [_1].',$ncol);
+	    $result .= '</div>';
+	}
+    }
+    return ($result,$fullname,\@col_fullnames);
+}
+
 #--- Retrieve the last submission for all the parts
 sub get_last_submission {
     my ($returnhash)=@_;
@@ -3913,7 +3921,8 @@ sub csvuploadassign {
                 if ($wgt) {
                     $entries{$fields{$dest}}=~s/\s//g;
                     my $pcr=$entries{$fields{$dest}} / $wgt;
-                    my $award='correct_by_override';
+                    my $award=($pcr == 0) ? 'incorrect_by_override'
+                                          : 'correct_by_override';
                     $grades{"resource.$part.awarded"}=$pcr;
                     $grades{"resource.$part.solved"}=$award;
                     $points{$part}=1;
@@ -5269,7 +5278,12 @@ sub scantron_parse_scanline {
 		|| (&occurence_count($currentquest, "[A-Z]") > 1)) {
 		push(@{$record{'scantron.doubleerror'}},$questnum);
 		for (my $ans = 0; $ans < $answers_needed; $ans++) { 
-		    $record{"scantron.$ansnum.answer"}='';
+		    my $bubble = substr($currentquest, $ans, 1);
+		    if ($bubble =~ /[A-Z]/ ) {
+			$record{"scantron.$ansnum.answer"} = $bubble;
+		    } else {
+			$record{"scantron.$ansnum.answer"}='';
+		    }
 		    $ansnum++;
 		}
 
@@ -5304,7 +5318,12 @@ sub scantron_parse_scanline {
 		|| (&occurence_count($currentquest, '\d') > 1)) {
 		push(@{$record{'scantron.doubleerror'}},$questnum);
 		for (my $ans = 0; $ans < $answers_needed; $ans++) {
-		    $record{"scantron.$ansnum.answer"}='';
+		    my $bubble = substr($currentquest, $ans, 1);
+		    if ($bubble =~ /\d/) {
+			$record{"scantron.$ansnum.answer"} = $alphabet[$bubble];
+		    } else {
+			$record{"scantron.$ansnum.answer"}=' ';
+		    }
 		    $ansnum++;
 		}
 
@@ -5374,20 +5393,22 @@ sub scantron_parse_scanline {
 
 		my $first_answer = $ansnum;
 		for (my $ans =0; $ans < $answers_needed; $ans++) {
-		    $record{"scantron.$ansnum.answer"} = '';
-		    $ans++;
+		    my $item = $first_answer+$ans;
+		    $record{"scantron.$item.answer"} = '';
 		}
 
 		my @ans=@array;
-		my $i=length($ans[0]);shift(@ans);
+		my $i=0;
+		my $increment = 0;
 		while ($#ans) {
-		    $i+=length($ans[0])+1;
-		    my $line   = $i/$$scantron_config{'Qlength'} + $first_answer;
+		    $i+=length($ans[0]) + $increment;
+		    my $line   = int($i/$$scantron_config{'Qlength'} + $first_answer);
 		    my $bubble = $i%$$scantron_config{'Qlength'};
-
 		    $record{"scantron.$line.answer"}.=$alphabet[$bubble];
 		    shift(@ans);
+		    $increment = 1;
 		}
+		$ansnum += $answers_needed;
 	    }
 	}
     }
@@ -5747,7 +5768,6 @@ SCANTRONFORM
 
   my $line = 0;
     while (defined($env{"form.scantron.bubblelines.$line"})) {
-	&Apache::lonnet::logthis("Saving chunk for $line");
        my $chunk =
 	   '<input type="hidden" name="scantron.bubblelines.'.$line.'" value="'.$env{"form.scantron.bubblelines.$line"}.'" />'."\n";
        $chunk .=
@@ -5813,7 +5833,6 @@ sub scantron_validate_file {
     }
     my $currentphase=$env{'form.validatepass'};
 
-    &Apache::lonnet::logthis("Phase: $currentphase");
 
     my $stop=0;
     while (!$stop && $currentphase < scalar(@validate_phases)) {
@@ -6424,10 +6443,10 @@ ENDSCRIPT
 	$r->print($message);
 	$r->print("<p>Please indicate which bubble should be used for grading</p>");
 	foreach my $question (@{$arg}) {
-
 	    my $selected  = &get_response_bubbles($scan_record, $question);
+	    my @select_array = split(/:/,$selected);
 	    &scantron_bubble_selector($r,$scan_config,$question,
-				      split('',$selected));
+				      @select_array);
 	}
     } elsif ($error eq 'missingbubble') {
 	$r->print("<p>There have been <b>no</b> bubbles scanned for some question(s)</p>\n");
@@ -6458,22 +6477,24 @@ ENDSCRIPT
     $r           - Apache request object
     $scan_config - hash from &get_scantron_config()
     $quest       - number of the bubble line to make a corrector for
-    $selected    - array of letters of previously selected bubbles
+    $lines       - array of answer lines.
 
 =cut
 
 sub scantron_bubble_selector {
-    my ($r,$scan_config,$quest,@selected)=@_;
+    my ($r,$scan_config,$quest,@lines)=@_;
     my $max=$$scan_config{'Qlength'};
 
+
     my $scmode=$$scan_config{'Qon'};
 
+    my $bubble_length = scalar(@lines);
+
 
     if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }	     
 
     my $response = $quest-1;
     my $lines = $bubble_lines_per_response{$response};
-    &Apache::lonnet::logthis("Question $quest, lines: $lines");
 
     my $total_lines = $lines*2;
     my @alphabet=('A'..'Z');
@@ -6483,11 +6504,7 @@ sub scantron_bubble_selector {
 	if ($l != 0) {
 	    $r->print('<tr>');
 	}
-
-	# FIXME:  This loop probably has to be considerably more clever for
-	#  multiline bubbles: User can multibubble by having bubbles in
-	#  several lines.  User can skip lines legitimately etc. etc.
-
+	my @selected = split(//,$lines[$l]);
 	for (my $i=0;$i<$max;$i++) {
 	    $r->print("\n".'<td align="center">');
 	    if ($selected[0] eq $alphabet[$i]) { 
@@ -6737,14 +6754,11 @@ sub scantron_validate_doublebubble {
 =cut
 
 sub scantron_get_maxbubble {    
-    &Apache::lonnet::logthis("get_max_bubble");
     if (defined($env{'form.scantron_maxbubble'}) &&
 	$env{'form.scantron_maxbubble'}) {
-	&Apache::lonnet::logthis("cached");
 	&restore_bubble_lines();
 	return $env{'form.scantron_maxbubble'};
     }
-    &Apache::lonnet::logthis("computing");
 
     my (undef, undef, $sequence) =
 	&Apache::lonnet::decode_symb($env{'form.selectpage'});
@@ -6782,9 +6796,9 @@ sub scantron_get_maxbubble {
 
 
 	foreach my $part_id (@{$analysis{'parts'}}) {
-	    my ($trash, $part) = split(/\./, $part_id);
 
-	    my $lines = $analysis{"$part_id.bubble_lines"}[0];
+
+	    my $lines = $analysis{"$part_id.bubble_lines"};;
 
 	    # TODO - make this a persistent hash not an array.
 
@@ -7190,10 +7204,6 @@ sub grading_menu {
     my $probTitle = &Apache::lonnet::gettitle($symb);
     my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle);
 
-    #
-    # Define menu data
-    $env{'form.probTitle'} = &Apache::lonnet::gettitle($symb);
-    my ($table) = &showResourceInfo($symb,$env{'form.probTitle'});
     $request->print($table);
     my %fields = ('symb'=>&Apache::lonenc::check_encrypt($symb),
                   'handgrade'=>$hdgrade,
@@ -8071,7 +8081,6 @@ sub handler {
 	} elsif ($command eq 'csvuploadassign' && $perm{'mgr'} ) {
 	    $request->print(&csvuploadassign($request));
 	} elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) {
-	    &Apache::lonnet::logthis("Selecting pyhase");
 	    $request->print(&scantron_selectphase($request));
  	} elsif ($command eq 'scantron_warning' && $perm{'mgr'}) {
  	    $request->print(&scantron_do_warning($request));