Return to grades.pm CVS log

Up to [LON-CAPA] / loncom / homework

Diff for /loncom/homework/grades.pm between versions 1.141 and 1.177

-version 1.141, 2003/09/21 21:40:06
+version 1.177, 2004/02/24 23:22:24
  Line 48  use Apache::lonhomework;
  use Apache::loncoursedata;
  use Apache::lonmsg qw(:user_normal_msg);
  use Apache::Constants qw(:common);
+ use Apache::lonlocal;
  use String::Similarity;
  my %oldessays=();
- Line 55  my %perm=();
+ Line 56  my %perm=();
  # ----- These first few routines are general use routines.----
  #
- # --- Retrieve the parts that matches stores_\d+ from the metadata file.---
+ # --- Retrieve the parts from the metadata file.---
  sub getpartlist {
-     my ($url) = @_;
+     my ($url,$symb) = @_;
-     my @parts =();
+     my $partorder = &Apache::lonnet::metadata($url, 'partorder');
-     my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys'));
+     my @parts;
-     foreach my $key (@metakeys) {
+     if ($partorder) {
- 	if ( $key =~ m/stores_(\w+)_.*/) {
+ 	for my $part (split (/,/,$partorder)) {
- 	    push(@parts,$key);
+ 	    if (!&Apache::loncommon::check_if_partid_hidden($part,$symb)) {
+ 		push(@parts, $part);
+ 	    }
+ 	}
+     } else {
+ 	my $metadata = &Apache::lonnet::metadata($url, 'packages');
+ 	foreach (split(/\,/,$metadata)) {
+ 	    if ($_ =~ /^part_(.*)$/) {
+ 		if (!&Apache::loncommon::check_if_partid_hidden($1,$symb)) {
+ 		    push(@parts, $1);
+ 		}
+ 	    }
+ 	}
+     }
+     my @stores;
+     foreach my $part (@parts) {
+ 	my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys'));
+ 	foreach my $key (@metakeys) {
+ 	    if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); }
  	}
      }
-     return @parts;
+     return @stores;
  }
  # --- Get the symbolic name of a problem and the url
  sub get_symb_and_url {
-     my ($request) = @_;
+     my ($request,$silent) = @_;
      (my $url=$ENV{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
      my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url)));
-     if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; }
+     if ($symb eq '') {
+ 	if (!$silent) {
+ 	    $request->print("Unable to handle ambiguous references:$url:.");
+ 	    return ();
+ 	}
+     }
      return ($symb,$url);
  }
- Line 114  sub response_type {
+ Line 138  sub response_type {
      my ($url,$symb) = shift;
      $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))) if ($symb eq '');
      my $allkeys = &Apache::lonnet::metadata($url,'keys');
+     my %vPart;
+     foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) {
+ 	$vPart{$partid}=1;
+     }
      my %seen = ();
-     my (@partlist,%handgrade);
+     my (@partlist,%handgrade,%responseType);
      foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) {
- 	if (/^\w+response_\w+.*/) {
+ 	if (/^\w+response_.*/) {
  	    my ($responsetype,$part) = split(/_/,$_,2);
  	    my ($partid,$respid) = split(/_/,$part);
+ 	    if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) {
+ 		next;
+ 	    }
+ 	    if (%vPart && !exists($vPart{$partid})) {
+ 		next;
+ 	    }
  	    $responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!!
  	    my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb);
- 	    $handgrade{$part} = $responsetype.':'.($value eq 'yes' ? 'yes' : 'no');
+ 	    $handgrade{$part} = ($value eq 'yes' ? 'yes' : 'no');
+ 	    if (!exists($responseType{$partid})) { $responseType{$partid}={}; }
+ 	    $responseType{$partid}->{$respid}=$responsetype;
  	    next if ($seen{$partid} > 0);
  	    $seen{$partid}++;
  	    push @partlist,$partid;
  	}
      }
-     return \@partlist,\%handgrade;
+     return \@partlist,\%handgrade,\%responseType;
  }
  #--- Show resource title
  #--- and parts and response type
  sub showResourceInfo {
-     my ($url,$probTitle) = @_;
+     my ($url,$probTitle,$checkboxes) = @_;
+     my $col=3;
+     if ($checkboxes) { $col=4; }
      my $result ='<table border="0">'.
- 	'<tr><td colspan=3><font size=+1><b>Current Resource: </b>'.$probTitle.'</font></td></tr>'."\n";
+ 	'<tr><td colspan="'.$col.'"><font size="+1"><b>'.&mt('Current Resource').': </b>'.
-     my ($partlist,$handgrade) = &response_type($url);
+ 	$probTitle.'</font></td></tr>'."\n";
+     my ($partlist,$handgrade,$responseType) = &response_type($url);
      my %resptype = ();
      my $hdgrade='no';
-     for (sort keys(%$handgrade)) {
+     my %partsseen;
- 	my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_});
+     for my $part_resID (sort keys(%$handgrade)) {
- 	my $partID = (split(/_/))[0];
+ 	my $handgrade=$$handgrade{$part_resID};
- 	$resptype{$partID} = $responsetype;
+ 	my ($partID,$resID) = split(/_/,$part_resID);
+ 	my $responsetype = $responseType->{$partID}->{$resID};
  	$hdgrade = $handgrade if ($handgrade eq 'yes');
- 	$result.='<tr><td><b>Part </b>'.$partID.'</td>'.
+ 	$result.='<tr>';
+ 	if ($checkboxes) {
+ 	    if (exists($partsseen{$partID})) {
+ 		$result.="<td>&nbsp;</td>";
+ 	    } else {
+ 		$result.="<td><input type='checkbox' name='vPart' value='$partID' checked='on' /></td>";
+ 	    }
+ 	    $partsseen{$partID}=1;
+ 	}
+ 	$result.='<td><b>Part </b>'.$partID.' <font color="#999999">'.
+ 	    $resID.'</font></td>'.
  	    '<td><b>Type: </b>'.$responsetype.'</td></tr>';
  #	    '<td><b>Handgrade: </b>'.$handgrade.'</td></tr>';
      }
      $result.='</table>'."\n";
-     return $result,\%resptype,$hdgrade,$partlist,$handgrade;
+     return $result,$responseType,$hdgrade,$partlist,$handgrade;
  }
+ sub get_order {
+     my ($partid,$respid,$symb,$uname,$udom)=@_;
+     my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);
+     $url=&Apache::lonnet::clutter($url);
+     my $subresult=&Apache::lonnet::ssi($url,
+ 				       ('grade_target' => 'analyze'),
+ 				       ('grade_domain' => $udom),
+ 				       ('grade_symb' => $symb),
+ 				       ('grade_courseid' =>
+ 					        $ENV{'request.course.id'}),
+ 				       ('grade_username' => $uname));
+     (undef,$subresult)=split(/_HASH_REF__/,$subresult,2);
+     my %analyze=&Apache::lonnet::str2hash($subresult);
+     return ($analyze{"$partid.$respid.shown"});
+ }
  #--- Clean response type for display
- #--- Currently filters option response type only.
+ #--- Currently filters option/rank/radiobutton/match/essay response types only.
  sub cleanRecord {
-     my ($answer,$response,$symb) = @_;
+     my ($answer,$response,$symb,$partid,$respid,$record,$order,$version) = @_;
-     if ($response eq 'option') {
+     my $grayFont = '<font color="#999999">';
- 	my (@IDs,@ans);
+     if ($response =~ /^(option|rank)$/) {
- 	foreach (split(/\&/,&Apache::lonnet::unescape($answer))) {
+ 	my %answer=&Apache::lonnet::str2hash($answer);
- 	    my ($optionID,$ans) = split(/=/);
+ 	my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"});
- 	    push @IDs,$optionID.'</font>';
+ 	my ($toprow,$bottomrow);
- 	    push @ans,$ans;
+ 	foreach my $foil (@$order) {
+ 	    if ($grading{$foil} == 1) {
+ 		$toprow.='<td><b>'.$answer{$foil}.'&nbsp;</b></td>';
+ 	    } else {
+ 		$toprow.='<td><i>'.$answer{$foil}.'&nbsp;</i></td>';
+ 	    }
+ 	    $bottomrow.='<td>'.$grayFont.$foil.'</font>&nbsp;</td>';
  	}
- 	my $grayFont = '<font color="#999999">';
  	return '<blockquote><table border="1">'.
- 	    '<tr valign="top"><td>Answer</td><td>'.
+ 	    '<tr valign="top"><td>Answer</td>'.$toprow.'</tr>'.
- 	    (join '</td><td>',@ans).'</td></tr>'.
+ 	    '<tr valign="top"><td>'.$grayFont.'Option ID</font></td>'.
- 	    '<tr valign="top"><td>'.$grayFont.'Option ID</font></td><td>'.$grayFont.
+ 	    $grayFont.$bottomrow.'</tr>'.'</table></blockquote>';
- 	    (join '</td><td>'.$grayFont,@IDs).'</font></td></tr>'.
+     } elsif ($response eq 'match') {
- 	    '</table></blockquote>';
+ 	my %answer=&Apache::lonnet::str2hash($answer);
-     }
+ 	my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"});
-     if ($response eq 'essay') {
+ 	my @items=&Apache::lonnet::str2array($record->{$version."resource.$partid.$respid.submissionitems"});
+ 	my ($toprow,$middlerow,$bottomrow);
+ 	foreach my $foil (@$order) {
+ 	    my $item=shift(@items);
+ 	    if ($grading{$foil} == 1) {
+ 		$toprow.='<td><b>'.$item.'&nbsp;</b></td>';
+ 		$middlerow.='<td><b>'.$grayFont.$answer{$foil}.'&nbsp;</font></b></td>';
+ 	    } else {
+ 		$toprow.='<td><i>'.$item.'&nbsp;</i></td>';
+ 		$middlerow.='<td><i>'.$grayFont.$answer{$foil}.'&nbsp;</font></i></td>';
+ 	    }
+ 	    $bottomrow.='<td>'.$grayFont.$foil.'</font>&nbsp;</td>';
+ 	}
+ 	return '<blockquote><table border="1">'.
+ 	    '<tr valign="top"><td>Answer</td>'.$toprow.'</tr>'.
+ 	    '<tr valign="top"><td>'.$grayFont.'Item ID</font></td>'.
+ 	    $middlerow.'</tr>'.
+ 	    '<tr valign="top"><td>'.$grayFont.'Option ID</font></td>'.
+ 	    $bottomrow.'</tr>'.'</table></blockquote>';
+     } elsif ($response eq 'radiobutton') {
+ 	my %answer=&Apache::lonnet::str2hash($answer);
+ 	my ($toprow,$bottomrow);
+ 	my $correct=($order->[0])+1;
+ 	for (my $i=1;$i<=$#$order;$i++) {
+ 	    my $foil=$order->[$i];
+ 	    if (exists($answer{$foil})) {
+ 		if ($i == $correct) {
+ 		    $toprow.='<td><b>true</b></td>';
+ 		} else {
+ 		    $toprow.='<td><i>true</i></td>';
+ 		}
+ 	    } else {
+ 		$toprow.='<td>false</td>';
+ 	    }
+ 	    $bottomrow.='<td>'.$grayFont.$foil.'</font>&nbsp;</td>';
+ 	}
+ 	return '<blockquote><table border="1">'.
+ 	    '<tr valign="top"><td>Answer</td>'.$toprow.'</tr>'.
+ 	    '<tr valign="top"><td>'.$grayFont.'Option ID</font></td>'.
+ 	    $grayFont.$bottomrow.'</tr>'.'</table></blockquote>';
+     } elsif ($response eq 'essay') {
  	if (! exists ($ENV{'form.'.$symb})) {
  	    my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade',
  						  $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
- Line 185  sub cleanRecord {
+ Line 296  sub cleanRecord {
  	    $ENV{'form.kwstyle'}  = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : '';
  	    $ENV{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob.
  	}
- 	return '<br /><br /><blockquote>'.&keywords_highlight($answer).'</blockquote>';
+ 	$answer =~ s-\n-<br />-g;
+ 	return '<br /><br /><blockquote><tt>'.&keywords_highlight($answer).'</tt></blockquote>';
      }
      return $answer;
  }
- Line 414  sub verifyreceipt {
+ Line 526  sub verifyreceipt {
      my ($string,$contents,$matches) = ('','',0);
      my (undef,undef,$fullname) = &getclasslist('all','0');
+     my $receiptparts=0;
+     if ($ENV{"course.$courseid.receiptalg"} eq 'receipt2') { $receiptparts=1; }
+     my $parts=['0'];
+     if ($receiptparts) { ($parts)=&response_type($url,$symb); }
+     $request->print("got Parts ".join(':',@$parts));
      foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {
  	my ($uname,$udom)=split(/\:/);
- 	if ($receipt eq
+ 	foreach my $part (@$parts) {
- 	    &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb)) {
+ 	    if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) {
- 	    $contents.='<tr bgcolor="#ffffe6"><td>&nbsp;'."\n".
+ 		$contents.='<tr bgcolor="#ffffe6"><td>&nbsp;'."\n".
- 		'<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom.
+ 		    '<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom.
- 		'\')"; TARGET=_self>'.$$fullname{$_}.'</a>&nbsp;</td>'."\n".
+ 		    '\')"; TARGET=_self>'.$$fullname{$_}.'</a>&nbsp;</td>'."\n".
- 		'<td>&nbsp;'.$uname.'&nbsp;</td>'.
+ 		    '<td>&nbsp;'.$uname.'&nbsp;</td>'.
- 		'<td>&nbsp;'.$udom.'&nbsp;</td></tr>'."\n";
+ 		    '<td>&nbsp;'.$udom.'&nbsp;</td>';
+ 		if ($receiptparts) {
- 	    $matches++;
+ 		    $contents.='<td>&nbsp;'.$part.'&nbsp;</td>';
+ 		}
+ 		$contents.='</tr>'."\n";
+ 		$matches++;
+ 	    }
  	}
      }
      if ($matches == 0) {
- Line 438  sub verifyreceipt {
+ Line 560  sub verifyreceipt {
  	    '<table border="0"><tr bgcolor="#e6ffff">'."\n".
  	    '<td><b>&nbsp;Fullname&nbsp;</b></td>'."\n".
  	    '<td><b>&nbsp;Username&nbsp;</b></td>'."\n".
- 	    '<td><b>&nbsp;Domain&nbsp;</b></td></tr>'."\n".
+ 	    '<td><b>&nbsp;Domain&nbsp;</b></td>';
- 	    $contents.
+ 	if ($receiptparts) {
+ 	    $string.='<td>&nbsp;Problem Part&nbsp;</td>';
+ 	}
+ 	$string.='</tr>'."\n".$contents.
  	    '</table></td></tr></table>'."\n";
      }
      return $string.&show_grading_menu_form($symb,$url);
- Line 465  sub listStudents {
+ Line 590  sub listStudents {
      my $result='<h3><font color="#339933">&nbsp;'.$viewgrade.
  	' Submissions for a Student or a Group of Students</font></h3>';
-     my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($url,$ENV{'form.probTitle'});
+     my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($url,$ENV{'form.probTitle'},($ENV{'form.showgrading'} eq 'yes'));
-     $result.=$table;
      $request->print(<<LISTJAVASCRIPT);
  <script type="text/javascript" language="javascript">
- Line 506  LISTJAVASCRIPT
+ Line 630  LISTJAVASCRIPT
      my $checkhdgrade = ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked' : '';
      my $checklastsub = $checkhdgrade eq '' ? 'checked' : '';
-     my $gradeTable='<form action="/adm/grades" method="post" name="gradesub">'."\n".
+     my $gradeTable='<form action="/adm/grades" method="post" name="gradesub">'.
- 	'&nbsp;<b>View Problem Text: </b><input type="radio" name="vProb" value="no" checked /> no '."\n".
+ 	"\n".$table.
+ 	'&nbsp;<b>View Problem Text: </b><input type="radio" name="vProb" value="no" checked="on" /> no '."\n".
  	'<input type="radio" name="vProb" value="yes" /> one student '."\n".
  	'<input type="radio" name="vProb" value="all" /> all students <br />'."\n".
+ 	'&nbsp;<b>View Answer: </b><input type="radio" name="vAns" value="no"  /> no '."\n".
+ 	'<input type="radio" name="vAns" value="yes" /> one student '."\n".
+ 	'<input type="radio" name="vAns" value="all" checked="on" /> all students <br />'."\n".
  	'&nbsp;<b>Submissions: </b>'."\n";
      if ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) {
  	$gradeTable.='<input type="radio" name="lastSub" value="hdgrade" '.$checkhdgrade.' /> essay part only'."\n";
- Line 569  LISTJAVASCRIPT
+ Line 697  LISTJAVASCRIPT
  	my %status = ();
  	if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') {
  	    (%status) =&student_gradeStatus($url,$symb,$udom,$uname,$partlist);
- 	    my $statusflg = '';
+ 	    my $submitted = 0;
+ 	    my $graded = 0;
  	    foreach (keys(%status)) {
- 		$statusflg = 1 if ($status{$_} ne 'nothing');
+ 		$submitted = 1 if ($status{$_} ne 'nothing');
+ 		$graded = 1 if ($status{$_} !~ /^correct/);
  		my ($foo,$partid,$foo1) = split(/\./,$_);
  		if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
- 		    $statusflg = '';
+ 		    $submitted = 0;
+ 		    my ($part)=split(/\./,$partid);
  		    $gradeTable.='<input type="hidden" name="'.
- 			$student.':submitted_by" value="'.
+ 			$student.':'.$part.':submitted_by" value="'.
  			$status{'resource.'.$partid.'.submitted_by'}.'" />';
  		}
  	    }
- 	    next if ($statusflg eq '' && $submitonly eq 'yes');
+ 	    next if (!$submitted && ($submitonly eq 'yes' ||
+ 				     $submitonly eq 'incorrect' ||
+ 				     $submitonly eq 'graded'));
+ 	    next if (!$graded && ($submitonly eq 'graded' ||
+ 				  $submitonly eq 'incorrect'));
  	}
  	$ctr++;
- Line 620  LISTJAVASCRIPT
+ Line 756  LISTJAVASCRIPT
  	if ($num_students eq 0) {
  	    $gradeTable='<br />&nbsp;<font color="red">There are no students currently enrolled.</font>';
  	} else {
+ 	    my $submissions='submissions';
+ 	    if ($submitonly eq 'incorrect') { $submissions = 'incorrect submissions'; }
+ 	    if ($submitonly eq 'graded'   ) { $submissions = 'ungraded submissions'; }
  	    $gradeTable='<br />&nbsp;<font color="red">'.
- 		'No submissions found for this resource for any students. ('.$num_students.
+ 		'No '.$submissions.' found for this resource for any students. ('.$num_students.
- 		' checked for submissions</font><br />';
+ 		' students checked for '.$submissions.')</font><br />';
  	}
      } elsif ($ctr == 1) {
  	$gradeTable =~ s/type=checkbox/type=checkbox checked/;
- Line 637  LISTJAVASCRIPT
+ Line 776  LISTJAVASCRIPT
  sub processGroup {
      my ($request)  = shift;
      my $ctr        = 0;
-     my @stuchecked = (ref($ENV{'form.stuinfo'}) ? @{$ENV{'form.stuinfo'}}
+     my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo');
- 		      : ($ENV{'form.stuinfo'}));
      my $total      = scalar(@stuchecked)-1;
      foreach (@stuchecked) {
- Line 1196  sub gradeBox {
+ Line 1334  sub gradeBox {
  }
  sub show_problem {
-     my ($request,$symb,$uname,$udom,$removeform,$viewon) = @_;
+     my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode) = @_;
-     my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom,
+     my $rendered;
- 						      $ENV{'request.course.id'});
+     if ($mode eq 'both' or $mode eq 'text') {
+ 	$rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom,
+ 					     $ENV{'request.course.id'});
+     }
      if ($removeform) {
  	$rendered=~s|<form(.*?)>||g;
  	$rendered=~s|</form>||g;
  	$rendered=~s|name="submit"|name="would_have_been_submit"|g;
      }
-     my $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom,
+     my $companswer;
- 							   $ENV{'request.course.id'});
+     if ($mode eq 'both' or $mode eq 'answer') {
+ 	$companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom,
+ 						    $ENV{'request.course.id'});
+     }
      if ($removeform) {
  	$companswer=~s|<form(.*?)>||g;
  	$companswer=~s|</form>||g;
- 	$rendered=~s|name="submit"|name="would_have_been_submit"|g;
+ 	$companswer=~s|name="submit"|name="would_have_been_submit"|g;
      }
      my $result.='<table border="0" width="100%"><tr><td bgcolor="#777777">';
      $result.='<table border="0" width="100%">';
-     $result.='<tr><td bgcolor="#e6ffff"><b> View of the problem - '.$ENV{'form.fullname'}.
+     if ($viewon) {
- 	'</b></td></tr>' if ($viewon);
+ 	$result.='<tr><td bgcolor="#e6ffff"><b> ';
-     $result.='<tr><td bgcolor="#ffffff">'.$rendered.'<br />';
+ 	if ($mode eq 'both' or $mode eq 'text') {
-     $result.='<b>Correct answer:</b><br />'.$companswer;
+ 	    $result.='View of the problem - ';
+ 	} else {
+ 	    $result.='Correct answer: ';
+ 	}
+ 	$result.=$ENV{'form.fullname'}.'</b></td></tr>';
+     }
+     if ($mode eq 'both') {
+ 	$result.='<tr><td bgcolor="#ffffff">'.$rendered.'<br />';
+ 	$result.='<b>Correct answer:</b><br />'.$companswer;
+     } elsif ($mode eq 'text') {
+ 	$result.='<tr><td bgcolor="#ffffff">'.$rendered;
+     } elsif ($mode eq 'answer') {
+ 	$result.='<tr><td bgcolor="#ffffff">'.$companswer;
+     }
      $result.='</td></tr></table>';
      $result.='</td></tr></table><br />';
      return $result;
- Line 1242  sub submission {
+ Line 1399  sub submission {
  	return;
      }
-     $ENV{'form.lastSub'} = ($ENV{'form.lastSub'} eq '' ? 'datesub' : $ENV{'form.lastSub'});
+     if (!$ENV{'form.lastSub'}) { $ENV{'form.lastSub'} = 'datesub'; }
+     if (!$ENV{'form.vProb'}) { $ENV{'form.vProb'} = 'yes'; }
+     if (!$ENV{'form.vAns'}) { $ENV{'form.vAns'} = 'yes'; }
      my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : '');
      my $checkIcon = '<img src="'.$request->dir_config('lonIconsURL').
  	'/check.gif" height="16" border="0" />';
- Line 1265  sub submission {
+ Line 1424  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' or !$ENV{'form.vProb'}) {
+ 	if ($ENV{'form.vProb'} eq 'yes' or $ENV{'form.vAns'} eq 'yes') {
- 	    $request->print(&show_problem($request,$symb,$uname,$udom,0,1));
+ 	    my $mode;
+ 	    if ($ENV{'form.vProb'} eq 'yes' && $ENV{'form.vAns'} eq 'yes') {
+ 		$mode='both';
+ 	    } elsif ($ENV{'form.vProb'} eq 'yes') {
+ 		$mode='text';
+ 	    } elsif ($ENV{'form.vAns'} eq 'yes') {
+ 		$mode='answer';
+ 	    }
+ 	    $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode));
  	}
  	# kwclr is the only variable that is guaranteed to be non blank
- Line 1301  sub submission {
+ Line 1468  sub submission {
  			'<input type="hidden" name="url"        value="'.$url.'" />'."\n".
  			'<input type="hidden" name="showgrading" value="'.$ENV{'form.showgrading'}.'" />'."\n".
  			'<input type="hidden" name="vProb"      value="'.$ENV{'form.vProb'}.'" />'."\n".
+ 			'<input type="hidden" name="vAns"       value="'.$ENV{'form.vAns'}.'" />'."\n".
  			'<input type="hidden" name="lastSub"    value="'.$ENV{'form.lastSub'}.'" />'."\n".
  			'<input type="hidden" name="section"    value="'.$ENV{'form.section'}.'">'."\n".
  			'<input type="hidden" name="submitonly" value="'.$ENV{'form.submitonly'}.'">'."\n".
- Line 1315  sub submission {
+ Line 1483  sub submission {
  			    '<input type="hidden" name="msgsub"   value="'.$ENV{'form.msgsub'}.'" />'."\n".
  			    '<input type="hidden" name="shownSub" value="0" />'."\n".
  			    '<input type="hidden" name="savemsgN" value="'.$ENV{'form.savemsgN'}.'" />'."\n");
+ 	    foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) {
+ 		$request->print('<input type="hidden" name="vPart" value="'.$partid.'" />'."\n");
+ 	    }
  	}
  	my ($cts,$prnmsg) = (1,'');
- Line 1351  KEYWORDS
+ Line 1522  KEYWORDS
          }
      }
-     if ($ENV{'form.vProb'} eq 'all') {
+     if ($ENV{'form.vProb'} eq 'all' or $ENV{'form.vAns'} eq 'all') {
  	$request->print('<br /><br /><br />') if ($counter > 0);
- 	$request->print(&show_problem($request,$symb,$uname,$udom,1,1));
+ 	my $mode;
+ 	if ($ENV{'form.vProb'} eq 'all' && $ENV{'form.vAns'} eq 'all') {
+ 	    $mode='both';
+ 	} elsif ($ENV{'form.vProb'} eq 'all' ) {
+ 	    $mode='text';
+ 	} elsif ($ENV{'form.vAns'} eq 'all') {
+ 	    $mode='answer';
+ 	}
+ 	$request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode));
      }
      my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname);
-     my ($partlist,$handgrade) = &response_type($url,$symb);
+     my ($partlist,$handgrade,$responseType) = &response_type($url,$symb);
      # Display student info
      $request->print(($counter == 0 ? '' : '<br />'));
- Line 1404  KEYWORDS
+ Line 1584  KEYWORDS
  		    $result.=$$fullname{$_}.'&nbsp; &nbsp; &nbsp;';
  		}
                  $result.='<br />'."\n";
+ 		my ($part)=split(/\./,$_);
  		$result.='<input type="hidden" name="collaborator'.$counter.
- 		    '" value="'.(join ':',@goodcollaborators).'" />'."\n";
+ 		    '" value="'.$part.':'.(join ':',@goodcollaborators).'" />'.
+ 		    "\n";
  	    }
  	    if (scalar(@badcollaborators) > 0) {
  		$result.='<table border="0"><tr bgcolor="#ffbbbb"><td>';
- Line 1431  KEYWORDS
+ Line 1613  KEYWORDS
      #             (3) Last submission plus the parts info
      #             (4) The whole record for this student
      if ($ENV{'form.lastSub'} =~ /^(lastonly|hdgrade)$/) {
- 	if ($ENV{'form.'.$uname.':'.$udom.':submitted_by'}) {
+ 	my ($string,$timestamp)= &get_last_submission(\%record);
- 	    my $submitby=''.
+ 	my $lastsubonly=''.
- 		'<b>Collaborative submission by: </b>'.
+ 	    ($$timestamp eq '' ? '' : '<b>Date Submitted:</b> '.
- 		'<a href="javascript:viewSubmitter(\''.
+ 	     $$timestamp)."</td></tr>\n";
- 		$ENV{'form.'.$uname.':'.$udom.':submitted_by'}.
+ 	if ($$timestamp eq '') {
- 		'\')"; TARGET=_self>'.
+ 	    $lastsubonly.='<tr><td bgcolor="#ffffe6">'.$$string[0];
- 		$$fullname{$ENV{'form.'.$uname.':'.$udom.':submitted_by'}}.'</a>';
+ 	} else {
- 	    $request->print($submitby);
+ 	    my %seenparts;
- 	} else {
+ 	    for my $part (sort keys(%$handgrade)) {
- 	    my ($string,$timestamp)= &get_last_submission (\%record);
+ 		my ($partid,$respid) = split(/_/,$part);
- 	    my $lastsubonly=''.
+ 		if ($ENV{"form.$uname:$udom:$partid:submitted_by"}) {
- 		($$timestamp eq '' ? '' : '<b>Date Submitted:</b> '.
+ 		    if (exists($seenparts{$partid})) { next; }
- 		 $$timestamp)."</td></tr>\n";
+ 		    $seenparts{$partid}=1;
- 	    if ($$timestamp eq '') {
+ 		    my $submitby='<b>Part '.$partid.
- 		$lastsubonly.='<tr><td bgcolor="#ffffe6">'.$$string[0];
+ 			' Collaborative submission by: </b>'.
- 	    } else {
+ 			'<a href="javascript:viewSubmitter(\''.
- 		for my $part (sort keys(%$handgrade)) {
+ 			$ENV{"form.$uname:$udom:$partid:submitted_by"}.
- 		    my ($responsetype,$foo) = split(/:/,$$handgrade{$part});
+ 			'\')"; TARGET=_self>'.
- 		    my ($partid,$respid) = split(/_/,$part);
+ 			$$fullname{$ENV{"form.$uname:$udom:$partid:submitted_by"}}.'</a><br />';
- 		    if (!exists($record{'resource.'.$partid.'.'.$respid.'.submission'})) {
+ 		    $request->print($submitby);
+ 		    next;
+ 		}
+ 		my $responsetype = $responseType->{$partid}->{$respid};
+ 		if (!exists($record{"resource.$partid.$respid.submission"})) {
+ 		    $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '.
+ 			$partid.'</b> <font color="#999999">( ID '.$respid.
+ 			' )</font>&nbsp; &nbsp;'.
+ 			'<font color="red">Nothing submitted - no attempts</font><br /><br />';
+ 		    next;
+ 		}
+ 		foreach (@$string) {
+ 		    my ($partid,$respid) = /^resource\.([^\.]*)\.([^\.]*)\.submission/;
+ 		    if ($part ne ($partid.'_'.$respid)) { next; }
+ 		    my ($ressub,$subval) = split(/:/,$_,2);
+ 		    # Similarity check
+ 		    my $similar='';
+ 		    if($ENV{'form.checkPlag'}){
+ 			my ($oname,$odom,$ocrsid,$oessay,$osim)=
+ 			    &most_similar($uname,$udom,$subval);
+ 			if ($osim) {
+ 			    $osim=int($osim*100.0);
+ 			    $similar="<hr /><h3><font color=\"#FF0000\">Essay".
+ 				" is $osim% similar to an essay by ".
+ 				&Apache::loncommon::plainname($oname,$odom).
+ 				'</font></h3><blockquote><i>'.
+ 				&keywords_highlight($oessay).
+ 				'</i></blockquote><hr />';
+ 			}
+ 		    }
+ 		    my $order=&get_order($partid,$respid,$symb,$uname,$udom);
+ 		    if ($ENV{'form.lastSub'} eq 'lastonly' ||
+ 			($ENV{'form.lastSub'} eq 'hdgrade' &&
+ 			 $$handgrade{$part} eq 'yes')) {
  			$lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '.
  			    $partid.'</b> <font color="#999999">( ID '.$respid.
- 			    ' )</font>&nbsp; &nbsp;'.
+ 			    ' )</font>&nbsp; &nbsp;';
- 			    '<font color="red">Nothing submitted - no attempts</font><br /><br />';
+ 			if ($record{"resource.$partid.$respid.uploadedurl"}) {
-  		    } else {
+ 			    $lastsubonly.='<a href="'.&Apache::lonnet::tokenwrapper($record{"resource.$partid.$respid.uploadedurl"}).'" target="lonGRDs"><img src="/adm/lonIcons/unknown.gif" border=0"> File uploaded by student</a> <font color="red" size="1">Like all files provided by users, this file may contain virusses</font><br />';
- 			foreach (@$string) {
- 			    my ($partid,$respid) = /^resource\.(\w+)\.(\w+)\.submission/;
- 			    if ($part eq ($partid.'_'.$respid)) {
- 				my ($ressub,$subval) = split(/:/,$_,2);
-                             # Similarity check
- 				my $similar='';
- 				my $oname;
- 				my $odom;
- 				my $ocrsid;
- 				my $oessay;
- 				my $osim;
- 				if($ENV{'form.checkPlag'}){
- 				    ($oname,$odom,$ocrsid,$oessay,$osim)=&most_similar($uname,$udom,$subval);
- 				    if ($osim) {
- 					$osim=int($osim*100.0);
- 					$similar='<hr /><h3><font color="#FF0000">Essay is '.$osim.
- 					    '% similar to an essay by '.&Apache::loncommon::plainname($oname,$odom).
- 					    '</font></h3><blockquote><i>'.
- 					    &keywords_highlight($oessay).'</i></blockquote><hr />';
- 				    }
- 				}
- 				$lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '.
- 				    $partid.'</b> <font color="#999999">( ID '.$respid.
- 				    ' )</font>&nbsp; &nbsp;'.
- 				    ($record{"resource.$partid.$respid.uploadedurl"}?
- 				     '<a href="'.
- 				     &Apache::lonnet::tokenwrapper($record{"resource.$partid.$respid.uploadedurl"}).
- 				     '"><img src="/adm/lonIcons/unknown.gif" border=0"> File uploaded by student</a> '.
- 				     '<font color="red" size="1">Like all files provided by users, '.
- 				     'this file may contain virusses</font><br />':'').
- 				     '<b>Submitted Answer: </b>'.
- 				     &cleanRecord($subval,$responsetype,$symb).
- 				     '<br /><br />'.$similar."\n"
- 				     if ($ENV{'form.lastSub'} eq 'lastonly' ||
- 					 ($ENV{'form.lastSub'} eq 'hdgrade' &&
- 					  $$handgrade{$part} =~ /:yes$/));
- 			    }
  			}
+ 			$lastsubonly.='<b>Submitted Answer: </b>'.
+ 			    &cleanRecord($subval,$responsetype,$symb,$partid,
+ 					 $respid,\%record,$order);
+ 			if ($similar) {$lastsubonly.="<br /><br />$similar\n";}
  		    }
  		}
  	    }
- 	    $lastsubonly.='</td></tr><tr bgcolor="#ffffff"><td>'."\n";
- 	    $request->print($lastsubonly);
  	}
+ 	$lastsubonly.='</td></tr><tr bgcolor="#ffffff"><td>'."\n";
+ 	$request->print($lastsubonly);
      } elsif ($ENV{'form.lastSub'} eq 'datesub') {
  	my (undef,$responseType,undef,$parts) = &showResourceInfo($url);
- 	$request->print(&displaySubByDates(\$symb,\%record,$parts,$responseType,$checkIcon));
+ 	$request->print(&displaySubByDates($symb,\%record,$parts,$responseType,$checkIcon,$uname,$udom));
      } elsif ($ENV{'form.lastSub'} =~ /^(last|all)$/) {
  	$request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom,
  								 $ENV{'request.course.id'},
- Line 1518  KEYWORDS
+ Line 1700  KEYWORDS
  	my $toGrade.='<input type="button" value="Grade Student" '.
  	    'onClick="javascript:checksubmit(this.form,\'Grade Student\',\''
  	    .$counter.'\');" TARGET=_self> &nbsp;'."\n" if (&canmodify($usec));
- 	$toGrade.='</td></tr></table></td></tr></table></form>'."\n";
+ 	$toGrade.='</td></tr></table></td></tr></table>'."\n";
- 	$toGrade.=&show_grading_menu_form($symb,$url)
+ 	if (($ENV{'form.command'} eq 'submission') ||
- 	    if (($ENV{'form.command'} eq 'submission') ||
+ 	    ($ENV{'form.command'} eq 'processGroup' && $counter == $total)) {
- 		($ENV{'form.command'} eq 'processGroup' && $counter == $total));
+ 	    $toGrade.='</form>'.&show_grading_menu_form($symb,$url)
+ 	}
  	$request = print($toGrade);
  	return;
      }
- Line 1675  sub processHandGrade {
+ Line 1858  sub processHandGrade {
  							       $ENV{'form.msgsub'},$message);
  	    }
  	    if ($ENV{'form.collaborator'.$ctr}) {
- 		my (@collaborators) = split(/:/,$ENV{'form.collaborator'.$ctr});
+ 		my @collabstrs=&Apache::loncommon::get_env_multiple("form.collaborator$ctr");
- 		foreach (@collaborators) {
+ 		foreach my $collabstr (@collabstrs) {
- 		    my ($errorflag,$pts,$wgt) =
+ 		    my ($part,@collaborators) = split(/:/,$collabstr);
- 			&saveHandGrade($request,$url,$symb,$_,$udom,$ctr,$ENV{'form.unamedom'.$ctr});
+ 		    foreach (@collaborators) {
- 		    if ($errorflag eq 'not_allowed') {
+ 			my ($errorflag,$pts,$wgt) =
- 			$request->print("<font color=\"red\">Not allowed to modify grades for $_:$udom</font>");
+ 			    &saveHandGrade($request,$url,$symb,$_,$udom,$ctr,
- 			next;
+ 					   $ENV{'form.unamedom'.$ctr},$part);
- 		    } else {
+ 			if ($errorflag eq 'not_allowed') {
- 			if ($message ne '') {
+ 			    $request->print("<font color=\"red\">Not allowed to modify grades for $_:$udom</font>");
- 			    $msgstatus = &Apache::lonmsg::user_normal_msg ($_,$udom,
+ 			    next;
- 									   $ENV{'form.msgsub'},
+ 			} else {
- 									   $message);
+ 			    if ($message ne '') {
+ 				$msgstatus = &Apache::lonmsg::user_normal_msg($_,$udom,$ENV{'form.msgsub'},$message);
+ 			    }
  			}
  		    }
  		}
- Line 1790  sub processHandGrade {
+ Line 1976  sub processHandGrade {
      }
      $ctr = 0;
      @parsedlist = reverse @parsedlist if ($button eq 'Previous');
+     my ($partlist) = &response_type($url);
      foreach my $student (@parsedlist) {
+ 	my $submitonly=$ENV{'form.submitonly'};
  	my ($uname,$udom) = split(/:/,$student);
- 	if ($ENV{'form.submitonly'} eq 'yes') {
+ 	if ($submitonly =~ /^(yes|graded|incorrect)$/) {
- 	    my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname);
+ #	    my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname);
- 	    my $statusflg = '';
+ 	    my %status=&student_gradeStatus($url,$symb,$udom,$uname,$partlist);
- 	    foreach (split(/:/,$ENV{'form.gradePartRespid'})){
+ 	    my $submitted = 0;
- 		$statusflg = 1 if (exists ($record{'resource.'.$_.'.submission'}));
+ 	    my $graded = 1;
+ 	    foreach (keys(%status)) {
+ 		$submitted = 1 if ($status{$_} ne 'nothing');
+ 		$graded = 0 if ($status{$_} =~ /^correct/);
+ 		my ($foo,$partid,$foo1) = split(/\./,$_);
+ 		if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
+ 		    $submitted = 0;
+ 		}
  	    }
- 	    next if ($statusflg eq '');
+ 	    next if (!$submitted && ($submitonly eq 'yes' ||
+ 				     $submitonly eq 'incorrect' ||
+ 				     $submitonly eq 'graded'));
+ 	    next if (!$graded && ($submitonly eq 'graded' ||
+ 				  $submitonly eq 'incorrect'));
  	}
  	push @nextlist,$student if ($ctr < $ntstu);
  	last if ($ctr == $ntstu);
- Line 1828  sub processHandGrade {
+ Line 2027  sub processHandGrade {
  #---- Save the score and award for each student, if changed
  sub saveHandGrade {
-     my ($request,$url,$symb,$stuname,$domain,$newflg,$submitter) = @_;
+     my ($request,$url,$symb,$stuname,$domain,$newflg,$submitter,$part) = @_;
      my $usec = &Apache::lonnet::getsection($domain,$stuname,
  					   $ENV{'request.course.id'});
      if (!&canmodify($usec)) { return('not_allowed'); }
- Line 1836  sub saveHandGrade {
+ Line 2035  sub saveHandGrade {
      my %newrecord  = ();
      my ($pts,$wgt) = ('','');
      foreach (split(/:/,$ENV{'form.partlist'.$newflg})) {
+ 	#collaborator may vary for different parts
+ 	if ($submitter && $_ ne $part) { next; }
  	my $dropMenu = $ENV{'form.GD_SEL'.$newflg.'_'.$_};
  	if ($dropMenu eq 'excused') {
  	    if ($record{'resource.'.$_.'.solved'} ne 'excused') {
- Line 1856  sub saveHandGrade {
+ Line 2057  sub saveHandGrade {
  	    $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 '');
+ 	    if ($pts eq '' && $ENV{'form.GD_SEL'.$newflg.'_'.$_} eq '') {
+ 		next;
+ 	    }
  	    $wgt = $ENV{'form.WGT'.$newflg.'_'.$_} eq '' ? 1 :
  		$ENV{'form.WGT'.$newflg.'_'.$_};
  	    my $partial= $pts/$wgt;
- 	    next if ($partial eq $record{'resource.'.$_.'.awarded'}); #do not update score for part if not changed.
+ 	    if ($partial eq $record{'resource.'.$_.'.awarded'}) {
- 	    $newrecord{'resource.'.$_.'.awarded'}  = $partial
+ 		#do not update score for part if not changed.
- 		if ($record{'resource.'.$_.'.awarded'} ne $partial);
+ 		next;
+ 	    }
+ 	    if ($record{'resource.'.$_.'.awarded'} ne $partial) {
+ 		$newrecord{'resource.'.$_.'.awarded'}  = $partial;
+ 	    }
  	    my $reckey = 'resource.'.$_.'.solved';
  	    if ($partial == 0) {
- 		$newrecord{$reckey} = 'incorrect_by_override'
+ 		if ($record{$reckey} ne 'incorrect_by_override') {
- 		    if ($record{$reckey} ne 'incorrect_by_override');
+ 		    $newrecord{$reckey} = 'incorrect_by_override';
+ 		}
  	    } else {
- 		$newrecord{$reckey} = 'correct_by_override'
+ 		if ($record{$reckey} ne 'correct_by_override') {
- 		    if ($record{$reckey} ne 'correct_by_override');
+ 		    $newrecord{$reckey} = 'correct_by_override';
+ 		}
+ 	    }
+ 	    if ($submitter &&
+ 		($record{'resource.'.$_.'.submitted_by'} ne $submitter)) {
+ 		$newrecord{'resource.'.$_.'.submitted_by'} = $submitter;
  	    }
- 	    $newrecord{'resource.'.$_.'.submitted_by'} = $submitter
+ 	    $newrecord{'resource.'.$_.'.regrader'}=
- 		if ($submitter && ($record{'resource.'.$_.'.submitted_by'} ne $submitter));
+ 		"$ENV{'user.name'}:$ENV{'user.domain'}";
- 	    $newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}";
  	}
      }
      if (scalar(keys(%newrecord)) > 0) {
  	&Apache::lonnet::cstore(\%newrecord,$symb,
  				$ENV{'request.course.id'},$domain,$stuname);
- Line 2059  sub viewgrades {
+ Line 2270  sub viewgrades {
      &viewgrades_js($request);
      my ($symb,$url) = ($ENV{'form.symb'},$ENV{'form.url'});
-     my $result='<h3><font color="#339933">Manual Grading</font></h3>';
+     #need to make sure we have the correct data for later EXT calls,
+     #thus invalidate the cache
+     &Apache::lonnet::devalidatecourseresdata(
+                  $ENV{'course.'.$ENV{'request.course.id'}.'.num'},
+                  $ENV{'course.'.$ENV{'request.course.id'}.'.domain'});
+     &Apache::lonnet::clear_EXT_cache_status();
+     my $result='<h3><font color="#339933">'.&mt('Manual Grading').'</font></h3>';
      $result.='<font size=+1><b>Current Resource: </b>'.$ENV{'form.probTitle'}.'</font>'."\n";
      #view individual student submission form - called using Javascript viewOneStudent
- Line 2098  sub viewgrades {
+ Line 2315  sub viewgrades {
  	my ($partid,$respid) = split (/_/,$_,2);
  	next if $seen{$partid};
  	$seen{$partid}++;
- 	my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_});
+ 	my $handgrade=$$handgrade{$_};
  	my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb);
  	$weight{$partid} = $wgt eq '' ? '1' : $wgt;
- Line 2140  sub viewgrades {
+ Line 2357  sub viewgrades {
      $result.= '<table border=0><tr><td bgcolor="#777777">'."\n".
  	'<table border=0><tr bgcolor="#deffff"><td>&nbsp;<b>No.</b>&nbsp;</td>'.
  	'<td>'.&nameUserString('header')."</td>\n";
-     my (@parts) = sort(&getpartlist($url));
+     my (@parts) = sort(&getpartlist($url,$symb));
      foreach my $part (@parts) {
  	my $display=&Apache::lonnet::metadata($url,$part.'.display');
  	$display =~ s|^Number of Attempts|Tries<br />|; # makes the column narrower
- Line 2257  sub editgrades {
+ Line 2474  sub editgrades {
      my %columns = ();
      my ($i,$ctr,$count,$rec_update) = (0,0,0,0);
-     my (@parts) = sort(&getpartlist($url));
+     my (@parts) = sort(&getpartlist($url,$symb));
      my $header;
      while ($ctr < $ENV{'form.totalparts'}) {
  	my $partid = $ENV{'form.partid_'.$ctr};
- Line 2522  ENDPICK
+ Line 2739  ENDPICK
  }
  sub csvupload_fields {
-     my ($url) = @_;
+     my ($url,$symb) = @_;
-     my (@parts) = &getpartlist($url);
+     my (@parts) = &getpartlist($url,$symb);
      my @fields=(['username','Student Username'],['domain','Student Domain']);
      foreach my $part (sort(@parts)) {
  	my @datum;
- Line 2606  sub csvuploadmap {
+ Line 2823  sub csvuploadmap {
      &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1);
      my ($i,$keyfields);
      if (@records) {
- 	my @fields=&csvupload_fields($url);
+ 	my @fields=&csvupload_fields($url,$symb);
  	if ($ENV{'form.upfile_associate'} eq 'reverse') {
  	    &Apache::loncommon::csv_print_samples($request,\@records);
- Line 2656  sub csvuploadassign {
+ Line 2873  sub csvuploadassign {
      foreach my $grade (@gradedata) {
  	my %entries=&Apache::loncommon::record_sep($grade);
  	my $username=$entries{$fields{'username'}};
+ 	$username=~s/\s//g;
  	my $domain=$entries{$fields{'domain'}};
+ 	$domain=~s/\s//g;
  	if (!exists($$classlist{"$username:$domain"})) {
  	    push(@skipped,"$username:$domain");
  	    next;
- Line 2755  LISTJAVASCRIPT
+ Line 2974  LISTJAVASCRIPT
      $result.='<input type="hidden" name="page" />'."\n".
  	'<input type="hidden" name="title" />'."\n";
-     $result.='&nbsp;<b>View Problems Text: </b><input type="radio" name="vProb" value="no" checked /> no '."\n".
+     $result.='&nbsp;<b>View Problems Text: </b><input type="radio" name="vProb" value="no" checked="on" /> no '."\n".
  	'<input type="radio" name="vProb" value="yes" /> yes '."<br>\n";
      $result.='&nbsp;<b>Submission Details: </b>'.
- Line 2841  sub displayPage {
+ Line 3060  sub displayPage {
      my ($classlist,undef,$fullname) = &getclasslist($getsec,'1');
      my ($uname,$udom) = split(/:/,$ENV{'form.student'});
      my $usec=$classlist->{$ENV{'form.student'}}[5];
+     #need to make sure we have the correct data for later EXT calls,
+     #thus invalidate the cache
+     &Apache::lonnet::devalidatecourseresdata(
+                  $ENV{'course.'.$ENV{'request.course.id'}.'.num'},
+                  $ENV{'course.'.$ENV{'request.course.id'}.'.domain'});
+     &Apache::lonnet::clear_EXT_cache_status();
      if (!&canview($usec)) {
  	$request->print('<font color="red">Unable to view requested student.('.$ENV{'form.student'}.')</font>');
  	$request->print(&show_grading_menu_form($symb,$url));
- Line 2894  sub displayPage {
+ Line 3121  sub displayPage {
  	    $studentTable.='<tr bgcolor="#ffffe6"><td align="center" valign="top" >'.$question.
  		(scalar(@{$parts}) == 1 ? '' : '<br>('.scalar(@{$parts}).'&nbsp;parts)').'</td>';
  	    $studentTable.='<td valign="top">';
- 	    if ($ENV{'form.vProb'} eq 'yes') {
+ 	    if ($ENV{'form.vProb'} eq 'yes' ) {
- 		$studentTable.=&show_problem($request,$symbx,$uname,$udom,1);
+ 		$studentTable.=&show_problem($request,$symbx,$uname,$udom,1,
+ 					     undef,'both');
  	    } else {
  		my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$ENV{'request.course.id'});
  		$companswer =~ s|<form(.*?)>||g;
- Line 2916  sub displayPage {
+ Line 3144  sub displayPage {
  		} else {
  		    my %responseType = ();
  		    foreach my $partid (@{$parts}) {
- 			$responseType{$partid} = $curRes->responseType($partid);
+ 			my @responseIds =$curRes->responseIds($partid);
+ 			my @responseType =$curRes->responseType($partid);
+ 			my %responseIds;
+ 			for (my $i=0;$i<=$#responseIds;$i++) {
+ 			    $responseIds{$responseIds[$i]}=$responseType[$i];
+ 			}
+ 			$responseType{$partid} = \%responseIds;
  		    }
- 		    $studentTable.= &displaySubByDates(\$symbx,\%record,$parts,\%responseType,$checkIcon);
+ 		    $studentTable.= &displaySubByDates($symbx,\%record,$parts,\%responseType,$checkIcon,$uname,$udom);
  		}
  	    } elsif ($ENV{'form.lastSub'} eq 'all') {
  		my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : '');
- Line 2953  sub displayPage {
+ Line 3188  sub displayPage {
  }
  sub displaySubByDates {
-     my ($symbx,$record,$parts,$responseType,$checkIcon) = @_;
+     my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_;
      my $studentTable='<table border="0" width="100%"><tr><td bgcolor="#777777">'.
  	'<table border="0" width="100%"><tr bgcolor="#e6ffff">'.
  	'<td><b>Date/Time</b></td>'.
- Line 2961  sub displaySubByDates {
+ Line 3196  sub displaySubByDates {
  	'<td><b>Status&nbsp;</b></td></tr>';
      my ($version);
      my %mark;
+     my %orders;
      $mark{'correct_by_student'} = $checkIcon;
-     return '<br />&nbsp;<font color="red">Nothing submitted - no attempts</font><br />'
+     if (!exists($$record{'1:timestamp'})) {
- 	if (!exists($$record{'1:timestamp'}));
+ 	return '<br />&nbsp;<font color="red">Nothing submitted - no attempts</font><br />';
+     }
      for ($version=1;$version<=$$record{'version'};$version++) {
  	my $timestamp = scalar(localtime($$record{$version.':timestamp'}));
  	$studentTable.='<tr bgcolor="#ffffff" valign="top"><td>'.$timestamp.'</td>';
  	my @versionKeys = split(/\:/,$$record{$version.':keys'});
  	my @displaySub = ();
  	foreach my $partid (@{$parts}) {
- 	    my @matchKey = grep /^resource\.$partid\..*?\.submission$/,@versionKeys;
+ 	    my @matchKey = sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys);
  #	    next if ($$record{"$version:resource.$partid.solved"} eq '');
- 	    $displaySub[0].=(exists $$record{$version.':'.$matchKey[0]}) ?
+ 	    foreach my $matchKey (@matchKey) {
- 		'<b>Part&nbsp;'.$partid.'&nbsp;'.
+ 		if (exists $$record{$version.':'.$matchKey}) {
- 		($$record{"$version:resource.$partid.tries"} eq '' ? 'Trial&nbsp;not&nbsp;counted' :
+ 		    my ($responseId)=($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/);
- 		 'Trial&nbsp;'.$$record{"$version:resource.$partid.tries"}).'</b>&nbsp; '.
+ 		    $displaySub[0].='<b>Part&nbsp;'.$partid.'&nbsp;';
- 		 &cleanRecord($$record{$version.':'.$matchKey[0]},$$responseType{$partid},$$symbx).'<br />' : '';
+ 		    $displaySub[0].='<font color="#999999">(ID&nbsp;'.
- 	    $displaySub[1].=(exists $$record{"$version:resource.$partid.award"}) ?
+ 			$responseId.')</font>&nbsp;';
- 		'<b>Part&nbsp;'.$partid.'</b> &nbsp;'.
+ 		    if ($$record{"$version:resource.$partid.tries"} eq '') {
- 		lc($$record{"$version:resource.$partid.award"}).' '.
+ 			$displaySub[0].='Trial&nbsp;not&nbsp;counted';
- 		$mark{$$record{"$version:resource.$partid.solved"}}.'<br />' : '';
+ 		    } else {
- 	    $displaySub[2].=(exists $$record{"$version:resource.$partid.regrader"}) ?
+ 			$displaySub[0].='Trial&nbsp;'.
- 		$$record{"$version:resource.$partid.regrader"}.' (<b>Part:</b> '.$partid.')' : '';
+ 			    $$record{"$version:resource.$partid.tries"};
- 	}
+ 		    }
- 	$displaySub[2].=(exists $$record{"$version:resource.regrader"}) ?
+ 		    my $responseType=$responseType->{$partid}->{$responseId};
- 	    $$record{"$version:resource.regrader"} : ''; # needed because old essay regrader has not parts info
+ 		    if (!exists($orders{$partid})) { $orders{$partid}={}; }
- 	$studentTable.='<td>'.$displaySub[0].'&nbsp;</td><td>'.$displaySub[1].
+ 		    if (!exists($orders{$partid}->{$responseId})) {
- 	    ($displaySub[2] eq '' ? '' : 'Manually graded by '.$displaySub[2]).'&nbsp;</td></tr>';
+ 			$orders{$partid}->{$responseId}=
+ 			    &get_order($partid,$responseId,$symb,$uname,$udom);
+ 		    }
+ 		    $displaySub[0].='</b>&nbsp; '.
+ 			&cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:").'<br />';
+ 		}
+ 	    }
+ 	    if (exists $$record{"$version:resource.$partid.award"}) {
+ 		$displaySub[1].='<b>Part&nbsp;'.$partid.'</b> &nbsp;'.
+ 		    lc($$record{"$version:resource.$partid.award"}).' '.
+ 		    $mark{$$record{"$version:resource.$partid.solved"}}.
+ 		    '<br />';
+ 	    }
+ 	    if (exists $$record{"$version:resource.$partid.regrader"}) {
+ 		$displaySub[2].=$$record{"$version:resource.$partid.regrader"}.
+ 		    ' (<b>'.&mt('Part').':</b> '.$partid.')';
+ 	    }
+ 	}
+ 	# needed because old essay regrader has not parts info
+ 	if (exists $$record{"$version:resource.regrader"}) {
+ 	    $displaySub[2].=$$record{"$version:resource.regrader"};
+ 	}
+ 	$studentTable.='<td>'.$displaySub[0].'&nbsp;</td><td>'.$displaySub[1];
+ 	if ($displaySub[2]) {
+ 	    $studentTable.='Manually graded by '.$displaySub[2];
+ 	}
+ 	$studentTable.='&nbsp;</td></tr>';
      }
      $studentTable.='</table></td></tr></table>';
      return $studentTable;
- Line 3153  sub getSequenceDropDown {
+ Line 3417  sub getSequenceDropDown {
  sub scantron_uploads {
      if (!-e $Apache::lonnet::perlvar{'lonScansDir'}) { return ''};
      my $result=	'<select name="scantron_selectfile">';
-     opendir(DIR,$Apache::lonnet::perlvar{'lonScansDir'});
+     my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
-     my @files=sort(readdir(DIR));
+     my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
+     my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname,
+ 				    &Apache::loncommon::propath($cdom,$cname));
      foreach my $filename (@files) {
- 	if ($filename eq '.' or $filename eq '..') { next; }
+ 	($filename)=split(/&/,$filename);
+ 	if ($filename!~/^scantron_orig_/) { next ; }
+ 	$filename=~s/^scantron_orig_//;
  	$result.="<option>$filename</option>\n";
      }
-     closedir(DIR);
      $result.="</select>";
      return $result;
  }
- Line 3187  sub scantron_selectphase {
+ Line 3454  sub scantron_selectphase {
      my $file_selector=&scantron_uploads();
      my $format_selector=&scantron_scantab();
      my $result;
+     #FIXME allow instructor to be able to download the scantron file
+     # and to upload it,
      $result.= <<SCANTRONFORM;
- <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantro_process">
+     <table width="100%" border="0">
-   <input type="hidden" name="command" value="scantron_process" />
-   $default_form_data
-   <table width="100%" border="0">
      <tr>
        <td bgcolor="#777777">
+        <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantro_process">
+        <input type="hidden" name="command" value="scantron_validate" />
+         $default_form_data
          <table width="100%" border="0">
            <tr bgcolor="#e6ffff">
-             <td>
+             <td colspan="2">
-               &nbsp;<b>Specify file location and which Folder/Sequence to grade</b>
+               &nbsp;<b>Specify file and which Folder/Sequence to grade</b>
              </td>
            </tr>
            <tr bgcolor="#ffffe6">
+             <td> Sequence to grade: </td><td> $sequence_selector </td>
+           </tr>
+           <tr bgcolor="#ffffe6">
+             <td> Filename of scoring office file: </td><td> $file_selector </td>
+           </tr>
+           <tr bgcolor="#ffffe6">
+             <td> Format of data file: </td><td> $format_selector </td>
+           </tr>
+           <tr bgcolor="#ffffe6">
              <td>
-                Sequence to grade: $sequence_selector
+ <!-- FIXME this is lazy, a single parse of the set should let me know what this is -->
+               Last line to expect an answer on: </td><td>
+                 <input type="text" name="scantron_maxbubble" />
  	    </td>
            </tr>
            <tr bgcolor="#ffffe6">
+             <td colspan="2">
+               <input type="submit" value="Validate Scantron Records" />
+             </td>
+           </tr>
+         </table>
+        </form>
+       </td>
+     </tr>
+ SCANTRONFORM
+     $r->print($result);
+     if (&Apache::lonnet::allowed('usc',$ENV{'request.role.domain'}) ||
+         &Apache::lonnet::allowed('usc',$ENV{'request.course.id'})) {
+         $r->print(<<SCANTRONFORM);
+     <tr>
+       <td bgcolor="#777777">
+         <table width="100%" border="0">
+           <tr bgcolor="#e6ffff">
              <td>
- 		Filename of scoring office file: $file_selector
+               &nbsp;<b>Specify a Scantron data file to upload.</b>
- 	    </td>
+             </td>
            </tr>
            <tr bgcolor="#ffffe6">
              <td>
-               Format of data file: $format_selector
+ SCANTRONFORM
- 	    </td>
+     my $default_form_data=&defaultFormData(&get_symb_and_url($r,1));
+     my $cdom= $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
+     my $cnum= $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
+     $r->print(<<UPLOAD);
+               <script type="text/javascript" language="javascript">
+     function checkUpload(formname) {
+ 	if (formname.upfile.value == "") {
+ 	    alert("Please use the browse button to select a file from your local directory.");
+ 	    return false;
+ 	}
+ 	formname.submit();
+     }
+               </script>
+               <form enctype='multipart/form-data' action='/adm/grades' name='rules' method='post'>
+                 $default_form_data
+                 <input name='courseid' type='hidden' value='$cnum' />
+                 <input name='domainid' type='hidden' value='$cdom' />
+                 <input name='command' value='scantronupload_save' type='hidden' />
+                 File to upload:<input type="file" name="upfile" size="50" />
+                 <br />
+                 <input type="button" onClick="javascript:checkUpload(this.form);" value="Upload Scantron Data" />
+               </form>
+ UPLOAD
+         $r->print(<<SCANTRONFORM);
+             </td>
            </tr>
          </table>
        </td>
      </tr>
+ SCANTRONFORM
+     }
+     $r->print(<<SCANTRONFORM);
    </table>
-   <input type="submit" value="Submit" />
  </form>
  $grading_menu_button
  SCANTRONFORM
-     return $result;
+     return
  }
  sub get_scantron_config {
      my ($which) = @_;
      my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
      my %config;
+     #FIXME probably should move to XML it has already gotten a bit much now
      foreach my $line (<$fh>) {
  	my ($name,$descrip)=split(/:/,$line);
  	if ($name ne $which ) { next; }
- Line 3247  sub get_scantron_config {
+ Line 3577  sub get_scantron_config {
  	$config{'Qlength'}=$config[8];
  	$config{'Qoff'}=$config[9];
  	$config{'Qon'}=$config[10];
+ 	$config{'PaperID'}=$config[11];
+ 	$config{'PaperIDlength'}=$config[12];
+ 	$config{'FirstName'}=$config[13];
+ 	$config{'FirstNamelength'}=$config[14];
+ 	$config{'LastName'}=$config[15];
+ 	$config{'LastNamelength'}=$config[16];
  	last;
      }
      return %config;
- Line 3262  sub username_to_idmap {
+ Line 3598  sub username_to_idmap {
      return %idmap;
  }
+ sub scantron_fixup_scanline {
+     my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_;
+     if ($field eq 'ID') {
+ 	if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) {
+ 	    return ($line,1,'New value to large');
+ 	}
+ 	if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) {
+ 	    $args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s',
+ 				     $args->{'newid'});
+ 	}
+ 	substr($line,$$scantron_config{'IDstart'}-1,
+ 	       $$scantron_config{'IDlength'})=$args->{'newid'};
+ 	if ($args->{'newid'}=~/^\s*$/) {
+ 	    &scan_data($scan_data,"$whichline.user",
+ 		       $args->{'username'}.':'.$args->{'domain'});
+ 	}
+     } elsif ($field eq 'answer') {
+ 	my $length=$scantron_config->{'Qlength'};
+ 	my $off=$scantron_config->{'Qoff'};
+ 	my $on=$scantron_config->{'Qon'};
+ 	my $answer=${off}x$length;
+ 	if ($args->{'response'} eq 'none') {
+ 	    &scan_data($scan_data,
+ 		       "$whichline.no_bubble.".$args->{'question'},'1');
+ 	} else {
+ 	    substr($answer,$args->{'response'},1)=$on;
+ 	    &scan_data($scan_data,
+ 		       "$whichline.no_bubble.".$args->{'question'},undef,'1');
+ 	}
+ 	my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'};
+ 	substr($line,$where-1,$length)=$answer;
+     }
+     return $line;
+ }
+ sub scan_data {
+     my ($scan_data,$key,$value,$delete)=@_;
+     my $filename=$ENV{'form.scantron_selectfile'};
+     if (defined($value)) {
+ 	$scan_data->{$filename.'_'.$key} = $value;
+     }
+     if ($delete) { delete($scan_data->{$filename.'_'.$key}); }
+     return $scan_data->{$filename.'_'.$key};
+ }
  sub scantron_parse_scanline {
-     my ($line,$scantron_config)=@_;
+     my ($line,$whichline,$scantron_config,$scan_data)=@_;
      my %record;
      my $questions=substr($line,$$scantron_config{'Qstart'}-1);
      my $data=substr($line,0,$$scantron_config{'Qstart'}-1);
- Line 3277  sub scantron_parse_scanline {
+ Line 3658  sub scantron_parse_scanline {
      }
      $record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1,
  				  $$scantron_config{'IDlength'});
+     $record{'scantron.PaperID'}=
+ 	substr($data,$$scantron_config{'PaperID'}-1,
+ 	       $$scantron_config{'PaperIDlength'});
+     $record{'scantron.FirstName'}=
+ 	substr($data,$$scantron_config{'FirstName'}-1,
+ 	       $$scantron_config{'FirstNamelength'});
+     $record{'scantron.LastName'}=
+ 	substr($data,$$scantron_config{'LastName'}-1,
+ 	       $$scantron_config{'LastNamelength'});
      my @alphabet=('A'..'Z');
      my $questnum=0;
      while ($questions) {
- Line 3284  sub scantron_parse_scanline {
+ Line 3674  sub scantron_parse_scanline {
  	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);
+ 	my @array=split($$scantron_config{'Qon'},$currentquest,-1);
- 	if (scalar(@array) gt 2) {
- 	    #FIXME do something intelligent with double bubbles
- 	    Apache->request->print("<br ><b>Wha!!!</b> <pre>".scalar(@array).
- 				   '-'.$currentquest.'-'.$questnum.'</pre><br />');
- 	}
  	if (length($array[0]) eq $$scantron_config{'Qlength'}) {
  	    $record{"scantron.$questnum.answer"}='';
+ 	    if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {
+ 		push(@{$record{"scantron.missingerror"}},$questnum);
+  	    }
  	} else {
  	    $record{"scantron.$questnum.answer"}=$alphabet[length($array[0])];
  	}
+  	if (scalar(@array) gt 2) {
+  	    push(@{$record{'scantron.doubleerror'}},$questnum);
+  	    my @ans=@array;
+  	    my $i=length($ans[0]);shift(@ans);
+ 	    while ($#ans) {
+  		$i+=length($ans[0])+1;
+  		$record{"scantron.$questnum.answer"}.=$alphabet[$i];
+  		shift(@ans);
+  	    }
+  	}
      }
      $record{'scantron.maxquest'}=$questnum;
      return \%record;
- Line 3302  sub scantron_parse_scanline {
+ Line 3700  sub scantron_parse_scanline {
  sub scantron_add_delay {
      my ($delayqueue,$scanline,$errormessage,$errorcode)=@_;
-     Apache->request->print('add_delay_error '.$_[2] );
      push(@$delayqueue,
  	 {'line' => $scanline, 'emsg' => $errormessage,
  	  'ecode' => $errorcode }
- Line 3310  sub scantron_add_delay {
+ Line 3707  sub scantron_add_delay {
  }
  sub scantron_find_student {
-     my ($scantron_record,$idmap)=@_;
+     my ($scantron_record,$scan_data,$idmap,$line)=@_;
      my $scanID=$$scantron_record{'scantron.ID'};
+     if ($scanID =~ /^\s*$/) {
+  	return &scan_data($scan_data,"$line.user");
+     }
      foreach my $id (keys(%$idmap)) {
- 	#Apache->request->print('<pre>checking studnet -'.$id.'- againt -'.$scanID.'- </pre>');
+  	if (lc($id) eq lc($scanID)) {
- 	if (lc($id) eq lc($scanID)) {
+  	    return $$idmap{$id};
- 	    #Apache->request->print('success');
+  	}
- 	    return $$idmap{$id};
- 	}
      }
      return undef;
  }
- Line 3330  sub scantron_filter {
+ Line 3728  sub scantron_filter {
      return 0;
  }
- #FIXME I think I am doing this in the wrong order, I think it would be
+ sub scantron_process_corrections {
- #better to make a several passes analyzing all of the lines in the
+     my ($r) = @_;
- #file for common errors wrong/invalid PID/username duplicated
+     my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
- #PID/username, missing bubbles, double bubbles, missing/invalid CODE
+     my ($scanlines,$scan_data)=&scantron_getfile();
- #and then get the instructor to fix all of these errors, then grade
+     my $classlist=&Apache::loncoursedata::get_classlist();
- #the corrected one, I'll still need to catch error conditions, but
+     my $which=$ENV{'form.scantron_line'};
- #maybe most will taken care even before we start
+     my $line=&scantron_get_line($scanlines,$which);
+     my ($skip,$err,$errmsg);
+     if ($ENV{'form.scantron_skip_record'}) {
+ 	$skip=1;
+     } elsif ($ENV{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) {
+ 	my $newstudent=$ENV{'form.scantron_username'}.':'.
+ 	    $ENV{'form.scantron_domain'};
+ 	my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID];
+ 	($line,$err,$errmsg)=
+ 	    &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which,
+ 				     'ID',{'newid'=>$newid,
+ 				    'username'=>$ENV{'form.scantron_username'},
+ 				    'domain'=>$ENV{'form.scantron_domain'}});
+     } elsif ($ENV{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) {
+ 	foreach my $question (split(',',$ENV{'form.scantron_questions'})) {
+ 	    ($line,$err,$errmsg)=
+ 		&scantron_fixup_scanline(\%scantron_config,$scan_data,$line,
+ 					 $which,'answer',
+ 					 { 'question'=>$question,
+ 		       'response'=>$ENV{"form.scantron_correct_Q_$question"}});
+ 	    if ($err) { last; }
+ 	}
+     }
+     if ($err) {
+ 	$r->print("Unable to accept last correction, an error occurred :$errmsg:");
+     } else {
+ 	&scantron_put_line($scanlines,$which,$line,$skip);
+ 	&scantron_putfile($scanlines,$scan_data);
+     }
+ }
+ sub scantron_validate_file {
+     my ($r) = @_;
+     my ($symb,$url)=&get_symb_and_url($r);
+     if (!$symb) {return '';}
+     my $default_form_data=&defaultFormData($symb,$url);
+     if ($ENV{'form.scantron_corrections'}) {
+ 	&scantron_process_corrections($r);
+     }
+     #get the student pick code ready
+     $r->print(&Apache::loncommon::studentbrowser_javascript());
+     my $result= <<SCANTRONFORM;
+ <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload">
+   <input type="hidden" name="selectpage" value="$ENV{'form.selectpage'}" />
+   <input type="hidden" name="scantron_format" value="$ENV{'form.scantron_format'}" />
+   <input type="hidden" name="scantron_selectfile" value="$ENV{'form.scantron_selectfile'}" />
+   <input type="hidden" name="scantron_maxbubble" value="$ENV{'form.scantron_maxbubble'}" />
+   $default_form_data
+ SCANTRONFORM
+     $r->print($result);
+     my @validate_phases=( 'ID',
+ 			  'CODE',
+ 			  'doublebubble',
+ 			  'missingbubbles');
+     if (!$ENV{'form.validatepass'}) {
+ 	$ENV{'form.valiadatepass'} = 0;
+     }
+     my $currentphase=$ENV{'form.valiadatepass'};
+     if ($ENV{'form.scantron_selectfile'}=~m-^/-) {
+ 	#first pass copy file to classdir
+     }
+     my $stop=0;
+     while (!$stop && $currentphase < scalar(@validate_phases)) {
+ 	$r->print("<p> Validating ".$validate_phases[$currentphase]."</p>");
+ 	$r->rflush();
+ 	my $which="scantron_validate_".$validate_phases[$currentphase];
+ 	{
+ 	    no strict 'refs';
+ 	    ($stop,$currentphase)=&$which($r,$currentphase);
+ 	}
+     }
+     if (!$stop) {
+ 	$r->print("Validation process complete.<br />");
+ 	$r->print('<input type="submit" name="submit" value="Start Grading" />');
+ 	$r->print('<input type="hidden" name="command" value="scantron_process" />');
+     } else {
+ 	$r->print('<input type="hidden" name="command" value="scantron_validate" />');
+ 	$r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />");
+     }
+     if ($stop) {
+ 	$r->print('<input type="submit" name="submit" value="Continue ->" />');
+ 	$r->print(' using corrected info <br />');
+ 	$r->print("<input type='submit' value='Skip' name='scantron_skip_record' />");
+ 	$r->print(" this scanline saving it for later.");
+     }
+     $r->print(" </form><br />".&show_grading_menu_form($symb,$url).
+ 	      "</body></html>");
+     return '';
+ }
+ sub scantron_getfile {
+     #FIXME really would prefer a scantron directory but tokenwrapper
+     # doesn't allow access to subdirs of userfiles
+     my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
+     my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
+     my $lines;
+     $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
+ 		       'scantron_orig_'.$ENV{'form.scantron_selectfile'});
+     my %scanlines;
+     $scanlines{'orig'}=[(split("\n",$lines,-1))];
+     my $temp=$scanlines{'orig'};
+     $scanlines{'count'}=$#$temp;
+     $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
+ 		       'scantron_corrected_'.$ENV{'form.scantron_selectfile'});
+     if ($lines eq '-1') {
+ 	$scanlines{'corrected'}=[];
+     } else {
+ 	$scanlines{'corrected'}=[(split("\n",$lines,-1))];
+     }
+     $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
+ 		       'scantron_skipped_'.$ENV{'form.scantron_selectfile'});
+     if ($lines eq '-1') {
+ 	$scanlines{'skipped'}=[];
+     } else {
+ 	$scanlines{'skipped'}=[(split("\n",$lines,-1))];
+     }
+     my @tmp=&Apache::lonnet::dump('nohist_scantrondata',$cdom,$cname);
+     if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); }
+     my %scan_data = @tmp;
+     return (\%scanlines,\%scan_data);
+ }
+ sub lonnet_putfile {
+     my ($contents,$filename)=@_;
+     my $docuname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
+     my $docudom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
+     my $docuhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'};
+     $ENV{'form.sillywaytopassafilearound'}=$contents;
+     &Apache::lonnet::finishuserfileupload($docuname,$docudom,$docuhome,'sillywaytopassafilearound',$filename);
+ }
+ sub scantron_putfile {
+     my ($scanlines,$scan_data) = @_;
+     #FIXME really would prefer a scantron directory but tokenwrapper
+     # doesn't allow access to subdirs of userfiles
+     my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
+     my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
+     my $prefix='scantron_';
+ # no need to update orig, shouldn't change
+ #   &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'.
+ #		    $ENV{'form.scantron_selectfile'});
+     &lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}),
+ 		    $prefix.'corrected_'.
+ 		    $ENV{'form.scantron_selectfile'});
+     &lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}),
+ 		    $prefix.'skipped_'.
+ 		    $ENV{'form.scantron_selectfile'});
+     &Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname);
+ }
+ sub scantron_get_line {
+     my ($scanlines,$i)=@_;
+     if ($scanlines->{'skipped'}[$i]) {return undef;}
+     if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];}
+     return $scanlines->{'orig'}[$i];
+ }
+ sub scantron_put_line {
+     my ($scanlines,$i,$newline,$skip)=@_;
+     if ($skip) {
+ 	$scanlines->{'skipped'}[$i]=$newline;
+ 	return;
+     }
+     $scanlines->{'corrected'}[$i]=$newline;
+ }
+ sub scantron_validate_ID {
+     my ($r,$currentphase) = @_;
+     #get student info
+     my $classlist=&Apache::loncoursedata::get_classlist();
+     my %idmap=&username_to_idmap($classlist);
+     #get scantron line setup
+     my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
+     my ($scanlines,$scan_data)=&scantron_getfile();
+     my %found=('ids'=>{},'usernames'=>{});
+     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
+ 	my $line=&scantron_get_line($scanlines,$i);
+ 	if ($line=~/^[\s\cz]*$/) { next; }
+ 	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
+ 						 $scan_data);
+ 	my $id=$$scan_record{'scantron.ID'};
+ 	my $found;
+ 	foreach my $checkid (keys(%idmap)) {
+ 	    if (lc($checkid) eq lc($id)) { $found=$checkid;last; }
+ 	}
+ 	if ($found) {
+ 	    my $username=$idmap{$found};
+ 	    if ($found{'ids'}{$found}) {
+ 		&scantron_get_correction($r,$i,$scan_record,\%scantron_config,
+ 					 $line,'duplicateID',$found);
+ 		return(1);
+ 	    } elsif ($found{'usernames'}{$username}) {
+ 		&scantron_get_correction($r,$i,$scan_record,\%scantron_config,
+ 					 $line,'duplicateID',$username);
+ 		return(1);
+ 	    }
+ 	    #FIXME store away line we prviously saw the ID on to use above
+ 	    $found{'ids'}{$found}++;
+ 	    $found{'usernames'}{$username}++;
+ 	} else {
+ 	    if ($id =~ /^\s*$/) {
+ 		my $username=&scan_data($scan_data,"$i.user");
+ 		if (defined($username) && $found{'usernames'}{$username}) {
+ 		    &scantron_get_correction($r,$i,$scan_record,
+ 					     \%scantron_config,
+ 					     $line,'duplicateID',$username);
+ 		    return(1);
+ 		} elsif (!defined($username)) {
+ 		    &scantron_get_correction($r,$i,$scan_record,
+ 					     \%scantron_config,
+ 					     $line,'incorrectID');
+ 		    return(1);
+ 		}
+ 		$found{'usernames'}{$username}++;
+ 	    } else {
+ 		&scantron_get_correction($r,$i,$scan_record,\%scantron_config,
+ 					 $line,'incorrectID');
+ 		return(1);
+ 	    }
+ 	}
+     }
+     return (0,$currentphase+1);
+ }
+ sub scantron_get_correction {
+     my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_;
+ #FIXME in the case of a duplicated ID the previous line, probaly need
+ #to show both the current line and the previous one and allow skipping
+ #the previous one or the current one
+     $r->print("<p><b>An error was detected ($error)</b>");
+     if ( defined($$scan_record{'scantron.PaperID'}) ) {
+ 	$r->print(" for PaperID <tt>".
+ 		  $$scan_record{'scantron.PaperID'}."</tt> \n");
+     } else {
+ 	$r->print(" in scanline $i <pre>".
+ 		  $line."</pre> \n");
+     }
+     $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n");
+     $r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n");
+     if ($error =~ /ID$/) {
+ 	if ($error eq 'unknownID') {
+ 	    $r->print("The encoded ID is not in the classlist</p>\n");
+ 	} elsif ($error eq 'duplicateID') {
+ 	    $r->print("The encoded ID has also been used by a previous paper $arg</p>\n");
+ 	}
+ 	$r->print("<p>The ID on the form is  <tt>".
+ 		  $$scan_record{'scantron.ID'}."</tt><br />\n");
+ 	$r->print("The name on the paper is ".
+ 		  $$scan_record{'scantron.LastName'}.",".
+ 		  $$scan_record{'scantron.FirstName'}."</p>");
+ 	$r->print("<p>How should I handle this? <br /> \n");
+ 	$r->print("\n<ul><li> ");
+ 	#FIXME it would be nice if this sent back the user ID and
+ 	#could do partial userID matches
+ 	$r->print(&Apache::loncommon::selectstudent_link('scantronupload',
+ 				       'scantron_username','scantron_domain'));
+ 	$r->print(": <input type='text' name='scantron_username' value='' />");
+ 	$r->print("\n@".
+ 		 &Apache::loncommon::select_dom_form($ENV{'request.role..domain'},'scantron_domain'));
+ 	$r->print('</li>');
+     } elsif ($error eq 'doublebubble') {
+ #FIXME Need to print out who this is along with the paper info
+ 	$r->print("<p>There have been multiple bubbles scanned for a some question(s)</p>\n");
+ 	$r->print('<input type="hidden" name="scantron_questions" value="'.
+ 		  join(',',@{$arg}).'" />');
+ 	$r->print("<p>Please indicate which bubble should be used for grading</p>");
+ 	foreach my $question (@{$arg}) {
+ 	    my $selected=$$scan_record{"scantron.$question.answer"};
+ 	    &scantron_bubble_selector($r,$scan_config,$question,split('',$selected));
+ 	}
+     } elsif ($error eq 'missingbubble') {
+ 	$r->print("<p>There have been <b>no</b> bubbles scanned for some question(s)</p>\n");
+ 	$r->print("<p>Please indicate which bubble should be used for grading</p>");
+ 	$r->print("Some questions have no scanned bubbles\n");
+ 	$r->print('<input type="hidden" name="scantron_questions" value="'.
+ 		  join(',',@{$arg}).'" />');
+ 	foreach my $question (@{$arg}) {
+ 	    my $selected=$$scan_record{"scantron.$question.answer"};
+ 	    &scantron_bubble_selector($r,$scan_config,$question);
+ 	}
+     } else {
+ 	$r->print("\n<ul>");
+     }
+     $r->print("\n</li></ul>");
+ }
+ sub scantron_bubble_selector {
+     my ($r,$scan_config,$quest,@selected)=@_;
+     my $max=$$scan_config{'Qlength'};
+     my @alphabet=('A'..'Z');
+     $r->print("<table border='1'><tr><td rowspan='2'>$quest</td>");
+     for (my $i=0;$i<$max+1;$i++) {
+ 	$r->print('<td align="center">');
+ 	if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) }
+ 	else { $r->print('&nbsp;'); }
+ 	$r->print('</td>');
+     }
+     $r->print('<td></td></tr><tr>');
+     for (my $i=0;$i<$max;$i++) {
+ 	$r->print('<td><input type="radio" name="scantron_correct_Q_'.$quest.
+ 		  '" value="'.$i.'" />'.$alphabet[$i]."</td>");
+     }
+     $r->print('<td><input type="radio" name="scantron_correct_Q_'.$quest.
+ 	      '" value="none" /> No bubble </td>');
+     $r->print('</tr></table>');
+ }
+ sub scantron_validate_CODE {
+     my ($r,$currentphase) = @_;
+     #FIXME doesn't do anything yet
+     return (0,$currentphase+1);
+ }
+ sub scantron_validate_doublebubble {
+     my ($r,$currentphase) = @_;
+     #get student info
+     my $classlist=&Apache::loncoursedata::get_classlist();
+     my %idmap=&username_to_idmap($classlist);
+     #get scantron line setup
+     my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
+     my ($scanlines,$scan_data)=&scantron_getfile();
+     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
+ 	my $line=&scantron_get_line($scanlines,$i);
+ 	if ($line=~/^[\s\cz]*$/) { next; }
+ 	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
+ 						 $scan_data);
+ 	if (!defined($$scan_record{'scantron.doubleerror'})) { next; }
+ 	&scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line,
+ 				 'doublebubble',
+ 				 $$scan_record{'scantron.doubleerror'});
+     	return (1,$currentphase);
+     }
+     return (0,$currentphase+1);
+ }
+ sub scantron_validate_missingbubbles {
+     my ($r,$currentphase) = @_;
+     #get student info
+     my $classlist=&Apache::loncoursedata::get_classlist();
+     my %idmap=&username_to_idmap($classlist);
+     #get scantron line setup
+     my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
+     my ($scanlines,$scan_data)=&scantron_getfile();
+     my $max_bubble=$ENV{'form.scantron_maxbubble'};
+     if (!$max_bubble) { $max_bubble=2**31; }
+     for (my $i=0;$i<=$scanlines->{'count'};$i++) {
+ 	my $line=&scantron_get_line($scanlines,$i);
+ 	if ($line=~/^[\s\cz]*$/) { next; }
+ 	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
+ 						 $scan_data);
+ 	if (!defined($$scan_record{'scantron.missingerror'})) { next; }
+ 	my @to_correct;
+ 	foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) {
+ 	    if ($missing > $max_bubble) { next; }
+ 	    push(@to_correct,$missing);
+ 	}
+ 	if (@to_correct) {
+ 	    &scantron_get_correction($r,$i,$scan_record,\%scantron_config,
+ 				     $line,'missingbubble',\@to_correct);
+ 	    return (1,$currentphase);
+ 	}
+     }
+     return (0,$currentphase+1);
+ }
  sub scantron_process_students {
      my ($r) = @_;
      my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($ENV{'form.selectpage'});
- Line 3345  sub scantron_process_students {
+ Line 4125  sub scantron_process_students {
      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,$scan_data)=&scantron_getfile();
-     my @scanlines=<$scanlines>;
      my $classlist=&Apache::loncoursedata::get_classlist();
      my %idmap=&username_to_idmap($classlist);
      my $navmap=Apache::lonnavmaps::navmap->new();
- Line 3363  SCANTRONFORM
+ Line 4142  SCANTRONFORM
      my @delayqueue;
      my %completedstudents;
-     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,
+     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status',
- 	           'Scantron Status','Scantron Progress',scalar(@scanlines));
+  				    'Scantron Progress',$scanlines->{'count'});
      &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
  					  'Processing first student');
      my $start=&Time::HiRes::time();
-     foreach my $line (@scanlines) {
+     my $i=-1;
- 	$r->print('<pre>line is'.$line.'</pre>');
+     my ($uname,$udom);
+     while ($i<$scanlines->{'count'}) {
- 	chomp($line);
+  	($uname,$udom)=('','');
- 	my $scan_record=&scantron_parse_scanline($line,\%scantron_config);
+  	$i++;
- 	my ($uname,$udom);
+  	my $line=&scantron_get_line($scanlines,$i);
- 	unless ($uname=&scantron_find_student($scan_record,\%idmap)) {
+  	if ($line=~/^[\s\cz]*$/) { next; }
- 	    &scantron_add_delay(\@delayqueue,$line,
+  	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
- 				'Unable to find a student that matches',1);
+  						 $scan_data);
- 	    next;
+  	unless ($uname=&scantron_find_student($scan_record,$scan_data,
- 	}
+  					      \%idmap,$i)) {
- 	if (exists $completedstudents{$uname}) {
+   	    &scantron_add_delay(\@delayqueue,$line,
- 	    &scantron_add_delay(\@delayqueue,$line,
+  				'Unable to find a student that matches',1);
- 				'Student '.$uname.' has multiple sheets',2);
+  	    next;
- 	    next;
+   	}
- 	}
+  	if (exists $completedstudents{$uname}) {
- 	$r->print('<pre>doing studnet'.$uname.'</pre>');
+  	    &scantron_add_delay(\@delayqueue,$line,
- 	($uname,$udom)=split(/:/,$uname);
+  				'Student '.$uname.' has multiple sheets',2);
- 	&Apache::lonnet::delenv('form.counter');
+  	    next;
- 	&Apache::lonnet::appenv(%$scan_record);
+  	}
- #    &Apache::lonhomework::showhash(%ENV);
+   	($uname,$udom)=split(/:/,$uname);
- #    $Apache::lonxml::debug=1;
+   	&Apache::lonnet::delenv('form.counter');
- #	&Apache::lonxml::debug("line is $line");
+   	&Apache::lonnet::appenv(%$scan_record);
- 	    my $i=0;
+ 	my $i=0;
  	foreach my $resource (@resources) {
  	    $i++;
  	    my $result=&Apache::lonnet::ssi($resource->src(),
- Line 3402  SCANTRONFORM
+ Line 4181  SCANTRONFORM
  				  '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('<pre>'.
- #		      $resource->symb().'-'.
- #		      $resource->src().'-'.'</pre>result is'.$result);
- #	    &Apache::lonhomework::showhash(%score);
- 	#    if ($i eq 3) {last;}
  	}
  	$completedstudents{$uname}={'line'=>$line};
      } continue {
- Line 3426  SCANTRONFORM
+ Line 4188  SCANTRONFORM
  	&Apache::lonnet::delenv('scantron\.');
  	&Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
  						 'last student');
- 	#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::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
-     my $lasttime = &Time::HiRes::time()-$start;
+ #    my $lasttime = &Time::HiRes::time()-$start;
-     $r->print("<p>took $lasttime</p>");
+ #    $r->print("<p>took $lasttime</p>");
-     #$Apache::lonxml::debug=0;
+     $navmap->untieHashes();
-     foreach my $delay (@delayqueue) {
+     $r->print("</form><p>Done</p>");
- 	#FIXME
+     $r->print(&show_grading_menu_form($symb,$url));
- 	#print out each delayed student with interface to select how
+     return '';
- 	#  to repair student provided info
+ }
- 	#Expected errors include
- 	#  1 bad/no stuid/username
+ sub scantron_upload_scantron_data {
- 	#  2 invalid bubblings
+     my ($r)=@_;
+     $r->print(&Apache::loncommon::coursebrowser_javascript($ENV{'request.role.domain'}));
+     my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid',
+ 							  'domainid');
+     my $domsel=&Apache::loncommon::select_dom_form($ENV{'request.role.domain'},
+ 						   'domainid');
+     my $default_form_data=&defaultFormData(&get_symb_and_url($r,1));
+     $r->print(<<UPLOAD);
+ <script type="text/javascript" language="javascript">
+     function checkUpload(formname) {
+ 	if (formname.upfile.value == "") {
+ 	    alert("Please use the browse button to select a file from your local directory.");
+ 	    return false;
+ 	}
+ 	formname.submit();
      }
+ </script>
+ <form enctype='multipart/form-data' action='/adm/grades' name='rules' method='post'>
+ $default_form_data
+ Course: <input name='courseid' type='text' />
+ Domain: $domsel $select_link
+ <br />
+ <input name='command' value='scantronupload_save' type='hidden' />
+ File to upload:<input type="file" name="upfile" size="50" />
+ <br />
+ <input type="button" onClick="javascript:checkUpload(this.form);" value="Upload Scantron Data" />
+ </form>
+ UPLOAD
+     return '';
+ }
+ sub scantron_upload_scantron_data_save {
+     my($r)=@_;
+     if (!&Apache::lonnet::allowed('usc',$ENV{'form.domainid'}) &&
+ 	!&Apache::lonnet::allowed('usc',
+ 			    $ENV{'form.domainid'}.'_'.$ENV{'form.courseid'})) {
+ 	$r->print("You are not allowed to upload Scantron data to the requested course.<br />");
+ 	$r->print(&show_grading_menu_form(&get_symb_and_url($r)));
+ 	return '';
+     }
+     $r->print("Doing upload to ".$ENV{'form.courseid'}." <br />");
+     my $home=&Apache::lonnet::homeserver($ENV{'form.courseid'},
+ 					 $ENV{'form.domainid'});
+     my $fname=$ENV{'form.upfile.filename'};
      #FIXME
-     # if delay queue exists 2 submits one to process delayed students one
+     #copied from lonnet::userfileupload()
-     #     to ignore delayed students, possibly saving the delay queue for later
+     #make that function able to target a specified course
+     # Replace Windows backslashes by forward slashes
-     $navmap->untieHashes();
+     $fname=~s/\\/\//g;
+     # Get rid of everything but the actual filename
+     $fname=~s/^.*\/([^\/]+)$/$1/;
+     # Replace spaces by underscores
+     $fname=~s/\s+/\_/g;
+     # Replace all other weird characters by nothing
+     $fname=~s/[^\w\.\-]//g;
+     # See if there is anything left
+     unless ($fname) { return 'error: no uploaded file'; }
+     $fname='scantron_orig_'.$fname;
+     $r->print(&Apache::lonnet::finishuserfileupload($ENV{'form.courseid'},
+ 						    $ENV{'form.domainid'},
+ 						    $home,'upfile',$fname));
+     my ($symb,$url)=&get_symb_and_url($r);
+     if ($symb) {
+ 	$r->print(&show_grading_menu_form(&get_symb_and_url($r)));
+     } else {
+ 	$r->print('<br /><form action="/adm/grades" method="post">'."\n".
+ 		  '<input type="hidden" name="command" value="scantronupload" />'."\n".
+ 		  '<input type="submit" name="submit" value="Do Another Upload" />'."\n".
+ 		  '</form>'."\n");
+     }
+     return '';
  }
  #-------- end of section for handling grading scantron forms -------
  #
  #-------------------------------------------------------------------
- Line 3505  sub gradingmenu {
+ Line 4326  sub gradingmenu {
  	}
  	formname.command.value = cmd;
  	formname.saveState.value = "saveCmd="+cmdsave+":saveSec="+pullDownSelection(formname.section)+
- 	    ":saveSub="+radioSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.Status);
+ 	    ":saveSub="+pullDownSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.Status);
  	if (val < 5) formname.submit();
  	if (val == 5) {
  	    if (!checkReceiptNo(formname,'notOK')) { return false;}
- Line 3556  GRADINGMENUJS
+ Line 4377  GRADINGMENUJS
      $result.='<table width="100%" border=0>';
      $result.='<tr bgcolor="#ffffe6" valign="top"><td>'."\n".
- 	'&nbsp;Select Section: <select name="section">'."\n";
+ 	'&nbsp;'.&mt('Select Section').': <select name="section">'."\n";
      if (ref($sections)) {
- 	foreach (sort (@$sections)) {$result.='<option value="'.$_.'" '.
+ 	foreach (sort (@$sections)) {
- 					 ($saveSec eq $_ ? 'selected="on"' : '').'>'.$_.'</option>'."\n";}
+ 	    $result.='<option value="'.$_.'" '.
+ 		($saveSec eq $_ ? 'selected="on"':'').'>'.$_.'</option>'."\n";
+ 	}
      }
      $result.= '<option value="all" '.($saveSec eq 'all' ? 'selected="on"' : ''). '>all</select> &nbsp; ';
-     $result.='Student Status:</b>'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef);
+     $result.=&mt('Student Status').':</b>'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef);
-     if (ref($sections)) {
+     if (ref($sections) && (grep /no/,@$sections)) {
- 	$result.='&nbsp;(Section "no" implies the students were not assigned a section.)<br />'
+ 	$result.='&nbsp;(Section "no" implies the students were not assigned a section.)<br />';
- 	    if (grep /no/,@$sections);
      }
      $result.='</td></tr>';
      $result.='<tr bgcolor="#ffffe6"valign="top"><td>'.
  	'<input type="radio" name="radioChoice" value="submission" '.
- 	($saveCmd eq 'submission' ? 'checked' : '').'> '.'<b>Current Resource:</b> For one or more students'.
+ 	($saveCmd eq 'submission' ? 'checked' : '').'> '.'<b>'.&mt('Current Resource').':</b> '.&mt('For one or more students').
- 	'<br />&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;-->For students with '.
+ 	' <select name="submitonly">'.
- 	'<input type="radio" name="submitonly" value="yes" '.
+ 	'<option value="yes" '.
- 	($saveSub eq 'yes' ? 'checked' : '').' /> submissions or '.
+ 	($saveSub eq 'yes' ? 'selected="on"' : '').'>with submissions</option>'.
- 	'<input type="radio" name="submitonly" value="all" '.
+ 	'<option value="graded" '.
- 	($saveSub eq 'all' ? 'checked' : '').' /> for all</td></tr>'."\n";
+ 	($saveSub eq 'graded' ? 'selected="on"' : '').'>with ungraded submissions</option>'.
+ 	'<option value="incorrect" '.
+ 	($saveSub eq 'incorrect' ? 'selected="on"' : '').'>with incorrect submissions</option>'.
+ 	'<option value="all" '.
+ 	($saveSub eq 'all' ? 'selected="on"' : '').'>with any status</option></select></td></tr>'."\n";
      $result.='<tr bgcolor="#ffffe6"valign="top"><td>'.
  	'<input type="radio" name="radioChoice" value="viewgrades" '.
- Line 3633  sub handler {
+ Line 4459  sub handler {
      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
      my $url=$ENV{'form.url'};
      my $symb=$ENV{'form.symb'};
-     my $command=$ENV{'form.command'};
+     my @commands=&Apache::loncommon::get_env_multiple('form.command');
+     my $command=$commands[0];
+     if ($#commands > 0) {
+ 	&Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands));
+     }
      if (!$url) {
  	my ($temp1,$temp2);
  	($temp1,$temp2,$ENV{'form.url'})=&Apache::lonnet::decode_symb($symb);
  	$url = $ENV{'form.url'};
      }
      &send_header($request);
-     if ($url eq '' && $symb eq '') {
+     if ($url eq '' && $symb eq '' && $command eq '') {
  	if ($ENV{'user.adv'}) {
  	    if (($ENV{'form.codeone'}) && ($ENV{'form.codetwo'}) &&
  		($ENV{'form.codethree'})) {
- Line 3681  sub handler {
+ Line 4511  sub handler {
  		delete($perm{'mgr'});
  	    }
  	}
  	if ($command eq 'submission' && $perm{'vgr'}) {
  	    ($ENV{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0));
  	} elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) {
- Line 3721  sub handler {
+ Line 4550  sub handler {
  	    }
  	} elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) {
  	    $request->print(&scantron_selectphase($request));
+  	} elsif ($command eq 'scantron_validate' && $perm{'mgr'}) {
+  	    $request->print(&scantron_validate_file($request));
+ 	} elsif ($command eq 'scantron_validate' && $perm{'mgr'}) {
+ 	    $request->print(&scantron_validate_file($request));
  	} elsif ($command eq 'scantron_process' && $perm{'mgr'}) {
  	    $request->print(&scantron_process_students($request));
+  	} elsif ($command eq 'scantronupload' &&
+  		 (&Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})||
+ 		  &Apache::lonnet::allowed('usc',$ENV{'request.course.id'}))) {
+  	    $request->print(&scantron_upload_scantron_data($request));
+  	} elsif ($command eq 'scantronupload_save' &&
+  		 (&Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})||
+ 		  &Apache::lonnet::allowed('usc',$ENV{'request.course.id'}))) {
+  	    $request->print(&scantron_upload_scantron_data_save($request));
+  	} elsif ($command eq 'scantrondownload' &&
+ 		 &Apache::lonnet::allowed('usc',$ENV{'request.course.id'})) {
+  	    $request->print(&scantron_download_scantron_data($request));
  	} elsif ($command) {
- 	    $request->print("Access Denied");
+ 	    $request->print("Access Denied ($command)");
  	}
      }
      &send_footer($request);
- Line 3740  sub send_header {
+ Line 4584  sub send_header {
  #remotewindow.close();
  #</script>");
      $request->print(&Apache::loncommon::bodytag('Grading'));
+     $request->rflush();
  }
  sub send_footer {

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.

Removed from v.1.141
changed lines
	Added in v.1.177