[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.6 and 1.130.2.1.2.11

version 1.130.2.1.2.6, 2003/09/29 21:31:30 version 1.130.2.1.2.11, 2003/10/16 03:51:52
Line 3145  sub getSequenceDropDown { Line 3145  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 {
     #FIXME need to support scantron files put in another location,  
     # maybe the course directory? a scantron dir in the course directory?  
     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">';
     opendir(DIR,$Apache::lonnet::perlvar{'lonScansDir'});      my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
     my @files=sort(readdir(DIR));      my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
       my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname,
          &propath($cdom,$cname));
     foreach my $filename (@files) {      foreach my $filename (@files) {
  if ($filename eq '.' or $filename eq '..') { next; }   ($filename)=split(/&/,$filename);
    if ($filename!~/^scantron_orig_/) { next ; }
    $filename=~s/^scantron_orig_//;
  $result.="<option>$filename</option>\n";   $result.="<option>$filename</option>\n";
     }      }
     closedir(DIR);  
     $result.="</select>";      $result.="</select>";
     return $result;      return $result;
 }  }
Line 3276  sub username_to_idmap { Line 3288  sub username_to_idmap {
 }  }
   
 sub scantron_fixup_scanline {  sub scantron_fixup_scanline {
     my ($scantron_config,$scan_data,$line,$whichline,$field,$newvalue,$arg)=@_;      my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_;
     if ($field eq 'ID') {      if ($field eq 'ID') {
  if ($newvalue > $$scantron_config{'IDlength'}) {   if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) {
     return ($line,1,'New value to large');      return ($line,1,'New value to large');
  }   }
  if ($newvalue < $$scantron_config{'IDlength'}) {   if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) {
     $newvalue=sprintf('%-'.$$scantron_config{'IDlength'}.'s',      $args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s',
       $newvalue);       $args->{'newid'});
  }   }
  substr($line,$$scantron_config{'IDstart'}-1,   substr($line,$$scantron_config{'IDstart'}-1,
        $$scantron_config{'IDlength'})=$newvalue;         $$scantron_config{'IDlength'})=$args->{'newid'};
    if ($args->{'newid'}=~/^\s*$/) {
       &scan_data($scan_data,"$whichline.user",
          $args->{'username'}.':'.$args->{'domain'});
    }
     } 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'};
  my $on=$scantron_config->{'Qon'};   my $on=$scantron_config->{'Qon'};
  my $answer=${off}x$length;   my $answer=${off}x$length;
  if ($arg eq 'none') {   if ($args->{'response'} eq 'none') {
     &scan_data($scan_data,"$whichline.no_bubble.$newvalue",'1');      &scan_data($scan_data,
          "$whichline.no_bubble.".$args->{'question'},'1');
  } else {   } else {
     substr($answer,$arg,1)=$on;      substr($answer,$args->{'response'},1)=$on;
     &scan_data($scan_data,"$whichline.no_bubble.$newvalue",undef,'1');      &scan_data($scan_data,
          "$whichline.no_bubble.".$args->{'question'},undef,'1');
  }   }
  my $where=$length*($newvalue-1)+$scantron_config->{'Qstart'};   my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'};
  Apache->request->print("where $where arg $arg ");  
  Apache->request->print('b:<pre>'.$line.'</pre>');  
  substr($line,$where-1,$length)=$answer;   substr($line,$where-1,$length)=$answer;
  Apache->request->print('a:<pre>'.$line.'</pre>');  
     }      }
     return $line;      return $line;
 }  }
Line 3361  sub scantron_parse_scanline { Line 3376  sub scantron_parse_scanline {
     push(@{$record{'scantron.doubleerror'}},$questnum);      push(@{$record{'scantron.doubleerror'}},$questnum);
     my @ans=@array;      my @ans=@array;
     my $i=length($ans[0]);shift(@ans);      my $i=length($ans[0]);shift(@ans);
     while (@ans) {      while ($#ans) {
  $i+=length($ans[0])+1;   $i+=length($ans[0])+1;
  $record{"scantron.$questnum.answer"}.=$alphabet[$i];   $record{"scantron.$questnum.answer"}.=$alphabet[$i];
  shift(@ans);   shift(@ans);
Line 3374  sub scantron_parse_scanline { Line 3389  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 3382  sub scantron_add_delay { Line 3396  sub scantron_add_delay {
 }  }
   
 sub scantron_find_student {  sub scantron_find_student {
     my ($scantron_record,$idmap)=@_;      my ($scantron_record,$scan_data,$idmap,$line)=@_;
     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 3402  sub scantron_filter { Line 3417  sub scantron_filter {
     return 0;      return 0;
 }  }
   
 #FIXME I think I am doing this in the wrong order, I think it would be  
 #better to make a several passes analyzing all of the lines in the  
 #file for common errors wrong/invalid PID/username duplicated  
 #PID/username, missing bubbles, double bubbles, missing/invalid CODE  
 #and then get the instructor to fix all of these errors, then grade  
 #the corrected one, I'll still need to catch error conditions, but  
 #maybe most will taken care even before we start  
   
 sub scantron_process_corrections {  sub scantron_process_corrections {
     my ($r) = @_;      my ($r) = @_;
     my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});      my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
Line 3426  sub scantron_process_corrections { Line 3433  sub scantron_process_corrections {
  my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID];   my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID];
  ($line,$err,$errmsg)=   ($line,$err,$errmsg)=
     &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which,      &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which,
      'ID',$newid);       'ID',{'newid'=>$newid,
       'username'=>$ENV{'form.scantron_username'},
       'domain'=>$ENV{'form.scantron_domain'}});
     } 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)=
  &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,   &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,
  $which,'answer',$question,   $which,'answer',
     $ENV{"form.scantron_correct_Q_$question"});   { 'question'=>$question,
          'response'=>$ENV{"form.scantron_correct_Q_$question"}});
     if ($err) { last; }      if ($err) { last; }
  }   }
     }      }
Line 3458  sub scantron_validate_file { Line 3468  sub scantron_validate_file {
     $r->print(&Apache::loncommon::studentbrowser_javascript());      $r->print(&Apache::loncommon::studentbrowser_javascript());
     my $result= <<SCANTRONFORM;      my $result= <<SCANTRONFORM;
 <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload">  <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload">
   <input type="hidden" name="command" value="scantron_validate" />  
   <input type="hidden" name="selectpage" value="$ENV{'form.selectpage'}" />    <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_format" value="$ENV{'form.scantron_format'}" />
   <input type="hidden" name="scantron_selectfile" value="$ENV{'form.scantron_selectfile'}" />    <input type="hidden" name="scantron_selectfile" value="$ENV{'form.scantron_selectfile'}" />
Line 3482  SCANTRONFORM Line 3491  SCANTRONFORM
     }      }
     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->rflush();
  my $which="scantron_validate_".$validate_phases[$currentphase];   my $which="scantron_validate_".$validate_phases[$currentphase];
  {   {
     no strict 'refs';      no strict 'refs';
     ($stop,$currentphase)=&$which($r,$currentphase);      ($stop,$currentphase)=&$which($r,$currentphase);
  }   }
     }      }
     $r->print("<input type='hidden' name='validatepass' value='".$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 '';      return '';
 }  }
   
 sub scantron_getfile {  sub scantron_getfile {
     #my $scanlines=Apache::File->new($Apache::lonnet::perlvar{'lonScansDir'}."/$ENV{'form.scantron_selectfile'}");  
     #FIXME really would prefer a scantron directory but tokenwrapper      #FIXME really would prefer a scantron directory but tokenwrapper
     # doesn't allow access to subdirs of userfiles      # 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'};
Line 3502  sub scantron_getfile { Line 3527  sub scantron_getfile {
     $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.      $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
        'scantron_orig_'.$ENV{'form.scantron_selectfile'});         'scantron_orig_'.$ENV{'form.scantron_selectfile'});
     if ($lines eq '-1') {      if ($lines eq '-1') {
        #FIXME need to actually replicate file to course space   #FIXME need to actually replicate file to course space
    #FIXME when replicating strip CRLF to LF or CR to LF
     }      }
     my %scanlines;      my %scanlines;
     $scanlines{'orig'}=[split("\n",$lines)];      $scanlines{'orig'}=[(split("\n",$lines,-1))];
     my $temp=$scanlines{'orig'};      my $temp=$scanlines{'orig'};
     $scanlines{'count'}=$#$temp;      $scanlines{'count'}=$#$temp;
   
Line 3514  sub scantron_getfile { Line 3540  sub scantron_getfile {
     if ($lines eq '-1') {      if ($lines eq '-1') {
  $scanlines{'corrected'}=[];   $scanlines{'corrected'}=[];
     } else {      } else {
  $scanlines{'corrected'}=[split("\n",$lines)];   $scanlines{'corrected'}=[(split("\n",$lines,-1))];
     }      }
     $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.      $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
        'scantron_skipped_'.$ENV{'form.scantron_selectfile'});         'scantron_skipped_'.$ENV{'form.scantron_selectfile'});
     if ($lines eq '-1') {      if ($lines eq '-1') {
  $scanlines{'skipped'}=[];   $scanlines{'skipped'}=[];
     } else {      } else {
  $scanlines{'skipped'}=[split("\n",$lines)];   $scanlines{'skipped'}=[(split("\n",$lines,-1))];
     }      }
     my @tmp=&Apache::lonnet::dump('scantrondata',$cdom,$cname);      my @tmp=&Apache::lonnet::dump('scantrondata',$cdom,$cname);
     if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); }      if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); }
Line 3567  sub scantron_get_line { Line 3593  sub scantron_get_line {
   
 sub scantron_put_line {  sub scantron_put_line {
     my ($scanlines,$i,$newline,$skip)=@_;      my ($scanlines,$i,$newline,$skip)=@_;
     if ($skip) { $scanlines->{'skipped'}[$i]=$newline;return; }      if ($skip) {
    $scanlines->{'skipped'}[$i]=$newline;
    return;
       }
     $scanlines->{'corrected'}[$i]=$newline;      $scanlines->{'corrected'}[$i]=$newline;
 }  }
   
Line 3585  sub scantron_validate_ID { Line 3614  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,$i);
  if (!$line) { 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);
  my $id=$$scan_record{'scantron.ID'};   my $id=$$scan_record{'scantron.ID'};
  $r->print("<p>Checking ID ".$$scan_record{'scantron.ID'}.  
   " on paper ID ".$$scan_record{'scantron.PaperID'}."</p>\n");  
  my $found;   my $found;
  foreach my $checkid (keys(%idmap)) {   foreach my $checkid (keys(%idmap)) {
     if (lc($checkid) eq lc($id)) {      if (lc($checkid) eq lc($id)) { $found=$checkid;last; }
  if ($checkid ne $id) {  
     $r->print("<p>Using $checkid for encoded $id</p>\n");  
  }  
  $found=$checkid;last;  
     }  
  }   }
  if ($found) {   if ($found) {
       my $username=$idmap{$found};
     if ($found{'ids'}{$found}) {      if ($found{'ids'}{$found}) {
  #FIXME store away line we prviously saw the ID on  
  &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);
     } else {      } elsif ($found{'usernames'}{$username}) {
  $found{'ids'}{$found}++;   &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 {   } else {
     &scantron_get_correction($r,$i,$scan_record,\%scantron_config,      if ($id =~ /^\s*$/) {
      $line,'incorrectID');   my $username=&scan_data($scan_data,"$i.user");
     return(1);   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);
       }
  }   }
     }      }
   
Line 3626  sub scantron_get_correction { Line 3669  sub scantron_get_correction {
 #to show both the current line and the previous one and allow skipping  #to show both the current line and the previous one and allow skipping
 #the previous one or the current one  #the previous one or the current one
   
     $r->print("<p>This scantron record has an error ($error). ");      $r->print("<p>An error was detected ($error) ");
     if ( defined($$scan_record{'scantron.PaperID'}) ) {      if ( defined($$scan_record{'scantron.PaperID'}) ) {
  $r->print("The current PaperID is <tt>".   $r->print(" for PaperID <tt>".
   $$scan_record{'scantron.PaperID'}."</tt> \n");    $$scan_record{'scantron.PaperID'}."</tt> \n");
     } else {      } else {
  $r->print("The current scanline is <pre>".   $r->print(" in scanline $i <pre>".
   $line."</pre> \n");    $line."</pre> \n");
     }      }
     $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n");      $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n");
Line 3642  sub scantron_get_correction { Line 3685  sub scantron_get_correction {
  } 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>Original ID is <tt>".$$scan_record{'scantron.ID'}.   $r->print("<p>The ID on the form is  <tt>".
   "</tt><br />\n");    $$scan_record{'scantron.ID'}."</tt><br />\n");
  $r->print("Name on paper is ".$$scan_record{'scantron.LastName'}.",".   $r->print("The name on the paper is ".
     $$scan_record{'scantron.LastName'}.",".
   $$scan_record{'scantron.FirstName'}."</p>");    $$scan_record{'scantron.FirstName'}."</p>");
  $r->print("<p>Please correct <br /> \n");   $r->print("<p>How should I handle this? <br /> \n");
  $r->print("\n<ul><li> Pick a specific user -- username:<input type='text' name='scantron_username' value='' />");   $r->print("\n<ul><li> ");
  $r->print("\ndomain:".  
  &Apache::loncommon::select_dom_form(undef,'scantron_domain'));  
  #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
  #could do partial userID matches   #could do partial userID matches
  $r->print(&Apache::loncommon::selectstudent_link('scantronupload',   $r->print(&Apache::loncommon::selectstudent_link('scantronupload',
       'scantron_username','scantron_domain'));         '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>');   $r->print('</li>');
     } elsif ($error eq 'doublebubble') {      } elsif ($error eq 'doublebubble') {
  $r->print("There have been multiple bubbles scanned for a single question\n");  #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="'.   $r->print('<input type="hidden" name="scantron_questions" value="'.
   join(',',@{$arg}).'" />');    join(',',@{$arg}).'" />');
    $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"};
     $r->print("<p> For question $question, selected bubbles were ".      &scantron_bubble_selector($r,$scan_config,$question,split('',$selected));
       join(" ",split('',$selected)).  
               " <br />Please pick which one should be used for grading<br />");  
     &scantron_bubble_selector($r,$scan_config,$question);  
  }   }
     } 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>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="'.
   join(',',@{$arg}).'" />');    join(',',@{$arg}).'" />');
  foreach my $question (@{$arg}) {   foreach my $question (@{$arg}) {
     my $selected=$$scan_record{"scantron.$question.answer"};      my $selected=$$scan_record{"scantron.$question.answer"};
     $r->print("<p>Question $question, Please select a bubble to use ");  
     &scantron_bubble_selector($r,$scan_config,$question);      &scantron_bubble_selector($r,$scan_config,$question);
  }   }
     } else {      } else {
  $r->print("\n<ul>");   $r->print("\n<ul>");
     }      }
     $r->print("<li>Skip this scanline saving it for later  ");      $r->print("\n</li></ul>");
     $r->print("\n<input type='checkbox' name='scantron_skip_record' /> </li></ul>");  
     &scantron_end_validate_form($r);  
 }  }
   
 sub scantron_bubble_selector {  sub scantron_bubble_selector {
     my ($r,$scan_config,$quest)=@_;      my ($r,$scan_config,$quest,@selected)=@_;
     my $max=$$scan_config{'Qlength'};      my $max=$$scan_config{'Qlength'};
     my @alphabet=('A'..'Z');      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++) {      for (my $i=0;$i<$max;$i++) {
  $r->print('<input type="radio" name="scantron_correct_Q_'.$quest.   $r->print('<td><input type="radio" name="scantron_correct_Q_'.$quest.
   '" value="'.$i.'" />'.$alphabet[$i]);    '" value="'.$i.'" />'.$alphabet[$i]."</td>");
     }      }
     $r->print('<input type="radio" name="scantron_correct_Q_'.$quest.      $r->print('<td><input type="radio" name="scantron_correct_Q_'.$quest.
       '" value="none" /> Nothing');        '" value="none" /> No bubble </td>');
     $r->print('<br />');      $r->print('</tr></table>');
 }  }
   
 sub scantron_validate_CODE {  sub scantron_validate_CODE {
Line 3713  sub scantron_validate_doublebubble { Line 3766  sub scantron_validate_doublebubble {
     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,$i);
  if (!$line) { 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);
  if (!defined($$scan_record{'scantron.doubleerror'})) { next; }   if (!defined($$scan_record{'scantron.doubleerror'})) { next; }
Line 3738  sub scantron_validate_missingbubbles { Line 3791  sub scantron_validate_missingbubbles {
     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,$i);
  if (!$line) { 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);
  if (!defined($$scan_record{'scantron.missingerror'})) { next; }   if (!defined($$scan_record{'scantron.missingerror'})) { next; }
  my @to_correct;   my @to_correct;
  foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) {   foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) {
     if ($missing gt $max_bubble) { next; }      if ($missing > $max_bubble) { next; }
     push(@to_correct,$missing);      push(@to_correct,$missing);
  }   }
  if (@to_correct) {   if (@to_correct) {
Line 3757  sub scantron_validate_missingbubbles { Line 3810  sub scantron_validate_missingbubbles {
     return (0,$currentphase+1);      return (0,$currentphase+1);
 }  }
   
 sub scantron_end_validate_form {  
     my ($r) = @_;  
     $r->print('<input type="submit" name="submit" /></form></body></html>');  
 }  
   
 sub scantron_process_students {  sub scantron_process_students {
     my ($r) = @_;      my ($r) = @_;
     my (undef,undef,$sequence)=split(/___/,$ENV{'form.selectpage'});      my (undef,undef,$sequence)=split(/___/,$ENV{'form.selectpage'});
Line 3792  SCANTRONFORM Line 3840  SCANTRONFORM
     &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=0;      my $i=-1;
     while ($i<=$scanlines->{'count'}) {      my ($uname,$udom);
       while ($i<$scanlines->{'count'}) {
    ($uname,$udom)=('','');
  $i++;   $i++;
  my $line=&scantron_get_line($scanlines,$i);   my $line=&scantron_get_line($scanlines,$i);
  if (!$line) { next; }  # $r->print('<pre>line is'.$line.'</pre>');
  $r->print('<pre>line is'.$line.'</pre>');   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);
  my ($uname,$udom);   unless ($uname=&scantron_find_student($scan_record,$scan_data,
  unless ($uname=&scantron_find_student($scan_record,\%idmap)) {        \%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 3811  SCANTRONFORM Line 3861  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 3851  SCANTRONFORM Line 3901  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,   &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,$uname);
  'last student');  
  #last;   #last;
  #FIXME   #FIXME
  #get iterator for $sequence   #get iterator for $sequence
Line 3863  SCANTRONFORM Line 3912  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 3880  SCANTRONFORM Line 3929  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 4067  sub handler { Line 4179  sub handler {
  $url = $ENV{'form.url'};   $url = $ENV{'form.url'};
     }      }
     &send_header($request);      &send_header($request);
     if ($url eq '' && $symb eq '') {      if ($url eq '' && $symb eq '' && $command 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 4108  sub handler { Line 4220  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 4152  sub handler { Line 4263  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("Access Denied");      $request->print("$command ".join(':',%perm)."Access Denied");
  }   }
     }      }
     &send_footer($request);      &send_footer($request);
Removed from v.1.130.2.1.2.6  
changed lines
  Added in v.1.130.2.1.2.11

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