[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.131

version 1.130.2.1.2.11, 2003/10/16 03:51:52 version 1.131, 2003/08/07 14:33:15
Line 2510  to this page if the data selected is ins Line 2510  to this page if the data selected is ins
 $javascript  $javascript
 </script>  </script>
 ENDPICK  ENDPICK
       $request->print(&show_grading_menu_form($symb,$url));
     return '';      return '';
   
 }  }
Line 2800  sub getSymbMap { Line 2801  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'}.'.db',
   $ENV{'request.course.fn'}.'_parms.db');    $ENV{'request.course.fn'}.'_parms.db');
 #    $navmap->init();      $navmap->init();
   
     my %symbx = ();      my %symbx = ();
     my @titles = ();      my @titles = ();
Line 3145  sub getSequenceDropDown { Line 3146  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 3183  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_process" />
   $default_form_data    $default_form_data
   <table width="100%" border="0">    <table width="100%" border="0">
     <tr>      <tr>
Line 3226  sub scantron_selectphase { Line 3211  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>
   </table>    </table>
   <input type="submit" value="Validate Scantron Records" />    <input type="submit" value="Submit" />
 </form>  </form>
 $grading_menu_button  $grading_menu_button
 SCANTRONFORM  SCANTRONFORM
Line 3249  sub get_scantron_config { Line 3227  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 3243  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 3258  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 3273  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 3280  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;
 }  }
   
 sub scantron_add_delay {  sub scantron_add_delay {
     my ($delayqueue,$scanline,$errormessage,$errorcode)=@_;  
     push(@$delayqueue,  
  {'line' => $scanline, 'emsg' => $errormessage,  
   'ecode' => $errorcode }  
  );  
 }  }
   
 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)) {
  if (lc($id) eq lc($scanID)) {   Apache->request->print('<pre>checking studnet -'.$id.'- againt -'.$scanID.'- </pre>');
     return $$idmap{$id};   if (lc($id) eq lc($scanID)) { Apache->request->print('success');return $$idmap{$id}; }
  }  
     }      }
     return undef;      return undef;
 }  }
Line 3417  sub scantron_filter { Line 3317  sub scantron_filter {
     return 0;      return 0;
 }  }
   
 sub scantron_process_corrections {  
     my ($r) = @_;  
     my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});  
     my ($scanlines,$scan_data)=&scantron_getfile();  
     my $classlist=&Apache::loncoursedata::get_classlist();  
     my $which=$ENV{'form.scantron_line'};  
     my $line=&scantron_get_line($scanlines,$which);  
     my ($skip,$err,$errmsg);  
     if ($ENV{'form.scantron_skip_record'}) {  
  $skip=1;  
     } elsif ($ENV{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) {  
  my $newstudent=$ENV{'form.scantron_username'}.':'.  
     $ENV{'form.scantron_domain'};  
  my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID];  
  ($line,$err,$errmsg)=  
     &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which,  
      'ID',{'newid'=>$newid,  
     'username'=>$ENV{'form.scantron_username'},  
     'domain'=>$ENV{'form.scantron_domain'}});  
     } elsif ($ENV{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) {  
  foreach my $question (split(',',$ENV{'form.scantron_questions'})) {  
     ($line,$err,$errmsg)=  
  &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,  
  $which,'answer',  
  { 'question'=>$question,  
        'response'=>$ENV{"form.scantron_correct_Q_$question"}});  
     if ($err) { last; }  
  }  
     }  
     if ($err) {  
  $r->print("Unable to accept last correction, an error occurred :$errmsg:");  
     } else {  
  &scantron_put_line($scanlines,$which,$line,$skip);  
  &scantron_putfile($scanlines,$scan_data);  
     }  
 }  
   
   
 sub scantron_validate_file {  
     my ($r) = @_;  
     my ($symb,$url)=&get_symb_and_url($r);  
     if (!$symb) {return '';}  
     my $default_form_data=&defaultFormData($symb,$url);  
   
     if ($ENV{'form.scantron_corrections'}) {  
  &scantron_process_corrections($r);  
     }  
     #get the student pick code ready  
     $r->print(&Apache::loncommon::studentbrowser_javascript());  
     my $result= <<SCANTRONFORM;  
 <form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload">  
   <input type="hidden" name="selectpage" value="$ENV{'form.selectpage'}" />  
   <input type="hidden" name="scantron_format" value="$ENV{'form.scantron_format'}" />  
   <input type="hidden" name="scantron_selectfile" value="$ENV{'form.scantron_selectfile'}" />  
   <input type="hidden" name="scantron_maxbubble" value="$ENV{'form.scantron_maxbubble'}" />  
   $default_form_data  
 SCANTRONFORM  
     $r->print($result);  
       
     my @validate_phases=( 'ID',  
   'CODE',  
   'doublebubble',  
   'missingbubbles');  
     if (!$ENV{'form.validatepass'}) {  
  $ENV{'form.valiadatepass'} = 0;  
     }  
     my $currentphase=$ENV{'form.valiadatepass'};  
   
     if ($ENV{'form.scantron_selectfile'}=~m-^/-) {  
  #first pass copy file to classdir  
   
     }  
     my $stop=0;  
     while (!$stop && $currentphase < scalar(@validate_phases)) {  
  $r->print("<p> Validating ".$validate_phases[$currentphase]."</p>");  
  $r->rflush();  
  my $which="scantron_validate_".$validate_phases[$currentphase];  
  {  
     no strict 'refs';  
     ($stop,$currentphase)=&$which($r,$currentphase);  
  }  
     }  
     if (!$stop) {  
  $r->print("Validation process complete.<br />");  
  $r->print('<input type="submit" name="submit" value="Start Grading" />');  
  $r->print('<input type="hidden" name="command" value="scantron_process" />');  
     } else {  
  $r->print('<input type="hidden" name="command" value="scantron_validate" />');  
  $r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />");  
     }  
     if ($stop) {  
  $r->print('<input type="submit" name="submit" value="Continue ->" />');  
  $r->print(' using corrected info <br />');  
  $r->print("<input type='submit' value='Skip' name='scantron_skip_record' />");  
  $r->print(" this scanline saving it for later.");  
     }  
     $r->print(" </form><br />".&show_grading_menu_form($symb,$url).  
       "</body></html>");  
     return '';  
 }  
   
 sub scantron_getfile {  
     #FIXME really would prefer a scantron directory but tokenwrapper  
     # doesn't allow access to subdirs of userfiles  
     my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};  
     my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};  
     my $lines;  
     $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.  
        'scantron_orig_'.$ENV{'form.scantron_selectfile'});  
     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)=split(/___/,$ENV{'form.selectpage'});
Line 3818  sub scantron_process_students { Line 3325  sub scantron_process_students {
     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(1, 1);
     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 />");
     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_configphase" />    <input type="hidden" name="command" value="scantron_configphase" />
Line 3833  SCANTRONFORM Line 3341  SCANTRONFORM
     $r->print($result);      $r->print($result);
   
     my @delayqueue;      my @delayqueue;
     my %completedstudents;      my $totalcorrect;
           my $totalincorrect;
     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status',  
     'Scantron Progress',$scanlines->{'count'});      my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,
     &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,             'Scantron Status','Scantron Progress',scalar(@scanlines));
   'Processing first student');      foreach my $line (@scanlines) {
     my $start=&Time::HiRes::time();   my $studentcorrect;
     my $i=-1;   my $studentincorrect;
     my ($uname,$udom);  
     while ($i<$scanlines->{'count'}) {   chomp($line);
  ($uname,$udom)=('','');   my $scan_record=&scantron_parse_scanline($line,\%scantron_config);
  $i++;   my ($uname,$udom);
  my $line=&scantron_get_line($scanlines,$i);   if ($uname=&scantron_find_student($scan_record,\%idmap)) {
 # $r->print('<pre>line is'.$line.'</pre>');  
  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,  
  'Unable to find a student that matches',1);  
     next;  
  }  
  if (exists $completedstudents{$uname}) {  
     &scantron_add_delay(\@delayqueue,$line,      &scantron_add_delay(\@delayqueue,$line,
  'Student '.$uname.' has multiple sheets',2);   'Unable to find a student that matches');
     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);
 #    &Apache::lonhomework::showhash(%ENV);  #    &Apache::lonhomework::showhash(%ENV);
 #    $Apache::lonxml::debug=1;      $Apache::lonxml::debug=1;
 # &Apache::lonxml::debug("line is $line");   &Apache::lonxml::debug("line is $line");
   
     my $i=0;      my $i=0;
  foreach my $resource (@resources) {   foreach my $resource (@resources) {
Line 3879  SCANTRONFORM Line 3375  SCANTRONFORM
   'grade_domain'  =>$udom,    'grade_domain'  =>$udom,
   'grade_courseid'=>$ENV{'request.course.id'},    'grade_courseid'=>$ENV{'request.course.id'},
   'grade_symb'    =>$resource->symb()));    'grade_symb'    =>$resource->symb()));
 #    my %score=&Apache::lonnet::restore($resource->symb(),      my %score=&Apache::lonnet::restore($resource->symb(),
 #       $ENV{'request.course.id'},         $ENV{'request.course.id'},
 #       $udom,$uname);         $udom,$uname);
 #    foreach my $part ($resource->{PARTS}) {      foreach my $part ($resource->{PARTS}) {
 # if ($score{'resource.'.$part.'.solved'} =~ /^correct/) {   if ($score{'resource.'.$part.'.solved'} =~ /^correct/) {
 #    $studentcorrect++;      $studentcorrect++;
 #    $totalcorrect++;      $totalcorrect++;
 # } else {   } else {
 #    $studentincorrect++;      $studentincorrect++;
 #    $totalincorrect++;      $totalincorrect++;
 # }   }
 #    }      }
 #    $r->print('<pre>'.      $r->print('<pre>'.
 #      $resource->symb().'-'.        $resource->symb().'-'.
 #      $resource->src().'-'.'</pre>result is'.$result);        $resource->src().'-'.'</pre>result is'.$result);
 #    &Apache::lonhomework::showhash(%score);      &Apache::lonhomework::showhash(%score);
  #    if ($i eq 3) {last;}   #    if ($i eq 3) {last;}
  }   }
  $completedstudents{$uname}={'line'=>$line};  
     } 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;               'last student Who got a '.$studentcorrect.' correct and '.
        $studentincorrect.' incorrect. The class has gotten '.
                $totalcorrect.' correct and '.$totalincorrect.' incorrect');
    last;
  #FIXME   #FIXME
  #get iterator for $sequence   #get iterator for $sequence
  #foreach question 'submit' the students answer to the server   #foreach question 'submit' the students answer to the server
Line 3910  SCANTRONFORM Line 3407  SCANTRONFORM
  #   generate data to pass back that includes grade recevied   #   generate data to pass back that includes grade recevied
  #}   #}
     }      }
     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);      $Apache::lonxml::debug=0;
     my $lasttime = &Time::HiRes::time()-$start;  
     #$r->print("<p>took $lasttime</p>");  
   
     #$Apache::lonxml::debug=0;  
     foreach my $delay (@delayqueue) {      foreach my $delay (@delayqueue) {
  #FIXME   #FIXME
  #print out each delayed student with interface to select how   #print out each delayed student with interface to select how
Line 3929  SCANTRONFORM Line 3422  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 4179  sub handler { Line 3609  sub handler {
  $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 4220  sub handler { Line 3650  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 4259  sub handler { Line 3690  sub handler {
     }      }
  } elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) {   } elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) {
     $request->print(&scantron_selectphase($request));      $request->print(&scantron_selectphase($request));
  } elsif ($command eq 'scantron_validate' && $perm{'mgr'}) {  
     $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 3709  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.131

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