Diff for /loncom/homework/grades.pm between versions 1.199 and 1.200

version 1.199, 2004/05/10 23:18:27 version 1.200, 2004/05/14 19:15:49
Line 3522  sub scantron_selectphase { Line 3522  sub scantron_selectphase {
           <tr bgcolor="#ffffe6">            <tr bgcolor="#ffffe6">
     <td> Options: </td>      <td> Options: </td>
             <td>              <td>
                 <input type="checkbox" name="scantron_options_redo" value="redo_skipped"/> Do only skipped records <br />                  <input type="checkbox" name="scantron_options_redo" value="redo_skipped"/> Do only previously skipped records <br />
                 <input type="checkbox" name="scantron_options_ignore" value="ignore_corrections"/> Remove any exisiting corrections                  <input type="checkbox" name="scantron_options_ignore" value="ignore_corrections"/> Remove all exisiting corrections
     </td>      </td>
           </tr>            </tr>
           <tr bgcolor="#ffffe6">            <tr bgcolor="#ffffe6">
Line 3833  sub scantron_process_corrections { Line 3833  sub scantron_process_corrections {
     my ($scanlines,$scan_data)=&scantron_getfile();      my ($scanlines,$scan_data)=&scantron_getfile();
     my $classlist=&Apache::loncoursedata::get_classlist();      my $classlist=&Apache::loncoursedata::get_classlist();
     my $which=$ENV{'form.scantron_line'};      my $which=$ENV{'form.scantron_line'};
     my $line=&scantron_get_line($scanlines,$which);      my $line=&scantron_get_line($scanlines,$scan_data,$which);
     my ($skip,$err,$errmsg);      my ($skip,$err,$errmsg);
     if ($ENV{'form.scantron_skip_record'}) {      if ($ENV{'form.scantron_skip_record'}) {
  $skip=1;   $skip=1;
Line 3879  sub scantron_process_corrections { Line 3879  sub scantron_process_corrections {
     if ($err) {      if ($err) {
  $r->print("Unable to accept last correction, an error occurred :$errmsg:");   $r->print("Unable to accept last correction, an error occurred :$errmsg:");
     } else {      } else {
  &scantron_put_line($scanlines,$which,$line,$skip);   &scantron_put_line($scanlines,$scan_data,$which,$line,$skip);
  &scantron_putfile($scanlines,$scan_data);   &scantron_putfile($scanlines,$scan_data);
     }      }
 }  }
   
   sub reset_skipping_status {
       my ($scanlines,$scan_data)=&scantron_getfile();
       &scan_data($scan_data,'remember_skipping',undef,1);
       &scantron_putfile(undef,$scan_data);
   }
   
   sub allow_skipping {
       my ($scan_data,$i)=@_;
       my %remembered=split(':',&scan_data($scan_data,'remember_skipping'));
       delete($remembered{$i});
       &scan_data($scan_data,'remember_skipping',join(':',%remembered));
   }
   
   sub should_be_skipped {
       my ($scan_data,$i)=@_;
       if ($ENV{'form.scantron_options_redo'} !~ /^redo_/) {
    # not redoing old skips
    return 0;
       }
       my %remembered=split(':',&scan_data($scan_data,'remember_skipping'));
       if (exists($remembered{$i})) { return 0; }
       return 1;
   }
   
   sub remember_current_skipped {
       my ($scanlines,$scan_data)=&scantron_getfile();
       my %to_remember;
       for (my $i=0;$i<=$scanlines->{'count'};$i++) {
    if ($scanlines->{'skipped'}[$i]) {
       $to_remember{$i}=1;
    }
       }
       &Apache::lonnet::logthis('remembering '.join(':',%to_remember));
       &scan_data($scan_data,'remember_skipping',join(':',%to_remember));
       &scantron_putfile(undef,$scan_data);
   }
   
   sub check_for_error {
       my ($r,$result)=@_;
       if ($result ne 'ok' && $result ne 'not_found' ) {
    $r->print("An error occured ($result) when trying to Remove the existing corrections.");
       }
   }
   
 sub scantron_validate_file {  sub scantron_validate_file {
     my ($r) = @_;      my ($r) = @_;
     my ($symb,$url)=&get_symb_and_url($r);      my ($symb,$url)=&get_symb_and_url($r);
     if (!$symb) {return '';}      if (!$symb) {return '';}
     my $default_form_data=&defaultFormData($symb,$url);      my $default_form_data=&defaultFormData($symb,$url);
       
       # do the detection of only doing skipped records first befroe we delete
       # them  when doing the corrections reset
       if ($ENV{'form.scantron_options_redo'} ne 'redo_skipped_ready') {
    &reset_skipping_status();
       }
       if ($ENV{'form.scantron_options_redo'} eq 'redo_skipped') {
    &remember_current_skipped();
    &scantron_remove_file('skipped');
    $ENV{'form.scantron_options_redo'}='redo_skipped_ready';
       }
   
     if ($ENV{'form.scantron_options_ignore'} eq 'ignore_corrections') {      if ($ENV{'form.scantron_options_ignore'} eq 'ignore_corrections') {
  my $result=&scantron_remove('corrected');   &check_for_error($r,&scantron_remove_file('corrected'));
  if ($result ne 'ok' && $result ne 'not_found' ) {   &check_for_error($r,&scantron_remove_file('skipped'));
     $r->print("An error occured ($result) when trying to Remove the existing corrections.");   &check_for_error($r,&scantron_remove_scan_data());
  }  
  $ENV{'form.scantron_options_ignore'}='done';   $ENV{'form.scantron_options_ignore'}='done';
     }      }
   
     if ($ENV{'form.scantron_corrections'}) {      if ($ENV{'form.scantron_corrections'}) {
  &scantron_process_corrections($r);   &scantron_process_corrections($r);
     }      }
Line 3956  SCANTRONFORM Line 4011  SCANTRONFORM
     return '';      return '';
 }  }
   
 sub scantron_remove {  sub scantron_remove_file {
     my ($which)=@_;      my ($which)=@_;
     my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};      my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
     my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};      my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
     my $file='scantron_';      my $file='scantron_';
     if ($which eq 'corrected') {      if ($which eq 'corrected' || $which eq 'skipped') {
  $file.='corrected_';   $file.=$which.'_';
     } else {      } else {
  return 'refused';   return 'refused';
     }      }
     $file.=$ENV{'form.scantron_selectfile'};      $file.=$ENV{'form.scantron_selectfile'};
     my $result=&Apache::lonnet::removeuserfile($cname,$cdom,$file);      return &Apache::lonnet::removeuserfile($cname,$cdom,$file);
   }
   
   sub scantron_remove_scan_data {
       my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
       my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
     my @keys=&Apache::lonnet::getkeys('nohist_scantrondata',$cdom,$cname);      my @keys=&Apache::lonnet::getkeys('nohist_scantrondata',$cdom,$cname);
     my @todelete;      my @todelete;
     my $filename=$ENV{'form.scantron_selectfile'};      my $filename=$ENV{'form.scantron_selectfile'};
     foreach my $key (@keys) {      foreach my $key (@keys) {
  if ($key=~/^\Q$filename\E_/) {   if ($key=~/^\Q$filename\E_/) {
       if ($ENV{'form.scantron_options_redo'} eq 'redo_skipped_ready' &&
    $key=~/remember_skipping/) {
    next;
       }
     push(@todelete,$key);      push(@todelete,$key);
  }   }
     }      }
       my $result;
     if (@todelete) {      if (@todelete) {
  &Apache::lonnet::del('nohist_scantrondata',\@todelete,$cdom,$cname);   $result=&Apache::lonnet::del('nohist_scantrondata',\@todelete,$cdom,$cname);
     }      }
     return $result;      return $result;
 }  }
   
 sub scantron_getfile {  sub scantron_getfile {
     #FIXME really would prefer a scantron directory but tokenwrapper      #FIXME really would prefer a scantron directory
     # doesn't allow access to subdirs of userfiles  
     my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};      my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
     my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};      my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
     my $lines;      my $lines;
Line 4027  sub lonnet_putfile { Line 4091  sub lonnet_putfile {
   
 sub scantron_putfile {  sub scantron_putfile {
     my ($scanlines,$scan_data) = @_;      my ($scanlines,$scan_data) = @_;
     #FIXME really would prefer a scantron directory but tokenwrapper      #FIXME really would prefer a scantron directory
     # doesn't allow access to subdirs of userfiles  
     my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};      my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
     my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};      my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
     my $prefix='scantron_';      if ($scanlines) {
    my $prefix='scantron_';
 # no need to update orig, shouldn't change  # no need to update orig, shouldn't change
 #   &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'.  #   &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'.
 #    $ENV{'form.scantron_selectfile'});  #    $ENV{'form.scantron_selectfile'});
     &lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}),   &lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}),
     $prefix.'corrected_'.   $prefix.'corrected_'.
     $ENV{'form.scantron_selectfile'});   $ENV{'form.scantron_selectfile'});
     &lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}),   &lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}),
     $prefix.'skipped_'.   $prefix.'skipped_'.
     $ENV{'form.scantron_selectfile'});   $ENV{'form.scantron_selectfile'});
       }
     &Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname);      &Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname);
 }  }
   
 sub scantron_get_line {  sub scantron_get_line {
     my ($scanlines,$i)=@_;      my ($scanlines,$scan_data,$i)=@_;
     if ($scanlines->{'skipped'}[$i]) {return undef;}      if (&should_be_skipped($scan_data,$i)) { return undef; }
       if ($scanlines->{'skipped'}[$i]) { return undef; }
     if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];}      if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];}
     return $scanlines->{'orig'}[$i];       return $scanlines->{'orig'}[$i]; 
 }  }
   
   sub get_todo_count {
       my ($scanlines,$scan_data)=@_;
       my $count=0;
       for (my $i=0;$i<=$scanlines->{'count'};$i++) {
    my $line=&scantron_get_line($scanlines,$scan_data,$i);
    if ($line=~/^[\s\cz]*$/) { next; }
    $count++;
       }
       return $count;
   }
   
 sub scantron_put_line {  sub scantron_put_line {
     my ($scanlines,$i,$newline,$skip)=@_;      my ($scanlines,$scan_data,$i,$newline,$skip)=@_;
     if ($skip) {      if ($skip) {
  $scanlines->{'skipped'}[$i]=$newline;   $scanlines->{'skipped'}[$i]=$newline;
    &allow_skipping($scan_data,$i);
  return;   return;
     }      }
     $scanlines->{'corrected'}[$i]=$newline;      $scanlines->{'corrected'}[$i]=$newline;
Line 4073  sub scantron_validate_ID { Line 4151  sub scantron_validate_ID {
   
     my %found=('ids'=>{},'usernames'=>{});      my %found=('ids'=>{},'usernames'=>{});
     for (my $i=0;$i<=$scanlines->{'count'};$i++) {      for (my $i=0;$i<=$scanlines->{'count'};$i++) {
  my $line=&scantron_get_line($scanlines,$i);   my $line=&scantron_get_line($scanlines,$scan_data,$i);
  if ($line=~/^[\s\cz]*$/) { next; }   if ($line=~/^[\s\cz]*$/) { next; }
  my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,   my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
  $scan_data);   $scan_data);
Line 4308  sub scantron_validate_CODE { Line 4386  sub scantron_validate_CODE {
   
     my ($scanlines,$scan_data)=&scantron_getfile();      my ($scanlines,$scan_data)=&scantron_getfile();
     for (my $i=0;$i<=$scanlines->{'count'};$i++) {      for (my $i=0;$i<=$scanlines->{'count'};$i++) {
  my $line=&scantron_get_line($scanlines,$i);   my $line=&scantron_get_line($scanlines,$scan_data,$i);
  if ($line=~/^[\s\cz]*$/) { next; }   if ($line=~/^[\s\cz]*$/) { next; }
  my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,   my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
  $scan_data);   $scan_data);
Line 4342  sub scantron_validate_doublebubble { Line 4420  sub scantron_validate_doublebubble {
     my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});      my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
     my ($scanlines,$scan_data)=&scantron_getfile();      my ($scanlines,$scan_data)=&scantron_getfile();
     for (my $i=0;$i<=$scanlines->{'count'};$i++) {      for (my $i=0;$i<=$scanlines->{'count'};$i++) {
  my $line=&scantron_get_line($scanlines,$i);   my $line=&scantron_get_line($scanlines,$scan_data,$i);
  if ($line=~/^[\s\cz]*$/) { next; }   if ($line=~/^[\s\cz]*$/) { next; }
  my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,   my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
  $scan_data);   $scan_data);
Line 4392  sub scantron_validate_missingbubbles { Line 4470  sub scantron_validate_missingbubbles {
     my $max_bubble=&scantron_get_maxbubble();      my $max_bubble=&scantron_get_maxbubble();
     if (!$max_bubble) { $max_bubble=2**31; }      if (!$max_bubble) { $max_bubble=2**31; }
     for (my $i=0;$i<=$scanlines->{'count'};$i++) {      for (my $i=0;$i<=$scanlines->{'count'};$i++) {
  my $line=&scantron_get_line($scanlines,$i);   my $line=&scantron_get_line($scanlines,$scan_data,$i);
  if ($line=~/^[\s\cz]*$/) { next; }   if ($line=~/^[\s\cz]*$/) { next; }
  my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,   my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
  $scan_data);   $scan_data);
Line 4437  SCANTRONFORM Line 4515  SCANTRONFORM
     my @delayqueue;      my @delayqueue;
     my %completedstudents;      my %completedstudents;
           
       my $count=&get_todo_count($scanlines,$scan_data);
     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status',      my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status',
      'Scantron Progress',$scanlines->{'count'},       'Scantron Progress',$count,
     'inline',undef,'scantronupload');      'inline',undef,'scantronupload');
     &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,      &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
   'Processing first student');    'Processing first student');
     my $start=&Time::HiRes::time();      my $start=&Time::HiRes::time();
     my $i=-1;      my $i=-1;
     my ($uname,$udom);      my ($uname,$udom,$started);
     while ($i<$scanlines->{'count'}) {      while ($i<$scanlines->{'count'}) {
   ($uname,$udom)=('','');    ($uname,$udom)=('','');
   $i++;    $i++;
   my $line=&scantron_get_line($scanlines,$i);    my $line=&scantron_get_line($scanlines,$scan_data,$i);
   if ($line=~/^[\s\cz]*$/) { next; }    if ($line=~/^[\s\cz]*$/) { next; }
    if ($started) {
       &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
        'last student');
    }
    $started=1;
   my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,    my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
   $scan_data);    $scan_data);
   unless ($uname=&scantron_find_student($scan_record,$scan_data,    unless ($uname=&scantron_find_student($scan_record,$scan_data,
Line 4487  SCANTRONFORM Line 4571  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,  
  'last student');  
     }      }
     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);      &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
 #    my $lasttime = &Time::HiRes::time()-$start;  #    my $lasttime = &Time::HiRes::time()-$start;
 #    $r->print("<p>took $lasttime</p>");  #    $r->print("<p>took $lasttime</p>");
   
     $navmap->untieHashes();      $navmap->untieHashes();
     $r->print("</form><p>Done</p>");      $r->print("</form>");
     $r->print(&show_grading_menu_form($symb,$url));      $r->print(&show_grading_menu_form($symb,$url));
     return '';      return '';
 }  }

Removed from v.1.199  
changed lines
  Added in v.1.200


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