[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.2 and 1.130.2.1.2.3

version 1.130.2.1.2.2, 2003/09/25 02:46:19 version 1.130.2.1.2.3, 2003/09/25 08:30:57
Line 3268  sub username_to_idmap { Line 3268  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 3354  sub scantron_filter { Line 3370  sub scantron_filter {
 #the corrected one, I'll still need to catch error conditions, but  #the corrected one, I'll still need to catch error conditions, but
 #maybe most will taken care even before we start  #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 $newstudent=$ENV{'form.scantron_username'}.':'.
       $ENV{'form.scantron_domain'};
    my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID];
    ($line,my $err,my $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);
       &scantron_putfile($scanlines);
    }
       }
   }
   
 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);
Line 3397  SCANTRONFORM Line 3435  SCANTRONFORM
  }   }
     }      }
     $r->print("<input type='hidden' name='validatepass' value='".$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 {  sub scantron_validate_ID {
Line 3408  sub scantron_validate_ID { Line 3528  sub scantron_validate_ID {
   
     #get scantron line setup      #get scantron line setup
     my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});      my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
     #my $scanlines=Apache::File->new($Apache::lonnet::perlvar{'lonScansDir'}."/$ENV{'form.scantron_selectfile'}");      my $scanlines=&scantron_getfile();
     #FIXME really would prefer a scantron directory but tokenwrapper  
     # doesn't allow access to subdirs of userfiles  
     my $scanlines=&Apache::lonnet::getfile('/uploaded/'.  
    $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.  
    $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.  
        'scantron_'.$ENV{'form.scantron_selectfile'});  
       
     my @scanlines=split("\n",$scanlines);  
   
     my %found=('ids'=>{},'usernames'=>{});      my %found=('ids'=>{},'usernames'=>{});
     foreach my $line (@scanlines) {      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 $scan_record=&scantron_parse_scanline($line,\%scantron_config);
  my $id=$$scan_record{'scantron.ID'};   my $id=$$scan_record{'scantron.ID'};
  $r->print("<p>Checking ID ".$$scan_record{'scantron.ID'}."</p>\n");   $r->print("<p>Checking ID ".$$scan_record{'scantron.ID'}."</p>\n");
Line 3434  sub scantron_validate_ID { Line 3548  sub scantron_validate_ID {
  }   }
  if ($found) {   if ($found) {
     if ($found{'ids'}{$found}) {      if ($found{'ids'}{$found}) {
  &scantron_get_ID_correction($r,$line,$scan_record,'duplicate',$found);   #FIXME store away line we prviously saw the ID on
    &scantron_get_ID_correction($r,$i,$scan_record,
       'duplicateID',$found);
  return(1);   return(1);
     } else {      } else {
  $found{'ids'}{$found}++;   $found{'ids'}{$found}++;
     }      }
  } else {   } else {
     &scantron_get_ID_correction($r,$line,$scan_record,'incorrect');      &scantron_get_ID_correction($r,$i,$scan_record,'incorrectID');
     return(1);      return(1);
  }   }
     }      }
Line 3449  sub scantron_validate_ID { Line 3565  sub scantron_validate_ID {
 }  }
   
 sub scantron_get_ID_correction {  sub scantron_get_ID_correction {
     my ($r,$line,$scan_record,$error,$arg)=@_;      my ($r,$i,$scan_record,$error,$arg)=@_;
   #FIXME allow th poosibility of skipping a line, or in the case of a duplicated ID the previous line, probaly need to show both the current line and the previous one.
     $r->print("<p>need to correct ID</p>\n");      $r->print("<p>need to correct ID</p>\n");
     $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n");      $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n");
     $r->print('<input type="hidden" name="scantron_line" value="'.&HTML::Entities::encode($line).'" />'."\n");      $r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n");
     if ($error eq 'unknown') {      if ($error eq 'unknownID') {
  $r->print("<p> Unknown ID </p>\n");   $r->print("<p> Unknown ID </p>\n");
     } elsif ($error eq 'duplicate') {      } elsif ($error eq 'duplicateID') {
  $r->print("<p> Duplicated ID </p>\n");   $r->print("<p> Duplicated ID </p>\n");
     }      }
     $r->print("<p>Original ID is ".$$scan_record{'scantron.ID'}."</p>\n");      $r->print("<p>Original ID is ".$$scan_record{'scantron.ID'}."</p>\n");
Removed from v.1.130.2.1.2.2  
changed lines
  Added in v.1.130.2.1.2.3

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