Diff for /loncom/homework/grades.pm between versions 1.173 and 1.247

version 1.173, 2004/02/09 22:16:32 version 1.247, 2005/02/17 08:58:16
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 101  sub get_symb_and_url { Line 91  sub get_symb_and_url {
     return ($symb,$url);      return ($symb,$url);
 }  }
   
 # --- 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;  
 }  
   
 #--- Format fullname, username:domain if different for display  #--- Format fullname, username:domain if different for display
 #--- Use anywhere where the student names are listed  #--- Use anywhere where the student names are listed
 sub nameUserString {  sub nameUserString {
Line 167  sub response_type { Line 138  sub response_type {
     return \@partlist,\%handgrade,\%responseType;      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 {
Line 194  sub showResourceInfo { Line 179  sub showResourceInfo {
     }      }
     $partsseen{$partID}=1;      $partsseen{$partID}=1;
  }   }
  $result.='<td><b>Part </b>'.$partID.' <font color="#999999">'.   my $display_part=&get_display_part($partID,$url);
    $result.='<td><b>Part: </b>'.$display_part.' <font color="#999999">'.
     $resID.'</font></td>'.      $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>';
Line 349  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 511  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 526  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 550  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 670  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 963  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 1072  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 1203  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 1277  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 1374  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;
     }      }
Line 1610  KEYWORDS Line 1623  KEYWORDS
     my %seenparts;      my %seenparts;
     for my $part (sort keys(%$handgrade)) {      for my $part (sort keys(%$handgrade)) {
  my ($partid,$respid) = split(/_/,$part);   my ($partid,$respid) = split(/_/,$part);
    my $display_part=&get_display_part($partid,$url,$symb);
  if ($ENV{"form.$uname:$udom:$partid:submitted_by"}) {   if ($ENV{"form.$uname:$udom:$partid:submitted_by"}) {
     if (exists($seenparts{$partid})) { next; }      if (exists($seenparts{$partid})) { next; }
     $seenparts{$partid}=1;      $seenparts{$partid}=1;
     my $submitby='<b>Part '.$partid.      my $submitby='<b>Part:</b> '.$display_part.
  ' Collaborative submission by: </b>'.   ' <b>Collaborative submission by:</b> '.
  '<a href="javascript:viewSubmitter(\''.   '<a href="javascript:viewSubmitter(\''.
  $ENV{"form.$uname:$udom:$partid:submitted_by"}.   $ENV{"form.$uname:$udom:$partid:submitted_by"}.
  '\')"; TARGET=_self>'.   '\')"; TARGET=_self>'.
Line 1624  KEYWORDS Line 1638  KEYWORDS
  }   }
  my $responsetype = $responseType->{$partid}->{$respid};   my $responsetype = $responseType->{$partid}->{$respid};
  if (!exists($record{"resource.$partid.$respid.submission"})) {   if (!exists($record{"resource.$partid.$respid.submission"})) {
     $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '.      $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part:</b> '.
  $partid.'</b> <font color="#999999">( ID '.$respid.   $display_part.' <font color="#999999">( ID '.$respid.
  ' )</font>&nbsp; &nbsp;'.   ' )</font>&nbsp; &nbsp;'.
  '<font color="red">Nothing submitted - no attempts</font><br /><br />';   '<font color="red">Nothing submitted - no attempts</font><br /><br />';
     next;      next;
Line 1653  KEYWORDS Line 1667  KEYWORDS
     if ($ENV{'form.lastSub'} eq 'lastonly' ||       if ($ENV{'form.lastSub'} eq 'lastonly' || 
  ($ENV{'form.lastSub'} eq 'hdgrade' &&    ($ENV{'form.lastSub'} eq 'hdgrade' && 
  $$handgrade{$part} eq 'yes')) {   $$handgrade{$part} eq 'yes')) {
  $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '.   my $display_part=&get_display_part($partid,$url,$symb);
     $partid.'</b> <font color="#999999">( ID '.$respid.   $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part:</b> '.
       $display_part.' <font color="#999999">( ID '.$respid.
     ' )</font>&nbsp; &nbsp;';      ' )</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"}) {   if ($record{"resource.$partid.$respid.uploadedurl"}) {
     $lastsubonly.='<a href="'.&Apache::lonnet::tokenwrapper($record{"resource.$partid.$respid.uploadedurl"}).'" target="lonGRDs"><img src="/adm/lonIcons/unknown.gif" border=0"> File uploaded by student</a> <font color="red" size="1">Like all files provided by users, this file may contain virusses</font><br />';      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>'.   $lastsubonly.='<b>Submitted Answer: </b>'.
     &cleanRecord($subval,$responsetype,$symb,$partid,      &cleanRecord($subval,$responsetype,$symb,$partid,
Line 1692  KEYWORDS Line 1725  KEYWORDS
     ($ENV{'form.command'} eq 'processGroup' && $counter == $total)) {      ($ENV{'form.command'} eq 'processGroup' && $counter == $total)) {
     $toGrade.='</form>'.&show_grading_menu_form($symb,$url)       $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 2035  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.'_'.$_} : 
Line 2283  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 2310  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 2349  sub viewgrades { Line 2385  sub viewgrades {
  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 2365  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 2391  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 2411  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 2422  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 2486  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 2582  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 2611  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 2649  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 2693  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 2704  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 2715  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 2728  ENDPICK Line 2774  ENDPICK
 sub csvupload_fields {  sub csvupload_fields {
     my ($url,$symb) = @_;      my ($url,$symb) = @_;
     my (@parts) = &getpartlist($url,$symb);      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 2775  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 2784  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 2807  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) {
Line 2832  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 2851  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 2859  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'}};
  $username=~s/\s//g;   $username=~s/\s//g;
  my $domain=$entries{$fields{'domain'}};   if (!$username) {
  $domain=~s/\s//g;      my $id=$entries{$fields{'ID'}};
       $id=~s/\s//g;
       my %ids=&Apache::lonnet::idget($domain,$id);
       $username=$ids{$id};
    }
  if (!exists($$classlist{"$username:$domain"})) {   if (!exists($$classlist{"$username:$domain"})) {
     push(@skipped,"$username:$domain");      my $id=$entries{$fields{'ID'}};
       $id=~s/\s//g;
       if ($id) {
    push(@skipped,"$id:$domain");
       } else {
    push(@skipped,"$username:$domain");
       }
     next;      next;
  }   }
  my $usec=$classlist->{"$username:$domain"}[5];   my $usec=$classlist->{"$username:$domain"}[5];
Line 2872  sub csvuploadassign { Line 2990  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);
    $entries{$fields{$dest}}=~s/\s//g;
    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 3020  sub getSymbMap { Line 3156  sub getSymbMap {
     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 3029  sub getSymbMap { Line 3166  sub getSymbMap {
     $minder++;      $minder++;
  }   }
     }      }
   
     $navmap->untieHashes();  
     return \@titles,\%symbx;      return \@titles,\%symbx;
 }  }
   
Line 3094  sub displayPage { Line 3229  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' ) {
Line 3155  sub displayPage { Line 3290  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 3162  sub displayPage { Line 3298  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 3176  sub displayPage { Line 3310  sub displayPage {
   
 sub displaySubByDates {  sub displaySubByDates {
     my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_;      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);
Line 3191  sub displaySubByDates { Line 3328  sub displaySubByDates {
     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 = sort(grep /^resource\.\Q$partid\E\..*?\.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 '');
       my $display_part=&get_display_part($partid,undef,$symb);
     foreach my $matchKey (@matchKey) {      foreach my $matchKey (@matchKey) {
  if (exists $$record{$version.':'.$matchKey}) {   if (exists($$record{$version.':'.$matchKey}) &&
       $$record{$version.':'.$matchKey} ne '') {
     my ($responseId)=($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/);      my ($responseId)=($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/);
     $displaySub[0].='<b>Part&nbsp;'.$partid.'&nbsp;';      $displaySub[0].='<b>Part:</b>&nbsp;'.$display_part.'&nbsp;';
     $displaySub[0].='<font color="#999999">(ID&nbsp;'.      $displaySub[0].='<font color="#999999">(ID&nbsp;'.
  $responseId.')</font>&nbsp;';   $responseId.')</font>&nbsp;<b>';
     if ($$record{"$version:resource.$partid.tries"} eq '') {      if ($$record{"$version:resource.$partid.tries"} eq '') {
  $displaySub[0].='Trial&nbsp;not&nbsp;counted';   $displaySub[0].='Trial&nbsp;not&nbsp;counted';
     } else {      } else {
Line 3219  sub displaySubByDates { Line 3361  sub displaySubByDates {
  }   }
     }      }
     if (exists $$record{"$version:resource.$partid.award"}) {      if (exists $$record{"$version:resource.$partid.award"}) {
  $displaySub[1].='<b>Part&nbsp;'.$partid.'</b> &nbsp;'.   $displaySub[1].='<b>Part:</b>&nbsp;'.$display_part.' &nbsp;'.
     lc($$record{"$version:resource.$partid.award"}).' '.      lc($$record{"$version:resource.$partid.award"}).' '.
     $mark{$$record{"$version:resource.$partid.solved"}}.      $mark{$$record{"$version:resource.$partid.solved"}}.
     '<br />';      '<br />';
     }      }
     if (exists $$record{"$version:resource.$partid.regrader"}) {      if (exists $$record{"$version:resource.$partid.regrader"}) {
  $displaySub[2].=$$record{"$version:resource.$partid.regrader"}.   $displaySub[2].=$$record{"$version:resource.$partid.regrader"}.
     ' (<b>'.&mt('Part').':</b> '.$partid.')';      ' (<b>'.&mt('Part').':</b> '.$display_part.')';
     }      }
  }   }
  # needed because old essay regrader has not parts info   # needed because old essay regrader has not parts info
Line 3281  sub updateGradeByPage { Line 3423  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 3290  sub updateGradeByPage { Line 3432  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 3323  sub updateGradeByPage { Line 3465  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 3351  sub updateGradeByPage { Line 3494  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 3401  sub getSequenceDropDown { Line 3543  sub getSequenceDropDown {
     return $result;      return $result;
 }  }
   
 sub scantron_uploads {  sub scantron_filenames {
     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,
     &Apache::loncommon::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 3421  sub scantron_uploads { Line 3572  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 3431  sub scantron_scantab { Line 3583  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;
     <table width="100%" border="0">      <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">
        <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantro_process">         <input type="hidden" name="command" value="scantron_warning" />
        <input type="hidden" name="command" value="scantron_validate" />  
         $default_form_data          $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  
     </td>  
           </tr>            </tr>
           <tr bgcolor="#ffffe6">            <tr bgcolor="#ffffe6">
             <td>              <td> Filename of scoring office file: </td><td> $file_selector </td>
  Filename of scoring office file: $file_selector  
     </td>  
           </tr>            </tr>
           <tr bgcolor="#ffffe6">            <tr bgcolor="#ffffe6">
             <td>              <td> Format of data file: </td><td> $format_selector </td>
               Format of data file: $format_selector  
     </td>  
           </tr>            </tr>
           <tr bgcolor="#ffffe6">            <tr bgcolor="#ffffe6">
               <td> Saved CODEs to validate against: </td><td> $CODE_selector</td>
             </tr>
             <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>
 <!-- FIXME this is lazy, a single parse of the set should let me know what this is -->                  <input type="checkbox" name="scantron_options_redo" value="redo_skipped"/> Do only previously skipped records <br />
               Last line to expect an answer on:                   <input type="checkbox" name="scantron_options_ignore" value="ignore_corrections"/> Remove all exisiting corrections
                 <input type="text" name="scantron_maxbubble" />  
     </td>      </td>
           </tr>            </tr>
           <tr bgcolor="#ffffe6">            <tr bgcolor="#ffffe6">
             <td>              <td colspan="2">
               <input type="submit" value="Validate Scantron Records" />                <input type="submit" value="Validate Scantron Records" />
             </td>              </td>
           </tr>            </tr>
         </table>          </table>
        </form>         </td>
       </td>       </form>
     </tr>      </tr>
 SCANTRONFORM  SCANTRONFORM
         
Line 3500  SCANTRONFORM Line 3679  SCANTRONFORM
         <table width="100%" border="0">          <table width="100%" border="0">
           <tr bgcolor="#e6ffff">            <tr bgcolor="#e6ffff">
             <td>              <td>
               Specify a Scantron data file to upload.                &nbsp;<b>Specify a Scantron data file to upload.</b>
             </td>              </td>
           </tr>            </tr>
           <tr bgcolor="#ffffe6">            <tr bgcolor="#ffffe6">
             <td>              <td>
 SCANTRONFORM  SCANTRONFORM
         &scantron_upload_scantron_data($r);      my $default_form_data=&defaultFormData(&get_symb_and_url($r,1));
       my $cdom= $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
       my $cnum= $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
       $r->print(<<UPLOAD);
                 <script type="text/javascript" language="javascript">
       function checkUpload(formname) {
    if (formname.upfile.value == "") {
       alert("Please use the browse button to select a file from your local directory.");
       return false;
    }
    formname.submit();
       }
                 </script>
   
                 <form enctype='multipart/form-data' action='/adm/grades' name='rules' method='post'>
                   $default_form_data
                   <input name='courseid' type='hidden' value='$cnum' />
                   <input name='domainid' type='hidden' value='$cdom' />
                   <input name='command' value='scantronupload_save' type='hidden' />
                   File to upload:<input type="file" name="upfile" size="50" />
                   <br />
                   <input type="button" onClick="javascript:checkUpload(this.form);" value="Upload Scantron Data" />
                 </form>
   UPLOAD
   
         $r->print(<<SCANTRONFORM);          $r->print(<<SCANTRONFORM);
             </td>              </td>
Line 3516  SCANTRONFORM Line 3718  SCANTRONFORM
     </tr>      </tr>
 SCANTRONFORM  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);      $r->print(<<SCANTRONFORM);
   </table>    </table>
 </form>  
 $grading_menu_button  $grading_menu_button
 SCANTRONFORM  SCANTRONFORM
   
Line 3572  sub scantron_fixup_scanline { Line 3797  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 3584  sub scantron_fixup_scanline { Line 3809  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 3614  sub scan_data { Line 3854  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 3637  sub scantron_parse_scanline { Line 3884  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 3644  sub scantron_parse_scanline { Line 3893  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'}) {
    $record{"scantron.$questnum.answer"}='';
    if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {
       push(@{$record{"scantron.missingerror"}},$questnum);
    }
       } else {
    $record{"scantron.$questnum.answer"}=
       $alphabet[length($array[0])];
       }
       if (scalar(@array) gt 2) {
    push(@{$record{'scantron.doubleerror'}},$questnum);
    my @ans=@array;
    my $i=length($ans[0]);shift(@ans);
    while ($#ans) {
       $i+=length($ans[0])+1;
       $record{"scantron.$questnum.answer"}.=$alphabet[$i];
       shift(@ans);
    }
       }
  }   }
   if (scalar(@array) gt 2) {  
      push(@{$record{'scantron.doubleerror'}},$questnum);  
      my @ans=@array;  
      my $i=length($ans[0]);shift(@ans);  
     while ($#ans) {  
   $i+=length($ans[0])+1;  
   $record{"scantron.$questnum.answer"}.=$alphabet[$i];  
   shift(@ans);  
      }  
   }  
     }      }
     $record{'scantron.maxquest'}=$questnum;      $record{'scantron.maxquest'}=$questnum;
     return \%record;      return \%record;
Line 3692  sub scantron_find_student { Line 3965  sub scantron_find_student {
   
 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 3704  sub scantron_process_corrections { Line 3978  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 3717  sub scantron_process_corrections { Line 3991  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 3730  sub scantron_process_corrections { Line 4024  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 3762  SCANTRONFORM Line 4180  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 3781  SCANTRONFORM Line 4195  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 3799  SCANTRONFORM Line 4218  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;
Line 3826  sub scantron_getfile { Line 4280  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 3844  sub lonnet_putfile { Line 4298  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 3890  sub scantron_validate_ID { Line 4358  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 3904  sub scantron_validate_ID { Line 4372  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 3920  sub scantron_validate_ID { Line 4388  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 3954  sub scantron_get_correction { Line 4422  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 3975  sub scantron_get_correction { Line 4445  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 3990  sub scantron_get_correction { Line 4507  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 4026  sub scantron_bubble_selector { Line 4544  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 4042  sub scantron_validate_doublebubble { Line 4635  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 4055  sub scantron_validate_doublebubble { Line 4648  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 4064  sub scantron_validate_missingbubbles { Line 4682  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 4112  SCANTRONFORM Line 4730  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);
   if ($line=~/^[\s\cz]*$/) { next; }    if ($line=~/^[\s\cz]*$/) { next; }
    if ($started) {
       &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
        'last student');
    }
    $started=1;
   my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,    my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
   $scan_data);    $scan_data);
   unless ($uname=&scantron_find_student($scan_record,$scan_data,    unless ($uname=&scantron_find_student($scan_record,$scan_data,
Line 4144  SCANTRONFORM Line 4769  SCANTRONFORM
  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'}) &&
    $scan_record->{'scantron.CODE'}) {
    $form{'CODE'}=$scan_record->{'scantron.CODE'};
       } else {
    $form{'CODE'}='';
       }
       my $result=&Apache::lonnet::ssi($resource->src(),%form);
       if ($result ne '') {
    &Apache::lonnet::logthis("scantron grading error -> $result");
    &Apache::lonnet::logthis("scantron grading error info name $uname domain $udom course $ENV{'request.course.id'} url ".$resource->src());
       }
       if (&Apache::loncommon::connection_aborted($r)) { 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,  
  'last student');  
     }      }
     &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>");
   
     $navmap->untieHashes();      $r->print("</form>");
     $r->print("</form><p>Done</p>");  
     $r->print(&show_grading_menu_form($symb,$url));      $r->print(&show_grading_menu_form($symb,$url));
     return '';      return '';
 }  }
Line 4173  sub scantron_upload_scantron_data { Line 4807  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));      my $default_form_data=&defaultFormData(&get_symb_and_url($r,1));
Line 4190  sub scantron_upload_scantron_data { Line 4825  sub scantron_upload_scantron_data {
   
 <form enctype='multipart/form-data' action='/adm/grades' name='rules' method='post'>  <form enctype='multipart/form-data' action='/adm/grades' name='rules' method='post'>
 $default_form_data  $default_form_data
 Course: <input name='courseid' type='text' />  <table>
 Domain: $domsel $select_link  <tr><td>$select_link </td></tr>
 <br />  <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 4204  UPLOAD Line 4841  UPLOAD
   
 sub scantron_upload_scantron_data_save {  sub scantron_upload_scantron_data_save {
     my($r)=@_;      my($r)=@_;
       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'}) &&      if (!&Apache::lonnet::allowed('usc',$ENV{'form.domainid'}) &&
  !&Apache::lonnet::allowed('usc',   !&Apache::lonnet::allowed('usc',
     $ENV{'form.domainid'}.'_'.$ENV{'form.courseid'})) {      $ENV{'form.domainid'}.'_'.$ENV{'form.courseid'})) {
  $r->print("You are not allowed to upload Scantron data to the requested course.<br />");   $r->print("You are not allowed to upload Scantron data to the requested course.<br />");
  $r->print(&show_grading_menu_form(&get_symb_and_url($r)));   if ($symb) {
       $r->print(&show_grading_menu_form($symb,$url));
    } else {
       $r->print($doanotherupload);
    }
  return '';   return '';
     }      }
     $r->print("Doing upload to ".$ENV{'form.courseid'}." <br />");      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 4228  sub scantron_upload_scantron_data_save { Line 4876  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;
     $r->print(&Apache::lonnet::finishuserfileupload($ENV{'form.courseid'},      if (length($ENV{'form.upfile'}) < 2) {
     $ENV{'form.domainid'},   $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.");
     $home,'upfile',$fname));      } else {
     $r->print('<br /><form action="/adm/grades" method="post">'."\n".   my $result=&Apache::lonnet::finishuserfileupload($ENV{'form.courseid'},$ENV{'form.domainid'},$home,'upfile',$fname);
  '<input type="hidden" name="command" value="scantronupload" />'."\n".   if ($result =~ m|^/uploaded/|) {
  '<input type="submit" name="submit" value="Do Another Upload" />'."\n".      $r->print("<font color='green'>Success:</font> Successfully uploaded ".(length($ENV{'form.upfile'})-1)." bytes of data into location <tt>".$result."</tt>");
  '</form>'."\n");   } 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 4297  sub gradingmenu { Line 4997  sub gradingmenu {
     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 4349  GRADINGMENUJS Line 5050  GRADINGMENUJS
  ($saveSec eq $_ ? 'selected="on"':'').'>'.$_.'</option>'."\n";   ($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.=&mt('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) && (grep /no/,@$sections)) {  
  $result.='&nbsp;(Section "no" implies the students were not assigned a section.)<br />';  
     }  
     $result.='</td></tr>';      $result.='</td></tr>';
   
     $result.='<tr bgcolor="#ffffe6"valign="top"><td>'.      $result.='<tr bgcolor="#ffffe6"valign="top"><td>'.
Line 4389  GRADINGMENUJS Line 5087  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 4502  sub handler { Line 5204  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 4513  sub handler { Line 5215  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_validate' && $perm{'mgr'}) {    } elsif ($command eq 'scantron_warning' && $perm{'mgr'}) {
      $request->print(&scantron_validate_file($request));       $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'}) {
Line 4529  sub handler { Line 5233  sub handler {
   (&Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})||    (&Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})||
   &Apache::lonnet::allowed('usc',$ENV{'request.course.id'}))) {    &Apache::lonnet::allowed('usc',$ENV{'request.course.id'}))) {
      $request->print(&scantron_upload_scantron_data_save($request));       $request->print(&scantron_upload_scantron_data_save($request));
   } elsif ($command eq 'scantrondownload' &&    } elsif ($command eq 'scantron_download' &&
  &Apache::lonnet::allowed('usc',$ENV{'request.course.id'})) {   &Apache::lonnet::allowed('usc',$ENV{'request.course.id'})) {
      $request->print(&scantron_download_scantron_data($request));       $request->print(&scantron_download_scantron_data($request));
  } elsif ($command) {   } elsif ($command) {
Line 4554  sub send_header { Line 5258  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.173  
changed lines
  Added in v.1.247


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