[BACK]Return to grades.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / homework

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

version 1.130.2.1.2.11, 2003/10/16 03:51:52 version 1.146, 2003/11/04 19:38:09
Line 55  my %perm=(); Line 55  my %perm=();
   
 # ----- These first few routines are general use routines.----  # ----- These first few routines are general use routines.----
 #  #
 # --- Retrieve the parts that matches stores_\d+ from the metadata file.---  # --- Retrieve the parts from the metadata file.---
 sub getpartlist {  sub getpartlist {
     my ($url) = @_;      my ($url,$symb) = @_;
     my @parts =();      my $partorder = &Apache::lonnet::metadata($url, 'partorder');
     my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys'));      my @parts;
     foreach my $key (@metakeys) {      if ($partorder) {
  if ( $key =~ m/stores_(\w+)_.*/) {   for my $part (split (/,/,$partorder)) {
     push(@parts,$key);      if (!&Apache::loncommon::check_if_partid_hidden($part,$symb)) {
    push(@parts, $part);
       }
    }    
       } else {
    my $metadata = &Apache::lonnet::metadata($url, 'packages');
    foreach (split(/\,/,$metadata)) {
       if ($_ =~ /^part_(.*)$/) {
    if (!&Apache::loncommon::check_if_partid_hidden($1,$symb)) {
       push(@parts, $1);
    }
       }
  }   }
     }      }
     return @parts;      my @stores;
       foreach my $part (@parts) {
    my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys'));
    foreach my $key (@metakeys) {
       if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); }
    }
       }
       return @stores;
 }  }
   
 # --- Get the symbolic name of a problem and the url  # --- Get the symbolic name of a problem and the url
Line 120  sub response_type { Line 138  sub response_type {
  if (/^\w+response_\w+.*/) {   if (/^\w+response_\w+.*/) {
     my ($responsetype,$part) = split(/_/,$_,2);      my ($responsetype,$part) = split(/_/,$_,2);
     my ($partid,$respid) = split(/_/,$part);      my ($partid,$respid) = split(/_/,$part);
       if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) {
    next;
       }
     $responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!!      $responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!!
     my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb);      my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb);
     $handgrade{$part} = $responsetype.':'.($value eq 'yes' ? 'yes' : 'no');       $handgrade{$part} = $responsetype.':'.($value eq 'yes' ? 'yes' : 'no'); 
Line 185  sub cleanRecord { Line 206  sub cleanRecord {
     $ENV{'form.kwstyle'}  = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : '';      $ENV{'form.kwstyle'}  = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : '';
     $ENV{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob.      $ENV{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob.
  }   }
  return '<br /><br /><blockquote>'.&keywords_highlight($answer).'</blockquote>';   return '<br /><br /><blockquote><pre>'.&keywords_highlight($answer).'</pre></blockquote>';
     }      }
     return $answer;      return $answer;
 }  }
Line 218  sub commonJSfunctions { Line 239  sub commonJSfunctions {
  }   }
     }      }
  } else {   } else {
     if (selectOne.selected) return selectOne.value;              // only one value it must be the selected one
       return selectOne.value;
  }   }
     }      }
 </script>  </script>
Line 506  LISTJAVASCRIPT Line 528  LISTJAVASCRIPT
     my $checkhdgrade = ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked' : '';      my $checkhdgrade = ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked' : '';
     my $checklastsub = $checkhdgrade eq '' ? 'checked' : '';      my $checklastsub = $checkhdgrade eq '' ? 'checked' : '';
     my $gradeTable='<form action="/adm/grades" method="post" name="gradesub">'."\n".      my $gradeTable='<form action="/adm/grades" method="post" name="gradesub">'."\n".
  '&nbsp;<b>View Problem Text: </b><input type="radio" name="vProb" value="no" checked /> no '."\n".   '&nbsp;<b>View Problem Text: </b><input type="radio" name="vProb" value="no" checked="on" /> no '."\n".
  '<input type="radio" name="vProb" value="yes" /> one student '."\n".   '<input type="radio" name="vProb" value="yes" /> one student '."\n".
  '<input type="radio" name="vProb" value="all" /> all students <br />'."\n".   '<input type="radio" name="vProb" value="all" /> all students <br />'."\n".
    '&nbsp;<b>View Answer: </b><input type="radio" name="vAns" value="no"  /> no '."\n".
    '<input type="radio" name="vAns" value="yes" /> one student '."\n".
    '<input type="radio" name="vAns" value="all" checked="on" /> all students <br />'."\n".
  '&nbsp;<b>Submissions: </b>'."\n";   '&nbsp;<b>Submissions: </b>'."\n";
     if ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) {      if ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) {
  $gradeTable.='<input type="radio" name="lastSub" value="hdgrade" '.$checkhdgrade.' /> essay part only'."\n";   $gradeTable.='<input type="radio" name="lastSub" value="hdgrade" '.$checkhdgrade.' /> essay part only'."\n";
Line 517  LISTJAVASCRIPT Line 542  LISTJAVASCRIPT
     my $saveStatus = $ENV{'form.Status'} eq '' ? 'Active' : $ENV{'form.Status'};      my $saveStatus = $ENV{'form.Status'} eq '' ? 'Active' : $ENV{'form.Status'};
     $ENV{'form.Status'} = $saveStatus;      $ENV{'form.Status'} = $saveStatus;
   
     $gradeTable.='<input type="radio" name="lastSub" value="lastonly" '.$checklastsub.' /> last sub only'."\n".      $gradeTable.='<input type="radio" name="lastSub" value="lastonly" '.$checklastsub.' /> last submission only'."\n".
  '<input type="radio" name="lastSub" value="last" /> last sub & parts info'."\n".   '<input type="radio" name="lastSub" value="last" /> last submission & parts info'."\n".
  '<input type="radio" name="lastSub" value="datesub" /> by dates and submissions'."\n".   '<input type="radio" name="lastSub" value="datesub" /> by dates and submissions'."\n".
  '<input type="radio" name="lastSub" value="all" /> all details'."\n".   '<input type="radio" name="lastSub" value="all" /> all details'."\n".
  '<input type="hidden" name="section"     value="'.$getsec.'" />'."\n".   '<input type="hidden" name="section"     value="'.$getsec.'" />'."\n".
Line 544  LISTJAVASCRIPT Line 569  LISTJAVASCRIPT
     $gradeTable.='<input type="button" '."\n".      $gradeTable.='<input type="button" '."\n".
  'onClick="javascript:checkSelect(this.form.stuinfo);" '."\n".   'onClick="javascript:checkSelect(this.form.stuinfo);" '."\n".
  'value="Next->" />'."\n";   'value="Next->" />'."\n";
       $gradeTable.='<input type="checkbox" name="checkPlag" checked="on">Check For Plagiarism</input>';
     my (undef, undef, $fullname) = &getclasslist($getsec,'1');        my (undef, undef, $fullname) = &getclasslist($getsec,'1');  
     $gradeTable.='<table border="0"><tr><td bgcolor="#777777">'.      $gradeTable.='<table border="0"><tr><td bgcolor="#777777">'.
  '<table border="0"><tr bgcolor="#e6ffff">';   '<table border="0"><tr bgcolor="#e6ffff">';
Line 568  LISTJAVASCRIPT Line 593  LISTJAVASCRIPT
  my %status = ();   my %status = ();
  if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') {   if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') {
     (%status) =&student_gradeStatus($url,$symb,$udom,$uname,$partlist);      (%status) =&student_gradeStatus($url,$symb,$udom,$uname,$partlist);
     my $statusflg = '';      my $submitted = 0;
       my $graded = 1;
     foreach (keys(%status)) {      foreach (keys(%status)) {
  $statusflg = 1 if ($status{$_} ne 'nothing');   $submitted = 1 if ($status{$_} ne 'nothing');
    $graded = 0 if ($status{$_} =~ /^correct/);
  my ($foo,$partid,$foo1) = split(/\./,$_);   my ($foo,$partid,$foo1) = split(/\./,$_);
  if ($status{'resource.'.$partid.'.submitted_by'} ne '') {   if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
     $statusflg = '';      $submitted = 0;
     $gradeTable.='<input type="hidden" name="'.      $gradeTable.='<input type="hidden" name="'.
  $student.':submitted_by" value="'.   $student.':submitted_by" value="'.
  $status{'resource.'.$partid.'.submitted_by'}.'" />';   $status{'resource.'.$partid.'.submitted_by'}.'" />';
  }   }
     }      }
     next if ($statusflg eq '' && $submitonly eq 'yes');      next if (!$submitted && ($submitonly eq 'yes' || $submitonly eq 'graded'));
       next if (!$graded && $submitonly eq 'graded');
  }   }
   
  $ctr++;   $ctr++;
Line 621  LISTJAVASCRIPT Line 649  LISTJAVASCRIPT
  } else {   } else {
     $gradeTable='<br />&nbsp;<font color="red">'.      $gradeTable='<br />&nbsp;<font color="red">'.
  'No submissions found for this resource for any students. ('.$num_students.   'No submissions found for this resource for any students. ('.$num_students.
  ' checked for submissions</font><br />';   ' checked for submissions)</font><br />';
  }   }
     } elsif ($ctr == 1) {      } elsif ($ctr == 1) {
  $gradeTable =~ s/type=checkbox/type=checkbox checked/;   $gradeTable =~ s/type=checkbox/type=checkbox checked/;
Line 1195  sub gradeBox { Line 1223  sub gradeBox {
 }  }
   
 sub show_problem {  sub show_problem {
     my ($request,$symb,$uname,$udom,$removeform,$viewon) = @_;      my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode) = @_;
     my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom,      my $rendered;
       $ENV{'request.course.id'});      if ($mode eq 'both' or $mode eq 'text') {
    $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom,
        $ENV{'request.course.id'});
       }
     if ($removeform) {      if ($removeform) {
  $rendered=~s|<form(.*?)>||g;   $rendered=~s|<form(.*?)>||g;
  $rendered=~s|</form>||g;   $rendered=~s|</form>||g;
  $rendered=~s|name="submit"|name="would_have_been_submit"|g;   $rendered=~s|name="submit"|name="would_have_been_submit"|g;
     }      }
     my $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom,      my $companswer;
    $ENV{'request.course.id'});      if ($mode eq 'both' or $mode eq 'answer') {
    $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom,
       $ENV{'request.course.id'});
       }
     if ($removeform) {      if ($removeform) {
  $companswer=~s|<form(.*?)>||g;   $companswer=~s|<form(.*?)>||g;
  $companswer=~s|</form>||g;   $companswer=~s|</form>||g;
  $rendered=~s|name="submit"|name="would_have_been_submit"|g;   $companswer=~s|name="submit"|name="would_have_been_submit"|g;
     }      }
     my $result.='<table border="0" width="100%"><tr><td bgcolor="#777777">';      my $result.='<table border="0" width="100%"><tr><td bgcolor="#777777">';
     $result.='<table border="0" width="100%">';      $result.='<table border="0" width="100%">';
     $result.='<tr><td bgcolor="#e6ffff"><b> View of the problem - '.$ENV{'form.fullname'}.      if ($viewon) {
  '</b></td></tr>' if ($viewon);   $result.='<tr><td bgcolor="#e6ffff"><b> ';
     $result.='<tr><td bgcolor="#ffffff">'.$rendered.'<br />';   if ($mode eq 'both' or $mode eq 'text') {
     $result.='<b>Correct answer:</b><br />'.$companswer;      $result.='View of the problem - ';
    } else {
       $result.='Correct answer: ';
    }
    $result.=$ENV{'form.fullname'}.'</b></td></tr>';
       }
       if ($mode eq 'both') {
    $result.='<tr><td bgcolor="#ffffff">'.$rendered.'<br />';
    $result.='<b>Correct answer:</b><br />'.$companswer;
       } elsif ($mode eq 'text') {
    $result.='<tr><td bgcolor="#ffffff">'.$rendered;
       } elsif ($mode eq 'answer') {
    $result.='<tr><td bgcolor="#ffffff">'.$companswer;
       }
     $result.='</td></tr></table>';      $result.='</td></tr></table>';
     $result.='</td></tr></table><br />';      $result.='</td></tr></table><br />';
     return $result;      return $result;
Line 1264  sub submission { Line 1311  sub submission {
   
  # option to display problem, only once else it cause problems    # option to display problem, only once else it cause problems 
         # with the form later since the problem has a form.          # with the form later since the problem has a form.
  if ($ENV{'form.vProb'} eq 'yes' or !$ENV{'form.vProb'}) {   if ($ENV{'form.vProb'} eq 'yes' or $ENV{'form.vAns'} eq 'yes') {
     $request->print(&show_problem($request,$symb,$uname,$udom,0,1));      my $mode;
       if ($ENV{'form.vProb'} eq 'yes' && $ENV{'form.vAns'} eq 'yes') {
    $mode='both';
       } elsif ($ENV{'form.vProb'} eq 'yes') {
    $mode='text';
       } elsif ($ENV{'form.vAns'} eq 'yes') {
    $mode='answer';
       }
       $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode));
  }   }
   
  # kwclr is the only variable that is guaranteed to be non blank    # kwclr is the only variable that is guaranteed to be non blank 
Line 1300  sub submission { Line 1355  sub submission {
  '<input type="hidden" name="url"        value="'.$url.'" />'."\n".   '<input type="hidden" name="url"        value="'.$url.'" />'."\n".
  '<input type="hidden" name="showgrading" value="'.$ENV{'form.showgrading'}.'" />'."\n".   '<input type="hidden" name="showgrading" value="'.$ENV{'form.showgrading'}.'" />'."\n".
  '<input type="hidden" name="vProb"      value="'.$ENV{'form.vProb'}.'" />'."\n".   '<input type="hidden" name="vProb"      value="'.$ENV{'form.vProb'}.'" />'."\n".
    '<input type="hidden" name="vAns"       value="'.$ENV{'form.vAns'}.'" />'."\n".
  '<input type="hidden" name="lastSub"    value="'.$ENV{'form.lastSub'}.'" />'."\n".   '<input type="hidden" name="lastSub"    value="'.$ENV{'form.lastSub'}.'" />'."\n".
  '<input type="hidden" name="section"    value="'.$ENV{'form.section'}.'">'."\n".   '<input type="hidden" name="section"    value="'.$ENV{'form.section'}.'">'."\n".
  '<input type="hidden" name="submitonly" value="'.$ENV{'form.submitonly'}.'">'."\n".   '<input type="hidden" name="submitonly" value="'.$ENV{'form.submitonly'}.'">'."\n".
Line 1350  KEYWORDS Line 1406  KEYWORDS
         }          }
     }      }
   
     if ($ENV{'form.vProb'} eq 'all') {      if ($ENV{'form.vProb'} eq 'all' or $ENV{'form.vAns'} eq 'all') {
  $request->print('<br /><br /><br />') if ($counter > 0);   $request->print('<br /><br /><br />') if ($counter > 0);
  $request->print(&show_problem($request,$symb,$uname,$udom,1,1));   my $mode;
    if ($ENV{'form.vProb'} eq 'all' && $ENV{'form.vAns'} eq 'all') {
       $mode='both';
    } elsif ($ENV{'form.vProb'} eq 'all' ) {
       $mode='text';
    } elsif ($ENV{'form.vAns'} eq 'all') {
       $mode='answer';
    }
    $request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode));
     }      }
   
     my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname);      my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname);
   
     my ($partlist,$handgrade) = &response_type($url,$symb);      my ($partlist,$handgrade) = &response_type($url,$symb);
Line 1461  KEYWORDS Line 1526  KEYWORDS
  my ($ressub,$subval) = split(/:/,$_,2);   my ($ressub,$subval) = split(/:/,$_,2);
                             # Similarity check                              # Similarity check
  my $similar='';   my $similar='';
  my ($oname,$odom,$ocrsid,$oessay,$osim)=&most_similar($uname,$udom,$subval);   my $oname;
  if ($osim) {   my $odom;
     $osim=int($osim*100.0);   my $ocrsid;
     $similar='<hr /><h3><font color="#FF0000">Essay is '.$osim.   my $oessay;
  '% similar to an essay by '.&Apache::loncommon::plainname($oname,$odom).   my $osim;
  '</font></h3><blockquote><i>'.   if($ENV{'form.checkPlag'}){
  &keywords_highlight($oessay).'</i></blockquote><hr />';      ($oname,$odom,$ocrsid,$oessay,$osim)=&most_similar($uname,$udom,$subval);
       if ($osim) {
    $osim=int($osim*100.0);
    $similar='<hr /><h3><font color="#FF0000">Essay is '.$osim.
       '% similar to an essay by '.&Apache::loncommon::plainname($oname,$odom).
       '</font></h3><blockquote><i>'.
       &keywords_highlight($oessay).'</i></blockquote><hr />';
       }
  }   }
  $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '.   $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '.
     $partid.'</b> <font color="#999999">( ID '.$respid.      $partid.'</b> <font color="#999999">( ID '.$respid.
Line 1480  KEYWORDS Line 1552  KEYWORDS
      'this file may contain virusses</font><br />':'').       'this file may contain virusses</font><br />':'').
      '<b>Submitted Answer: </b>'.       '<b>Submitted Answer: </b>'.
      &cleanRecord($subval,$responsetype,$symb).       &cleanRecord($subval,$responsetype,$symb).
       '<br /><br />'.$similar."\n"       '<br /><br />'.$similar."\n"
      if ($ENV{'form.lastSub'} eq 'lastonly' ||        if ($ENV{'form.lastSub'} eq 'lastonly' || 
  ($ENV{'form.lastSub'} eq 'hdgrade' &&    ($ENV{'form.lastSub'} eq 'hdgrade' && 
   $$handgrade{$part} =~ /:yes$/));    $$handgrade{$part} =~ /:yes$/));
Line 1782  sub processHandGrade { Line 1854  sub processHandGrade {
     }      }
     $ctr = 0;      $ctr = 0;
     @parsedlist = reverse @parsedlist if ($button eq 'Previous');      @parsedlist = reverse @parsedlist if ($button eq 'Previous');
       my ($partlist) = &response_type($url);
     foreach my $student (@parsedlist) {      foreach my $student (@parsedlist) {
    my $submitonly=$ENV{'form.submitonly'};
  my ($uname,$udom) = split(/:/,$student);   my ($uname,$udom) = split(/:/,$student);
  if ($ENV{'form.submitonly'} eq 'yes') {   if ($submitonly =~ /^(yes|graded)$/) {
     my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname);  #    my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname);
     my $statusflg = '';      my %status=&student_gradeStatus($url,$symb,$udom,$uname,$partlist);
     foreach (split(/:/,$ENV{'form.gradePartRespid'})){      my $submitted = 0;
  $statusflg = 1 if (exists ($record{'resource.'.$_.'.submission'}));      my $graded = 1;
       foreach (keys(%status)) {
    $submitted = 1 if ($status{$_} ne 'nothing');
    $graded = 0 if ($status{$_} =~ /^correct/);
    my ($foo,$partid,$foo1) = split(/\./,$_);
    if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
       $submitted = 0;
    }
     }      }
     next if ($statusflg eq '');      next if (!$submitted && ($submitonly eq 'yes' || $submitonly eq 'graded'));
       next if (!$graded && $submitonly eq 'graded');
  }   }
  push @nextlist,$student if ($ctr < $ntstu);   push @nextlist,$student if ($ctr < $ntstu);
  last if ($ctr == $ntstu);   last if ($ctr == $ntstu);
Line 2132  sub viewgrades { Line 2214  sub viewgrades {
     $result.= '<table border=0><tr><td bgcolor="#777777">'."\n".      $result.= '<table border=0><tr><td bgcolor="#777777">'."\n".
  '<table border=0><tr bgcolor="#deffff"><td>&nbsp;<b>No.</b>&nbsp;</td>'.   '<table border=0><tr bgcolor="#deffff"><td>&nbsp;<b>No.</b>&nbsp;</td>'.
  '<td>'.&nameUserString('header')."</td>\n";   '<td>'.&nameUserString('header')."</td>\n";
     my (@parts) = sort(&getpartlist($url));      my (@parts) = sort(&getpartlist($url,$symb));
     foreach my $part (@parts) {      foreach my $part (@parts) {
  my $display=&Apache::lonnet::metadata($url,$part.'.display');   my $display=&Apache::lonnet::metadata($url,$part.'.display');
  $display =~ s|^Number of Attempts|Tries<br />|; # makes the column narrower   $display =~ s|^Number of Attempts|Tries<br />|; # makes the column narrower
Line 2249  sub editgrades { Line 2331  sub editgrades {
     my %columns = ();      my %columns = ();
     my ($i,$ctr,$count,$rec_update) = (0,0,0,0);      my ($i,$ctr,$count,$rec_update) = (0,0,0,0);
   
     my (@parts) = sort(&getpartlist($url));      my (@parts) = sort(&getpartlist($url,$symb));
     my $header;      my $header;
     while ($ctr < $ENV{'form.totalparts'}) {      while ($ctr < $ENV{'form.totalparts'}) {
  my $partid = $ENV{'form.partid_'.$ctr};   my $partid = $ENV{'form.partid_'.$ctr};
Line 2327  sub editgrades { Line 2409  sub editgrades {
  $newrecord{'resource.'.$_.'.awarded'} = 0;   $newrecord{'resource.'.$_.'.awarded'} = 0;
  $newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}";   $newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}";
  $updateflag = 1;   $updateflag = 1;
       } elsif (!($old_part eq $partial && $old_score eq $score)) {
    $updateflag = 1;
    $newrecord{'resource.'.$_.'.awarded'}  = $partial if $partial ne '';
    $newrecord{'resource.'.$_.'.solved'}   = $score;
    $rec_update++;
     }      }
   
     $line .= '<td align="center">'.$old_aw.'&nbsp;</td>'.      $line .= '<td align="center">'.$old_aw.'&nbsp;</td>'.
  '<td align="center">'.$awarded.   '<td align="center">'.$awarded.
  ($score eq 'excused' ? $score : '').'&nbsp;</td>';   ($score eq 'excused' ? $score : '').'&nbsp;</td>';
   
     if (!($old_part eq $partial && $old_score eq $score)) {  
  $updateflag = 1;  
  $newrecord{'resource.'.$_.'.awarded'}  = $partial if $partial ne '';  
  $newrecord{'resource.'.$_.'.solved'}   = $score;  
  $rec_update++;  
     }  
   
     my $partid=$_;      my $partid=$_;
     foreach my $stores (@parts) {      foreach my $stores (@parts) {
Line 2515  ENDPICK Line 2596  ENDPICK
 }  }
   
 sub csvupload_fields {  sub csvupload_fields {
     my ($url) = @_;      my ($url,$symb) = @_;
     my (@parts) = &getpartlist($url);      my (@parts) = &getpartlist($url,$symb);
     my @fields=(['username','Student Username'],['domain','Student Domain']);      my @fields=(['username','Student Username'],['domain','Student Domain']);
     foreach my $part (sort(@parts)) {      foreach my $part (sort(@parts)) {
  my @datum;   my @datum;
Line 2599  sub csvuploadmap { Line 2680  sub csvuploadmap {
     &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1);      &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1);
     my ($i,$keyfields);      my ($i,$keyfields);
     if (@records) {      if (@records) {
  my @fields=&csvupload_fields($url);   my @fields=&csvupload_fields($url,$symb);
   
  if ($ENV{'form.upfile_associate'} eq 'reverse') {   if ($ENV{'form.upfile_associate'} eq 'reverse') {
     &Apache::loncommon::csv_print_samples($request,\@records);      &Apache::loncommon::csv_print_samples($request,\@records);
Line 2726  LISTJAVASCRIPT Line 2807  LISTJAVASCRIPT
     $result.='<form action="/adm/grades" method="post" name="displayPage">'."\n";      $result.='<form action="/adm/grades" method="post" name="displayPage">'."\n";
     $result.='&nbsp;<b>Problems from:</b> <select name="selectpage">'."\n";      $result.='&nbsp;<b>Problems from:</b> <select name="selectpage">'."\n";
     my ($titles,$symbx) = &getSymbMap($request);      my ($titles,$symbx) = &getSymbMap($request);
     my ($curpage,$type,$mapId) = ($symb =~ /(.*?\.(page|sequence))___(\d+)___/);       my ($curpage) =&Apache::lonnet::decode_symb($symb); 
   #    my ($curpage,$mapId) =&Apache::lonnet::decode_symb($symb); 
   #    my $type=($curpage =~ /\.(page|sequence)/);
     my $ctr=0;      my $ctr=0;
     foreach (@$titles) {      foreach (@$titles) {
  my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/);   my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/);
Line 2746  LISTJAVASCRIPT Line 2829  LISTJAVASCRIPT
     $result.='<input type="hidden" name="page" />'."\n".      $result.='<input type="hidden" name="page" />'."\n".
  '<input type="hidden" name="title" />'."\n";   '<input type="hidden" name="title" />'."\n";
   
     $result.='&nbsp;<b>View Problems Text: </b><input type="radio" name="vProb" value="no" checked /> no '."\n".      $result.='&nbsp;<b>View Problems Text: </b><input type="radio" name="vProb" value="no" checked="on" /> no '."\n".
  '<input type="radio" name="vProb" value="yes" /> yes '."<br>\n";   '<input type="radio" name="vProb" value="yes" /> yes '."<br>\n";
   
     $result.='&nbsp;<b>Submission Details: </b>'.      $result.='&nbsp;<b>Submission Details: </b>'.
Line 2798  LISTJAVASCRIPT Line 2881  LISTJAVASCRIPT
   
 sub getSymbMap {  sub getSymbMap {
     my ($request) = @_;      my ($request) = @_;
     my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db',      my $navmap = Apache::lonnavmaps::navmap->new();
   $ENV{'request.course.fn'}.'_parms.db');  
 #    $navmap->init();  
   
     my %symbx = ();      my %symbx = ();
     my @titles = ();      my @titles = ();
Line 2845  sub displayPage { Line 2926  sub displayPage {
     &sub_page_js($request);      &sub_page_js($request);
     $request->print($result);      $request->print($result);
   
     my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db',      my $navmap = Apache::lonnavmaps::navmap->new();
   $ENV{'request.course.fn'}.'_parms.db',1, 1);      my ($mapUrl, $id, $resUrl)=&Apache::lonnet::decode_symb($ENV{'form.page'});
     my ($mapUrl, $id, $resUrl) = split(/___/, $ENV{'form.page'});  
     my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps      my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps
   
     my $iterator = $navmap->getIterator($map->map_start(),      my $iterator = $navmap->getIterator($map->map_start(),
Line 2888  sub displayPage { Line 2968  sub displayPage {
     $studentTable.='<tr bgcolor="#ffffe6"><td align="center" valign="top" >'.$question.      $studentTable.='<tr bgcolor="#ffffe6"><td align="center" valign="top" >'.$question.
  (scalar(@{$parts}) == 1 ? '' : '<br>('.scalar(@{$parts}).'&nbsp;parts)').'</td>';   (scalar(@{$parts}) == 1 ? '' : '<br>('.scalar(@{$parts}).'&nbsp;parts)').'</td>';
     $studentTable.='<td valign="top">';      $studentTable.='<td valign="top">';
     if ($ENV{'form.vProb'} eq 'yes') {      if ($ENV{'form.vProb'} eq 'yes' ) {
  $studentTable.=&show_problem($request,$symbx,$uname,$udom,1);   $studentTable.=&show_problem($request,$symbx,$uname,$udom,1,
        undef,'both');
     } else {      } else {
  my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$ENV{'request.course.id'});   my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$ENV{'request.course.id'});
  $companswer =~ s|<form(.*?)>||g;   $companswer =~ s|<form(.*?)>||g;
Line 3008  sub updateGradeByPage { Line 3089  sub updateGradeByPage {
   
     $request->print($result);      $request->print($result);
   
     my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db',      my $navmap = Apache::lonnavmaps::navmap->new();
   $ENV{'request.course.fn'}.'_parms.db',1, 1);      my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $ENV{'form.page'});
     my ($mapUrl, $id, $resUrl) = split(/___/, $ENV{'form.page'});  
     my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps      my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps
   
     my $iterator = $navmap->getIterator($map->map_start(),      my $iterator = $navmap->getIterator($map->map_start(),
Line 3132  sub getSequenceDropDown { Line 3212  sub getSequenceDropDown {
     my ($request,$symb)=@_;      my ($request,$symb)=@_;
     my $result='<select name="selectpage">'."\n";      my $result='<select name="selectpage">'."\n";
     my ($titles,$symbx) = &getSymbMap($request);      my ($titles,$symbx) = &getSymbMap($request);
     my ($curpage,$type,$mapId) = ($symb =~ /(.*?\.(page|sequence))___(\d+)___/);       my ($curpage)=&Apache::lonnet::decode_symb($symb); 
     my $ctr=0;      my $ctr=0;
     foreach (@$titles) {      foreach (@$titles) {
  my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/);   my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/);
Line 3145  sub getSequenceDropDown { Line 3225  sub getSequenceDropDown {
     return $result;      return $result;
 }  }
   
 #FIXME, I am in loncreatecourse, use that one instead  
 sub propath {  
     my ($udom,$uname)=@_;  
     $udom=~s/\W//g;  
     $uname=~s/\W//g;  
     my $subdir=$uname.'__';  
     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;  
     my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname";  
     return $proname;  
 }   
   
 sub scantron_uploads {  sub scantron_uploads {
     if (!-e $Apache::lonnet::perlvar{'lonScansDir'}) { return ''};      if (!-e $Apache::lonnet::perlvar{'lonScansDir'}) { return ''};
     my $result= '<select name="scantron_selectfile">';      my $result= '<select name="scantron_selectfile">';
     my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};      opendir(DIR,$Apache::lonnet::perlvar{'lonScansDir'});
     my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};      my @files=sort(readdir(DIR));
     my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname,  
        &propath($cdom,$cname));  
     foreach my $filename (@files) {      foreach my $filename (@files) {
  ($filename)=split(/&/,$filename);   if ($filename eq '.' or $filename eq '..') { next; }
  if ($filename!~/^scantron_orig_/) { next ; }  
  $filename=~s/^scantron_orig_//;  
  $result.="<option>$filename</option>\n";   $result.="<option>$filename</option>\n";
     }      }
       closedir(DIR);
     $result.="</select>";      $result.="</select>";
     return $result;      return $result;
 }  }
Line 3196  sub scantron_selectphase { Line 3262  sub scantron_selectphase {
     my $file_selector=&scantron_uploads();      my $file_selector=&scantron_uploads();
     my $format_selector=&scantron_scantab();      my $format_selector=&scantron_scantab();
     my $result;      my $result;
     #FIXME allow instructor to be able to download the scantron file  
     # and to upload it,  
     $result.= <<SCANTRONFORM;      $result.= <<SCANTRONFORM;
 <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantro_process">  <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantro_process">
   <input type="hidden" name="command" value="scantron_validate" />    <input type="hidden" name="command" value="scantron_validate" />
Line 3226  sub scantron_selectphase { Line 3290  sub scantron_selectphase {
               Format of data file: $format_selector                Format of data file: $format_selector
     </td>      </td>
           </tr>            </tr>
           <tr bgcolor="#ffffe6">  
             <td>  
 <!-- FIXME this is lazy, a single parse of the set should let me know what this is -->  
               Last line to expect an answer on:   
                 <input type="text" name="scantron_maxbubble" />  
     </td>  
           </tr>  
         </table>          </table>
       </td>        </td>
     </tr>      </tr>
Line 3249  sub get_scantron_config { Line 3306  sub get_scantron_config {
     my ($which) = @_;      my ($which) = @_;
     my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');      my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
     my %config;      my %config;
     #FIXME probably should move to XML it has already gotten a bit much now  
     foreach my $line (<$fh>) {      foreach my $line (<$fh>) {
  my ($name,$descrip)=split(/:/,$line);   my ($name,$descrip)=split(/:/,$line);
  if ($name ne $which ) { next; }   if ($name ne $which ) { next; }
Line 3266  sub get_scantron_config { Line 3322  sub get_scantron_config {
  $config{'Qlength'}=$config[8];   $config{'Qlength'}=$config[8];
  $config{'Qoff'}=$config[9];   $config{'Qoff'}=$config[9];
  $config{'Qon'}=$config[10];   $config{'Qon'}=$config[10];
  $config{'PaperID'}=$config[11];  
  $config{'PaperIDlength'}=$config[12];  
  $config{'FirstName'}=$config[13];  
  $config{'FirstNamelength'}=$config[14];  
  $config{'LastName'}=$config[15];  
  $config{'LastNamelength'}=$config[16];  
  last;   last;
     }      }
     return %config;      return %config;
Line 3287  sub username_to_idmap { Line 3337  sub username_to_idmap {
     return %idmap;      return %idmap;
 }  }
   
 sub scantron_fixup_scanline {  
     my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_;  
     if ($field eq 'ID') {  
  if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) {  
     return ($line,1,'New value to large');  
  }  
  if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) {  
     $args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s',  
      $args->{'newid'});  
  }  
  substr($line,$$scantron_config{'IDstart'}-1,  
        $$scantron_config{'IDlength'})=$args->{'newid'};  
  if ($args->{'newid'}=~/^\s*$/) {  
     &scan_data($scan_data,"$whichline.user",  
        $args->{'username'}.':'.$args->{'domain'});  
  }  
     } elsif ($field eq 'answer') {  
  my $length=$scantron_config->{'Qlength'};  
  my $off=$scantron_config->{'Qoff'};  
  my $on=$scantron_config->{'Qon'};  
  my $answer=${off}x$length;  
  if ($args->{'response'} eq 'none') {  
     &scan_data($scan_data,  
        "$whichline.no_bubble.".$args->{'question'},'1');  
  } else {  
     substr($answer,$args->{'response'},1)=$on;  
     &scan_data($scan_data,  
        "$whichline.no_bubble.".$args->{'question'},undef,'1');  
  }  
  my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'};  
  substr($line,$where-1,$length)=$answer;  
     }  
     return $line;  
 }  
   
 sub scan_data {  
     my ($scan_data,$key,$value,$delete)=@_;  
     my $filename=$ENV{'form.scantron_selectfile'};  
     if (defined($value)) {  
  $scan_data->{$filename.'_'.$key} = $value;  
     }  
     if ($delete) { delete($scan_data->{$filename.'_'.$key}); }  
     return $scan_data->{$filename.'_'.$key};  
 }  
   
 sub scantron_parse_scanline {  sub scantron_parse_scanline {
     my ($line,$whichline,$scantron_config,$scan_data)=@_;      my ($line,$scantron_config)=@_;
     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);
Line 3347  sub scantron_parse_scanline { Line 3352  sub scantron_parse_scanline {
     }      }
     $record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1,      $record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1,
   $$scantron_config{'IDlength'});    $$scantron_config{'IDlength'});
     $record{'scantron.PaperID'}=  
  substr($data,$$scantron_config{'PaperID'}-1,  
        $$scantron_config{'PaperIDlength'});  
     $record{'scantron.FirstName'}=  
  substr($data,$$scantron_config{'FirstName'}-1,  
        $$scantron_config{'FirstNamelength'});  
     $record{'scantron.LastName'}=  
  substr($data,$$scantron_config{'LastName'}-1,  
        $$scantron_config{'LastNamelength'});  
     my @alphabet=('A'..'Z');      my @alphabet=('A'..'Z');
     my $questnum=0;      my $questnum=0;
     while ($questions) {      while ($questions) {
Line 3363  sub scantron_parse_scanline { Line 3359  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);   my (@array)=split(/$$scantron_config{'Qon'}/,$currentquest);
    if (scalar(@array) gt 2) {
       #FIXME do something intelligent with double bubbles
       Apache->request->print("<br ><b>Wha!!!</b> <pre>".scalar(@array).
      '-'.$currentquest.'-'.$questnum.'</pre><br />');
    }
  if (length($array[0]) eq $$scantron_config{'Qlength'}) {   if (length($array[0]) eq $$scantron_config{'Qlength'}) {
     $record{"scantron.$questnum.answer"}='';      $record{"scantron.$questnum.answer"}='';
     if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {  
  push(@{$record{"scantron.missingerror"}},$questnum);  
     }  
  } else {   } else {
     $record{"scantron.$questnum.answer"}=$alphabet[length($array[0])];      $record{"scantron.$questnum.answer"}=$alphabet[length($array[0])];
  }   }
  if (scalar(@array) gt 2) {  
     push(@{$record{'scantron.doubleerror'}},$questnum);  
     my @ans=@array;  
     my $i=length($ans[0]);shift(@ans);  
     while ($#ans) {  
  $i+=length($ans[0])+1;  
  $record{"scantron.$questnum.answer"}.=$alphabet[$i];  
  shift(@ans);  
     }  
  }  
     }      }
     $record{'scantron.maxquest'}=$questnum;      $record{'scantron.maxquest'}=$questnum;
     return \%record;      return \%record;
Line 3389  sub scantron_parse_scanline { Line 3377  sub scantron_parse_scanline {
   
 sub scantron_add_delay {  sub scantron_add_delay {
     my ($delayqueue,$scanline,$errormessage,$errorcode)=@_;      my ($delayqueue,$scanline,$errormessage,$errorcode)=@_;
       Apache->request->print('add_delay_error '.$_[2] );
     push(@$delayqueue,      push(@$delayqueue,
  {'line' => $scanline, 'emsg' => $errormessage,   {'line' => $scanline, 'emsg' => $errormessage,
   'ecode' => $errorcode }    'ecode' => $errorcode }
Line 3396  sub scantron_add_delay { Line 3385  sub scantron_add_delay {
 }  }
   
 sub scantron_find_student {  sub scantron_find_student {
     my ($scantron_record,$scan_data,$idmap,$line)=@_;      my ($scantron_record,$idmap)=@_;
     my $scanID=$$scantron_record{'scantron.ID'};      my $scanID=$$scantron_record{'scantron.ID'};
     if ($scanID =~ /^\s*$/) {  
  return &scan_data($scan_data,"$line.user");  
     }  
     foreach my $id (keys(%$idmap)) {      foreach my $id (keys(%$idmap)) {
    #Apache->request->print('<pre>checking studnet -'.$id.'- againt -'.$scanID.'- </pre>');
  if (lc($id) eq lc($scanID)) {   if (lc($id) eq lc($scanID)) {
       #Apache->request->print('success');
     return $$idmap{$id};      return $$idmap{$id};
  }   }
     }      }
Line 3417  sub scantron_filter { Line 3405  sub scantron_filter {
     return 0;      return 0;
 }  }
   
 sub scantron_process_corrections {  #FIXME I think I am doing this in the wrong order, I think it would be
     my ($r) = @_;  #better to make a several passes analyzing all of the lines in the
     my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});  #file for common errors wrong/invalid PID/username duplicated
     my ($scanlines,$scan_data)=&scantron_getfile();  #PID/username, missing bubbles, double bubbles, missing/invalid CODE
     my $classlist=&Apache::loncoursedata::get_classlist();  #and then get the instructor to fix all of these errors, then grade
     my $which=$ENV{'form.scantron_line'};  #the corrected one, I'll still need to catch error conditions, but
     my $line=&scantron_get_line($scanlines,$which);  #maybe most will taken care even before we start
     my ($skip,$err,$errmsg);  
     if ($ENV{'form.scantron_skip_record'}) {  
  $skip=1;  
     } elsif ($ENV{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) {  
  my $newstudent=$ENV{'form.scantron_username'}.':'.  
     $ENV{'form.scantron_domain'};  
  my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID];  
  ($line,$err,$errmsg)=  
     &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which,  
      'ID',{'newid'=>$newid,  
     'username'=>$ENV{'form.scantron_username'},  
     'domain'=>$ENV{'form.scantron_domain'}});  
     } elsif ($ENV{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) {  
  foreach my $question (split(',',$ENV{'form.scantron_questions'})) {  
     ($line,$err,$errmsg)=  
  &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,  
  $which,'answer',  
  { 'question'=>$question,  
        'response'=>$ENV{"form.scantron_correct_Q_$question"}});  
     if ($err) { last; }  
  }  
     }  
     if ($err) {  
  $r->print("Unable to accept last correction, an error occurred :$errmsg:");  
     } else {  
  &scantron_put_line($scanlines,$which,$line,$skip);  
  &scantron_putfile($scanlines,$scan_data);  
     }  
 }  
   
   
 sub scantron_validate_file {  sub scantron_validate_file {
     my ($r) = @_;      my ($r) = @_;
     my ($symb,$url)=&get_symb_and_url($r);  
     if (!$symb) {return '';}  
     my $default_form_data=&defaultFormData($symb,$url);  
   
     if ($ENV{'form.scantron_corrections'}) {  
  &scantron_process_corrections($r);  
     }  
     #get the student pick code ready  
     $r->print(&Apache::loncommon::studentbrowser_javascript());  
     my $result= <<SCANTRONFORM;  
 <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload">  
   <input type="hidden" name="selectpage" value="$ENV{'form.selectpage'}" />  
   <input type="hidden" name="scantron_format" value="$ENV{'form.scantron_format'}" />  
   <input type="hidden" name="scantron_selectfile" value="$ENV{'form.scantron_selectfile'}" />  
   <input type="hidden" name="scantron_maxbubble" value="$ENV{'form.scantron_maxbubble'}" />  
   $default_form_data  
 SCANTRONFORM  
     $r->print($result);  
       
     my @validate_phases=( 'ID',  
   'CODE',  
   'doublebubble',  
   'missingbubbles');  
     if (!$ENV{'form.validatepass'}) {  
  $ENV{'form.valiadatepass'} = 0;  
     }  
     my $currentphase=$ENV{'form.valiadatepass'};  
   
     if ($ENV{'form.scantron_selectfile'}=~m-^/-) {  
  #first pass copy file to classdir  
   
     }  
     my $stop=0;  
     while (!$stop && $currentphase < scalar(@validate_phases)) {  
  $r->print("<p> Validating ".$validate_phases[$currentphase]."</p>");  
  $r->rflush();  
  my $which="scantron_validate_".$validate_phases[$currentphase];  
  {  
     no strict 'refs';  
     ($stop,$currentphase)=&$which($r,$currentphase);  
  }  
     }  
     if (!$stop) {  
  $r->print("Validation process complete.<br />");  
  $r->print('<input type="submit" name="submit" value="Start Grading" />');  
  $r->print('<input type="hidden" name="command" value="scantron_process" />');  
     } else {  
  $r->print('<input type="hidden" name="command" value="scantron_validate" />');  
  $r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />");  
     }  
     if ($stop) {  
  $r->print('<input type="submit" name="submit" value="Continue ->" />');  
  $r->print(' using corrected info <br />');  
  $r->print("<input type='submit' value='Skip' name='scantron_skip_record' />");  
  $r->print(" this scanline saving it for later.");  
     }  
     $r->print(" </form><br />".&show_grading_menu_form($symb,$url).  
       "</body></html>");  
     return '';  
 }  
   
 sub scantron_getfile {  
     #FIXME really would prefer a scantron directory but tokenwrapper  
     # doesn't allow access to subdirs of userfiles  
     my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};  
     my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};  
     my $lines;  
     $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.  
        'scantron_orig_'.$ENV{'form.scantron_selectfile'});  
     if ($lines eq '-1') {  
  #FIXME need to actually replicate file to course space  
  #FIXME when replicating strip CRLF to LF or CR to LF  
     }  
     my %scanlines;  
     $scanlines{'orig'}=[(split("\n",$lines,-1))];  
     my $temp=$scanlines{'orig'};  
     $scanlines{'count'}=$#$temp;  
   
     $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.  
        'scantron_corrected_'.$ENV{'form.scantron_selectfile'});  
     if ($lines eq '-1') {  
  $scanlines{'corrected'}=[];  
     } else {  
  $scanlines{'corrected'}=[(split("\n",$lines,-1))];  
     }  
     $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.  
        'scantron_skipped_'.$ENV{'form.scantron_selectfile'});  
     if ($lines eq '-1') {  
  $scanlines{'skipped'}=[];  
     } else {  
  $scanlines{'skipped'}=[(split("\n",$lines,-1))];  
     }  
     my @tmp=&Apache::lonnet::dump('scantrondata',$cdom,$cname);  
     if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); }  
     my %scan_data = @tmp;  
     return (\%scanlines,\%scan_data);  
 }  
   
 sub lonnet_putfile {  
     my ($contents,$filename)=@_;  
     my $docuname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};  
     my $docudom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};  
     my $docuhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'};  
     $ENV{'form.sillywaytopassafilearound'}=$contents;  
     &Apache::lonnet::finishuserfileupload($docuname,$docudom,$docuhome,'sillywaytopassafilearound',$filename);  
   
 }  
   
 sub scantron_putfile {  
     my ($scanlines,$scan_data) = @_;  
     #FIXME really would prefer a scantron directory but tokenwrapper  
     # doesn't allow access to subdirs of userfiles  
     my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};  
     my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};  
     my $prefix='scantron_';  
 # no need to update orig, shouldn't change  
 #   &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'.  
 #    $ENV{'form.scantron_selectfile'});  
     &lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}),  
     $prefix.'corrected_'.  
     $ENV{'form.scantron_selectfile'});  
     &lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}),  
     $prefix.'skipped_'.  
     $ENV{'form.scantron_selectfile'});  
     &Apache::lonnet::put('scantrondata',$scan_data,$cdom,$cname);  
 }  
   
 sub scantron_get_line {  
     my ($scanlines,$i)=@_;  
     if ($scanlines->{'skipped'}[$i]) {return undef;}  
     if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];}  
     return $scanlines->{'orig'}[$i];   
 }  
   
 sub scantron_put_line {  
     my ($scanlines,$i,$newline,$skip)=@_;  
     if ($skip) {  
  $scanlines->{'skipped'}[$i]=$newline;  
  return;  
     }  
     $scanlines->{'corrected'}[$i]=$newline;  
 }  
   
 sub scantron_validate_ID {  
     my ($r,$currentphase) = @_;  
       
     #get student info  
     my $classlist=&Apache::loncoursedata::get_classlist();  
     my %idmap=&username_to_idmap($classlist);  
   
     #get scantron line setup  
     my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});  
     my ($scanlines,$scan_data)=&scantron_getfile();  
   
     my %found=('ids'=>{},'usernames'=>{});  
     for (my $i=0;$i<=$scanlines->{'count'};$i++) {  
  my $line=&scantron_get_line($scanlines,$i);  
  if ($line=~/^[\s\cz]*$/) { next; }  
  my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,  
  $scan_data);  
  my $id=$$scan_record{'scantron.ID'};  
  my $found;  
  foreach my $checkid (keys(%idmap)) {  
     if (lc($checkid) eq lc($id)) { $found=$checkid;last; }  
  }  
  if ($found) {  
     my $username=$idmap{$found};  
     if ($found{'ids'}{$found}) {  
  &scantron_get_correction($r,$i,$scan_record,\%scantron_config,  
  $line,'duplicateID',$found);  
  return(1);  
     } elsif ($found{'usernames'}{$username}) {  
  &scantron_get_correction($r,$i,$scan_record,\%scantron_config,  
  $line,'duplicateID',$username);  
  return(1);  
     }  
     #FIXME store away line we prviously saw the ID on to use above  
     $found{'ids'}{$found}++;  
     $found{'usernames'}{$username}++;  
  } else {  
     if ($id =~ /^\s*$/) {  
  my $username=&scan_data($scan_data,"$i.user");  
  if (defined($username) && $found{'usernames'}{$username}) {  
     &scantron_get_correction($r,$i,$scan_record,  
      \%scantron_config,  
      $line,'duplicateID',$username);  
     return(1);  
  } elsif (!defined($username)) {  
     &scantron_get_correction($r,$i,$scan_record,  
      \%scantron_config,  
      $line,'incorrectID');  
     return(1);  
  }  
  $found{'usernames'}{$username}++;  
     } else {  
  &scantron_get_correction($r,$i,$scan_record,\%scantron_config,  
  $line,'incorrectID');  
  return(1);  
     }  
  }  
     }  
   
     return (0,$currentphase+1);  
 }  
   
 sub scantron_get_correction {  
     my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_;  
   
 #FIXME in the case of a duplicated ID the previous line, probaly need  
 #to show both the current line and the previous one and allow skipping  
 #the previous one or the current one  
   
     $r->print("<p>An error was detected ($error) ");  
     if ( defined($$scan_record{'scantron.PaperID'}) ) {  
  $r->print(" for PaperID <tt>".  
   $$scan_record{'scantron.PaperID'}."</tt> \n");  
     } else {  
  $r->print(" in scanline $i <pre>".  
   $line."</pre> \n");  
     }  
     $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n");  
     $r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n");  
     if ($error =~ /ID$/) {  
  if ($error eq 'unknownID') {  
     $r->print("The encoded ID is not in the classlist</p>\n");  
  } elsif ($error eq 'duplicateID') {  
     $r->print("The encoded ID has also been used by a previous paper $arg</p>\n");  
  }  
  $r->print("<p>The ID on the form is  <tt>".  
   $$scan_record{'scantron.ID'}."</tt><br />\n");  
  $r->print("The name on the paper is ".  
   $$scan_record{'scantron.LastName'}.",".  
   $$scan_record{'scantron.FirstName'}."</p>");  
  $r->print("<p>How should I handle this? <br /> \n");  
  $r->print("\n<ul><li> ");  
  #FIXME it would be nice if this sent back the user ID and  
  #could do partial userID matches  
  $r->print(&Apache::loncommon::selectstudent_link('scantronupload',  
        'scantron_username','scantron_domain'));  
  $r->print(": <input type='text' name='scantron_username' value='' />");  
  $r->print("\n@".  
  &Apache::loncommon::select_dom_form(undef,'scantron_domain'));  
   
  $r->print('</li>');  
     } elsif ($error eq 'doublebubble') {  
 #FIXME Need to print out who this is along with the paper info  
  $r->print("<p>There have been multiple bubbles scanned for a some question(s)</p>\n");  
  $r->print('<input type="hidden" name="scantron_questions" value="'.  
   join(',',@{$arg}).'" />');  
  $r->print("<p>Please indicate which bubble should be used for grading</p>");  
  foreach my $question (@{$arg}) {  
     my $selected=$$scan_record{"scantron.$question.answer"};  
     &scantron_bubble_selector($r,$scan_config,$question,split('',$selected));  
  }  
     } elsif ($error eq 'missingbubble') {  
  $r->print("<p>There have been <b>no</b> bubbles scanned for some question(s)</p>\n");  
  $r->print("<p>Please indicate which bubble should be used for grading</p>");  
  $r->print("Some questions have no scanned bubbles\n");  
  $r->print('<input type="hidden" name="scantron_questions" value="'.  
   join(',',@{$arg}).'" />');  
  foreach my $question (@{$arg}) {  
     my $selected=$$scan_record{"scantron.$question.answer"};  
     &scantron_bubble_selector($r,$scan_config,$question);  
  }  
     } else {  
  $r->print("\n<ul>");  
     }  
     $r->print("\n</li></ul>");  
   
 }  
   
 sub scantron_bubble_selector {  
     my ($r,$scan_config,$quest,@selected)=@_;  
     my $max=$$scan_config{'Qlength'};  
     my @alphabet=('A'..'Z');  
     $r->print("<table border='1'><tr><td rowspan='2'>$quest</td>");  
     for (my $i=0;$i<$max+1;$i++) {  
  $r->print('<td align="center">');  
  if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) }  
  else { $r->print('&nbsp;'); }  
  $r->print('</td>');  
     }  
     $r->print('<td></td></tr><tr>');  
     for (my $i=0;$i<$max;$i++) {  
  $r->print('<td><input type="radio" name="scantron_correct_Q_'.$quest.  
   '" value="'.$i.'" />'.$alphabet[$i]."</td>");  
     }  
     $r->print('<td><input type="radio" name="scantron_correct_Q_'.$quest.  
       '" value="none" /> No bubble </td>');  
     $r->print('</tr></table>');  
 }  
   
 sub scantron_validate_CODE {  
     my ($r,$currentphase) = @_;  
     #FIXME doesn't do anything yet  
     return (0,$currentphase+1);  
 }  
   
 sub scantron_validate_doublebubble {  
     my ($r,$currentphase) = @_;  
     #get student info  
     my $classlist=&Apache::loncoursedata::get_classlist();  
     my %idmap=&username_to_idmap($classlist);  
   
     #get scantron line setup  
     my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});  
     my ($scanlines,$scan_data)=&scantron_getfile();  
     for (my $i=0;$i<=$scanlines->{'count'};$i++) {  
  my $line=&scantron_get_line($scanlines,$i);  
  if ($line=~/^[\s\cz]*$/) { next; }  
  my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,  
  $scan_data);  
  if (!defined($$scan_record{'scantron.doubleerror'})) { next; }  
  &scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line,  
  'doublebubble',  
  $$scan_record{'scantron.doubleerror'});  
     return (1,$currentphase);  
     }  
     return (0,$currentphase+1);  
 }  
   
 sub scantron_validate_missingbubbles {  
     my ($r,$currentphase) = @_;  
     #get student info  
     my $classlist=&Apache::loncoursedata::get_classlist();  
     my %idmap=&username_to_idmap($classlist);  
   
     #get scantron line setup  
     my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});  
     my ($scanlines,$scan_data)=&scantron_getfile();  
     my $max_bubble=$ENV{'form.scantron_maxbubble'};  
     if (!$max_bubble) { $max_bubble=2**31; }  
     for (my $i=0;$i<=$scanlines->{'count'};$i++) {  
  my $line=&scantron_get_line($scanlines,$i);  
  if ($line=~/^[\s\cz]*$/) { next; }  
  my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,  
  $scan_data);  
  if (!defined($$scan_record{'scantron.missingerror'})) { next; }  
  my @to_correct;  
  foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) {  
     if ($missing > $max_bubble) { next; }  
     push(@to_correct,$missing);  
  }  
  if (@to_correct) {  
     &scantron_get_correction($r,$i,$scan_record,\%scantron_config,  
      $line,'missingbubble',\@to_correct);  
     return (1,$currentphase);  
  }  
   
     }  
     return (0,$currentphase+1);  
 }  }
   
 sub scantron_process_students {  sub scantron_process_students {
     my ($r) = @_;      my ($r) = @_;
     my (undef,undef,$sequence)=split(/___/,$ENV{'form.selectpage'});      my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($ENV{'form.selectpage'});
     my ($symb,$url)=&get_symb_and_url($r);      my ($symb,$url)=&get_symb_and_url($r);
     if (!$symb) {return '';}      if (!$symb) {return '';}
     my $default_form_data=&defaultFormData($symb,$url);      my $default_form_data=&defaultFormData($symb,$url);
   
     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=Apache::File->new($Apache::lonnet::perlvar{'lonScansDir'}."/$ENV{'form.scantron_selectfile'}");
       my @scanlines=<$scanlines>;
     my $classlist=&Apache::loncoursedata::get_classlist();      my $classlist=&Apache::loncoursedata::get_classlist();
     my %idmap=&username_to_idmap($classlist);      my %idmap=&username_to_idmap($classlist);
     my $navmap=Apache::lonnavmaps::navmap->new($ENV{'request.course.fn'}.'.db',$ENV{'request.course.fn'}.'_parms.db',1, 1);      my $navmap=Apache::lonnavmaps::navmap->new();
     my $map=$navmap->getResourceByUrl($sequence);      my $map=$navmap->getResourceByUrl($sequence);
     my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);      my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
 #    $r->print("geto ".scalar(@resources)."<br />");  #    $r->print("geto ".scalar(@resources)."<br />");
Line 3835  SCANTRONFORM Line 3443  SCANTRONFORM
     my @delayqueue;      my @delayqueue;
     my %completedstudents;      my %completedstudents;
           
     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status',      my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,
     'Scantron Progress',$scanlines->{'count'});             'Scantron Status','Scantron Progress',scalar(@scanlines));
     &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;      foreach my $line (@scanlines) {
     my ($uname,$udom);   $r->print('<pre>line is'.$line.'</pre>');
     while ($i<$scanlines->{'count'}) {  
  ($uname,$udom)=('','');   chomp($line);
  $i++;   my $scan_record=&scantron_parse_scanline($line,\%scantron_config);
  my $line=&scantron_get_line($scanlines,$i);   my ($uname,$udom);
 # $r->print('<pre>line is'.$line.'</pre>');   unless ($uname=&scantron_find_student($scan_record,\%idmap)) {
  if ($line=~/^[\s\cz]*$/) { next; }  
  my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,  
  $scan_data);  
  unless ($uname=&scantron_find_student($scan_record,$scan_data,  
       \%idmap,$i)) {  
     &scantron_add_delay(\@delayqueue,$line,      &scantron_add_delay(\@delayqueue,$line,
  'Unable to find a student that matches',1);   'Unable to find a student that matches',1);
     next;      next;
Line 3861  SCANTRONFORM Line 3464  SCANTRONFORM
  'Student '.$uname.' has multiple sheets',2);   'Student '.$uname.' has multiple sheets',2);
     next;      next;
  }   }
 # $r->print('<pre>doing studnet'.$uname.'</pre>');   $r->print('<pre>doing studnet'.$uname.'</pre>');
  ($uname,$udom)=split(/:/,$uname);   ($uname,$udom)=split(/:/,$uname);
  &Apache::lonnet::delenv('form.counter');   &Apache::lonnet::delenv('form.counter');
  &Apache::lonnet::appenv(%$scan_record);   &Apache::lonnet::appenv(%$scan_record);
Line 3901  SCANTRONFORM Line 3504  SCANTRONFORM
     } continue {      } continue {
  &Apache::lonnet::delenv('form.counter');   &Apache::lonnet::delenv('form.counter');
  &Apache::lonnet::delenv('scantron\.');   &Apache::lonnet::delenv('scantron\.');
  &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,$uname);   &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
    'last student');
  #last;   #last;
  #FIXME   #FIXME
  #get iterator for $sequence   #get iterator for $sequence
Line 3912  SCANTRONFORM Line 3516  SCANTRONFORM
     }      }
     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);      &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
     my $lasttime = &Time::HiRes::time()-$start;      my $lasttime = &Time::HiRes::time()-$start;
     #$r->print("<p>took $lasttime</p>");      $r->print("<p>took $lasttime</p>");
   
     #$Apache::lonxml::debug=0;      #$Apache::lonxml::debug=0;
     foreach my $delay (@delayqueue) {      foreach my $delay (@delayqueue) {
Line 3929  SCANTRONFORM Line 3533  SCANTRONFORM
     #     to ignore delayed students, possibly saving the delay queue for later      #     to ignore delayed students, possibly saving the delay queue for later
           
     $navmap->untieHashes();      $navmap->untieHashes();
     $r->print("<p>Done</p>");  
     $r->print(&show_grading_menu_form($symb,$url));  
     return '';  
 }  
   
 sub scantron_upload_scantron_data {  
     my ($r)=@_;  
     $r->print(&Apache::loncommon::coursebrowser_javascript($ENV{'request.role.domain'}));  
     my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid',  
   'domainid');  
     my $domsel=&Apache::loncommon::select_dom_form($ENV{'request.role.domain'},  
    'domainid');  
     $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'>  
 Course: <input name='courseid' type='text' />  
 Domain: $domsel $select_link  
 <br />  
 <input name='command' value='scantronupload_save' type='hidden' />  
 File to upload:<input type="file" name="upfile" size="50" />  
 <br />  
 <input type="button" onClick="javascript:checkUpload(this.form);" value="Upload Scantron Data" />  
 </form>  
 UPLOAD  
     return '';  
 }  
   
 sub scantron_upload_scantron_data_save {  
     my($r)=@_;  
     $r->print("Doing upload to ".$ENV{'form.courseid'});  
     my $home=&Apache::lonnet::homeserver($ENV{'form.courseid'},  
  $ENV{'form.domainid'});  
     my $fname=$ENV{'form.upfile.filename'};  
     #FIXME  
     #copied from lonnet::userfileupload()  
     #make that function able to target a specified course  
     # Replace Windows backslashes by forward slashes  
     $fname=~s/\\/\//g;  
     # Get rid of everything but the actual filename  
     $fname=~s/^.*\/([^\/]+)$/$1/;  
     # Replace spaces by underscores  
     $fname=~s/\s+/\_/g;  
     # Replace all other weird characters by nothing  
     $fname=~s/[^\w\.\-]//g;  
     # See if there is anything left  
     unless ($fname) { return 'error: no uploaded file'; }  
     $fname='scantron_orig_'.$fname;  
     &Apache::lonnet::logthis("fname is $fname");  
     $r->print(&Apache::lonnet::finishuserfileupload($ENV{'form.courseid'},  
     $ENV{'form.domainid'},  
     $home,'upfile',$fname));  
     return '';  
 }  }
   
   
 #-------- end of section for handling grading scantron forms -------  #-------- end of section for handling grading scantron forms -------
 #  #
 #-------------------------------------------------------------------  #-------------------------------------------------------------------
Line 4044  sub gradingmenu { Line 3585  sub gradingmenu {
  }   }
  formname.command.value = cmd;   formname.command.value = cmd;
  formname.saveState.value = "saveCmd="+cmdsave+":saveSec="+pullDownSelection(formname.section)+   formname.saveState.value = "saveCmd="+cmdsave+":saveSec="+pullDownSelection(formname.section)+
     ":saveSub="+radioSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.Status);      ":saveSub="+pullDownSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.Status);
  if (val < 5) formname.submit();   if (val < 5) formname.submit();
  if (val == 5) {   if (val == 5) {
     if (!checkReceiptNo(formname,'notOK')) { return false;}      if (!checkReceiptNo(formname,'notOK')) { return false;}
Line 4112  GRADINGMENUJS Line 3653  GRADINGMENUJS
   
     $result.='<tr bgcolor="#ffffe6"valign="top"><td>'.      $result.='<tr bgcolor="#ffffe6"valign="top"><td>'.
  '<input type="radio" name="radioChoice" value="submission" '.   '<input type="radio" name="radioChoice" value="submission" '.
  ($saveCmd eq 'submission' ? 'checked' : '').'> '.'<b>Current Resource:</b> For one or more students'.   ($saveCmd eq 'submission' ? 'checked' : '').'> '.'<b>Current Resource:</b> For one or more students '.
  '<br />&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;-->For students with '.   '<select name="submitonly">'.
  '<input type="radio" name="submitonly" value="yes" '.   '<option value="yes" '.
  ($saveSub eq 'yes' ? 'checked' : '').' /> submissions or '.   ($saveSub eq 'yes' ? 'selected="on"' : '').'>with submissions</option>'.
  '<input type="radio" name="submitonly" value="all" '.   '<option value="graded" '.
  ($saveSub eq 'all' ? 'checked' : '').' /> for all</td></tr>'."\n";   ($saveSub eq 'graded' ? 'selected="on"' : '').'>with ungraded submissions</option>'.
    '<option value="all" '.
    ($saveSub eq 'all' ? 'selected="on"' : '').'>with any status</option></select></td></tr>'."\n";
   
     $result.='<tr bgcolor="#ffffe6"valign="top"><td>'.      $result.='<tr bgcolor="#ffffe6"valign="top"><td>'.
  '<input type="radio" name="radioChoice" value="viewgrades" '.   '<input type="radio" name="radioChoice" value="viewgrades" '.
Line 4163  sub handler { Line 3706  sub handler {
   
     undef(%perm);      undef(%perm);
     if ($ENV{'browser.mathml'}) {      if ($ENV{'browser.mathml'}) {
  $request->content_type('text/xml');   &Apache::loncommon::content_type($request,'text/xml');
     } else {      } else {
  $request->content_type('text/html');   &Apache::loncommon::content_type($request,'text/html');
     }      }
     $request->send_http_header;      $request->send_http_header;
     return '' if $request->header_only;      return '' if $request->header_only;
Line 4175  sub handler { Line 3718  sub handler {
     my $command=$ENV{'form.command'};      my $command=$ENV{'form.command'};
     if (!$url) {      if (!$url) {
  my ($temp1,$temp2);   my ($temp1,$temp2);
  ($temp1,$temp2,$ENV{'form.url'})=split(/___/,$symb);   ($temp1,$temp2,$ENV{'form.url'})=&Apache::lonnet::decode_symb($symb);
  $url = $ENV{'form.url'};   $url = $ENV{'form.url'};
     }      }
     &send_header($request);      &send_header($request);
     if ($url eq '' && $symb eq '' && $command eq '') {      if ($url eq '' && $symb eq '') {
  if ($ENV{'user.adv'}) {   if ($ENV{'user.adv'}) {
     if (($ENV{'form.codeone'}) && ($ENV{'form.codetwo'}) &&      if (($ENV{'form.codeone'}) && ($ENV{'form.codetwo'}) &&
  ($ENV{'form.codethree'})) {   ($ENV{'form.codethree'})) {
Line 4188  sub handler { Line 3731  sub handler {
  my ($tsymb,$tuname,$tudom,$tcrsid)=   my ($tsymb,$tuname,$tudom,$tcrsid)=
     &Apache::lonnet::checkin($token);      &Apache::lonnet::checkin($token);
  if ($tsymb) {   if ($tsymb) {
     my ($map,$id,$url)=split(/\_\_\_/,$tsymb);      my ($map,$id,$url)=&Apache::lonnet::decode_symb($tsymb);
     if (&Apache::lonnet::allowed('mgr',$tcrsid)) {      if (&Apache::lonnet::allowed('mgr',$tcrsid)) {
  $request->print(&Apache::lonnet::ssi_body('/res/'.$url,   $request->print(&Apache::lonnet::ssi_body('/res/'.$url,
   ('grade_username' => $tuname,    ('grade_username' => $tuname,
Line 4220  sub handler { Line 3763  sub handler {
  delete($perm{'mgr'});   delete($perm{'mgr'});
     }      }
  }   }
   
  if ($command eq 'submission' && $perm{'vgr'}) {   if ($command eq 'submission' && $perm{'vgr'}) {
     ($ENV{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0));      ($ENV{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0));
  } elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) {   } elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) {
Line 4263  sub handler { Line 3807  sub handler {
     $request->print(&scantron_validate_file($request));      $request->print(&scantron_validate_file($request));
  } elsif ($command eq 'scantron_process' && $perm{'mgr'}) {   } elsif ($command eq 'scantron_process' && $perm{'mgr'}) {
     $request->print(&scantron_process_students($request));      $request->print(&scantron_process_students($request));
  } elsif ($command eq 'scantronupload' &&   
  &Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})) {  
     $request->print(&scantron_upload_scantron_data($request));  
   
  } elsif ($command eq 'scantronupload_save' &&  
  &Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})) {  
     $request->print(&scantron_upload_scantron_data_save($request));  
  } elsif ($command) {   } elsif ($command) {
     $request->print("$command ".join(':',%perm)."Access Denied");      $request->print("Access Denied");
  }   }
     }      }
     &send_footer($request);      &send_footer($request);
Line 4287  sub send_header { Line 3824  sub send_header {
 #remotewindow.close();  #remotewindow.close();
 #</script>");   #</script>"); 
     $request->print(&Apache::loncommon::bodytag('Grading'));      $request->print(&Apache::loncommon::bodytag('Grading'));
     $request->rflush();  
 }  }
   
 sub send_footer {  sub send_footer {
Removed from v.1.130.2.1.2.11  
changed lines
  Added in v.1.146

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