[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.4 and 1.136

version 1.130.2.1.2.4, 2003/09/27 01:59:10 version 1.136, 2003/09/09 18:46:28
Line 517  LISTJAVASCRIPT Line 517  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 544  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 1461  KEYWORDS Line 1461  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 1487  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 2798  LISTJAVASCRIPT Line 2805  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 2850  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 3008  sub updateGradeByPage { Line 3012  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 3146  sub getSequenceDropDown { Line 3149  sub getSequenceDropDown {
 }  }
   
 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'});      opendir(DIR,$Apache::lonnet::perlvar{'lonScansDir'});
Line 3184  sub scantron_selectphase { Line 3185  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 3218  sub scantron_selectphase { Line 3217  sub scantron_selectphase {
       </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 3230  sub get_scantron_config { Line 3229  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 3247  sub get_scantron_config { Line 3245  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 3268  sub username_to_idmap { Line 3260  sub username_to_idmap {
     return %idmap;      return %idmap;
 }  }
   
 sub scantron_fixup_scanline {  
     my ($scantron_config,$line,$field,$newvalue) = @_;  
     if ($field eq 'ID') {  
  if ($newvalue > $$scantron_config{'IDlength'}) {  
     return ($line,1,'New value to large');  
  }  
  if ($newvalue < $$scantron_config{'IDlength'}) {  
     $newvalue=sprintf('%-'.$$scantron_config{'IDlength'}.'s',  
       $newvalue);  
  }  
  substr($line,$$scantron_config{'IDstart'}-1,  
        $$scantron_config{'IDlength'})=$newvalue;  
     }  
     return $line;  
 }  
   
 sub scantron_parse_scanline {  sub scantron_parse_scanline {
     my ($line,$scantron_config)=@_;      my ($line,$scantron_config)=@_;
     my %record;      my %record;
Line 3299  sub scantron_parse_scanline { Line 3275  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 3316  sub scantron_parse_scanline { Line 3283  sub scantron_parse_scanline {
  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);   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"}='';
  } 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'}},$currentquest);  
     my @ans=@array;  
     my $i=length($ans[0]);shift(@ans);  
     while (@ans) {  
  $i+=length($ans[0])+1;  
  $record{"scantron.$questnum.answer"}.=$alphabet[$i];  
     }  
  }  
     }      }
     $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)=@_;  
     Apache->request->print('add_delay_error '.$_[2] );  
     push(@$delayqueue,  
  {'line' => $scanline, 'emsg' => $errormessage,  
   'ecode' => $errorcode }  
  );  
 }  }
   
 sub scantron_find_student {  sub scantron_find_student {
     my ($scantron_record,$idmap)=@_;      my ($scantron_record,$idmap)=@_;
     my $scanID=$$scantron_record{'scantron.ID'};      my $scanID=$$scantron_record{'scantron.ID'};
     foreach my $id (keys(%$idmap)) {      foreach my $id (keys(%$idmap)) {
  #Apache->request->print('<pre>checking studnet -'.$id.'- againt -'.$scanID.'- </pre>');   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}; }
     #Apache->request->print('success');  
     return $$idmap{$id};  
  }  
     }      }
     return undef;      return undef;
 }  }
Line 3365  sub scantron_filter { Line 3319  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 {  
     my ($r) = @_;  
     if ($ENV{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) {  
  my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});  
  my $scanlines=&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;  
  } else {  
     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,$line,'ID',$newid);  
  }  
  if ($err) {  
     $r->print("Unable to accept last correction, an error occurred :$errmsg:");  
  } else {  
     &scantron_put_line($scanlines,$which,$line,$skip);  
     &scantron_putfile($scanlines);  
  }  
     }  
 }  
   
 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="command" value="scantron_validate" />  
   <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'}" />  
   $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)) {  
  my $which="scantron_validate_".$validate_phases[$currentphase];  
  {  
     no strict 'refs';  
     ($stop,$currentphase)=&$which($r,$currentphase);  
  }  
     }  
     $r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />");  
     return '';  
 }  
   
 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  
     # doesn't allow access to subdirs of userfiles  
     my $lines;  
     $lines=&Apache::lonnet::getfile('/uploaded/'.  
    $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.  
    $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.  
        'scantron_orig_'.$ENV{'form.scantron_selectfile'});  
     if ($lines eq '-1') {  
        #FIXME need to actually replicate file to course space  
     }  
     my %scanlines;  
     $scanlines{'orig'}=[split("\n",$lines)];  
     my $temp=$scanlines{'orig'};  
     $scanlines{'count'}=$#$temp;  
   
     $lines=&Apache::lonnet::getfile('/uploaded/'.  
    $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.  
    $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.  
        'scantron_corrected_'.$ENV{'form.scantron_selectfile'});  
     if ($lines eq '-1') {  
  $scanlines{'corrected'}=[];  
     } else {  
  $scanlines{'corrected'}=[split("\n",$lines)];  
     }  
     $lines=&Apache::lonnet::getfile('/uploaded/'.  
    $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.  
    $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.  
        'scantron_skipped_'.$ENV{'form.scantron_selectfile'});  
     if ($lines eq '-1') {  
  $scanlines{'skipped'}=[];  
     } else {  
  $scanlines{'skipped'}=[split("\n",$lines)];  
     }  
     return \%scanlines;  
 }  
   
 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) = @_;  
     #FIXME really would prefer a scantron directory but tokenwrapper  
     # doesn't allow access to subdirs of userfiles  
     my $prefix='/uploaded/'.  
  $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.  
  $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.  
  'scantron_';  
     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'});  
 }  
   
 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=&scantron_getfile();  
   
     my %found=('ids'=>{},'usernames'=>{});  
     for (my $i=0;$i<=$scanlines->{'count'};$i++) {  
  my $line=&scantron_get_line($scanlines,$i);  
  if (!$line) { next; }  
  my $scan_record=&scantron_parse_scanline($line,\%scantron_config);  
  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;  
  foreach my $checkid (keys(%idmap)) {  
     if (lc($checkid) eq lc($id)) {  
  if ($checkid ne $id) {  
     $r->print("<p>Using $checkid for encoded $id</p>\n");  
  }  
  $found=$checkid;last;  
     }  
  }  
  if ($found) {  
     if ($found{'ids'}{$found}) {  
  #FIXME store away line we prviously saw the ID on  
  &scantron_get_correction($r,$i,$scan_record,$line,  
  'duplicateID',$found);  
  return(1);  
     } else {  
  $found{'ids'}{$found}++;  
     }  
  } else {  
     &scantron_get_correction($r,$i,$scan_record,$line,  
      'incorrectID');  
     return(1);  
  }  
     }  
   
     return (0,$currentphase+1);  
 }  
   
 sub scantron_get_correction {  
     my ($r,$i,$scan_record,$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>This scantron record has an error.");  
     if ( defined($$scan_record{'scantron.PaperID'}) ) {  
  $r->print("The current PaperID is <tt>".  
   $$scan_record{'scantron.PaperID'}."</tt> \n");  
     } else {  
  $r->print("The current scanline is <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>Original ID is <tt>".$$scan_record{'scantron.ID'}.  
   "</tt><br />\n");  
  $r->print("Name on paper is ".$$scan_record{'scantron.LastName'}.",".  
   $$scan_record{'scantron.FirstName'}."</p>");  
  $r->print("<p>Please correct <br /> \n");  
  $r->print("\n<ul><li> Pick a specific user -- username:<input type='text' name='scantron_username' value='' />");  
  $r->print("\ndomain:".  
  &Apache::loncommon::select_dom_form(undef,'scantron_domain'));  
  #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'));  
     } elsif ($error eq 'doublebubble') {  
  $r->print("There have been muttiple bubbles scanned for a single question\n");  
  foreach my $question (@{$arg}) {  
     my $selected=$$scan_record{"scantron.$question.answer"};  
     $r->print("<p> For question $question, selected bubbles were".  
       join(" ",split('',$selected)).  
       " Please pick which one should be used for grading");  
     #FIXMENEXT need to have radio buttons to chose which one to use  
       
  }  
     }  
     $r->print("</li> <li>Skip this scanline saving it for later  ");  
     $r->print("\n<input type='checkbox' name='scantron_skip_record' /> </li></ul>");  
     &scantron_end_validate_form($r);  
 }  
   
 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=&scantron_getfile();  
     for (my $i=0;$i<=$scanlines->{'count'};$i++) {  
  my $line=&scantron_get_line($scanlines,$i);  
  if (!$line) { next; }  
  my $scan_record=&scantron_parse_scanline($line,\%scantron_config);  
  if (!defined($$scan_record{'scantron.doubleerror'})) { next; }  
  &scantron_get_correction($r,$i,$scan_record,$line,'double',  
  $$scan_record{'scantron.doubleerror'});  
     return (1,$currentphase);  
     }  
     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)=&Apache::lonnet::decode_symb($ENV{'form.selectpage'});
     my ($symb,$url)=&get_symb_and_url($r);      my ($symb,$url)=&get_symb_and_url($r);
     if (!$symb) {return '';}      if (!$symb) {return '';}
     my $default_form_data=&defaultFormData($symb,$url);      my $default_form_data=&defaultFormData($symb,$url);
Line 3669  sub scantron_process_students { Line 3331  sub scantron_process_students {
     my @scanlines=<$scanlines>;      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 />");
     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 3681  SCANTRONFORM Line 3343  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,      my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,
            'Scantron Status','Scantron Progress',scalar(@scanlines));             'Scantron Status','Scantron Progress',scalar(@scanlines));
     &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,  
   'Processing first student');  
     my $start=&Time::HiRes::time();  
     foreach my $line (@scanlines) {      foreach my $line (@scanlines) {
  $r->print('<pre>line is'.$line.'</pre>');   my $studentcorrect;
    my $studentincorrect;
   
  chomp($line);   chomp($line);
  my $scan_record=&scantron_parse_scanline($line,\%scantron_config);   my $scan_record=&scantron_parse_scanline($line,\%scantron_config);
  my ($uname,$udom);   my ($uname,$udom);
  unless ($uname=&scantron_find_student($scan_record,\%idmap)) {   if ($uname=&scantron_find_student($scan_record,\%idmap)) {
     &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 3722  SCANTRONFORM Line 3377  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,   &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
  'last student');               'last student Who got a '.$studentcorrect.' correct and '.
  #last;       $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 3754  SCANTRONFORM Line 3409  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 3956  sub handler { Line 3607  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);
Line 4041  sub handler { Line 3692  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) {   } elsif ($command) {
Removed from v.1.130.2.1.2.4  
changed lines
  Added in v.1.136

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