Diff for /loncom/homework/grades.pm between versions 1.130.2.1.2.11 and 1.246

version 1.130.2.1.2.11, 2003/10/16 03:51:52 version 1.246, 2005/02/12 15:18:41
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # 2/9,2/13 Guy Albertelli  
 # 6/8 Gerd Kortemeyer  
 # 7/26 H.K. Ng  
 # 8/20 Gerd Kortemeyer  
 # Year 2002  
 # June-August H.K. Ng  
 # Year 2003  
 # February, March H.K. Ng  
 # July, H. K. Ng  
 #  
   
 package Apache::grades;  package Apache::grades;
 use strict;  use strict;
Line 48  use Apache::lonhomework; Line 38  use Apache::lonhomework;
 use Apache::loncoursedata;  use Apache::loncoursedata;
 use Apache::lonmsg qw(:user_normal_msg);  use Apache::lonmsg qw(:user_normal_msg);
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
   use Apache::lonlocal;
 use String::Similarity;  use String::Similarity;
   
 my %oldessays=();  my %oldessays=();
Line 55  my %perm=(); Line 46  my %perm=();
   
 # ----- These first few routines are general use routines.----  # ----- These first few routines are general use routines.----
 #  #
 # --- Retrieve the parts that matches stores_\d+ from the metadata file.---  # --- Retrieve the parts from the metadata file.---
 sub getpartlist {  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);
    }
       }
  }   }
     }      }
     return @parts;      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 @stores;
 }  }
   
 # --- Get the symbolic name of a problem and the url  # --- Get the symbolic name of a problem and the url
 sub get_symb_and_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 $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)));      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 '') { 
     return ($symb,$url);   if (!$silent) {
 }      $request->print("Unable to handle ambiguous references:$url:.");
       return ();
 # --- Retrieve the fullname for a user. Return lastname, first middle ---   }
 # --- Generation is attached next to the lastname if it exists. ---  
 sub get_fullname {  
     my ($uname,$udom) = @_;  
     my %name=&Apache::lonnet::get('environment', ['lastname','generation',  
   'firstname','middlename'],  
                                   $udom,$uname);  
     my $fullname;  
     my ($tmp) = keys(%name);  
     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {  
         $fullname = &Apache::loncoursedata::ProcessFullName  
             (@name{qw/lastname generation firstname middlename/});  
     } else {  
         &Apache::lonnet::logthis('grades.pm: no name data for '.$uname.  
                                  '@'.$udom.':'.$tmp);  
     }      }
     return $fullname;      return ($symb,$url);
 }  }
   
 #--- Format fullname, username:domain if different for display  #--- Format fullname, username:domain if different for display
Line 114  sub response_type { Line 109  sub response_type {
     my ($url,$symb) = shift;      my ($url,$symb) = shift;
     $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))) if ($symb eq '');      $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))) if ($symb eq '');
     my $allkeys = &Apache::lonnet::metadata($url,'keys');      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 %seen = ();
     my (@partlist,%handgrade);      my (@partlist,%handgrade,%responseType);
     foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) {      foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) {
  if (/^\w+response_\w+.*/) {   if (/^\w+response_.*/) {
     my ($responsetype,$part) = split(/_/,$_,2);      my ($responsetype,$part) = split(/_/,$_,2);
     my ($partid,$respid) = split(/_/,$part);      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!!      $responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!!
     my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb);      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);      next if ($seen{$partid} > 0);
     $seen{$partid}++;      $seen{$partid}++;
     push @partlist,$partid;      push @partlist,$partid;
  }   }
     }      }
     return \@partlist,\%handgrade;      return \@partlist,\%handgrade,\%responseType;
 }  }
   
   sub get_display_part {
       my ($partID,$url,$symb)=@_;
       if (!defined($symb) || $symb eq '') {
    $symb=$ENV{'form.symb'};
    if ($symb eq '') { $symb=&Apache::lonnet::symbread($url) }
       }
       my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb);
       if (defined($display) and $display ne '') {
    $display.= " (<font color=\"#999900\">id $partID</font>)";
       } else {
    $display=$partID;
       }
       return $display;
   }
 #--- Show resource title  #--- Show resource title
 #--- and parts and response type  #--- and parts and response type
 sub showResourceInfo {  sub showResourceInfo {
     my ($url,$probTitle) = @_;      my ($url,$probTitle,$checkboxes) = @_;
       my $col=3;
       if ($checkboxes) { $col=4; }
     my $result ='<table border="0">'.      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 %resptype = ();
     my $hdgrade='no';      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');   $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;
    }
    my $display_part=&get_display_part($partID,$url);
    $result.='<td><b>Part: </b>'.$display_part.' <font color="#999999">'.
       $resID.'</font></td>'.
     '<td><b>Type: </b>'.$responsetype.'</td></tr>';      '<td><b>Type: </b>'.$responsetype.'</td></tr>';
 #    '<td><b>Handgrade: </b>'.$handgrade.'</td></tr>';  #    '<td><b>Handgrade: </b>'.$handgrade.'</td></tr>';
     }      }
     $result.='</table>'."\n";      $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  #--- Clean response type for display
 #--- Currently filters option response type only.  #--- Currently filters option/rank/radiobutton/match/essay response types only.
 sub cleanRecord {  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">'.   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})) {   if (! exists ($ENV{'form.'.$symb})) {
     my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade',      my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade',
   $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},    $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
Line 185  sub cleanRecord { Line 282  sub cleanRecord {
     $ENV{'form.kwstyle'}  = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : '';      $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.      $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;      return $answer;
 }  }
Line 218  sub commonJSfunctions { Line 316  sub commonJSfunctions {
  }   }
     }      }
  } else {   } else {
     if (selectOne.selected) return selectOne.value;              // only one value it must be the selected one
       return selectOne.value;
  }   }
     }      }
 </script>  </script>
Line 236  sub getclasslist { Line 335  sub getclasslist {
     #      #
     my %sections;      my %sections;
     my %fullnames;      my %fullnames;
     foreach (keys(%$classlist)) {      foreach my $student (keys(%$classlist)) {
         # the following undefs are for 'domain', and 'username' respectively.          my $end      = 
  my (undef,undef,$end,$start,$id,$section,$fullname,$status)=              $classlist->{$student}->[&Apache::loncoursedata::CL_END()];
             @{$classlist->{$_}};          my $start    = 
               $classlist->{$student}->[&Apache::loncoursedata::CL_START()];
           my $id       = 
               $classlist->{$student}->[&Apache::loncoursedata::CL_ID()];
           my $section  = 
               $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()];
           my $fullname = 
               $classlist->{$student}->[&Apache::loncoursedata::CL_FULLNAME()];
           my $status   = 
               $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()];
  # filter students according to status selected   # filter students according to status selected
  if ($filterlist && $ENV{'form.Status'} ne 'Any') {   if ($filterlist && $ENV{'form.Status'} ne 'Any') {
     if ($ENV{'form.Status'} ne $status) {      if ($ENV{'form.Status'} ne $status) {
  delete ($classlist->{$_});   delete ($classlist->{$student});
  next;   next;
     }      }
  }   }
  $section = ($section ne '' ? $section : 'no');   $section = ($section ne '' ? $section : 'none');
  if (&canview($section)) {   if (&canview($section)) {
     if ($getsec eq 'all' || $getsec eq $section) {      if ($getsec eq 'all' || $getsec eq $section) {
  $sections{$section}++;   $sections{$section}++;
  $fullnames{$_}=$fullname;   $fullnames{$student}=$fullname;
     } else {      } else {
  delete($classlist->{$_});   delete($classlist->{$student});
     }      }
  } else {   } else {
     delete($classlist->{$_});      delete($classlist->{$student});
  }   }
     }      }
     my %seen = ();      my %seen = ();
Line 398  sub verifyreceipt { Line 506  sub verifyreceipt {
     my $request  = shift;      my $request  = shift;
   
     my $courseid = $ENV{'request.course.id'};      my $courseid = $ENV{'request.course.id'};
     my $receipt  = unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}).'-'.      my $receipt  = &Apache::lonnet::recprefix($courseid).'-'.
  $ENV{'form.receipt'};   $ENV{'form.receipt'};
     $receipt     =~ s/[^\-\d]//g;      $receipt     =~ s/[^\-\d]//g;
     my $url      = $ENV{'form.url'};      my $url      = $ENV{'form.url'};
Line 413  sub verifyreceipt { Line 521  sub verifyreceipt {
   
     my ($string,$contents,$matches) = ('','',0);      my ($string,$contents,$matches) = ('','',0);
     my (undef,undef,$fullname) = &getclasslist('all','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); }
     foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {      foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {
  my ($uname,$udom)=split(/\:/);   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) {      if ($matches == 0) {
Line 437  sub verifyreceipt { Line 554  sub verifyreceipt {
     '<table border="0"><tr bgcolor="#e6ffff">'."\n".      '<table border="0"><tr bgcolor="#e6ffff">'."\n".
     '<td><b>&nbsp;Fullname&nbsp;</b></td>'."\n".      '<td><b>&nbsp;Fullname&nbsp;</b></td>'."\n".
     '<td><b>&nbsp;Username&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";      '</table></td></tr></table>'."\n";
     }      }
     return $string.&show_grading_menu_form($symb,$url);      return $string.&show_grading_menu_form($symb,$url);
Line 464  sub listStudents { Line 584  sub listStudents {
     my $result='<h3><font color="#339933">&nbsp;'.$viewgrade.      my $result='<h3><font color="#339933">&nbsp;'.$viewgrade.
  ' Submissions for a Student or a Group of Students</font></h3>';   ' 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);      $request->print(<<LISTJAVASCRIPT);
 <script type="text/javascript" language="javascript">  <script type="text/javascript" language="javascript">
Line 505  LISTJAVASCRIPT Line 624  LISTJAVASCRIPT
   
     my $checkhdgrade = ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked' : '';      my $checkhdgrade = ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked' : '';
     my $checklastsub = $checkhdgrade eq '' ? '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="yes" /> one student '."\n".
  '<input type="radio" name="vProb" value="all" /> all students <br />'."\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";   '&nbsp;<b>Submissions: </b>'."\n";
     if ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) {      if ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) {
  $gradeTable.='<input type="radio" name="lastSub" value="hdgrade" '.$checkhdgrade.' /> essay part only'."\n";   $gradeTable.='<input type="radio" name="lastSub" value="hdgrade" '.$checkhdgrade.' /> essay part only'."\n";
Line 517  LISTJAVASCRIPT Line 640  LISTJAVASCRIPT
     my $saveStatus = $ENV{'form.Status'} eq '' ? 'Active' : $ENV{'form.Status'};      my $saveStatus = $ENV{'form.Status'} eq '' ? 'Active' : $ENV{'form.Status'};
     $ENV{'form.Status'} = $saveStatus;      $ENV{'form.Status'} = $saveStatus;
   
     $gradeTable.='<input type="radio" name="lastSub" value="lastonly" '.$checklastsub.' /> last sub only'."\n".      $gradeTable.='<input type="radio" name="lastSub" value="lastonly" '.$checklastsub.' /> last submission only'."\n".
  '<input type="radio" name="lastSub" value="last" /> last sub & parts info'."\n".   '<input type="radio" name="lastSub" value="last" /> last submission & parts info'."\n".
  '<input type="radio" name="lastSub" value="datesub" /> by dates and submissions'."\n".   '<input type="radio" name="lastSub" value="datesub" /> by dates and submissions'."\n".
  '<input type="radio" name="lastSub" value="all" /> all details'."\n".   '<input type="radio" name="lastSub" value="all" /> all details'."\n".
  '<input type="hidden" name="section"     value="'.$getsec.'" />'."\n".   '<input type="hidden" name="section"     value="'.$getsec.'" />'."\n".
Line 544  LISTJAVASCRIPT Line 667  LISTJAVASCRIPT
     $gradeTable.='<input type="button" '."\n".      $gradeTable.='<input type="button" '."\n".
  'onClick="javascript:checkSelect(this.form.stuinfo);" '."\n".   'onClick="javascript:checkSelect(this.form.stuinfo);" '."\n".
  'value="Next->" />'."\n";   'value="Next->" />'."\n";
       $gradeTable.='<input type="checkbox" name="checkPlag" checked="on">Check For Plagiarism</input>';
     my (undef, undef, $fullname) = &getclasslist($getsec,'1');        my (undef, undef, $fullname) = &getclasslist($getsec,'1');  
     $gradeTable.='<table border="0"><tr><td bgcolor="#777777">'.      $gradeTable.='<table border="0"><tr><td bgcolor="#777777">'.
  '<table border="0"><tr bgcolor="#e6ffff">';   '<table border="0"><tr bgcolor="#e6ffff">';
Line 554  LISTJAVASCRIPT Line 677  LISTJAVASCRIPT
     '<td>'.&nameUserString('header').'</td>';      '<td>'.&nameUserString('header').'</td>';
  if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') {   if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') {
     foreach (sort(@$partlist)) {      foreach (sort(@$partlist)) {
  $gradeTable.='<td><b>&nbsp;Part '.(split(/_/))[0].' Status&nbsp;</b></td>';   my $display_part=&get_display_part((split(/_/))[0],$url,$symb);
    $gradeTable.='<td><b>&nbsp;Part: '.$display_part.
       ' Status&nbsp;</b></td>';
     }      }
  }   }
  $loop++;   $loop++;
Line 568  LISTJAVASCRIPT Line 693  LISTJAVASCRIPT
  my %status = ();   my %status = ();
  if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') {   if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') {
     (%status) =&student_gradeStatus($url,$symb,$udom,$uname,$partlist);      (%status) =&student_gradeStatus($url,$symb,$udom,$uname,$partlist);
     my $statusflg = '';      my $submitted = 0;
       my $graded = 0;
     foreach (keys(%status)) {      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(/\./,$_);   my ($foo,$partid,$foo1) = split(/\./,$_);
  if ($status{'resource.'.$partid.'.submitted_by'} ne '') {   if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
     $statusflg = '';      $submitted = 0;
       my ($part)=split(/\./,$partid);
     $gradeTable.='<input type="hidden" name="'.      $gradeTable.='<input type="hidden" name="'.
  $student.':submitted_by" value="'.   $student.':'.$part.':submitted_by" value="'.
  $status{'resource.'.$partid.'.submitted_by'}.'" />';   $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++;   $ctr++;
Line 619  LISTJAVASCRIPT Line 752  LISTJAVASCRIPT
  if ($num_students eq 0) {   if ($num_students eq 0) {
     $gradeTable='<br />&nbsp;<font color="red">There are no students currently enrolled.</font>';      $gradeTable='<br />&nbsp;<font color="red">There are no students currently enrolled.</font>';
  } else {   } else {
       my $submissions='submissions';
       if ($submitonly eq 'incorrect') { $submissions = 'incorrect submissions'; }
       if ($submitonly eq 'graded'   ) { $submissions = 'ungraded submissions'; }
     $gradeTable='<br />&nbsp;<font color="red">'.      $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) {      } elsif ($ctr == 1) {
  $gradeTable =~ s/type=checkbox/type=checkbox checked/;   $gradeTable =~ s/type=checkbox/type=checkbox checked/;
Line 636  LISTJAVASCRIPT Line 772  LISTJAVASCRIPT
 sub processGroup {  sub processGroup {
     my ($request)  = shift;      my ($request)  = shift;
     my $ctr        = 0;      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;      my $total      = scalar(@stuchecked)-1;
   
     foreach (@stuchecked) {      foreach (@stuchecked) {
Line 837  sub sub_page_kw_js { Line 972  sub sub_page_kw_js {
     my $request = shift;      my $request = shift;
     my $iconpath = $request->dir_config('lonIconsURL');      my $iconpath = $request->dir_config('lonIconsURL');
     &commonJSfunctions($request);      &commonJSfunctions($request);
       my $docopen=&Apache::lonhtmlcommon::javascript_docopen();
       $docopen=~s/^document\.//;
     $request->print(<<SUBJAVASCRIPT);      $request->print(<<SUBJAVASCRIPT);
 <script type="text/javascript" language="javascript">  <script type="text/javascript" language="javascript">
   
Line 946  sub sub_page_kw_js { Line 1083  sub sub_page_kw_js {
     var ypos = (screen.height-height)/2-30;      var ypos = (screen.height-height)/2-30;
     ypos = (ypos < 0) ? '0' : ypos;      ypos = (ypos < 0) ? '0' : ypos;
   
     pWin = window.open('', 'MessageCenter', 'toolbar=no,location=no,scrollbars='+scrollbar+',screenx='+xpos+',screeny='+ypos+',width=600,height='+height);      pWin = window.open('', 'MessageCenter', 'resizable=yes,toolbar=no,location=no,scrollbars='+scrollbar+',screenx='+xpos+',screeny='+ypos+',width=600,height='+height);
     pWin.focus();      pWin.focus();
     pDoc = pWin.document;      pDoc = pWin.document;
     pDoc.open('text/html','replace');      pDoc.$docopen;
     pDoc.write("<html><head>");      pDoc.write("<html><head>");
     pDoc.write("<title>Message Central</title>");      pDoc.write("<title>Message Central</title>");
   
Line 1077  sub sub_page_kw_js { Line 1214  sub sub_page_kw_js {
     var ypos = (screen.height-330)/2-30;      var ypos = (screen.height-330)/2-30;
     ypos = (ypos < 0) ? '0' : ypos;      ypos = (ypos < 0) ? '0' : ypos;
   
     hwdWin = window.open('', 'KeywordHighlightCentral', 'toolbar=no,location=no,scrollbars=no,width=400,height=300,screenx='+xpos+',screeny='+ypos);      hwdWin = window.open('', 'KeywordHighlightCentral', 'resizeable=yes,toolbar=no,location=no,scrollbars=no,width=400,height=300,screenx='+xpos+',screeny='+ypos);
     hwdWin.focus();      hwdWin.focus();
     var hDoc = hwdWin.document;      var hDoc = hwdWin.document;
     hDoc.open('text/html','replace');      hDoc.$docopen;
     hDoc.write("<html><head>");      hDoc.write("<html><head>");
     hDoc.write("<title>Highlight Central</title>");      hDoc.write("<title>Highlight Central</title>");
   
Line 1151  sub gradeBox { Line 1288  sub gradeBox {
   '' : $$record{'resource.'.$partid.'.awarded'}*$wgt);    '' : $$record{'resource.'.$partid.'.awarded'}*$wgt);
     my $result='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n";      my $result='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n";
   
       my $display_part=&get_display_part($partid,undef,$symb);
     $result.='<table border="0"><tr><td>'.      $result.='<table border="0"><tr><td>'.
  '<b>Part </b>'.$partid.' <b>Points: </b></td><td>'."\n";   '<b>Part: </b>'.$display_part.' <b>Points: </b></td><td>'."\n";
   
     my $ctr = 0;      my $ctr = 0;
     $result.='<table border="0"><tr>'."\n";  # display radio buttons in a nice table 10 across      $result.='<table border="0"><tr>'."\n";  # display radio buttons in a nice table 10 across
     while ($ctr<=$wgt) {      while ($ctr<=$wgt) {
  $result.= '<td><input type="radio" name="RADVAL'.$counter.'_'.$partid.'" '.   $result.= '<td><nobr><input type="radio" name="RADVAL'.$counter.'_'.$partid.'" '.
     'onclick="javascript:writeBox(this.form,\''.$counter.'_'.$partid.'\','.      'onclick="javascript:writeBox(this.form,\''.$counter.'_'.$partid.'\','.
     $ctr.')" value="'.$ctr.'" '.      $ctr.')" value="'.$ctr.'" '.
     ($score eq $ctr ? 'checked':'').' /> '.$ctr."</td>\n";      ($score eq $ctr ? 'checked':'').' /> '.$ctr."</nobr></td>\n";
  $result.=(($ctr+1)%10 == 0 ? '</tr><tr>' : '');   $result.=(($ctr+1)%10 == 0 ? '</tr><tr>' : '');
  $ctr++;   $ctr++;
     }      }
Line 1195  sub gradeBox { Line 1333  sub gradeBox {
 }  }
   
 sub show_problem {  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) {      if ($removeform) {
  $rendered=~s|<form(.*?)>||g;   $rendered=~s|<form(.*?)>||g;
  $rendered=~s|</form>||g;   $rendered=~s|</form>||g;
  $rendered=~s|name="submit"|name="would_have_been_submit"|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) {      if ($removeform) {
  $companswer=~s|<form(.*?)>||g;   $companswer=~s|<form(.*?)>||g;
  $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">';      my $result.='<table border="0" width="100%"><tr><td bgcolor="#777777">';
     $result.='<table border="0" width="100%">';      $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>';
     $result.='</td></tr></table><br />';      $result.='</td></tr></table><br />';
     return $result;      return $result;
Line 1229  sub submission { Line 1386  sub submission {
     my ($uname,$udom)     = ($ENV{'form.student'},$ENV{'form.userdom'});      my ($uname,$udom)     = ($ENV{'form.student'},$ENV{'form.userdom'});
     $udom = ($udom eq '' ? $ENV{'user.domain'} : $udom); #has form.userdom changed for a student?      $udom = ($udom eq '' ? $ENV{'user.domain'} : $udom); #has form.userdom changed for a student?
     my $usec = &Apache::lonnet::getsection($udom,$uname,$ENV{'request.course.id'});      my $usec = &Apache::lonnet::getsection($udom,$uname,$ENV{'request.course.id'});
     $ENV{'form.fullname'} = &get_fullname ($uname,$udom) if $ENV{'form.fullname'} eq '';      $ENV{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $ENV{'form.fullname'} eq '';
   
     my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url)));      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 '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; }
   
     if (!&canview($usec)) {      if (!&canview($usec)) {
  $request->print('<font color="red">Unable to view requested student.('.   $request->print('<font color="red">Unable to view requested student.('.
  $uname.$udom.$usec.$ENV{'request.course.id'}.')</font>');   $uname.'@'.$udom.' in section '.$usec.' in course id '.
    $ENV{'request.course.id'}.')</font>');
  $request->print(&show_grading_menu_form($symb,$url));   $request->print(&show_grading_menu_form($symb,$url));
  return;   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 $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : '');
     my $checkIcon = '<img src="'.$request->dir_config('lonIconsURL').      my $checkIcon = '<img src="'.$request->dir_config('lonIconsURL').
  '/check.gif" height="16" border="0" />';   '/check.gif" height="16" border="0" />';
Line 1264  sub submission { Line 1424  sub submission {
   
  # option to display problem, only once else it cause problems    # option to display problem, only once else it cause problems 
         # with the form later since the problem has a form.          # 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    # kwclr is the only variable that is guaranteed to be non blank 
Line 1300  sub submission { Line 1468  sub submission {
  '<input type="hidden" name="url"        value="'.$url.'" />'."\n".   '<input type="hidden" name="url"        value="'.$url.'" />'."\n".
  '<input type="hidden" name="showgrading" value="'.$ENV{'form.showgrading'}.'" />'."\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="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="lastSub"    value="'.$ENV{'form.lastSub'}.'" />'."\n".
  '<input type="hidden" name="section"    value="'.$ENV{'form.section'}.'">'."\n".   '<input type="hidden" name="section"    value="'.$ENV{'form.section'}.'">'."\n".
  '<input type="hidden" name="submitonly" value="'.$ENV{'form.submitonly'}.'">'."\n".   '<input type="hidden" name="submitonly" value="'.$ENV{'form.submitonly'}.'">'."\n".
Line 1314  sub submission { Line 1483  sub submission {
     '<input type="hidden" name="msgsub"   value="'.$ENV{'form.msgsub'}.'" />'."\n".      '<input type="hidden" name="msgsub"   value="'.$ENV{'form.msgsub'}.'" />'."\n".
     '<input type="hidden" name="shownSub" value="0" />'."\n".      '<input type="hidden" name="shownSub" value="0" />'."\n".
     '<input type="hidden" name="savemsgN" value="'.$ENV{'form.savemsgN'}.'" />'."\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,'');   my ($cts,$prnmsg) = (1,'');
Line 1350  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('<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 %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      # Display student info
     $request->print(($counter == 0 ? '' : '<br />'));      $request->print(($counter == 0 ? '' : '<br />'));
Line 1403  KEYWORDS Line 1584  KEYWORDS
     $result.=$$fullname{$_}.'&nbsp; &nbsp; &nbsp;';      $result.=$$fullname{$_}.'&nbsp; &nbsp; &nbsp;';
  }   }
                 $result.='<br />'."\n";                  $result.='<br />'."\n";
    my ($part)=split(/\./,$_);
  $result.='<input type="hidden" name="collaborator'.$counter.   $result.='<input type="hidden" name="collaborator'.$counter.
     '" value="'.(join ':',@goodcollaborators).'" />'."\n";      '" value="'.$part.':'.(join ':',@goodcollaborators).'" />'.
       "\n";
     }      }
     if (scalar(@badcollaborators) > 0) {      if (scalar(@badcollaborators) > 0) {
  $result.='<table border="0"><tr bgcolor="#ffbbbb"><td>';   $result.='<table border="0"><tr bgcolor="#ffbbbb"><td>';
Line 1430  KEYWORDS Line 1613  KEYWORDS
     #             (3) Last submission plus the parts info      #             (3) Last submission plus the parts info
     #             (4) The whole record for this student      #             (4) The whole record for this student
     if ($ENV{'form.lastSub'} =~ /^(lastonly|hdgrade)$/) {      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>';  
     $request->print($submitby);  
  } else {   } else {
     my ($string,$timestamp)= &get_last_submission (\%record);      my %seenparts;
     my $lastsubonly=''.      for my $part (sort keys(%$handgrade)) {
  ($$timestamp eq '' ? '' : '<b>Date Submitted:</b> '.   my ($partid,$respid) = split(/_/,$part);
  $$timestamp)."</td></tr>\n";   my $display_part=&get_display_part($partid,$url,$symb);
     if ($$timestamp eq '') {   if ($ENV{"form.$uname:$udom:$partid:submitted_by"}) {
  $lastsubonly.='<tr><td bgcolor="#ffffe6">'.$$string[0];       if (exists($seenparts{$partid})) { next; }
     } else {      $seenparts{$partid}=1;
  for my $part (sort keys(%$handgrade)) {      my $submitby='<b>Part:</b> '.$display_part.
     my ($responsetype,$foo) = split(/:/,$$handgrade{$part});   ' <b>Collaborative submission by:</b> '.
     my ($partid,$respid) = split(/_/,$part);   '<a href="javascript:viewSubmitter(\''.
     if (!exists($record{'resource.'.$partid.'.'.$respid.'.submission'})) {   $ENV{"form.$uname:$udom:$partid:submitted_by"}.
  $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '.   '\')"; TARGET=_self>'.
     $partid.'</b> <font color="#999999">( ID '.$respid.   $$fullname{$ENV{"form.$uname:$udom:$partid:submitted_by"}}.'</a><br />';
     ' )</font>&nbsp; &nbsp;'.      $request->print($submitby);
     '<font color="red">Nothing submitted - no attempts</font><br /><br />';      next;
      } else {   }
  foreach (@$string) {   my $responsetype = $responseType->{$partid}->{$respid};
     my ($partid,$respid) = /^resource\.(\w+)\.(\w+)\.submission/;   if (!exists($record{"resource.$partid.$respid.submission"})) {
     if ($part eq ($partid.'_'.$respid)) {      $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part:</b> '.
  my ($ressub,$subval) = split(/:/,$_,2);   $display_part.' <font color="#999999">( ID '.$respid.
                             # Similarity check   ' )</font>&nbsp; &nbsp;'.
  my $similar='';   '<font color="red">Nothing submitted - no attempts</font><br /><br />';
  my ($oname,$odom,$ocrsid,$oessay,$osim)=&most_similar($uname,$udom,$subval);      next;
  if ($osim) {   }
     $osim=int($osim*100.0);   foreach (@$string) {
     $similar='<hr /><h3><font color="#FF0000">Essay is '.$osim.      my ($partid,$respid) = /^resource\.([^\.]*)\.([^\.]*)\.submission/;
  '% similar to an essay by '.&Apache::loncommon::plainname($oname,$odom).      if ($part ne ($partid.'_'.$respid)) { next; }
  '</font></h3><blockquote><i>'.      my ($ressub,$subval) = split(/:/,$_,2);
  &keywords_highlight($oessay).'</i></blockquote><hr />';      # Similarity check
  }      my $similar='';
  $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '.      if($ENV{'form.checkPlag'}){
     $partid.'</b> <font color="#999999">( ID '.$respid.   my ($oname,$odom,$ocrsid,$oessay,$osim)=
     ' )</font>&nbsp; &nbsp;'.      &most_similar($uname,$udom,$subval);
     ($record{"resource.$partid.$respid.uploadedurl"}?   if ($osim) {
      '<a href="'.      $osim=int($osim*100.0);
      &Apache::lonnet::tokenwrapper($record{"resource.$partid.$respid.uploadedurl"}).      $similar="<hr /><h3><font color=\"#FF0000\">Essay".
      '"><img src="/adm/lonIcons/unknown.gif" border=0"> File uploaded by student</a> '.   " is $osim% similar to an essay by ".
      '<font color="red" size="1">Like all files provided by users, '.   &Apache::loncommon::plainname($oname,$odom).
      'this file may contain virusses</font><br />':'').   '</font></h3><blockquote><i>'.
      '<b>Submitted Answer: </b>'.   &keywords_highlight($oessay).
      &cleanRecord($subval,$responsetype,$symb).   '</i></blockquote><hr />';
       '<br /><br />'.$similar."\n"   }
      if ($ENV{'form.lastSub'} eq 'lastonly' ||       }
  ($ENV{'form.lastSub'} eq 'hdgrade' &&       my $order=&get_order($partid,$respid,$symb,$uname,$udom);
   $$handgrade{$part} =~ /:yes$/));      if ($ENV{'form.lastSub'} eq 'lastonly' || 
    ($ENV{'form.lastSub'} eq 'hdgrade' && 
    $$handgrade{$part} eq 'yes')) {
    my $display_part=&get_display_part($partid,$url,$symb);
    $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part:</b> '.
       $display_part.' <font color="#999999">( ID '.$respid.
       ' )</font>&nbsp; &nbsp;';
    my @files;
    if ($record{"resource.$partid.$respid.portfiles"}) {
       my $file_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio';
       foreach my $file (split(',',$record{"resource.$partid.$respid.portfiles"})) {
    push(@files,$file_url.$file);
       
    &Apache::lonnet::logthis("found a portfolio file".$record{"resource.$partid.$respid.portfiles"});
    &Apache::lonnet::logthis("uploaded URL file".$record{"resource.$partid.$respid.uploadedurl"});
     }      }
  }   }
    if ($record{"resource.$partid.$respid.uploadedurl"}) {
       push(@files,$record{"resource.$partid.$respid.uploadedurl"});
    }
    if (@files) {
       $lastsubonly.='<br /><font color="red" size="1">Like all files provided by users, this file may contain virusses</font><br />';
       foreach my $file (@files) {
    &Apache::lonnet::allowuploaded('/adm/grades',$file);
    $lastsubonly.='<br /><a href="'.$file.'" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border=0"> '.$file.'</a>';
       }
       $lastsubonly.='<br />';
    }
    $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') {      } elsif ($ENV{'form.lastSub'} eq 'datesub') {
  my (undef,$responseType,undef,$parts) = &showResourceInfo($url);   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)$/) {      } elsif ($ENV{'form.lastSub'} =~ /^(last|all)$/) {
  $request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom,   $request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom,
  $ENV{'request.course.id'},   $ENV{'request.course.id'},
Line 1510  KEYWORDS Line 1720  KEYWORDS
  my $toGrade.='<input type="button" value="Grade Student" '.   my $toGrade.='<input type="button" value="Grade Student" '.
     'onClick="javascript:checksubmit(this.form,\'Grade Student\',\''      'onClick="javascript:checksubmit(this.form,\'Grade Student\',\''
     .$counter.'\');" TARGET=_self> &nbsp;'."\n" if (&canmodify($usec));      .$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);   }
    $request->print($toGrade);
  return;   return;
       } else {
    $request->print('</td></tr></table></td></tr></table>'."\n");
     }      }
   
     # essay grading message center      # essay grading message center
Line 1667  sub processHandGrade { Line 1880  sub processHandGrade {
        $ENV{'form.msgsub'},$message);         $ENV{'form.msgsub'},$message);
     }      }
     if ($ENV{'form.collaborator'.$ctr}) {      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 1782  sub processHandGrade { Line 1998  sub processHandGrade {
     }      }
     $ctr = 0;      $ctr = 0;
     @parsedlist = reverse @parsedlist if ($button eq 'Previous');      @parsedlist = reverse @parsedlist if ($button eq 'Previous');
       my ($partlist) = &response_type($url);
     foreach my $student (@parsedlist) {      foreach my $student (@parsedlist) {
    my $submitonly=$ENV{'form.submitonly'};
  my ($uname,$udom) = split(/:/,$student);   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);   push @nextlist,$student if ($ctr < $ntstu);
  last if ($ctr == $ntstu);   last if ($ctr == $ntstu);
Line 1820  sub processHandGrade { Line 2049  sub processHandGrade {
   
 #---- Save the score and award for each student, if changed  #---- Save the score and award for each student, if changed
 sub saveHandGrade {  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,      my $usec = &Apache::lonnet::getsection($domain,$stuname,
    $ENV{'request.course.id'});     $ENV{'request.course.id'});
     if (!&canmodify($usec)) { return('not_allowed'); }      if (!&canmodify($usec)) { return('not_allowed'); }
Line 1828  sub saveHandGrade { Line 2057  sub saveHandGrade {
     my %newrecord  = ();      my %newrecord  = ();
     my ($pts,$wgt) = ('','');      my ($pts,$wgt) = ('','');
     foreach (split(/:/,$ENV{'form.partlist'.$newflg})) {      foreach (split(/:/,$ENV{'form.partlist'.$newflg})) {
    #collaborator may vary for different parts
    if ($submitter && $_ ne $part) { next; }
  my $dropMenu = $ENV{'form.GD_SEL'.$newflg.'_'.$_};   my $dropMenu = $ENV{'form.GD_SEL'.$newflg.'_'.$_};
  if ($dropMenu eq 'excused') {   if ($dropMenu eq 'excused') {
     if ($record{'resource.'.$_.'.solved'} ne 'excused') {      if ($record{'resource.'.$_.'.solved'} ne 'excused') {
Line 1839  sub saveHandGrade { Line 2070  sub saveHandGrade {
     }      }
  } elsif ($dropMenu eq 'reset status'   } elsif ($dropMenu eq 'reset status'
  && exists($record{'resource.'.$_.'.solved'})) { #don't bother if no old records -> no attempts   && exists($record{'resource.'.$_.'.solved'})) { #don't bother if no old records -> no attempts
     $newrecord{'resource.'.$_.'.tries'} = 0;      foreach my $key (keys (%record)) {
     $newrecord{'resource.'.$_.'.solved'} = '';   if ($key=~/^resource\.\Q$_\E\./) { $newrecord{$key} = ''; }
     $newrecord{'resource.'.$_.'.award'} = '';      }
     $newrecord{'resource.'.$_.'.awarded'} = 0;      $newrecord{'resource.'.$_.'.regrader'}=
     $newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}";   "$ENV{'user.name'}:$ENV{'user.domain'}";
  } elsif ($dropMenu eq '') {   } elsif ($dropMenu eq '') {
     $pts = ($ENV{'form.GD_BOX'.$newflg.'_'.$_} ne '' ?       $pts = ($ENV{'form.GD_BOX'.$newflg.'_'.$_} ne '' ? 
     $ENV{'form.GD_BOX'.$newflg.'_'.$_} :       $ENV{'form.GD_BOX'.$newflg.'_'.$_} : 
     $ENV{'form.RADVAL'.$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 :       $wgt = $ENV{'form.WGT'.$newflg.'_'.$_} eq '' ? 1 : 
  $ENV{'form.WGT'.$newflg.'_'.$_};   $ENV{'form.WGT'.$newflg.'_'.$_};
     my $partial= $pts/$wgt;      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';      my $reckey = 'resource.'.$_.'.solved';
     if ($partial == 0) {      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 {      } 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) {      if (scalar(keys(%newrecord)) > 0) {
  &Apache::lonnet::cstore(\%newrecord,$symb,   &Apache::lonnet::cstore(\%newrecord,$symb,
  $ENV{'request.course.id'},$domain,$stuname);   $ENV{'request.course.id'},$domain,$stuname);
Line 2051  sub viewgrades { Line 2292  sub viewgrades {
     &viewgrades_js($request);      &viewgrades_js($request);
   
     my ($symb,$url) = ($ENV{'form.symb'},$ENV{'form.url'});       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";      $result.='<font size=+1><b>Current Resource: </b>'.$ENV{'form.probTitle'}.'</font>'."\n";
   
     #view individual student submission form - called using Javascript viewOneStudent      #view individual student submission form - called using Javascript viewOneStudent
Line 2071  sub viewgrades { Line 2318  sub viewgrades {
     my $sectionClass;      my $sectionClass;
     if ($ENV{'form.section'} eq 'all') {      if ($ENV{'form.section'} eq 'all') {
  $sectionClass='Class </h3>';   $sectionClass='Class </h3>';
     } elsif ($ENV{'form.section'} eq 'no') {      } elsif ($ENV{'form.section'} eq 'none') {
  $sectionClass='Students in no Section </h3>';   $sectionClass='Students in no Section </h3>';
     } else {      } else {
  $sectionClass='Students in Section '.$ENV{'form.section'}.'</h3>';   $sectionClass='Students in Section '.$ENV{'form.section'}.'</h3>';
Line 2090  sub viewgrades { Line 2337  sub viewgrades {
  my ($partid,$respid) = split (/_/,$_,2);   my ($partid,$respid) = split (/_/,$_,2);
  next if $seen{$partid};   next if $seen{$partid};
  $seen{$partid}++;   $seen{$partid}++;
  my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_});   my $handgrade=$$handgrade{$_};
  my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb);   my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb);
  $weight{$partid} = $wgt eq '' ? '1' : $wgt;   $weight{$partid} = $wgt eq '' ? '1' : $wgt;
   
Line 2098  sub viewgrades { Line 2345  sub viewgrades {
     $ctsparts.'" value="'.$partid.'" />'."\n";      $ctsparts.'" value="'.$partid.'" />'."\n";
  $result.='<input type="hidden" name="weight_'.   $result.='<input type="hidden" name="weight_'.
     $partid.'" value="'.$weight{$partid}.'" />'."\n";      $partid.'" value="'.$weight{$partid}.'" />'."\n";
  $result.='<tr><td><b>Part  '.$partid.'&nbsp; &nbsp;Point:</b> </td><td>';   my $display_part=&get_display_part($partid,$url,$symb);
    $result.='<tr><td><b>Part:</b> '.$display_part.'&nbsp; &nbsp;<b>Point:</b> </td><td>';
  $result.='<table border="0"><tr>';     $result.='<table border="0"><tr>';  
  my $ctr = 0;   my $ctr = 0;
  while ($ctr<=$weight{$partid}) { # display radio buttons in a nice table 10 across   while ($ctr<=$weight{$partid}) { # display radio buttons in a nice table 10 across
Line 2132  sub viewgrades { Line 2380  sub viewgrades {
     $result.= '<table border=0><tr><td bgcolor="#777777">'."\n".      $result.= '<table border=0><tr><td bgcolor="#777777">'."\n".
  '<table border=0><tr bgcolor="#deffff"><td>&nbsp;<b>No.</b>&nbsp;</td>'.   '<table border=0><tr bgcolor="#deffff"><td>&nbsp;<b>No.</b>&nbsp;</td>'.
  '<td>'.&nameUserString('header')."</td>\n";   '<td>'.&nameUserString('header')."</td>\n";
     my (@parts) = sort(&getpartlist($url));      my (@parts) = sort(&getpartlist($url,$symb));
     foreach my $part (@parts) {      foreach my $part (@parts) {
  my $display=&Apache::lonnet::metadata($url,$part.'.display');   my $display=&Apache::lonnet::metadata($url,$part.'.display');
  $display =~ s|^Number of Attempts|Tries<br />|; # makes the column narrower   $display =~ s|^Number of Attempts|Tries<br />|; # makes the column narrower
  if  (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); }   if  (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); }
    my ($partid) = &split_part_type($part);
    my $display_part=&get_display_part($partid,$url,$symb);
  if ($display =~ /^Partial Credit Factor/) {   if ($display =~ /^Partial Credit Factor/) {
     my ($partid) = &split_part_type($part);      $result.='<td><b>Score Part:</b> '.$display_part.
     $result.='<td><b>Score Part '.$partid.'<br />(weight = '.   ' <br /><b>(weight = '.$weight{$partid}.')</b></td>'."\n";
  $weight{$partid}.')</b></td>'."\n";  
     next;      next;
    } else {
       $display =~s/\[Part: \Q$partid\E\]/Part:<\/b> $display_part/;
  }   }
  $display =~ s|Problem Status|Grade Status<br />|;   $display =~ s|Problem Status|Grade Status<br />|;
  $result.='<td><b>'.$display.'</b></td>'."\n";   $result.='<td><b>'.$display.'</td>'."\n";
     }      }
     $result.='</tr>';      $result.='</tr>';
   
Line 2153  sub viewgrades { Line 2404  sub viewgrades {
     my (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'1');      my (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'1');
     my $ctr = 0;      my $ctr = 0;
     foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {      foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {
  my $uname = $_;  
  $uname=~s/:/_/;  
  $result.='<input type="hidden" name="ctr'.$ctr.'" value="'.$uname.'" />'."\n";  
  $ctr++;   $ctr++;
  $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},   $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},
    $_,$$fullname{$_},\@parts,\%weight,$ctr);     $_,$$fullname{$_},\@parts,\%weight,$ctr);
Line 2179  sub viewstudentgrade { Line 2427  sub viewstudentgrade {
     my ($uname,$udom) = split(/:/,$student);      my ($uname,$udom) = split(/:/,$student);
     $student=~s/:/_/;      $student=~s/:/_/;
     my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname);      my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname);
     my $result='<tr bgcolor="#ffffdd"><td align="right">'.$ctr.'&nbsp;</td><td>&nbsp;'.      my $result='<tr bgcolor="#ffffdd"><td align="right">'.
    '<input type="hidden" name="ctr'.($ctr-1).'" value="'.$student.'" />'.
    "\n".$ctr.'&nbsp;</td><td>&nbsp;'.
  '<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom.   '<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom.
  '\')"; TARGET=_self>'.$fullname.'</a> '.   '\')"; TARGET=_self>'.$fullname.'</a> '.
  '<font color="#999999">('.$uname.($ENV{'user.domain'} eq $udom ? '' : ':'.$udom).')</font></td>'."\n";   '<font color="#999999">('.$uname.($ENV{'user.domain'} eq $udom ? '' : ':'.$udom).')</font></td>'."\n";
     foreach my $apart (@$parts) {      foreach my $apart (@$parts) {
  my ($part,$type) = &split_part_type($apart);   my ($part,$type) = &split_part_type($apart);
  my $score=$record{"resource.$part.$type"};   my $score=$record{"resource.$part.$type"};
    $result.='<td align="middle">';
  if ($type eq 'awarded') {   if ($type eq 'awarded') {
     my $pts = $score eq '' ? '' : $score*$$weight{$part};      my $pts = $score eq '' ? '' : $score*$$weight{$part};
     $result.='<input type="hidden" name="'.      $result.='<input type="hidden" name="'.
  'GD_'.$student.'_'.$part.'_awarded_s" value="'.$pts.'" />'."\n";   'GD_'.$student.'_'.$part.'_awarded_s" value="'.$pts.'" />'."\n";
     $result.='<td align="middle"><input type="text" name="'.      $result.='<input type="text" name="'.
  'GD_'.$student.'_'.$part.'_awarded" '.   'GD_'.$student.'_'.$part.'_awarded" '.
  'onChange="javascript:changeSelect(\''.$part.'\',\''.$student.   'onChange="javascript:changeSelect(\''.$part.'\',\''.$student.
  '\')" value="'.$pts.'" size="4" /></td>'."\n";   '\')" value="'.$pts.'" size="4" /></td>'."\n";
Line 2199  sub viewstudentgrade { Line 2450  sub viewstudentgrade {
     $status = 'nothing' if ($status eq '');      $status = 'nothing' if ($status eq '');
     $result.='<input type="hidden" name="'.'GD_'.$student.'_'.      $result.='<input type="hidden" name="'.'GD_'.$student.'_'.
  $part.'_solved_s" value="'.$status.'" />'."\n";   $part.'_solved_s" value="'.$status.'" />'."\n";
     $result.='<td align="middle">&nbsp;<select name="'.      $result.='&nbsp;<select name="'.
  'GD_'.$student.'_'.$part.'_solved" '.   'GD_'.$student.'_'.$part.'_solved" '.
  'onChange="javascript:changeOneScore(\''.$part.'\',\''.$student.'\')" >'."\n";   'onChange="javascript:changeOneScore(\''.$part.'\',\''.$student.'\')" >'."\n";
     $result.= (($status eq 'excused') ? '<option> </option><option selected="on">excused</option>'       $result.= (($status eq 'excused') ? '<option> </option><option selected="on">excused</option>' 
Line 2210  sub viewstudentgrade { Line 2461  sub viewstudentgrade {
     $result.='<input type="hidden" name="'.      $result.='<input type="hidden" name="'.
  'GD_'.$student.'_'.$part.'_'.$type.'_s" value="'.$score.'" />'.   'GD_'.$student.'_'.$part.'_'.$type.'_s" value="'.$score.'" />'.
     "\n";      "\n";
     $result.='<td align="middle"><input type="text" name="'.      $result.='<input type="text" name="'.
  'GD_'.$student.'_'.$part.'_'.$type.'" '.   'GD_'.$student.'_'.$part.'_'.$type.'" '.
  'value="'.$score.'" size="4" /></td>'."\n";   'value="'.$score.'" size="4" /></td>'."\n";
  }   }
Line 2249  sub editgrades { Line 2500  sub editgrades {
     my %columns = ();      my %columns = ();
     my ($i,$ctr,$count,$rec_update) = (0,0,0,0);      my ($i,$ctr,$count,$rec_update) = (0,0,0,0);
   
     my (@parts) = sort(&getpartlist($url));      my (@parts) = sort(&getpartlist($url,$symb));
     my $header;      my $header;
     while ($ctr < $ENV{'form.totalparts'}) {      while ($ctr < $ENV{'form.totalparts'}) {
  my $partid = $ENV{'form.partid_'.$ctr};   my $partid = $ENV{'form.partid_'.$ctr};
Line 2274  sub editgrades { Line 2525  sub editgrades {
  }   }
     }      }
     foreach my $partid (@partid) {      foreach my $partid (@partid) {
    my $display_part=&get_display_part($partid,$url,$symb);
  $result .= '<td colspan="'.$columns{$partid}.   $result .= '<td colspan="'.$columns{$partid}.
     '" align="center"><b>Part '.$partid.      '" align="center"><b>Part:</b> '.$display_part.
     '</b> (Weight = '.$weight{$partid}.')</td>';      ' (Weight = '.$weight{$partid}.')</td>';
   
     }      }
     $result .= '</tr><tr bgcolor="#deffff">';      $result .= '</tr><tr bgcolor="#deffff">';
Line 2327  sub editgrades { Line 2579  sub editgrades {
  $newrecord{'resource.'.$_.'.awarded'} = 0;   $newrecord{'resource.'.$_.'.awarded'} = 0;
  $newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}";   $newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}";
  $updateflag = 1;   $updateflag = 1;
       } elsif (!($old_part eq $partial && $old_score eq $score)) {
    $updateflag = 1;
    $newrecord{'resource.'.$_.'.awarded'}  = $partial if $partial ne '';
    $newrecord{'resource.'.$_.'.solved'}   = $score;
    $rec_update++;
     }      }
   
     $line .= '<td align="center">'.$old_aw.'&nbsp;</td>'.      $line .= '<td align="center">'.$old_aw.'&nbsp;</td>'.
  '<td align="center">'.$awarded.   '<td align="center">'.$awarded.
  ($score eq 'excused' ? $score : '').'&nbsp;</td>';   ($score eq 'excused' ? $score : '').'&nbsp;</td>';
   
     if (!($old_part eq $partial && $old_score eq $score)) {  
  $updateflag = 1;  
  $newrecord{'resource.'.$_.'.awarded'}  = $partial if $partial ne '';  
  $newrecord{'resource.'.$_.'.solved'}   = $score;  
  $rec_update++;  
     }  
   
     my $partid=$_;      my $partid=$_;
     foreach my $stores (@parts) {      foreach my $stores (@parts) {
Line 2371  sub editgrades { Line 2622  sub editgrades {
     if ($noupdate) {      if ($noupdate) {
 # my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3;  # my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3;
  my $numcols=scalar(@partid)*4+2;   my $numcols=scalar(@partid)*4+2;
  $result .= '<tr bgcolor="#ffffff"><td align="center" colspan="'.$numcols.'">No Changes Occurred For the Students Below</td></tr>'.$noupdate;   $result .= '<tr bgcolor="#ffffff"><td align="center" colspan="'.$numcols.'">No Changes Occurred For the Students Below</td></tr><tr bgcolor="#ffffde">'.$noupdate;
     }      }
     $result .= '</table></td></tr></table>'."\n".      $result .= '</table></td></tr></table>'."\n".
  &show_grading_menu_form ($symb,$url);   &show_grading_menu_form ($symb,$url);
Line 2400  sub split_part_type { Line 2651  sub split_part_type {
 #  #
 #--- Javascript to handle csv upload  #--- Javascript to handle csv upload
 sub csvupload_javascript_reverse_associate {  sub csvupload_javascript_reverse_associate {
       my $error1=&mt('You need to specify the username or ID');
       my $error2=&mt('You need to specify at least one grading field');
   return(<<ENDPICK);    return(<<ENDPICK);
   function verify(vf) {    function verify(vf) {
     var foundsomething=0;      var foundsomething=0;
     var founduname=0;      var founduname=0;
     var founddomain=0;      var foundID=0;
     for (i=0;i<=vf.nfields.value;i++) {      for (i=0;i<=vf.nfields.value;i++) {
       tw=eval('vf.f'+i+'.selectedIndex');        tw=eval('vf.f'+i+'.selectedIndex');
       if (i==0 && tw!=0) { founduname=1; }        if (i==0 && tw!=0) { foundID=1; }
       if (i==1 && tw!=0) { founddomain=1; }        if (i==1 && tw!=0) { founduname=1; }
       if (i!=0 && i!=1 && tw!=0) { foundsomething=1; }        if (i!=0 && i!=1 && i!=2 && tw!=0) { foundsomething=1; }
     }      }
     if (founduname==0 || founddomain==0) {      if (founduname==0 && foundID==0) {
       alert('You need to specify at both the username and domain');   alert('$error1');
       return;   return;
     }      }
     if (foundsomething==0) {      if (foundsomething==0) {
       alert('You need to specify at least one grading field');   alert('$error2');
       return;   return;
     }      }
     vf.submit();      vf.submit();
   }    }
Line 2438  ENDPICK Line 2691  ENDPICK
 }  }
   
 sub csvupload_javascript_forward_associate {  sub csvupload_javascript_forward_associate {
       my $error1=&mt('You need to specify the username or ID');
       my $error2=&mt('You need to specify at least one grading field');
   return(<<ENDPICK);    return(<<ENDPICK);
   function verify(vf) {    function verify(vf) {
     var foundsomething=0;      var foundsomething=0;
     var founduname=0;      var founduname=0;
     var founddomain=0;      var foundID=0;
     for (i=0;i<=vf.nfields.value;i++) {      for (i=0;i<=vf.nfields.value;i++) {
       tw=eval('vf.f'+i+'.selectedIndex');        tw=eval('vf.f'+i+'.selectedIndex');
       if (tw==1) { founduname=1; }        if (tw==1) { foundID=1; }
       if (tw==2) { founddomain=1; }        if (tw==2) { founduname=1; }
       if (tw>2) { foundsomething=1; }        if (tw>3) { foundsomething=1; }
     }      }
     if (founduname==0 || founddomain==0) {      if (founduname==0 && foundID==0) {
       alert('You need to specify at both the username and domain');   alert('$error1');
       return;   return;
     }      }
     if (foundsomething==0) {      if (foundsomething==0) {
       alert('You need to specify at least one grading field');   alert('$error2');
       return;   return;
     }      }
     vf.submit();      vf.submit();
   }    }
Line 2482  sub csvuploadmap_header { Line 2737  sub csvuploadmap_header {
     }      }
   
     my ($result) = &showResourceInfo($url,$ENV{'form.probTitle'});      my ($result) = &showResourceInfo($url,$ENV{'form.probTitle'});
       my $checked=(($ENV{'form.noFirstLine'})?' checked="checked"':'');
       my $ignore=&mt('Ignore First Line');
     $request->print(<<ENDPICK);      $request->print(<<ENDPICK);
 <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">  <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
 <h3><font color="#339933">Uploading Class Grades</font></h3>  <h3><font color="#339933">Uploading Class Grades</font></h3>
Line 2493  Total number of records found in file: $ Line 2749  Total number of records found in file: $
 Enter as many fields as you can. The system will inform you and bring you back  Enter as many fields as you can. The system will inform you and bring you back
 to this page if the data selected is insufficient to run your class.<hr />  to this page if the data selected is insufficient to run your class.<hr />
 <input type="button" value="Reverse Association" onClick="javascript:this.form.associate.value='Reverse Association';submit(this.form);" />  <input type="button" value="Reverse Association" onClick="javascript:this.form.associate.value='Reverse Association';submit(this.form);" />
   <label><input type="checkbox" name="noFirstLine" $checked />$ignore</label>
 <input type="hidden" name="associate"  value="" />  <input type="hidden" name="associate"  value="" />
 <input type="hidden" name="phase"      value="three" />  <input type="hidden" name="phase"      value="three" />
 <input type="hidden" name="datatoken"  value="$datatoken" />  <input type="hidden" name="datatoken"  value="$datatoken" />
Line 2504  to this page if the data selected is ins Line 2761  to this page if the data selected is ins
 <input type="hidden" name="url"        value="$url" />  <input type="hidden" name="url"        value="$url" />
 <input type="hidden" name="saveState"  value="$ENV{'form.saveState'}" />  <input type="hidden" name="saveState"  value="$ENV{'form.saveState'}" />
 <input type="hidden" name="probTitle"  value="$ENV{'form.probTitle'}" />  <input type="hidden" name="probTitle"  value="$ENV{'form.probTitle'}" />
 <input type="hidden" name="command"    value="csvuploadassign" />  <input type="hidden" name="command"    value="csvuploadoptions" />
 <hr />  <hr />
 <script type="text/javascript" language="Javascript">  <script type="text/javascript" language="Javascript">
 $javascript  $javascript
Line 2515  ENDPICK Line 2772  ENDPICK
 }  }
   
 sub csvupload_fields {  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']);      my @fields=(['ID','Student ID'],
    ['username','Student Username'],
    ['domain','Student Domain']);
     foreach my $part (sort(@parts)) {      foreach my $part (sort(@parts)) {
  my @datum;   my @datum;
  my $display=&Apache::lonnet::metadata($url,$part.'.display');   my $display=&Apache::lonnet::metadata($url,$part.'.display');
  my $name=$part;   my $name=$part;
  if  (!$display) { $display = $name; }   if  (!$display) { $display = $name; }
  @datum=($name,$display);   @datum=($name,$display);
    if ($name=~/^stores_(.*)_awarded/) {
       push(@fields,['stores_'.$1.'_points',"Points [Part: $1]"]);
    }
  push(@fields,\@datum);   push(@fields,\@datum);
     }      }
     return (@fields);      return (@fields);
Line 2564  CSVFORMJS Line 2826  CSVFORMJS
  '.</b></td></tr>'."\n";   '.</b></td></tr>'."\n";
     $result.='<tr bgcolor=#ffffe6><td>'."\n";      $result.='<tr bgcolor=#ffffe6><td>'."\n";
     my $upfile_select=&Apache::loncommon::upfile_select_html();      my $upfile_select=&Apache::loncommon::upfile_select_html();
       my $ignore=&mt('Ignore First Line');
     $result.=<<ENDUPFORM;      $result.=<<ENDUPFORM;
 <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">  <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
 <input type="hidden" name="symb" value="$symb" />  <input type="hidden" name="symb" value="$symb" />
Line 2573  CSVFORMJS Line 2836  CSVFORMJS
 <input type="hidden" name="saveState"  value="$ENV{'form.saveState'}" />  <input type="hidden" name="saveState"  value="$ENV{'form.saveState'}" />
 $upfile_select  $upfile_select
 <br /><input type="button" onClick="javascript:checkUpload(this.form);" value="Upload Scores" />  <br /><input type="button" onClick="javascript:checkUpload(this.form);" value="Upload Scores" />
   <label><input type="checkbox" name="noFirstLine" />$ignore</lable>
 </form>  </form>
 ENDUPFORM  ENDUPFORM
     $result.='</td></tr></table>'."\n";      $result.='</td></tr></table>'."\n";
Line 2596  sub csvuploadmap { Line 2859  sub csvuploadmap {
  &Apache::loncommon::load_tmp_file($request);   &Apache::loncommon::load_tmp_file($request);
     }      }
     my @records=&Apache::loncommon::upfile_record_sep();      my @records=&Apache::loncommon::upfile_record_sep();
       if ($ENV{'form.noFirstLine'}) { shift(@records); }
     &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1);      &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1);
     my ($i,$keyfields);      my ($i,$keyfields);
     if (@records) {      if (@records) {
  my @fields=&csvupload_fields($url);   my @fields=&csvupload_fields($url,$symb);
   
  if ($ENV{'form.upfile_associate'} eq 'reverse') {   if ($ENV{'form.upfile_associate'} eq 'reverse') {
     &Apache::loncommon::csv_print_samples($request,\@records);      &Apache::loncommon::csv_print_samples($request,\@records);
Line 2621  sub csvuploadmap { Line 2885  sub csvuploadmap {
     return '';      return '';
 }  }
   
 sub csvuploadassign {  sub csvuploadoptions {
     my ($request)= @_;      my ($request)= @_;
     my ($symb,$url)=&get_symb_and_url($request);      my ($symb,$url)=&get_symb_and_url($request);
     if (!$symb) {return '';}      my $checked=(($ENV{'form.noFirstLine'})?'1':'0');
     &Apache::loncommon::load_tmp_file($request);      my $ignore=&mt('Ignore First Line');
     my @gradedata = &Apache::loncommon::upfile_record_sep();      $request->print(<<ENDPICK);
   <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
   <h3><font color="#339933">Uploading Class Grade Options</font></h3>
   <input type="hidden" name="command"    value="csvuploadassign" />
   <input type="submit" value="Assign Grades" /><br />
   <p>
   <label>
      <input type="checkbox" name="show_full_results" />
      Show a table of all changes
   </label>
   </p>
   <p>
   <label>
      <input type="checkbox" name="overwite_scores" checked="checked" />
      Overwrite any existing score
   </label>
   </p>
   ENDPICK
       my %fields=&get_fields();
       if (!defined($fields{'domain'})) {
    my $domform = &Apache::loncommon::select_dom_form($ENV{'request.role.domain'},'default_domain');
    $request->print("\n<p> Users are in domain: ".$domform."</p>\n");
       }
       foreach my $key (sort(keys(%ENV))) {
    if ($key !~ /^form\.(.*)$/) { next; }
    my $cleankey=$1;
    if ($cleankey eq 'command') { next; }
    $request->print('<input type="hidden" name="'.$cleankey.
    '"  value="'.$ENV{$key}.'" />'."\n");
       }
       # FIXME do a check for any duplicated user ids...
       # FIXME do a check for any invalid user ids?...
       $request->print("<hr /></form>\n");
       $request->print(&show_grading_menu_form($symb,$url));
       return '';
   }
   
   sub get_fields {
       my %fields;
     my @keyfields = split(/\,/,$ENV{'form.keyfields'});      my @keyfields = split(/\,/,$ENV{'form.keyfields'});
     my %fields=();  
     for (my $i=0; $i<=$ENV{'form.nfields'}; $i++) {      for (my $i=0; $i<=$ENV{'form.nfields'}; $i++) {
  if ($ENV{'form.upfile_associate'} eq 'reverse') {   if ($ENV{'form.upfile_associate'} eq 'reverse') {
     if ($ENV{'form.f'.$i} ne 'none') {      if ($ENV{'form.f'.$i} ne 'none') {
Line 2640  sub csvuploadassign { Line 2941  sub csvuploadassign {
     }      }
  }   }
     }      }
       return %fields;
   }
   
   sub csvuploadassign {
       my ($request)= @_;
       my ($symb,$url)=&get_symb_and_url($request);
       if (!$symb) {return '';}
       &Apache::loncommon::load_tmp_file($request);
       my @gradedata = &Apache::loncommon::upfile_record_sep();
       if ($ENV{'form.noFirstLine'}) { shift(@gradedata); }
       my %fields=&get_fields();
     $request->print('<h3>Assigning Grades</h3>');      $request->print('<h3>Assigning Grades</h3>');
     my $courseid=$ENV{'request.course.id'};      my $courseid=$ENV{'request.course.id'};
     my ($classlist) = &getclasslist('all',0);      my ($classlist) = &getclasslist('all',0);
Line 2648  sub csvuploadassign { Line 2960  sub csvuploadassign {
     my $countdone=0;      my $countdone=0;
     foreach my $grade (@gradedata) {      foreach my $grade (@gradedata) {
  my %entries=&Apache::loncommon::record_sep($grade);   my %entries=&Apache::loncommon::record_sep($grade);
    my $domain;
    if ($entries{$fields{'domain'}}) {
       $domain=$entries{$fields{'domain'}};
    } else {
       $domain=$ENV{'form.default_domain'};
    }
    $domain=~s/\s//g;
  my $username=$entries{$fields{'username'}};   my $username=$entries{$fields{'username'}};
  my $domain=$entries{$fields{'domain'}};   $username=~s/\s//g;
    if (!$username) {
       my $id=$entries{$fields{'ID'}};
       my %ids=&Apache::lonnet::idget($domain,$id);
       $username=$ids{$id};
    }
  if (!exists($$classlist{"$username:$domain"})) {   if (!exists($$classlist{"$username:$domain"})) {
     push(@skipped,"$username:$domain");      push(@skipped,"$username:$domain");
     next;      next;
Line 2659  sub csvuploadassign { Line 2983  sub csvuploadassign {
     push(@notallowed,"$username:$domain");      push(@notallowed,"$username:$domain");
     next;      next;
  }   }
    my %points;
  my %grades;   my %grades;
  foreach my $dest (keys(%fields)) {   foreach my $dest (keys(%fields)) {
     if ($dest eq 'username' || $dest eq 'domain') { next; }      if ($dest eq 'ID' || $dest eq 'username' ||
     if ($entries{$fields{$dest}} eq '') { next; }   $dest eq 'domain') { next; }
     my $store_key=$dest;      if ($entries{$fields{$dest}} =~ /^\s*$/) { next; }
     $store_key=~s/^stores/resource/;      if ($dest=~/stores_(.*)_points/) {
     $store_key=~s/_/\./g;   my $part=$1;
     $grades{$store_key}=$entries{$fields{$dest}};   my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight',
         $symb,$domain,$username);
    my $pcr=$entries{$fields{$dest}} / $wgt;
    my $award='correct_by_override';
    $grades{"resource.$part.awarded"}=$pcr;
    $grades{"resource.$part.solved"}=$award;
    $points{$part}=1;
       } else {
    if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} }
    if ($dest=~/stores_(.*)_solved/)  { if ($points{$1}) {next;} }
    my $store_key=$dest;
    $store_key=~s/^stores/resource/;
    $store_key=~s/_/\./g;
    $grades{$store_key}=$entries{$fields{$dest}};
       }
  }   }
    if (! %grades) { push(@skipped,"$username:$domain no data to store"); }
  $grades{"resource.regrader"}="$ENV{'user.name'}:$ENV{'user.domain'}";   $grades{"resource.regrader"}="$ENV{'user.name'}:$ENV{'user.domain'}";
   # &Apache::lonnet::logthis(" storing ".(join('-',%grades)));
  &Apache::lonnet::cstore(\%grades,$symb,$ENV{'request.course.id'},   &Apache::lonnet::cstore(\%grades,$symb,$ENV{'request.course.id'},
  $domain,$username);   $domain,$username);
  $request->print('.');   $request->print('.');
Line 2726  LISTJAVASCRIPT Line 3067  LISTJAVASCRIPT
     $result.='<form action="/adm/grades" method="post" name="displayPage">'."\n";      $result.='<form action="/adm/grades" method="post" name="displayPage">'."\n";
     $result.='&nbsp;<b>Problems from:</b> <select name="selectpage">'."\n";      $result.='&nbsp;<b>Problems from:</b> <select name="selectpage">'."\n";
     my ($titles,$symbx) = &getSymbMap($request);      my ($titles,$symbx) = &getSymbMap($request);
     my ($curpage,$type,$mapId) = ($symb =~ /(.*?\.(page|sequence))___(\d+)___/);       my ($curpage) =&Apache::lonnet::decode_symb($symb); 
   #    my ($curpage,$mapId) =&Apache::lonnet::decode_symb($symb); 
   #    my $type=($curpage =~ /\.(page|sequence)/);
     my $ctr=0;      my $ctr=0;
     foreach (@$titles) {      foreach (@$titles) {
  my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/);   my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/);
Line 2746  LISTJAVASCRIPT Line 3089  LISTJAVASCRIPT
     $result.='<input type="hidden" name="page" />'."\n".      $result.='<input type="hidden" name="page" />'."\n".
  '<input type="hidden" name="title" />'."\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";   '<input type="radio" name="vProb" value="yes" /> yes '."<br>\n";
   
     $result.='&nbsp;<b>Submission Details: </b>'.      $result.='&nbsp;<b>Submission Details: </b>'.
Line 2798  LISTJAVASCRIPT Line 3141  LISTJAVASCRIPT
   
 sub getSymbMap {  sub getSymbMap {
     my ($request) = @_;      my ($request) = @_;
     my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db',      my $navmap = Apache::lonnavmaps::navmap->new();
   $ENV{'request.course.fn'}.'_parms.db');  
 #    $navmap->init();  
   
     my %symbx = ();      my %symbx = ();
     my @titles = ();      my @titles = ();
     my $minder = 0;      my $minder = 0;
   
     # Gather every sequence that has problems.      # Gather every sequence that has problems.
     my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); }, 1);      my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); },
          1,0,1);
     for my $sequence ($navmap->getById('0.0'), @sequences) {      for my $sequence ($navmap->getById('0.0'), @sequences) {
  if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) {   if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) {
     my $title = $minder.'.'.$sequence->compTitle();      my $title = $minder.'.'.$sequence->compTitle();
Line 2816  sub getSymbMap { Line 3158  sub getSymbMap {
     $minder++;      $minder++;
  }   }
     }      }
   
     $navmap->untieHashes();  
     return \@titles,\%symbx;      return \@titles,\%symbx;
 }  }
   
Line 2834  sub displayPage { Line 3174  sub displayPage {
     my ($classlist,undef,$fullname) = &getclasslist($getsec,'1');      my ($classlist,undef,$fullname) = &getclasslist($getsec,'1');
     my ($uname,$udom) = split(/:/,$ENV{'form.student'});      my ($uname,$udom) = split(/:/,$ENV{'form.student'});
     my $usec=$classlist->{$ENV{'form.student'}}[5];      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)) {      if (!&canview($usec)) {
  $request->print('<font color="red">Unable to view requested student.('.$ENV{'form.student'}.')</font>');   $request->print('<font color="red">Unable to view requested student.('.$ENV{'form.student'}.')</font>');
  $request->print(&show_grading_menu_form($symb,$url));   $request->print(&show_grading_menu_form($symb,$url));
Line 2845  sub displayPage { Line 3193  sub displayPage {
     &sub_page_js($request);      &sub_page_js($request);
     $request->print($result);      $request->print($result);
   
     my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db',      my $navmap = Apache::lonnavmaps::navmap->new();
   $ENV{'request.course.fn'}.'_parms.db',1, 1);      my ($mapUrl, $id, $resUrl)=&Apache::lonnet::decode_symb($ENV{'form.page'});
     my ($mapUrl, $id, $resUrl) = split(/___/, $ENV{'form.page'});  
     my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps      my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps
   
     my $iterator = $navmap->getIterator($map->map_start(),      my $iterator = $navmap->getIterator($map->map_start(),
Line 2874  sub displayPage { Line 3221  sub displayPage {
  '<td align="center"><b>&nbsp;Prob.&nbsp;</b></td>'.   '<td align="center"><b>&nbsp;Prob.&nbsp;</b></td>'.
  '<td><b>&nbsp;'.($ENV{'form.vProb'} eq 'no' ? 'Title' : 'Problem Text').'/Grade</b></td></tr>';   '<td><b>&nbsp;'.($ENV{'form.vProb'} eq 'no' ? 'Title' : 'Problem Text').'/Grade</b></td></tr>';
   
     my ($depth,$question) = (1,1);      my ($depth,$question,$prob) = (1,1,1);
     $iterator->next(); # skip the first BEGIN_MAP      $iterator->next(); # skip the first BEGIN_MAP
     my $curRes = $iterator->next(); # for "current resource"      my $curRes = $iterator->next(); # for "current resource"
     while ($depth > 0) {      while ($depth > 0) {
         if($curRes == $iterator->BEGIN_MAP) { $depth++; }          if($curRes == $iterator->BEGIN_MAP) { $depth++; }
         if($curRes == $iterator->END_MAP) { $depth--; }          if($curRes == $iterator->END_MAP) { $depth--; }
   
         if (ref($curRes) && $curRes->is_problem()) {          if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) {
     my $parts = $curRes->parts();      my $parts = $curRes->parts();
             my $title = $curRes->compTitle();              my $title = $curRes->compTitle();
     my $symbx = $curRes->symb();      my $symbx = $curRes->symb();
     $studentTable.='<tr bgcolor="#ffffe6"><td align="center" valign="top" >'.$question.      $studentTable.='<tr bgcolor="#ffffe6"><td align="center" valign="top" >'.$prob.
  (scalar(@{$parts}) == 1 ? '' : '<br>('.scalar(@{$parts}).'&nbsp;parts)').'</td>';   (scalar(@{$parts}) == 1 ? '' : '<br>('.scalar(@{$parts}).'&nbsp;parts)').'</td>';
     $studentTable.='<td valign="top">';      $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 {      } else {
  my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$ENV{'request.course.id'});   my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$ENV{'request.course.id'});
  $companswer =~ s|<form(.*?)>||g;   $companswer =~ s|<form(.*?)>||g;
Line 2910  sub displayPage { Line 3258  sub displayPage {
  } else {   } else {
     my %responseType = ();      my %responseType = ();
     foreach my $partid (@{$parts}) {      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') {      } elsif ($ENV{'form.lastSub'} eq 'all') {
  my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : '');   my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : '');
Line 2927  sub displayPage { Line 3282  sub displayPage {
     $studentTable.='<input type="hidden" name="q_'.$question.'" value="'.$partid.'" />'."\n";      $studentTable.='<input type="hidden" name="q_'.$question.'" value="'.$partid.'" />'."\n";
     $question++;      $question++;
  }   }
    $prob++;
     }      }
     $studentTable.='</td></tr>';      $studentTable.='</td></tr>';
   
Line 2934  sub displayPage { Line 3290  sub displayPage {
         $curRes = $iterator->next();          $curRes = $iterator->next();
     }      }
   
     $navmap->untieHashes();  
   
     $studentTable.='</td></tr></table></td></tr></table>'."\n".      $studentTable.='</td></tr></table></td></tr></table>'."\n".
  '<input type="button" value="Save" '.   '<input type="button" value="Save" '.
  'onClick="javascript:checkSubmitPage(this.form,'.$question.');" TARGET=_self />'.   'onClick="javascript:checkSubmitPage(this.form,'.$question.');" TARGET=_self />'.
Line 2947  sub displayPage { Line 3301  sub displayPage {
 }  }
   
 sub displaySubByDates {  sub displaySubByDates {
     my ($symbx,$record,$parts,$responseType,$checkIcon) = @_;      my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_;
       my $isCODE=0;
       if (exists($record->{'resource.CODE'})) { $isCODE=1; }
     my $studentTable='<table border="0" width="100%"><tr><td bgcolor="#777777">'.      my $studentTable='<table border="0" width="100%"><tr><td bgcolor="#777777">'.
  '<table border="0" width="100%"><tr bgcolor="#e6ffff">'.   '<table border="0" width="100%"><tr bgcolor="#e6ffff">'.
  '<td><b>Date/Time</b></td>'.   '<td><b>Date/Time</b></td>'.
    ($isCODE?'<td><b>CODE</b></td>':'').
  '<td><b>Submission</b></td>'.   '<td><b>Submission</b></td>'.
  '<td><b>Status&nbsp;</b></td></tr>';   '<td><b>Status&nbsp;</b></td></tr>';
     my ($version);      my ($version);
     my %mark;      my %mark;
       my %orders;
     $mark{'correct_by_student'} = $checkIcon;      $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++) {      for ($version=1;$version<=$$record{'version'};$version++) {
  my $timestamp = scalar(localtime($$record{$version.':timestamp'}));   my $timestamp = scalar(localtime($$record{$version.':timestamp'}));
  $studentTable.='<tr bgcolor="#ffffff" valign="top"><td>'.$timestamp.'</td>';   $studentTable.='<tr bgcolor="#ffffff" valign="top"><td>'.$timestamp.'</td>';
    if ($isCODE) {
       $studentTable.='<td>'.$record->{$version.':resource.CODE'}.'</td>';
    }
  my @versionKeys = split(/\:/,$$record{$version.':keys'});   my @versionKeys = split(/\:/,$$record{$version.':keys'});
  my @displaySub = ();   my @displaySub = ();
  foreach my $partid (@{$parts}) {   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 '');  #    next if ($$record{"$version:resource.$partid.solved"} eq '');
     $displaySub[0].=(exists $$record{$version.':'.$matchKey[0]}) ?       my $display_part=&get_display_part($partid,undef,$symb);
  '<b>Part&nbsp;'.$partid.'&nbsp;'.      foreach my $matchKey (@matchKey) {
  ($$record{"$version:resource.$partid.tries"} eq '' ? 'Trial&nbsp;not&nbsp;counted' :   if (exists($$record{$version.':'.$matchKey}) &&
  'Trial&nbsp;'.$$record{"$version:resource.$partid.tries"}).'</b>&nbsp; '.      $$record{$version.':'.$matchKey} ne '') {
  &cleanRecord($$record{$version.':'.$matchKey[0]},$$responseType{$partid},$$symbx).'<br />' : '';      my ($responseId)=($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/);
     $displaySub[1].=(exists $$record{"$version:resource.$partid.award"}) ?      $displaySub[0].='<b>Part:</b>&nbsp;'.$display_part.'&nbsp;';
  '<b>Part&nbsp;'.$partid.'</b> &nbsp;'.      $displaySub[0].='<font color="#999999">(ID&nbsp;'.
  lc($$record{"$version:resource.$partid.award"}).' '.   $responseId.')</font>&nbsp;<b>';
  $mark{$$record{"$version:resource.$partid.solved"}}.'<br />' : '';      if ($$record{"$version:resource.$partid.tries"} eq '') {
     $displaySub[2].=(exists $$record{"$version:resource.$partid.regrader"}) ?   $displaySub[0].='Trial&nbsp;not&nbsp;counted';
  $$record{"$version:resource.$partid.regrader"}.' (<b>Part:</b> '.$partid.')' : '';      } else {
  }   $displaySub[0].='Trial&nbsp;'.
  $displaySub[2].=(exists $$record{"$version:resource.regrader"}) ?      $$record{"$version:resource.$partid.tries"};
     $$record{"$version:resource.regrader"} : ''; # needed because old essay regrader has not parts info      }
  $studentTable.='<td>'.$displaySub[0].'&nbsp;</td><td>'.$displaySub[1].      my $responseType=$responseType->{$partid}->{$responseId};
     ($displaySub[2] eq '' ? '' : 'Manually graded by '.$displaySub[2]).'&nbsp;</td></tr>';      if (!exists($orders{$partid})) { $orders{$partid}={}; }
       if (!exists($orders{$partid}->{$responseId})) {
    $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:</b>&nbsp;'.$display_part.' &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> '.$display_part.')';
       }
    }
    # 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>';      $studentTable.='</table></td></tr></table>';
     return $studentTable;      return $studentTable;
Line 3008  sub updateGradeByPage { Line 3399  sub updateGradeByPage {
   
     $request->print($result);      $request->print($result);
   
     my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db',      my $navmap = Apache::lonnavmaps::navmap->new();
   $ENV{'request.course.fn'}.'_parms.db',1, 1);      my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $ENV{'form.page'});
     my ($mapUrl, $id, $resUrl) = split(/___/, $ENV{'form.page'});  
     my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps      my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps
   
     my $iterator = $navmap->getIterator($map->map_start(),      my $iterator = $navmap->getIterator($map->map_start(),
Line 3025  sub updateGradeByPage { Line 3415  sub updateGradeByPage {
   
     $iterator->next(); # skip the first BEGIN_MAP      $iterator->next(); # skip the first BEGIN_MAP
     my $curRes = $iterator->next(); # for "current resource"      my $curRes = $iterator->next(); # for "current resource"
     my ($depth,$question,$changeflag)= (1,1,0);      my ($depth,$question,$prob,$changeflag)= (1,1,1,0);
     while ($depth > 0) {      while ($depth > 0) {
         if($curRes == $iterator->BEGIN_MAP) { $depth++; }          if($curRes == $iterator->BEGIN_MAP) { $depth++; }
         if($curRes == $iterator->END_MAP) { $depth--; }          if($curRes == $iterator->END_MAP) { $depth--; }
Line 3034  sub updateGradeByPage { Line 3424  sub updateGradeByPage {
     my $parts = $curRes->parts();      my $parts = $curRes->parts();
             my $title = $curRes->compTitle();              my $title = $curRes->compTitle();
     my $symbx = $curRes->symb();      my $symbx = $curRes->symb();
     $studentTable.='<tr bgcolor="#ffffe6"><td align="center" valign="top" >'.$question.      $studentTable.='<tr bgcolor="#ffffe6"><td align="center" valign="top" >'.$prob.
  (scalar(@{$parts}) == 1 ? '' : '<br>('.scalar(@{$parts}).'&nbsp;parts)').'</td>';   (scalar(@{$parts}) == 1 ? '' : '<br>('.scalar(@{$parts}).'&nbsp;parts)').'</td>';
     $studentTable.='<td valign="top">&nbsp;<b>'.$title.'</b>&nbsp;</td>';      $studentTable.='<td valign="top">&nbsp;<b>'.$title.'</b>&nbsp;</td>';
   
Line 3067  sub updateGradeByPage { Line 3457  sub updateGradeByPage {
     $changeflag++;      $changeflag++;
     $newpts = '';      $newpts = '';
  }   }
    my $display_part=&get_display_part($partid,undef,
      $curRes->symb());
  my $oldstatus = $ENV{'form.solved'.$question.'_'.$partid};   my $oldstatus = $ENV{'form.solved'.$question.'_'.$partid};
  $displayPts[0].='&nbsp;<b>Part</b> '.$partid.' = '.   $displayPts[0].='&nbsp;<b>Part:</b> '.$display_part.' = '.
     (($oldstatus eq 'excused') ? 'excused' : $oldpts).      (($oldstatus eq 'excused') ? 'excused' : $oldpts).
     '&nbsp;<br>';      '&nbsp;<br>';
  $displayPts[1].='&nbsp;<b>Part</b> '.$partid.' = '.   $displayPts[1].='&nbsp;<b>Part:</b> '.$display_part.' = '.
      (($score eq 'excused') ? 'excused' : $newpts).       (($score eq 'excused') ? 'excused' : $newpts).
     '&nbsp;<br>';      '&nbsp;<br>';
   
Line 3095  sub updateGradeByPage { Line 3486  sub updateGradeByPage {
  '<td valign="top">'.$displayPts[1].'</td>'.   '<td valign="top">'.$displayPts[1].'</td>'.
  '</tr>';   '</tr>';
   
       $prob++;
  }   }
         $curRes = $iterator->next();          $curRes = $iterator->next();
     }      }
   
     $navmap->untieHashes();  
   
     $studentTable.='</td></tr></table></td></tr></table>';      $studentTable.='</td></tr></table></td></tr></table>';
     $studentTable.=&show_grading_menu_form($ENV{'form.symb'},$ENV{'form.url'});      $studentTable.=&show_grading_menu_form($ENV{'form.symb'},$ENV{'form.url'});
     my $grademsg=($changeflag == 0 ? 'No score was changed or updated.' :      my $grademsg=($changeflag == 0 ? 'No score was changed or updated.' :
Line 3132  sub getSequenceDropDown { Line 3522  sub getSequenceDropDown {
     my ($request,$symb)=@_;      my ($request,$symb)=@_;
     my $result='<select name="selectpage">'."\n";      my $result='<select name="selectpage">'."\n";
     my ($titles,$symbx) = &getSymbMap($request);      my ($titles,$symbx) = &getSymbMap($request);
     my ($curpage,$type,$mapId) = ($symb =~ /(.*?\.(page|sequence))___(\d+)___/);       my ($curpage)=&Apache::lonnet::decode_symb($symb); 
     my $ctr=0;      my $ctr=0;
     foreach (@$titles) {      foreach (@$titles) {
  my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/);   my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/);
Line 3145  sub getSequenceDropDown { Line 3535  sub getSequenceDropDown {
     return $result;      return $result;
 }  }
   
 #FIXME, I am in loncreatecourse, use that one instead  sub scantron_filenames {
 sub propath {  
     my ($udom,$uname)=@_;  
     $udom=~s/\W//g;  
     $uname=~s/\W//g;  
     my $subdir=$uname.'__';  
     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;  
     my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname";  
     return $proname;  
 }   
   
 sub scantron_uploads {  
     if (!-e $Apache::lonnet::perlvar{'lonScansDir'}) { return ''};  
     my $result= '<select name="scantron_selectfile">';  
     my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};      my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
     my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};      my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
     my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname,      my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname,
        &propath($cdom,$cname));      &Apache::loncommon::propath($cdom,$cname));
     foreach my $filename (@files) {      my @possiblenames;
       foreach my $filename (sort(@files)) {
  ($filename)=split(/&/,$filename);   ($filename)=split(/&/,$filename);
  if ($filename!~/^scantron_orig_/) { next ; }   if ($filename!~/^scantron_orig_/) { next ; }
  $filename=~s/^scantron_orig_//;   $filename=~s/^scantron_orig_//;
  $result.="<option>$filename</option>\n";   push(@possiblenames,$filename);
       }
       return @possiblenames;
   }
   
   sub scantron_uploads {
       my ($file2grade) = @_;
       my $result= '<select name="scantron_selectfile">';
       $result.="<option></option>";
       foreach my $filename (sort(&scantron_filenames())) {
    $result.="<option".($filename eq $file2grade ? ' selected="on"':'').">$filename</option>\n";
     }      }
     $result.="</select>";      $result.="</select>";
     return $result;      return $result;
Line 3176  sub scantron_uploads { Line 3564  sub scantron_uploads {
 sub scantron_scantab {  sub scantron_scantab {
     my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');      my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
     my $result='<select name="scantron_format">'."\n";      my $result='<select name="scantron_format">'."\n";
       $result.='<option></option>'."\n";
     foreach my $line (<$fh>) {      foreach my $line (<$fh>) {
  my ($name,$descrip)=split(/:/,$line);   my ($name,$descrip)=split(/:/,$line);
  if ($name =~ /^\#/) { next; }   if ($name =~ /^\#/) { next; }
Line 3186  sub scantron_scantab { Line 3575  sub scantron_scantab {
     return $result;      return $result;
 }  }
   
   sub scantron_CODElist {
       my $cdom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
       my $cnum = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
       my @names=&Apache::lonnet::getkeys('CODEs',$cdom,$cnum);
       my $namechoice='<option></option>';
       foreach my $name (sort {uc($a) cmp uc($b)} @names) {
    if ($name =~ /^error: 2 /) { next; }
    $namechoice.='<option value="'.$name.'">'.$name.'</option>';
       }
       $namechoice='<select name="scantron_CODElist">'.$namechoice.'</select>';
       return $namechoice;
   }
   
   sub scantron_CODEunique {
       my $result='<nobr>
                    <input type="radio" name="scantron_CODEunique"
                           value="Yes" checked="on" /> Yes
                   </nobr>
                   <nobr>
                    <input type="radio" name="scantron_CODEunique"
                           value="No" /> No
                   </nobr>';
       return $result;
   }
   
 sub scantron_selectphase {  sub scantron_selectphase {
     my ($r) = @_;      my ($r,$file2grade) = @_;
     my ($symb,$url)=&get_symb_and_url($r);      my ($symb,$url)=&get_symb_and_url($r);
     if (!$symb) {return '';}      if (!$symb) {return '';}
     my $sequence_selector=&getSequenceDropDown($r,$symb);      my $sequence_selector=&getSequenceDropDown($r,$symb);
     my $default_form_data=&defaultFormData($symb,$url);      my $default_form_data=&defaultFormData($symb,$url);
     my $grading_menu_button=&show_grading_menu_form($symb,$url);      my $grading_menu_button=&show_grading_menu_form($symb,$url);
     my $file_selector=&scantron_uploads();      my $file_selector=&scantron_uploads($file2grade);
     my $format_selector=&scantron_scantab();      my $format_selector=&scantron_scantab();
       my $CODE_selector=&scantron_CODElist();
       my $CODE_unique=&scantron_CODEunique();
     my $result;      my $result;
     #FIXME allow instructor to be able to download the scantron file      #FIXME allow instructor to be able to download the scantron file
     # and to upload it,      # and to upload it,
     $result.= <<SCANTRONFORM;      $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_validate" />  
   $default_form_data  
   <table width="100%" border="0">  
     <tr>      <tr>
        <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantron_process">
       <td bgcolor="#777777">        <td bgcolor="#777777">
          <input type="hidden" name="command" value="scantron_warning" />
           $default_form_data
         <table width="100%" border="0">          <table width="100%" border="0">
           <tr bgcolor="#e6ffff">            <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>              </td>
           </tr>            </tr>
           <tr bgcolor="#ffffe6">            <tr bgcolor="#ffffe6">
             <td>              <td> Sequence to grade: </td><td> $sequence_selector </td>
                Sequence to grade: $sequence_selector            </tr>
     </td>            <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> Saved CODEs to validate against: </td><td> $CODE_selector</td>
           </tr>            </tr>
           <tr bgcolor="#ffffe6">            <tr bgcolor="#ffffe6">
               <td> Each CODE is only to be used once:</td><td> $CODE_unique </td>
             </tr>
             <tr bgcolor="#ffffe6">
       <td> Options: </td>
             <td>              <td>
  Filename of scoring office file: $file_selector                  <input type="checkbox" name="scantron_options_redo" value="redo_skipped"/> Do only previously skipped records <br />
                   <input type="checkbox" name="scantron_options_ignore" value="ignore_corrections"/> Remove all exisiting corrections
     </td>      </td>
           </tr>            </tr>
           <tr bgcolor="#ffffe6">            <tr bgcolor="#ffffe6">
               <td colspan="2">
                 <input type="submit" value="Validate Scantron Records" />
               </td>
             </tr>
           </table>
          </td>
        </form>
       </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>              <td>
               Format of data file: $format_selector                &nbsp;<b>Specify a Scantron data file to upload.</b>
     </td>              </td>
           </tr>            </tr>
           <tr bgcolor="#ffffe6">            <tr bgcolor="#ffffe6">
             <td>              <td>
 <!-- FIXME this is lazy, a single parse of the set should let me know what this is -->  SCANTRONFORM
               Last line to expect an answer on:       my $default_form_data=&defaultFormData(&get_symb_and_url($r,1));
                 <input type="text" name="scantron_maxbubble" />      my $cdom= $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
     </td>      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>            </tr>
         </table>          </table>
       </td>        </td>
     </tr>      </tr>
   SCANTRONFORM
       }
       $r->print(<<SCANTRONFORM);
       <tr>
         <form action='/adm/grades' name='scantron_download'>
           <td bgcolor="#777777">
             <input type="hidden" name="command" value="scantron_download" />
             <table width="100%" border="0">
               <tr bgcolor="#e6ffff">
                 <td colspan="2">
                   &nbsp;<b>Download a scoring office file</b>
                 </td>
               </tr>
               <tr bgcolor="#ffffe6">
                 <td> Filename of scoring office file: </td><td> $file_selector </td>
               </tr>
               <tr bgcolor="#ffffe6">
                 <td colspan="2">
                   <input type="submit" value="Show List of Files" />
                 </td>
               </tr>
             </table>
           </td>
         </form>
       </tr>
   SCANTRONFORM
   
       $r->print(<<SCANTRONFORM);
   </table>    </table>
   <input type="submit" value="Validate Scantron Records" />  
 </form>  
 $grading_menu_button  $grading_menu_button
 SCANTRONFORM  SCANTRONFORM
   
     return $result;      return
 }  }
   
 sub get_scantron_config {  sub get_scantron_config {
Line 3291  sub scantron_fixup_scanline { Line 3789  sub scantron_fixup_scanline {
     my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_;      my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_;
     if ($field eq 'ID') {      if ($field eq 'ID') {
  if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) {   if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) {
     return ($line,1,'New value to large');      return ($line,1,'New value too large');
  }   }
  if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) {   if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) {
     $args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s',      $args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s',
Line 3303  sub scantron_fixup_scanline { Line 3801  sub scantron_fixup_scanline {
     &scan_data($scan_data,"$whichline.user",      &scan_data($scan_data,"$whichline.user",
        $args->{'username'}.':'.$args->{'domain'});         $args->{'username'}.':'.$args->{'domain'});
  }   }
       } elsif ($field eq 'CODE') {
    if ($args->{'CODE_ignore_dup'}) {
       &scan_data($scan_data,"$whichline.CODE_ignore_dup",'1');
    }
    &scan_data($scan_data,"$whichline.useCODE",'1');
    if ($args->{'CODE'} ne 'use_unfound') {
       if (length($args->{'CODE'}) > $$scantron_config{'CODElength'}) {
    return ($line,1,'New CODE value too large');
       }
       if (length($args->{'CODE'}) < $$scantron_config{'CODElength'}) {
    $args->{'CODE'}=sprintf('%-'.$$scantron_config{'CODElength'}.'s',$args->{'CODE'});
       }
       substr($line,$$scantron_config{'CODEstart'}-1,
      $$scantron_config{'CODElength'})=$args->{'CODE'};
    }
     } elsif ($field eq 'answer') {      } elsif ($field eq 'answer') {
  my $length=$scantron_config->{'Qlength'};   my $length=$scantron_config->{'Qlength'};
  my $off=$scantron_config->{'Qoff'};   my $off=$scantron_config->{'Qoff'};
Line 3333  sub scan_data { Line 3846  sub scan_data {
 }  }
   
 sub scantron_parse_scanline {  sub scantron_parse_scanline {
     my ($line,$whichline,$scantron_config,$scan_data)=@_;      my ($line,$whichline,$scantron_config,$scan_data,$justHeader)=@_;
     my %record;      my %record;
     my $questions=substr($line,$$scantron_config{'Qstart'}-1);      my $questions=substr($line,$$scantron_config{'Qstart'}-1);
     my $data=substr($line,0,$$scantron_config{'Qstart'}-1);      my $data=substr($line,0,$$scantron_config{'Qstart'}-1);
     if ($$scantron_config{'CODElocation'} ne 0) {      if ($$scantron_config{'CODElocation'} ne 0) {
  if ($$scantron_config{'CODElocation'} < 0) {   if ($$scantron_config{'CODElocation'} < 0) {
     $record{'scantron.CODE'}=substr($data,$$scantron_config{'CODEstart'}-1,      $record{'scantron.CODE'}=substr($data,
       $$scantron_config{'CODEstart'}-1,
     $$scantron_config{'CODElength'});      $$scantron_config{'CODElength'});
       if (&scan_data($scan_data,"$whichline.useCODE")) {
    $record{'scantron.useCODE'}=1;
       }
       if (&scan_data($scan_data,"$whichline.CODE_ignore_dup")) {
    $record{'scantron.CODE_ignore_dup'}=1;
       }
  } else {   } else {
     #FIXME interpret first N questions      #FIXME interpret first N questions
  }   }
Line 3356  sub scantron_parse_scanline { Line 3876  sub scantron_parse_scanline {
     $record{'scantron.LastName'}=      $record{'scantron.LastName'}=
  substr($data,$$scantron_config{'LastName'}-1,   substr($data,$$scantron_config{'LastName'}-1,
        $$scantron_config{'LastNamelength'});         $$scantron_config{'LastNamelength'});
       if ($justHeader) { return \%record; }
   
     my @alphabet=('A'..'Z');      my @alphabet=('A'..'Z');
     my $questnum=0;      my $questnum=0;
     while ($questions) {      while ($questions) {
Line 3363  sub scantron_parse_scanline { Line 3885  sub scantron_parse_scanline {
  my $currentquest=substr($questions,0,$$scantron_config{'Qlength'});   my $currentquest=substr($questions,0,$$scantron_config{'Qlength'});
  substr($questions,0,$$scantron_config{'Qlength'})='';   substr($questions,0,$$scantron_config{'Qlength'})='';
  if (length($currentquest) < $$scantron_config{'Qlength'}) { next; }   if (length($currentquest) < $$scantron_config{'Qlength'}) { next; }
  my @array=split($$scantron_config{'Qon'},$currentquest,-1);   if ($$scantron_config{'Qon'} eq 'letter') {
  if (length($array[0]) eq $$scantron_config{'Qlength'}) {      if (!$currentquest || $currentquest eq $$scantron_config{'Qoff'} ||
     $record{"scantron.$questnum.answer"}='';   $currentquest !~ /^[A-Z]$/) {
     if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {   $record{"scantron.$questnum.answer"}='';
  push(@{$record{"scantron.missingerror"}},$questnum);   if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {
       push(@{$record{"scantron.missingerror"}},$questnum);
    }
       } else {
    $record{"scantron.$questnum.answer"}=$currentquest;
       }
    } elsif ($$scantron_config{'Qon'} eq 'number') {
       if (!$currentquest || $currentquest eq $$scantron_config{'Qoff'} ||
    $currentquest !~ /^\d$/) {
    $record{"scantron.$questnum.answer"}='';
    if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {
       push(@{$record{"scantron.missingerror"}},$questnum);
    }
       } else {
    $record{"scantron.$questnum.answer"}=
       $alphabet[$currentquest-1];
     }      }
  } else {   } else {
     $record{"scantron.$questnum.answer"}=$alphabet[length($array[0])];      my @array=split($$scantron_config{'Qon'},$currentquest,-1);
  }      if (length($array[0]) eq $$scantron_config{'Qlength'}) {
  if (scalar(@array) gt 2) {   $record{"scantron.$questnum.answer"}='';
     push(@{$record{'scantron.doubleerror'}},$questnum);   if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {
     my @ans=@array;      push(@{$record{"scantron.missingerror"}},$questnum);
     my $i=length($ans[0]);shift(@ans);   }
     while ($#ans) {      } else {
  $i+=length($ans[0])+1;   $record{"scantron.$questnum.answer"}=
  $record{"scantron.$questnum.answer"}.=$alphabet[$i];      $alphabet[length($array[0])];
  shift(@ans);      }
       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);
    }
     }      }
  }   }
     }      }
Line 3399  sub scantron_find_student { Line 3945  sub scantron_find_student {
     my ($scantron_record,$scan_data,$idmap,$line)=@_;      my ($scantron_record,$scan_data,$idmap,$line)=@_;
     my $scanID=$$scantron_record{'scantron.ID'};      my $scanID=$$scantron_record{'scantron.ID'};
     if ($scanID =~ /^\s*$/) {      if ($scanID =~ /^\s*$/) {
  return &scan_data($scan_data,"$line.user");    return &scan_data($scan_data,"$line.user");
     }      }
     foreach my $id (keys(%$idmap)) {      foreach my $id (keys(%$idmap)) {
  if (lc($id) eq lc($scanID)) {    if (lc($id) eq lc($scanID)) {
     return $$idmap{$id};       return $$idmap{$id};
  }    }
     }      }
     return undef;      return undef;
 }  }
   
 sub scantron_filter {  sub scantron_filter {
     my ($curres)=@_;      my ($curres)=@_;
     if (ref($curres) && $curres->is_problem() && !$curres->randomout) {                          # randomout is dysfunctional at best for this purpose
       if (ref($curres) && $curres->is_problem()) { #&& !$curres->randomout) {
  return 1;   return 1;
     }      }
     return 0;      return 0;
Line 3423  sub scantron_process_corrections { Line 3970  sub scantron_process_corrections {
     my ($scanlines,$scan_data)=&scantron_getfile();      my ($scanlines,$scan_data)=&scantron_getfile();
     my $classlist=&Apache::loncoursedata::get_classlist();      my $classlist=&Apache::loncoursedata::get_classlist();
     my $which=$ENV{'form.scantron_line'};      my $which=$ENV{'form.scantron_line'};
     my $line=&scantron_get_line($scanlines,$which);      my $line=&scantron_get_line($scanlines,$scan_data,$which);
     my ($skip,$err,$errmsg);      my ($skip,$err,$errmsg);
     if ($ENV{'form.scantron_skip_record'}) {      if ($ENV{'form.scantron_skip_record'}) {
  $skip=1;   $skip=1;
Line 3436  sub scantron_process_corrections { Line 3983  sub scantron_process_corrections {
      'ID',{'newid'=>$newid,       'ID',{'newid'=>$newid,
     'username'=>$ENV{'form.scantron_username'},      'username'=>$ENV{'form.scantron_username'},
     'domain'=>$ENV{'form.scantron_domain'}});      'domain'=>$ENV{'form.scantron_domain'}});
       } elsif ($ENV{'form.scantron_corrections'} =~ /^(duplicate|incorrect)CODE$/) {
    my $resolution=$ENV{'form.scantron_CODE_resolution'};
    my $newCODE;
    my %args;
    if      ($resolution eq 'use_unfound') {
       $newCODE='use_unfound';
    } elsif ($resolution eq 'use_found') {
       $newCODE=$ENV{'form.scantron_CODE_selectedvalue'};
    } elsif ($resolution eq 'use_typed') {
       $newCODE=$ENV{'form.scantron_CODE_newvalue'};
    } elsif ($resolution =~ /^use_closest_(\d+)/) {
       $newCODE=$ENV{"form.scantron_CODE_closest_$1"};
    }
    if ($ENV{'form.scantron_corrections'} eq 'duplicateCODE') {
       $args{'CODE_ignore_dup'}=1;
    }
    $args{'CODE'}=$newCODE;
    ($line,$err,$errmsg)=
       &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which,
        'CODE',\%args);
     } elsif ($ENV{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) {      } elsif ($ENV{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) {
  foreach my $question (split(',',$ENV{'form.scantron_questions'})) {   foreach my $question (split(',',$ENV{'form.scantron_questions'})) {
     ($line,$err,$errmsg)=      ($line,$err,$errmsg)=
Line 3449  sub scantron_process_corrections { Line 4016  sub scantron_process_corrections {
     if ($err) {      if ($err) {
  $r->print("Unable to accept last correction, an error occurred :$errmsg:");   $r->print("Unable to accept last correction, an error occurred :$errmsg:");
     } else {      } else {
  &scantron_put_line($scanlines,$which,$line,$skip);   &scantron_put_line($scanlines,$scan_data,$which,$line,$skip);
  &scantron_putfile($scanlines,$scan_data);   &scantron_putfile($scanlines,$scan_data);
     }      }
 }  }
   
   sub reset_skipping_status {
       my ($scanlines,$scan_data)=&scantron_getfile();
       &scan_data($scan_data,'remember_skipping',undef,1);
       &scantron_putfile(undef,$scan_data);
   }
   
   sub allow_skipping {
       my ($scan_data,$i)=@_;
       my %remembered=split(':',&scan_data($scan_data,'remember_skipping'));
       delete($remembered{$i});
       &scan_data($scan_data,'remember_skipping',join(':',%remembered));
   }
   
   sub should_be_skipped {
       my ($scan_data,$i)=@_;
       if ($ENV{'form.scantron_options_redo'} !~ /^redo_/) {
    # not redoing old skips
    return 0;
       }
       my %remembered=split(':',&scan_data($scan_data,'remember_skipping'));
       if (exists($remembered{$i})) { return 0; }
       return 1;
   }
   
   sub remember_current_skipped {
       my ($scanlines,$scan_data)=&scantron_getfile();
       my %to_remember;
       for (my $i=0;$i<=$scanlines->{'count'};$i++) {
    if ($scanlines->{'skipped'}[$i]) {
       $to_remember{$i}=1;
    }
       }
       &Apache::lonnet::logthis('remembering '.join(':',%to_remember));
       &scan_data($scan_data,'remember_skipping',join(':',%to_remember));
       &scantron_putfile(undef,$scan_data);
   }
   
   sub check_for_error {
       my ($r,$result)=@_;
       if ($result ne 'ok' && $result ne 'not_found' ) {
    $r->print("An error occured ($result) when trying to Remove the existing corrections.");
       }
   }
   
   sub scantron_warning_screen {
       my ($button_text)=@_;
       my $title=&Apache::lonnet::gettitle($ENV{'form.selectpage'});
       return (<<STUFF);
   <p>
   <font color="red">Please double check the information
                    below before clicking on '$button_text'</font>
   </p>
   <table>
   <tr><td><b>Sequence To be Graded:</b></td><td>$title</td></tr>
   <tr><td><b>Data File that will be used:</b></td><td><tt>$ENV{'form.scantron_selectfile'}</tt></td></tr>
   </table>
   </font>
   <br />
   <p> If this information is correct, please click on '$button_text'.</p>
   <p> If something is incorrect, please click the 'Grading Menu' button to start over.</p>
   
   <br />
   STUFF
   }
   
   sub scantron_do_warning {
       my ($r)=@_;
       my ($symb,$url)=&get_symb_and_url($r);
       if (!$symb) {return '';}
       my $default_form_data=&defaultFormData($symb,$url);
       $r->print(&scantron_form_start().$default_form_data);
       if ( $ENV{'form.selectpage'} eq '' ||
    $ENV{'form.scantron_selectfile'} eq '' ||
    $ENV{'form.scantron_format'} eq '' ) {
    $r->print("<p>You have forgetten to specify some information. Please go Back and try again.</p>");
    if ( $ENV{'form.selectpage'} eq '') {
       $r->print('<p><font color="red">You have not selected a Sequence to grade</font></p>');
    } 
    if ( $ENV{'form.scantron_selectfile'} eq '') {
       $r->print('<p><font color="red">You have not selected a file that contains the student\'s response data.</font></p>');
    } 
    if ( $ENV{'form.scantron_format'} eq '') {
       $r->print('<p><font color="red">You have not selected a the format of the student\'s response data.</font></p>');
    } 
       } else {
    my $warning=&scantron_warning_screen('Validate Records');
    $r->print(<<STUFF);
   $warning
   <input type="submit" name="submit" value="Validate Records" />
   <input type="hidden" name="command" value="scantron_validate" />
   STUFF
       }
       $r->print("</form><br />".&show_grading_menu_form($symb,$url)."</body></html>");
       return '';
   }
   
   sub scantron_form_start {
       my ($max_bubble)=@_;
       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="$max_bubble" />
     <input type="hidden" name="scantron_CODElist" value="$ENV{'form.scantron_CODElist'}" />
     <input type="hidden" name="scantron_CODEunique" value="$ENV{'form.scantron_CODEunique'}" />
     <input type="hidden" name="scantron_options_redo" value="$ENV{'form.scantron_options_redo'}" />
     <input type="hidden" name="scantron_options_ignore" value="$ENV{'form.scantron_options_ignore'}" />
   SCANTRONFORM
       return $result;
   }
   
 sub scantron_validate_file {  sub scantron_validate_file {
     my ($r) = @_;      my ($r) = @_;
     my ($symb,$url)=&get_symb_and_url($r);      my ($symb,$url)=&get_symb_and_url($r);
     if (!$symb) {return '';}      if (!$symb) {return '';}
     my $default_form_data=&defaultFormData($symb,$url);      my $default_form_data=&defaultFormData($symb,$url);
       
       # do the detection of only doing skipped records first befroe we delete
       # them  when doing the corrections reset
       if ($ENV{'form.scantron_options_redo'} ne 'redo_skipped_ready') {
    &reset_skipping_status();
       }
       if ($ENV{'form.scantron_options_redo'} eq 'redo_skipped') {
    &remember_current_skipped();
    &scantron_remove_file('skipped');
    $ENV{'form.scantron_options_redo'}='redo_skipped_ready';
       }
   
       if ($ENV{'form.scantron_options_ignore'} eq 'ignore_corrections') {
    &check_for_error($r,&scantron_remove_file('corrected'));
    &check_for_error($r,&scantron_remove_file('skipped'));
    &check_for_error($r,&scantron_remove_scan_data());
    $ENV{'form.scantron_options_ignore'}='done';
       }
   
     if ($ENV{'form.scantron_corrections'}) {      if ($ENV{'form.scantron_corrections'}) {
  &scantron_process_corrections($r);   &scantron_process_corrections($r);
     }      }
       $r->print("<p>Gathering neccessary info.</p>");$r->rflush();
     #get the student pick code ready      #get the student pick code ready
     $r->print(&Apache::loncommon::studentbrowser_javascript());      $r->print(&Apache::loncommon::studentbrowser_javascript());
     my $result= <<SCANTRONFORM;      my $max_bubble=&scantron_get_maxbubble($r);
 <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload">      my $result=&scantron_form_start($max_bubble).$default_form_data;
   <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);      $r->print($result);
           
     my @validate_phases=( 'ID',      my @validate_phases=( 'ID',
Line 3481  SCANTRONFORM Line 4172  SCANTRONFORM
   'doublebubble',    'doublebubble',
   'missingbubbles');    'missingbubbles');
     if (!$ENV{'form.validatepass'}) {      if (!$ENV{'form.validatepass'}) {
  $ENV{'form.valiadatepass'} = 0;   $ENV{'form.validatepass'} = 0;
     }      }
     my $currentphase=$ENV{'form.valiadatepass'};      my $currentphase=$ENV{'form.validatepass'};
   
     if ($ENV{'form.scantron_selectfile'}=~m-^/-) {  
  #first pass copy file to classdir  
   
     }  
     my $stop=0;      my $stop=0;
     while (!$stop && $currentphase < scalar(@validate_phases)) {      while (!$stop && $currentphase < scalar(@validate_phases)) {
  $r->print("<p> Validating ".$validate_phases[$currentphase]."</p>");   $r->print("<p> Validating ".$validate_phases[$currentphase]."</p>");
Line 3500  SCANTRONFORM Line 4187  SCANTRONFORM
  }   }
     }      }
     if (!$stop) {      if (!$stop) {
  $r->print("Validation process complete.<br />");   my $warning=&scantron_warning_screen('Start Grading');
  $r->print('<input type="submit" name="submit" value="Start Grading" />');   $r->print(<<STUFF);
  $r->print('<input type="hidden" name="command" value="scantron_process" />');  Validation process complete.<br />
   $warning
   <input type="submit" name="submit" value="Start Grading" />
   <input type="hidden" name="command" value="scantron_process" />
   STUFF
   
     } else {      } else {
  $r->print('<input type="hidden" name="command" value="scantron_validate" />');   $r->print('<input type="hidden" name="command" value="scantron_validate" />');
  $r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />");   $r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />");
Line 3518  SCANTRONFORM Line 4210  SCANTRONFORM
     return '';      return '';
 }  }
   
   sub scantron_remove_file {
       my ($which)=@_;
       my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
       my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
       my $file='scantron_';
       if ($which eq 'corrected' || $which eq 'skipped') {
    $file.=$which.'_';
       } else {
    return 'refused';
       }
       $file.=$ENV{'form.scantron_selectfile'};
       return &Apache::lonnet::removeuserfile($cname,$cdom,$file);
   }
   
   sub scantron_remove_scan_data {
       my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
       my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
       my @keys=&Apache::lonnet::getkeys('nohist_scantrondata',$cdom,$cname);
       my @todelete;
       my $filename=$ENV{'form.scantron_selectfile'};
       foreach my $key (@keys) {
    if ($key=~/^\Q$filename\E_/) {
       if ($ENV{'form.scantron_options_redo'} eq 'redo_skipped_ready' &&
    $key=~/remember_skipping/) {
    next;
       }
       push(@todelete,$key);
    }
       }
       my $result;
       if (@todelete) {
    $result=&Apache::lonnet::del('nohist_scantrondata',\@todelete,$cdom,$cname);
       }
       return $result;
   }
   
 sub scantron_getfile {  sub scantron_getfile {
     #FIXME really would prefer a scantron directory but tokenwrapper      #FIXME really would prefer a scantron directory
     # doesn't allow access to subdirs of userfiles  
     my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};      my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
     my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};      my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
     my $lines;      my $lines;
     $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.      $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
        'scantron_orig_'.$ENV{'form.scantron_selectfile'});         'scantron_orig_'.$ENV{'form.scantron_selectfile'});
     if ($lines eq '-1') {  
  #FIXME need to actually replicate file to course space  
  #FIXME when replicating strip CRLF to LF or CR to LF  
     }  
     my %scanlines;      my %scanlines;
     $scanlines{'orig'}=[(split("\n",$lines,-1))];      $scanlines{'orig'}=[(split("\n",$lines,-1))];
     my $temp=$scanlines{'orig'};      my $temp=$scanlines{'orig'};
Line 3549  sub scantron_getfile { Line 4272  sub scantron_getfile {
     } else {      } else {
  $scanlines{'skipped'}=[(split("\n",$lines,-1))];   $scanlines{'skipped'}=[(split("\n",$lines,-1))];
     }      }
     my @tmp=&Apache::lonnet::dump('scantrondata',$cdom,$cname);      my @tmp=&Apache::lonnet::dump('nohist_scantrondata',$cdom,$cname);
     if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); }      if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); }
     my %scan_data = @tmp;      my %scan_data = @tmp;
     return (\%scanlines,\%scan_data);      return (\%scanlines,\%scan_data);
Line 3567  sub lonnet_putfile { Line 4290  sub lonnet_putfile {
   
 sub scantron_putfile {  sub scantron_putfile {
     my ($scanlines,$scan_data) = @_;      my ($scanlines,$scan_data) = @_;
     #FIXME really would prefer a scantron directory but tokenwrapper      #FIXME really would prefer a scantron directory
     # doesn't allow access to subdirs of userfiles  
     my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};      my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
     my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};      my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
     my $prefix='scantron_';      if ($scanlines) {
    my $prefix='scantron_';
 # no need to update orig, shouldn't change  # no need to update orig, shouldn't change
 #   &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'.  #   &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'.
 #    $ENV{'form.scantron_selectfile'});  #    $ENV{'form.scantron_selectfile'});
     &lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}),   &lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}),
     $prefix.'corrected_'.   $prefix.'corrected_'.
     $ENV{'form.scantron_selectfile'});   $ENV{'form.scantron_selectfile'});
     &lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}),   &lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}),
     $prefix.'skipped_'.   $prefix.'skipped_'.
     $ENV{'form.scantron_selectfile'});   $ENV{'form.scantron_selectfile'});
     &Apache::lonnet::put('scantrondata',$scan_data,$cdom,$cname);      }
       &Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname);
 }  }
   
 sub scantron_get_line {  sub scantron_get_line {
     my ($scanlines,$i)=@_;      my ($scanlines,$scan_data,$i)=@_;
     if ($scanlines->{'skipped'}[$i]) {return undef;}      if (&should_be_skipped($scan_data,$i)) { return undef; }
       if ($scanlines->{'skipped'}[$i]) { return undef; }
     if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];}      if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];}
     return $scanlines->{'orig'}[$i];       return $scanlines->{'orig'}[$i]; 
 }  }
   
   sub get_todo_count {
       my ($scanlines,$scan_data)=@_;
       my $count=0;
       for (my $i=0;$i<=$scanlines->{'count'};$i++) {
    my $line=&scantron_get_line($scanlines,$scan_data,$i);
    if ($line=~/^[\s\cz]*$/) { next; }
    $count++;
       }
       return $count;
   }
   
 sub scantron_put_line {  sub scantron_put_line {
     my ($scanlines,$i,$newline,$skip)=@_;      my ($scanlines,$scan_data,$i,$newline,$skip)=@_;
     if ($skip) {      if ($skip) {
  $scanlines->{'skipped'}[$i]=$newline;   $scanlines->{'skipped'}[$i]=$newline;
    &allow_skipping($scan_data,$i);
  return;   return;
     }      }
     $scanlines->{'corrected'}[$i]=$newline;      $scanlines->{'corrected'}[$i]=$newline;
Line 3613  sub scantron_validate_ID { Line 4350  sub scantron_validate_ID {
   
     my %found=('ids'=>{},'usernames'=>{});      my %found=('ids'=>{},'usernames'=>{});
     for (my $i=0;$i<=$scanlines->{'count'};$i++) {      for (my $i=0;$i<=$scanlines->{'count'};$i++) {
  my $line=&scantron_get_line($scanlines,$i);   my $line=&scantron_get_line($scanlines,$scan_data,$i);
  if ($line=~/^[\s\cz]*$/) { next; }   if ($line=~/^[\s\cz]*$/) { next; }
  my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,   my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
  $scan_data);   $scan_data);
Line 3627  sub scantron_validate_ID { Line 4364  sub scantron_validate_ID {
     if ($found{'ids'}{$found}) {      if ($found{'ids'}{$found}) {
  &scantron_get_correction($r,$i,$scan_record,\%scantron_config,   &scantron_get_correction($r,$i,$scan_record,\%scantron_config,
  $line,'duplicateID',$found);   $line,'duplicateID',$found);
  return(1);   return(1,$currentphase);
     } elsif ($found{'usernames'}{$username}) {      } elsif ($found{'usernames'}{$username}) {
  &scantron_get_correction($r,$i,$scan_record,\%scantron_config,   &scantron_get_correction($r,$i,$scan_record,\%scantron_config,
  $line,'duplicateID',$username);   $line,'duplicateID',$username);
  return(1);   return(1,$currentphase);
     }      }
     #FIXME store away line we prviously saw the ID on to use above      #FIXME store away line we previously saw the ID on to use above
     $found{'ids'}{$found}++;      $found{'ids'}{$found}++;
     $found{'usernames'}{$username}++;      $found{'usernames'}{$username}++;
  } else {   } else {
Line 3643  sub scantron_validate_ID { Line 4380  sub scantron_validate_ID {
     &scantron_get_correction($r,$i,$scan_record,      &scantron_get_correction($r,$i,$scan_record,
      \%scantron_config,       \%scantron_config,
      $line,'duplicateID',$username);       $line,'duplicateID',$username);
     return(1);      return(1,$currentphase);
  } elsif (!defined($username)) {   } elsif (!defined($username)) {
     &scantron_get_correction($r,$i,$scan_record,      &scantron_get_correction($r,$i,$scan_record,
      \%scantron_config,       \%scantron_config,
      $line,'incorrectID');       $line,'incorrectID');
     return(1);      return(1,$currentphase);
  }   }
  $found{'usernames'}{$username}++;   $found{'usernames'}{$username}++;
     } else {      } else {
  &scantron_get_correction($r,$i,$scan_record,\%scantron_config,   &scantron_get_correction($r,$i,$scan_record,\%scantron_config,
  $line,'incorrectID');   $line,'incorrectID');
  return(1);   return(1,$currentphase);
     }      }
  }   }
     }      }
Line 3669  sub scantron_get_correction { Line 4406  sub scantron_get_correction {
 #to show both the current line and the previous one and allow skipping  #to show both the current line and the previous one and allow skipping
 #the previous one or the current one  #the previous one or the current one
   
     $r->print("<p>An error was detected ($error) ");      $r->print("<p><b>An error was detected ($error)</b>");
     if ( defined($$scan_record{'scantron.PaperID'}) ) {      if ( defined($$scan_record{'scantron.PaperID'}) ) {
  $r->print(" for PaperID <tt>".   $r->print(" for PaperID <tt>".
   $$scan_record{'scantron.PaperID'}."</tt> \n");    $$scan_record{'scantron.PaperID'}."</tt> \n");
Line 3677  sub scantron_get_correction { Line 4414  sub scantron_get_correction {
  $r->print(" in scanline $i <pre>".   $r->print(" in scanline $i <pre>".
   $line."</pre> \n");    $line."</pre> \n");
     }      }
       my $message="<p>The ID on the form is  <tt>".
    $$scan_record{'scantron.ID'}."</tt><br />\n".
    "The name on the paper is ".
    $$scan_record{'scantron.LastName'}.",".
    $$scan_record{'scantron.FirstName'}."</p>";
   
     $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n");      $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n");
     $r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n");      $r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n");
     if ($error =~ /ID$/) {      if ($error =~ /ID$/) {
  if ($error eq 'unknownID') {   if ($error eq 'incorrectID') {
     $r->print("The encoded ID is not in the classlist</p>\n");      $r->print("The encoded ID is not in the classlist</p>\n");
  } elsif ($error eq 'duplicateID') {   } elsif ($error eq 'duplicateID') {
     $r->print("The encoded ID has also been used by a previous paper $arg</p>\n");      $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>".   $r->print($message);
   $$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("<p>How should I handle this? <br /> \n");
  $r->print("\n<ul><li> ");   $r->print("\n<ul><li> ");
  #FIXME it would be nice if this sent back the user ID and   #FIXME it would be nice if this sent back the user ID and
Line 3698  sub scantron_get_correction { Line 4437  sub scantron_get_correction {
        'scantron_username','scantron_domain'));         'scantron_username','scantron_domain'));
  $r->print(": <input type='text' name='scantron_username' value='' />");   $r->print(": <input type='text' name='scantron_username' value='' />");
  $r->print("\n@".   $r->print("\n@".
  &Apache::loncommon::select_dom_form(undef,'scantron_domain'));   &Apache::loncommon::select_dom_form($ENV{'request.role.domain'},'scantron_domain'));
   
  $r->print('</li>');   $r->print('</li>');
       } elsif ($error =~ /CODE$/) {
    if ($error eq 'incorrectCODE') {
       $r->print("</p><p>The encoded CODE is not in the list of possible CODEs</p>\n");
    } elsif ($error eq 'duplicateCODE') {
       $r->print("</p><p>The encoded CODE has also been used by a previous paper ".join(', ',@{$arg}).", and CODEs are supposed to be unique</p>\n");
    }
    $r->print("<p>The CODE on the form is  <tt>'".
     $$scan_record{'scantron.CODE'}."'</tt><br />\n");
    $r->print($message);
    $r->print("<p>How should I handle this? <br /> \n");
    $r->print("\n<br /> ");
    my $i=0;
    if ($error eq 'incorrectCODE') {
       my ($max,$closest)=&scantron_get_closely_matching_CODEs($arg,$$scan_record{'scantron.CODE'});
       foreach my $testcode (@{$closest}) {
    my $checked='';
    if (!$i) { $checked=' checked="on" '; }
    $r->print("<input type='radio' name='scantron_CODE_resolution' value='use_closest_$i' $checked /> Use the similar CODE <b><tt>".$testcode."</tt></b> instead.<input type='hidden' name='scantron_CODE_closest_$i' value='$testcode' />");
    $r->print("\n<br />");
    $i++;
       }
    }
    my $checked; if (!$i) { $checked=' checked="on" '; }
    $r->print("<input type='radio' name='scantron_CODE_resolution' value='use_unfound' $checked /> Use the CODE <b><tt>".$$scan_record{'scantron.CODE'}."</tt></b> that is was on the paper, ignoring the error.");
    $r->print("\n<br />");
   
    $r->print(<<ENDSCRIPT);
   <script type="text/javascript">
   function change_radio(field) {
       var slct=document.scantronupload.scantron_CODE_resolution;
       var i;
       for (i=0;i<slct.length;i++) {
           if (slct[i].value==field) { slct[i].checked=true; }
       }
   }
   </script>
   ENDSCRIPT
    my $href="/adm/pickcode?".
      "form=".&Apache::lonnet::escape("scantronupload").
      "&scantron_format=".&Apache::lonnet::escape($ENV{'form.scantron_format'}).
      "&scantron_CODElist=".&Apache::lonnet::escape($ENV{'form.scantron_CODElist'}).
      "&curCODE=".&Apache::lonnet::escape($$scan_record{'scantron.CODE'}).
      "&scantron_selectfile=".&Apache::lonnet::escape($ENV{'form.scantron_selectfile'});
    $r->print("<input type='radio' name='scantron_CODE_resolution' value='use_found' /> <a target='_blank' href='$href'>Select</a> a CODE from the list of all CODEs and use it. Selected CODE is <input readonly='true' type='text' size='8' name='scantron_CODE_selectedvalue' onfocus=\"javascript:change_radio('use_found')\" onchange=\"javascript:change_radio('use_found')\" />");
    $r->print("\n<br />");
    $r->print("<input type='radio' name='scantron_CODE_resolution' value='use_typed' /> Use <input type='text' size='8' name='scantron_CODE_newvalue' onfocus=\"javascript:change_radio('use_typed')\" onkeypress=\"javascript:change_radio('use_typed')\" /> as the CODE.");
    $r->print("\n<br /><br />");
     } elsif ($error eq 'doublebubble') {      } 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("<p>There have been multiple bubbles scanned for a some question(s)</p>\n");
  $r->print('<input type="hidden" name="scantron_questions" value="'.   $r->print('<input type="hidden" name="scantron_questions" value="'.
   join(',',@{$arg}).'" />');    join(',',@{$arg}).'" />');
    $r->print($message);
  $r->print("<p>Please indicate which bubble should be used for grading</p>");   $r->print("<p>Please indicate which bubble should be used for grading</p>");
  foreach my $question (@{$arg}) {   foreach my $question (@{$arg}) {
     my $selected=$$scan_record{"scantron.$question.answer"};      my $selected=$$scan_record{"scantron.$question.answer"};
Line 3713  sub scantron_get_correction { Line 4499  sub scantron_get_correction {
  }   }
     } elsif ($error eq 'missingbubble') {      } elsif ($error eq 'missingbubble') {
  $r->print("<p>There have been <b>no</b> bubbles scanned for some question(s)</p>\n");   $r->print("<p>There have been <b>no</b> bubbles scanned for some question(s)</p>\n");
    $r->print($message);
  $r->print("<p>Please indicate which bubble should be used for grading</p>");   $r->print("<p>Please indicate which bubble should be used for grading</p>");
  $r->print("Some questions have no scanned bubbles\n");   $r->print("Some questions have no scanned bubbles\n");
  $r->print('<input type="hidden" name="scantron_questions" value="'.   $r->print('<input type="hidden" name="scantron_questions" value="'.
Line 3749  sub scantron_bubble_selector { Line 4536  sub scantron_bubble_selector {
     $r->print('</tr></table>');      $r->print('</tr></table>');
 }  }
   
   sub num_matches {
       my ($orig,$code) = @_;
       my @code=split(//,$code);
       my @orig=split(//,$orig);
       my $same=0;
       for (my $i=0;$i<scalar(@code);$i++) {
    if ($code[$i] eq $orig[$i]) { $same++; }
       }
       return $same;
   }
   
   sub scantron_get_closely_matching_CODEs {
       my ($allcodes,$CODE)=@_;
       my @CODEs;
       foreach my $testcode (sort(keys(%{$allcodes}))) {
    push(@{$CODEs[&num_matches($CODE,$testcode)]},$testcode);
       }
   
       return ($#CODEs,$CODEs[-1]);
   }
   
   sub get_codes {
       my $old_name=$ENV{'form.scantron_CODElist'};
       my $cdom =$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
       my $cnum =$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
       my %result=&Apache::lonnet::get('CODEs',[$old_name],$cdom,$cnum);
       my %allcodes=map {(&Apache::lonprintout::num_to_letters($_),1)} split(',',$result{$old_name});
       return %allcodes;
   }
   
 sub scantron_validate_CODE {  sub scantron_validate_CODE {
     my ($r,$currentphase) = @_;      my ($r,$currentphase) = @_;
     #FIXME doesn't do anything yet      my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
       if ($scantron_config{'CODElocation'} &&
    $scantron_config{'CODEstart'} &&
    $scantron_config{'CODElength'}) {
    if (!defined($ENV{'form.scantron_CODElist'})) {
       &FIXME_blow_up()
    }
       } else {
    return (0,$currentphase+1);
       }
       
       my %usedCODEs;
   
       my %allcodes=&get_codes();
   
       my ($scanlines,$scan_data)=&scantron_getfile();
       for (my $i=0;$i<=$scanlines->{'count'};$i++) {
    my $line=&scantron_get_line($scanlines,$scan_data,$i);
    if ($line=~/^[\s\cz]*$/) { next; }
    my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
    $scan_data);
    my $CODE=$$scan_record{'scantron.CODE'};
    my $error=0;
    if (!&Apache::lonnet::validCODE($CODE)) {
       &scantron_get_correction($r,$i,$scan_record,
        \%scantron_config,
        $line,'incorrectCODE',\%allcodes);
       return(1,$currentphase);
    }
    if (%allcodes && !exists($allcodes{$CODE}) 
       && !$$scan_record{'scantron.useCODE'}) {
       &scantron_get_correction($r,$i,$scan_record,
        \%scantron_config,
        $line,'incorrectCODE',\%allcodes);
       return(1,$currentphase);
    }
    if (exists($usedCODEs{$CODE}) 
       && $ENV{'form.scantron_CODEunique'} eq 'yes'
       && !$$scan_record{'scantron.CODE_ignore_dup'}) {
       &scantron_get_correction($r,$i,$scan_record,
        \%scantron_config,
        $line,'duplicateCODE',$usedCODEs{$CODE});
       return(1,$currentphase);
    }
    push (@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'});
       }
     return (0,$currentphase+1);      return (0,$currentphase+1);
 }  }
   
Line 3765  sub scantron_validate_doublebubble { Line 4627  sub scantron_validate_doublebubble {
     my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});      my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
     my ($scanlines,$scan_data)=&scantron_getfile();      my ($scanlines,$scan_data)=&scantron_getfile();
     for (my $i=0;$i<=$scanlines->{'count'};$i++) {      for (my $i=0;$i<=$scanlines->{'count'};$i++) {
  my $line=&scantron_get_line($scanlines,$i);   my $line=&scantron_get_line($scanlines,$scan_data,$i);
  if ($line=~/^[\s\cz]*$/) { next; }   if ($line=~/^[\s\cz]*$/) { next; }
  my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,   my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
  $scan_data);   $scan_data);
Line 3778  sub scantron_validate_doublebubble { Line 4640  sub scantron_validate_doublebubble {
     return (0,$currentphase+1);      return (0,$currentphase+1);
 }  }
   
   sub scantron_get_maxbubble {
       my ($r)=@_;
       if (defined($ENV{'form.scantron_maxbubble'}) &&
    $ENV{'form.scantron_maxbubble'}) {
    return $ENV{'form.scantron_maxbubble'};
       }
       my $navmap=Apache::lonnavmaps::navmap->new();
       my (undef,undef,$sequence)=
    &Apache::lonnet::decode_symb($ENV{'form.selectpage'});
       my $map=$navmap->getResourceByUrl($sequence);
       my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
       &Apache::lonnet::delenv('form.counter');
       foreach my $resource (@resources) {
    my $result=&Apache::lonnet::ssi($resource->src().'?symb='.&Apache::lonnet::escape($resource->symb()));
       }
       &Apache::lonnet::delenv('scantron\.');
       my $envfile=$ENV{'user.environment'};
       $envfile=~/\/([^\/]+)\.id$/;
       $envfile=$1;
       &Apache::lonnet::transfer_profile_to_env($r->dir_config('lonIDsDir'),
        $envfile);
       $ENV{'form.scantron_maxbubble'}=$ENV{'form.counter'}-1;
       return $ENV{'form.scantron_maxbubble'};
   }
   
 sub scantron_validate_missingbubbles {  sub scantron_validate_missingbubbles {
     my ($r,$currentphase) = @_;      my ($r,$currentphase) = @_;
     #get student info      #get student info
Line 3787  sub scantron_validate_missingbubbles { Line 4674  sub scantron_validate_missingbubbles {
     #get scantron line setup      #get scantron line setup
     my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});      my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
     my ($scanlines,$scan_data)=&scantron_getfile();      my ($scanlines,$scan_data)=&scantron_getfile();
     my $max_bubble=$ENV{'form.scantron_maxbubble'};      my $max_bubble=&scantron_get_maxbubble();
     if (!$max_bubble) { $max_bubble=2**31; }      if (!$max_bubble) { $max_bubble=2**31; }
     for (my $i=0;$i<=$scanlines->{'count'};$i++) {      for (my $i=0;$i<=$scanlines->{'count'};$i++) {
  my $line=&scantron_get_line($scanlines,$i);   my $line=&scantron_get_line($scanlines,$scan_data,$i);
  if ($line=~/^[\s\cz]*$/) { next; }   if ($line=~/^[\s\cz]*$/) { next; }
  my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,   my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
  $scan_data);   $scan_data);
Line 3812  sub scantron_validate_missingbubbles { Line 4699  sub scantron_validate_missingbubbles {
   
 sub scantron_process_students {  sub scantron_process_students {
     my ($r) = @_;      my ($r) = @_;
     my (undef,undef,$sequence)=split(/___/,$ENV{'form.selectpage'});      my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($ENV{'form.selectpage'});
     my ($symb,$url)=&get_symb_and_url($r);      my ($symb,$url)=&get_symb_and_url($r);
     if (!$symb) {return '';}      if (!$symb) {return '';}
     my $default_form_data=&defaultFormData($symb,$url);      my $default_form_data=&defaultFormData($symb,$url);
Line 3821  sub scantron_process_students { Line 4708  sub scantron_process_students {
     my ($scanlines,$scan_data)=&scantron_getfile();      my ($scanlines,$scan_data)=&scantron_getfile();
     my $classlist=&Apache::loncoursedata::get_classlist();      my $classlist=&Apache::loncoursedata::get_classlist();
     my %idmap=&username_to_idmap($classlist);      my %idmap=&username_to_idmap($classlist);
     my $navmap=Apache::lonnavmaps::navmap->new($ENV{'request.course.fn'}.'.db',$ENV{'request.course.fn'}.'_parms.db',1, 1);      my $navmap=Apache::lonnavmaps::navmap->new();
     my $map=$navmap->getResourceByUrl($sequence);      my $map=$navmap->getResourceByUrl($sequence);
     my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);      my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
 #    $r->print("geto ".scalar(@resources)."<br />");  #    $r->print("geto ".scalar(@resources)."<br />");
Line 3835  SCANTRONFORM Line 4722  SCANTRONFORM
     my @delayqueue;      my @delayqueue;
     my %completedstudents;      my %completedstudents;
           
       my $count=&get_todo_count($scanlines,$scan_data);
     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status',      my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status',
     'Scantron Progress',$scanlines->{'count'});       'Scantron Progress',$count,
       'inline',undef,'scantronupload');
     &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,      &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
   'Processing first student');    'Processing first student');
     my $start=&Time::HiRes::time();      my $start=&Time::HiRes::time();
     my $i=-1;      my $i=-1;
     my ($uname,$udom);      my ($uname,$udom,$started);
     while ($i<$scanlines->{'count'}) {      while ($i<$scanlines->{'count'}) {
  ($uname,$udom)=('','');    ($uname,$udom)=('','');
  $i++;    $i++;
  my $line=&scantron_get_line($scanlines,$i);    my $line=&scantron_get_line($scanlines,$scan_data,$i);
 # $r->print('<pre>line is'.$line.'</pre>');    if ($line=~/^[\s\cz]*$/) { next; }
  if ($line=~/^[\s\cz]*$/) { next; }   if ($started) {
  my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,      &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
  $scan_data);       'last student');
  unless ($uname=&scantron_find_student($scan_record,$scan_data,   }
       \%idmap,$i)) {   $started=1;
     &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) {   foreach my $resource (@resources) {
     $i++;      $i++;
     my $result=&Apache::lonnet::ssi($resource->src(),      my %form=('submitted'     =>'scantron',
  ('submitted'     =>'scantron',        'grade_target'  =>'grade',
   'grade_target'  =>'grade',        'grade_username'=>$uname,
   'grade_username'=>$uname,        'grade_domain'  =>$udom,
   'grade_domain'  =>$udom,        'grade_courseid'=>$ENV{'request.course.id'},
   'grade_courseid'=>$ENV{'request.course.id'},        'grade_symb'    =>$resource->symb());
   'grade_symb'    =>$resource->symb()));      if (exists($scan_record->{'scantron.CODE'}) &&
 #    my %score=&Apache::lonnet::restore($resource->symb(),   $scan_record->{'scantron.CODE'}) {
 #       $ENV{'request.course.id'},   $form{'CODE'}=$scan_record->{'scantron.CODE'};
 #       $udom,$uname);      } else {
 #    foreach my $part ($resource->{PARTS}) {   $form{'CODE'}='';
 # if ($score{'resource.'.$part.'.solved'} =~ /^correct/) {      }
 #    $studentcorrect++;      my $result=&Apache::lonnet::ssi($resource->src(),%form);
 #    $totalcorrect++;      if ($result ne '') {
 # } else {   &Apache::lonnet::logthis("scantron grading error -> $result");
 #    $studentincorrect++;   &Apache::lonnet::logthis("scantron grading error info name $uname domain $udom course $ENV{'request.course.id'} url ".$resource->src());
 #    $totalincorrect++;      }
 # }      if (&Apache::loncommon::connection_aborted($r)) { last; }
 #    }  
 #    $r->print('<pre>'.  
 #      $resource->symb().'-'.  
 #      $resource->src().'-'.'</pre>result is'.$result);  
 #    &Apache::lonhomework::showhash(%score);  
  #    if ($i eq 3) {last;}  
  }   }
  $completedstudents{$uname}={'line'=>$line};   $completedstudents{$uname}={'line'=>$line};
    if (&Apache::loncommon::connection_aborted($r)) { last; }
     } continue {      } continue {
  &Apache::lonnet::delenv('form.counter');   &Apache::lonnet::delenv('form.counter');
  &Apache::lonnet::delenv('scantron\.');   &Apache::lonnet::delenv('scantron\.');
  &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,$uname);  
  #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);      &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;      $r->print("</form>");
     foreach my $delay (@delayqueue) {  
  #FIXME  
  #print out each delayed student with interface to select how  
  #  to repair student provided info  
  #Expected errors include  
  #  1 bad/no stuid/username  
  #  2 invalid bubblings  
   
     }  
     #FIXME  
     # if delay queue exists 2 submits one to process delayed students one  
     #     to ignore delayed students, possibly saving the delay queue for later  
       
     $navmap->untieHashes();  
     $r->print("<p>Done</p>");  
     $r->print(&show_grading_menu_form($symb,$url));      $r->print(&show_grading_menu_form($symb,$url));
     return '';      return '';
 }  }
Line 3938  sub scantron_upload_scantron_data { Line 4799  sub scantron_upload_scantron_data {
     my ($r)=@_;      my ($r)=@_;
     $r->print(&Apache::loncommon::coursebrowser_javascript($ENV{'request.role.domain'}));      $r->print(&Apache::loncommon::coursebrowser_javascript($ENV{'request.role.domain'}));
     my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid',      my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid',
   'domainid');    'domainid',
     'coursename');
     my $domsel=&Apache::loncommon::select_dom_form($ENV{'request.role.domain'},      my $domsel=&Apache::loncommon::select_dom_form($ENV{'request.role.domain'},
    'domainid');     'domainid');
       my $default_form_data=&defaultFormData(&get_symb_and_url($r,1));
     $r->print(<<UPLOAD);      $r->print(<<UPLOAD);
 <script type="text/javascript" language="javascript">  <script type="text/javascript" language="javascript">
     function checkUpload(formname) {      function checkUpload(formname) {
Line 3953  sub scantron_upload_scantron_data { Line 4816  sub scantron_upload_scantron_data {
 </script>  </script>
   
 <form enctype='multipart/form-data' action='/adm/grades' name='rules' method='post'>  <form enctype='multipart/form-data' action='/adm/grades' name='rules' method='post'>
 Course: <input name='courseid' type='text' />  $default_form_data
 Domain: $domsel $select_link  <table>
 <br />  <tr><td>$select_link </td></tr>
   <tr><td>Course ID:   </td><td><input name='courseid' type='text' />  </td></tr>
   <tr><td>Course Name: </td><td><input name='coursename' type='text' /></td></tr>
   <tr><td>Domain:      </td><td>$domsel                                </td></tr>
   <tr><td>File to upload:</td><td><input type="file" name="upfile" size="50" /></td></tr>
   </table>
 <input name='command' value='scantronupload_save' type='hidden' />  <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" />  <input type="button" onClick="javascript:checkUpload(this.form);" value="Upload Scantron Data" />
 </form>  </form>
 UPLOAD  UPLOAD
Line 3967  UPLOAD Line 4833  UPLOAD
   
 sub scantron_upload_scantron_data_save {  sub scantron_upload_scantron_data_save {
     my($r)=@_;      my($r)=@_;
     $r->print("Doing upload to ".$ENV{'form.courseid'});      my ($symb,$url)=&get_symb_and_url($r,1);
       my $doanotherupload=
    '<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";
       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 />");
    if ($symb) {
       $r->print(&show_grading_menu_form($symb,$url));
    } else {
       $r->print($doanotherupload);
    }
    return '';
       }
       my %coursedata=&Apache::lonnet::coursedescription($ENV{'form.domainid'}.'_'.$ENV{'form.courseid'});
       $r->print("Doing upload to ".$coursedata{'description'}." <br />");
     my $home=&Apache::lonnet::homeserver($ENV{'form.courseid'},      my $home=&Apache::lonnet::homeserver($ENV{'form.courseid'},
  $ENV{'form.domainid'});   $ENV{'form.domainid'});
     my $fname=$ENV{'form.upfile.filename'};      my $fname=$ENV{'form.upfile.filename'};
Line 3984  sub scantron_upload_scantron_data_save { Line 4868  sub scantron_upload_scantron_data_save {
     $fname=~s/[^\w\.\-]//g;      $fname=~s/[^\w\.\-]//g;
     # See if there is anything left      # See if there is anything left
     unless ($fname) { return 'error: no uploaded file'; }      unless ($fname) { return 'error: no uploaded file'; }
       my $uploadedfile=$fname;
     $fname='scantron_orig_'.$fname;      $fname='scantron_orig_'.$fname;
     &Apache::lonnet::logthis("fname is $fname");      if (length($ENV{'form.upfile'}) < 2) {
     $r->print(&Apache::lonnet::finishuserfileupload($ENV{'form.courseid'},   $r->print("<font color='red'>Error:</font> The file you attempted to upload, <tt>".&HTML::Entities::encode($ENV{'form.upfile.filename'},'<>&"')."</tt>, contained no information. Please check that you entered the correct filename.");
     $ENV{'form.domainid'},      } else {
     $home,'upfile',$fname));   my $result=&Apache::lonnet::finishuserfileupload($ENV{'form.courseid'},$ENV{'form.domainid'},$home,'upfile',$fname);
    if ($result =~ m|^/uploaded/|) {
       $r->print("<font color='green'>Success:</font> Successfully uploaded ".(length($ENV{'form.upfile'})-1)." bytes of data into location <tt>".$result."</tt>");
    } else {
       $r->print("<font color='red'>Error:</font> An error (".$result.") occurred when attempting to upload the file, <tt>".&HTML::Entities::encode($ENV{'form.upfile.filename'},'<>&"')."</tt>");
    }
       }
       if ($symb) {
    $r->print(&scantron_selectphase($r,$uploadedfile));
       } else {
    $r->print($doanotherupload);
       }
     return '';      return '';
 }  }
   
   sub valid_file {
       my ($requested_file)=@_;
       foreach my $filename (sort(&scantron_filenames())) {
    &Apache::lonnet::logthis("$requested_file  $filename");
    if ($requested_file eq $filename) { return 1; }
       }
       return 0;
   }
   
   sub scantron_download_scantron_data {
       my ($r)=@_;
       my $default_form_data=&defaultFormData(&get_symb_and_url($r,1));
       my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
       my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
       my $file=$ENV{'form.scantron_selectfile'};
       if (! &valid_file($file)) {
    $r->print(<<ERROR);
    <p>
       The requested file name was invalid.
           </p>
   ERROR
    $r->print(&show_grading_menu_form(&get_symb_and_url($r,1)));
    return;
       }
       my $orig='/uploaded/'.$cdom.'/'.$cname.'/scantron_orig_'.$file;
       my $corrected='/uploaded/'.$cdom.'/'.$cname.'/scantron_corrected_'.$file;
       my $skipped='/uploaded/'.$cdom.'/'.$cname.'/scantron_skipped_'.$file;
       &Apache::lonnet::allowuploaded('/adm/grades',$orig);
       &Apache::lonnet::allowuploaded('/adm/grades',$corrected);
       &Apache::lonnet::allowuploaded('/adm/grades',$skipped);
       $r->print(<<DOWNLOAD);
       <p>
    <a href="$orig">Original</a> file as uploaded by the scantron office.
       </p>
       <p>
    <a href="$corrected">Corrections</a>, a file of corrected records that were used in grading.
       </p>
       <p>
    <a href="$skipped">Skipped</a>, a file of records that were skipped.
       </p>
   DOWNLOAD
       $r->print(&show_grading_menu_form(&get_symb_and_url($r,1)));
       return '';
   }
   
 #-------- end of section for handling grading scantron forms -------  #-------- end of section for handling grading scantron forms -------
 #  #
 #-------------------------------------------------------------------  #-------------------------------------------------------------------
   
   
 #-------------------------- Menu interface -------------------------  #-------------------------- Menu interface -------------------------
 #  #
 #--- Show a Grading Menu button - Calls the next routine ---  #--- Show a Grading Menu button - Calls the next routine ---
Line 4044  sub gradingmenu { Line 4983  sub gradingmenu {
  }   }
  formname.command.value = cmd;   formname.command.value = cmd;
  formname.saveState.value = "saveCmd="+cmdsave+":saveSec="+pullDownSelection(formname.section)+   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) formname.submit();
  if (val == 5) {   if (val == 5) {
     if (!checkReceiptNo(formname,'notOK')) { return false;}      if (!checkReceiptNo(formname,'notOK')) { return false;}
     formname.submit();      formname.submit();
  }   }
    if (val < 7) formname.submit();
     }      }
   
     function checkReceiptNo(formname,nospace) {      function checkReceiptNo(formname,nospace) {
Line 4095  GRADINGMENUJS Line 5035  GRADINGMENUJS
   
     $result.='<table width="100%" border=0>';      $result.='<table width="100%" border=0>';
     $result.='<tr bgcolor="#ffffe6" valign="top"><td>'."\n".      $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)) {      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.= '<option value="all" '.($saveSec eq 'all' ? 'selected="on"' : ''). '>all</option></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)) {  
  $result.='&nbsp;(Section "no" implies the students were not assigned a section.)<br />'   
     if (grep /no/,@$sections);  
     }  
     $result.='</td></tr>';      $result.='</td></tr>';
   
     $result.='<tr bgcolor="#ffffe6"valign="top"><td>'.      $result.='<tr bgcolor="#ffffe6"valign="top"><td>'.
  '<input type="radio" name="radioChoice" value="submission" '.   '<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>'.      $result.='<tr bgcolor="#ffffe6"valign="top"><td>'.
  '<input type="radio" name="radioChoice" value="viewgrades" '.   '<input type="radio" name="radioChoice" value="viewgrades" '.
Line 4137  GRADINGMENUJS Line 5079  GRADINGMENUJS
   
     $result.='<table width="100%" border=0>';      $result.='<table width="100%" border=0>';
     $result.='<tr bgcolor="#ffffe6"><td>'.      $result.='<tr bgcolor="#ffffe6"><td>'.
  '<input type="button" onClick="javascript:checkChoice(this.form,\'3\',\'csvform\');" value="Upload" />'.   '<input type="button" onClick="javascript:checkChoice(this.form,\'3\',\'csvform\');" value="'.&mt('Upload').'" />'.
  ' scores from file </td></tr>'."\n";   ' '.&mt('scores from file').' </td></tr>'."\n";
   
     $result.='<tr bgcolor="#ffffe6"valign="top"><td colspan="2">'.      $result.='<tr bgcolor="#ffffe6"valign="top"><td colspan="2">'.
  '<input type="button" onClick="javascript:checkChoice(this.form,\'4\',\'scantron_selectphase\');'.   '<input type="button" onClick="javascript:checkChoice(this.form,\'4\',\'scantron_selectphase\');'.
  '" value="Grade" /> scantron forms</td></tr>'."\n";   '" value="'.&mt('Grade').'" /> scantron forms</td></tr>'."\n";
   
     if ((&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) && ($symb)) {      if ((&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) && ($symb)) {
  $result.='<tr bgcolor="#ffffe6"valign="top"><td>'.   $result.='<tr bgcolor="#ffffe6"valign="top"><td>'.
     '<input type="button" onClick="javascript:checkChoice(this.form,\'5\',\'verify\');" value="Verify" />'.      '<input type="button" onClick="javascript:checkChoice(this.form,\'5\',\'verify\');" value="'.&mt('Verify').'" />'.
     ' submission Receipt no: '.unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}).      ' '.&mt('receipt').': '.
       &Apache::lonnet::recprefix($ENV{'request.course.id'}).
     '-<input type="text" name="receipt" size="4" onChange="javascript:checkReceiptNo(this.form,\'OK\')">'.      '-<input type="text" name="receipt" size="4" onChange="javascript:checkReceiptNo(this.form,\'OK\')">'.
     '</td></tr>'."\n";      '</td></tr>'."\n";
     }       } 
       $result.='<tr bgcolor="#ffffe6"valign="top"><td colspan="2">'.
    '<input type="button" onClick="javascript:this.form.action=\'/adm/helper/resettimes.helper\';this.form.submit();'.
    '" value="'.&mt('Manage').'" /> access times.</td></tr>'."\n";
   
     $result.='</form></td></tr></table>'."\n".      $result.='</form></td></tr></table>'."\n".
  '</td></tr></table>'."\n".   '</td></tr></table>'."\n".
Line 4163  sub handler { Line 5109  sub handler {
   
     undef(%perm);      undef(%perm);
     if ($ENV{'browser.mathml'}) {      if ($ENV{'browser.mathml'}) {
  $request->content_type('text/xml');   &Apache::loncommon::content_type($request,'text/xml');
     } else {      } else {
  $request->content_type('text/html');   &Apache::loncommon::content_type($request,'text/html');
     }      }
     $request->send_http_header;      $request->send_http_header;
     return '' if $request->header_only;      return '' if $request->header_only;
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
     my $url=$ENV{'form.url'};      my $url=$ENV{'form.url'};
     my $symb=$ENV{'form.symb'};      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) {      if (!$url) {
  my ($temp1,$temp2);   my ($temp1,$temp2);
  ($temp1,$temp2,$ENV{'form.url'})=split(/___/,$symb);   ($temp1,$temp2,$ENV{'form.url'})=&Apache::lonnet::decode_symb($symb);
  $url = $ENV{'form.url'};   $url = $ENV{'form.url'};
     }      }
     &send_header($request);      &send_header($request);
Line 4188  sub handler { Line 5138  sub handler {
  my ($tsymb,$tuname,$tudom,$tcrsid)=   my ($tsymb,$tuname,$tudom,$tcrsid)=
     &Apache::lonnet::checkin($token);      &Apache::lonnet::checkin($token);
  if ($tsymb) {   if ($tsymb) {
     my ($map,$id,$url)=split(/\_\_\_/,$tsymb);      my ($map,$id,$url)=&Apache::lonnet::decode_symb($tsymb);
     if (&Apache::lonnet::allowed('mgr',$tcrsid)) {      if (&Apache::lonnet::allowed('mgr',$tcrsid)) {
  $request->print(&Apache::lonnet::ssi_body('/res/'.$url,   $request->print(&Apache::lonnet::ssi_body('/res/'.$url,
   ('grade_username' => $tuname,    ('grade_username' => $tuname,
Line 4246  sub handler { Line 5196  sub handler {
     $request->print(&csvupload($request));      $request->print(&csvupload($request));
  } elsif ($command eq 'csvuploadmap' && $perm{'mgr'} ) {   } elsif ($command eq 'csvuploadmap' && $perm{'mgr'} ) {
     $request->print(&csvuploadmap($request));      $request->print(&csvuploadmap($request));
  } elsif ($command eq 'csvuploadassign' && $perm{'mgr'}) {   } elsif ($command eq 'csvuploadoptions' && $perm{'mgr'}) {
     if ($ENV{'form.associate'} ne 'Reverse Association') {      if ($ENV{'form.associate'} ne 'Reverse Association') {
  $request->print(&csvuploadassign($request));   $request->print(&csvuploadoptions($request));
     } else {      } else {
  if ( $ENV{'form.upfile_associate'} ne 'reverse' ) {   if ( $ENV{'form.upfile_associate'} ne 'reverse' ) {
     $ENV{'form.upfile_associate'} = 'reverse';      $ENV{'form.upfile_associate'} = 'reverse';
Line 4257  sub handler { Line 5207  sub handler {
  }   }
  $request->print(&csvuploadmap($request));   $request->print(&csvuploadmap($request));
     }      }
    } elsif ($command eq 'csvuploadassign' && $perm{'mgr'} ) {
       $request->print(&csvuploadassign($request));
  } elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) {   } elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) {
     $request->print(&scantron_selectphase($request));      $request->print(&scantron_selectphase($request));
     } elsif ($command eq 'scantron_warning' && $perm{'mgr'}) {
        $request->print(&scantron_do_warning($request));
  } elsif ($command eq 'scantron_validate' && $perm{'mgr'}) {   } elsif ($command eq 'scantron_validate' && $perm{'mgr'}) {
     $request->print(&scantron_validate_file($request));      $request->print(&scantron_validate_file($request));
  } elsif ($command eq 'scantron_process' && $perm{'mgr'}) {   } elsif ($command eq 'scantron_process' && $perm{'mgr'}) {
     $request->print(&scantron_process_students($request));      $request->print(&scantron_process_students($request));
  } elsif ($command eq 'scantronupload' &&     } elsif ($command eq 'scantronupload' && 
  &Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})) {    (&Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})||
     $request->print(&scantron_upload_scantron_data($request));    &Apache::lonnet::allowed('usc',$ENV{'request.course.id'}))) {
        $request->print(&scantron_upload_scantron_data($request)); 
  } elsif ($command eq 'scantronupload_save' &&    } elsif ($command eq 'scantronupload_save' &&
  &Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})) {    (&Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})||
     $request->print(&scantron_upload_scantron_data_save($request));    &Apache::lonnet::allowed('usc',$ENV{'request.course.id'}))) {
        $request->print(&scantron_upload_scantron_data_save($request));
     } elsif ($command eq 'scantron_download' &&
    &Apache::lonnet::allowed('usc',$ENV{'request.course.id'})) {
        $request->print(&scantron_download_scantron_data($request));
  } elsif ($command) {   } elsif ($command) {
     $request->print("$command ".join(':',%perm)."Access Denied");      $request->print("Access Denied ($command)");
  }   }
     }      }
     &send_footer($request);      &send_footer($request);
Line 4292  sub send_header { Line 5250  sub send_header {
   
 sub send_footer {  sub send_footer {
     my ($request)= @_;      my ($request)= @_;
     $request->print('</body>');      $request->print('</body></html>');
     $request->print(&Apache::lontexconvert::footer());  
 }  }
   
 1;  1;

Removed from v.1.130.2.1.2.11  
changed lines
  Added in v.1.246


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