[BACK]Return to grades.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / homework

Diff for /loncom/homework/grades.pm between versions 1.421 and 1.422

version 1.421, 2007/07/06 23:17:28 version 1.422, 2007/07/19 09:52:59
Line 4354  sub updateGradeByPage { Line 4354  sub updateGradeByPage {
 #  #
 #------ start of section for handling grading by page/sequence ---------  #------ start of section for handling grading by page/sequence ---------
   
   # Create the hidden field entries used to hold context/default values.
   
 sub defaultFormData {  sub defaultFormData {
     my ($symb)=@_;      my ($symb)=@_;
     return '      return '
Line 4362  sub defaultFormData { Line 4364  sub defaultFormData {
      '<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n";       '<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n";
 }  }
   
   # Make a drop down of the sequences
   
 sub getSequenceDropDown {  sub getSequenceDropDown {
     my ($request,$symb)=@_;      my ($request,$symb)=@_;
     my $result='<select name="selectpage">'."\n";      my $result='<select name="selectpage">'."\n";
Line 4379  sub getSequenceDropDown { Line 4383  sub getSequenceDropDown {
     return $result;      return $result;
 }  }
   
   # Returns a list of the scantron files that have been uploaded to date.
   
 sub scantron_filenames {  sub scantron_filenames {
     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};      my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
     my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};      my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
Line 4394  sub scantron_filenames { Line 4400  sub scantron_filenames {
     return @possiblenames;      return @possiblenames;
 }  }
   
   # Returns the html required for a drop-down list of scantron
   # files that have been uploaded.
   
 sub scantron_uploads {  sub scantron_uploads {
     my ($file2grade) = @_;      my ($file2grade) = @_;
     my $result= '<select name="scantron_selectfile">';      my $result= '<select name="scantron_selectfile">';
Line 4405  sub scantron_uploads { Line 4414  sub scantron_uploads {
     return $result;      return $result;
 }  }
   
   # Returns the html for a drop down list of the scantron formats in the
   # scantronformat.tab file.
   
 sub scantron_scantab {  sub scantron_scantab {
     my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');      my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
     my $result='<select name="scantron_format">'."\n";      my $result='<select name="scantron_format">'."\n";
Line 4419  sub scantron_scantab { Line 4431  sub scantron_scantab {
     return $result;      return $result;
 }  }
   
   #  Returns the html for the options in the
   #  saved codes dropdown.
   
 sub scantron_CODElist {  sub scantron_CODElist {
     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};      my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};      my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
Line 4433  sub scantron_CODElist { Line 4448  sub scantron_CODElist {
     return $namechoice;      return $namechoice;
 }  }
   
   # Returns the HTML for "Each CODE to be used once" radio.
   
 sub scantron_CODEunique {  sub scantron_CODEunique {
     my $result='<span style="white-space: nowrap;">      my $result='<span style="white-space: nowrap;">
                  <label><input type="radio" name="scantron_CODEunique"                   <label><input type="radio" name="scantron_CODEunique"
Line 4444  sub scantron_CODEunique { Line 4461  sub scantron_CODEunique {
                 </span>';                  </span>';
     return $result;      return $result;
 }  }
   #
   #    Display the first scantron file selection form.
   # Paramters:
   #    r           - The apache request object
   #    file2grade  - The name of the scantron file to be graded(?).
   
 sub scantron_selectphase {  sub scantron_selectphase {
     my ($r,$file2grade) = @_;      my ($r,$file2grade) = @_;
Line 4459  sub scantron_selectphase { Line 4481  sub scantron_selectphase {
     my $result;      my $result;
     #FIXME allow instructor to be able to download the scantron file      #FIXME allow instructor to be able to download the scantron file
     # and to upload it,      # and to upload it,
   
       # Chunk of form to prompt for a file to grade and how:
   
     $result.= <<SCANTRONFORM;      $result.= <<SCANTRONFORM;
     <table width="100%" border="0">      <table width="100%" border="0">
     <tr>      <tr>
Line 4511  SCANTRONFORM Line 4536  SCANTRONFORM
     if (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) ||      if (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) ||
         &Apache::lonnet::allowed('usc',$env{'request.course.id'})) {          &Apache::lonnet::allowed('usc',$env{'request.course.id'})) {
   
    # Chunk of form to prompt for a scantron file upload.
   
         $r->print(<<SCANTRONFORM);          $r->print(<<SCANTRONFORM);
     <tr>      <tr>
       <td bgcolor="#777777">        <td bgcolor="#777777">
Line 4556  UPLOAD Line 4583  UPLOAD
     </tr>      </tr>
 SCANTRONFORM  SCANTRONFORM
     }      }
   
       # Chunk of the form that prompts to view a scoring office file,
       # corrected file, skipped records in a file.
   
     $r->print(<<SCANTRONFORM);      $r->print(<<SCANTRONFORM);
     <tr>      <tr>
       <form action='/adm/grades' name='scantron_download'>        <form action='/adm/grades' name='scantron_download'>
Line 4590  SCANTRONFORM Line 4621  SCANTRONFORM
     return      return
 }  }
   
   # Parse and return the scantron configuration line selected as a
   # hash of configuration file fields.
   #
   # Parameters:
   #   which - the name of the configuration to parse from the file.
   #           If the named configuration is not in the file, an empty
   #           hash is returned.
   
 sub get_scantron_config {  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');
Line 4622  sub get_scantron_config { Line 4661  sub get_scantron_config {
     return %config;      return %config;
 }  }
   
   #  creates a hash keyed by student id that conains
   #  the corresponding student username:domain.
   # Parameters:
   #   reference to the class list hash. This is a hash
   #   keyed by student name:domain  whose elements are references
   #   to arrays containng various chunks of information
   #   about the student. (See loncoursedata for more info).
   #
   # 
 sub username_to_idmap {  sub username_to_idmap {
     my ($classlist)= @_;      my ($classlist)= @_;
     my %idmap;      my %idmap;
Line 4631  sub username_to_idmap { Line 4679  sub username_to_idmap {
     }      }
     return %idmap;      return %idmap;
 }  }
   #
   # Make a correction in a scantron line?
   # Parameters:
   #   scantron_config    - Format of the scantron file
   #   scan_data          - Hash of line by line info about the scan(?).
   #   line               - Scantron line to edit?
   #   whichline
   #   field  
   #   args               - Keyword/value hash of additional parameters.
   #
   
 sub scantron_fixup_scanline {  sub scantron_fixup_scanline {
     my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_;      my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_;
       #
       # ID field, args->{'newid'} is the new value of the ID field.
       #
     if ($field eq 'ID') {      if ($field eq 'ID') {
  if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) {   if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) {
     return ($line,1,'New value too large');      return ($line,1,'New value too large');
Line 4648  sub scantron_fixup_scanline { Line 4709  sub scantron_fixup_scanline {
     &scan_data($scan_data,"$whichline.user",      &scan_data($scan_data,"$whichline.user",
        $args->{'username'}.':'.$args->{'domain'});         $args->{'username'}.':'.$args->{'domain'});
  }   }
    # CODE Field, 
    #   args->{CODE_ignore_dup} is true if duplicates should be ignored.
    #   args->{CODE} is new code or 'use_unfound' if an unfound code should
    #                be used as is?
    #
     } elsif ($field eq 'CODE') {      } elsif ($field eq 'CODE') {
  if ($args->{'CODE_ignore_dup'}) {   if ($args->{'CODE_ignore_dup'}) {
     &scan_data($scan_data,"$whichline.CODE_ignore_dup",'1');      &scan_data($scan_data,"$whichline.CODE_ignore_dup",'1');
Line 4663  sub scantron_fixup_scanline { Line 4729  sub scantron_fixup_scanline {
     substr($line,$$scantron_config{'CODEstart'}-1,      substr($line,$$scantron_config{'CODEstart'}-1,
    $$scantron_config{'CODElength'})=$args->{'CODE'};     $$scantron_config{'CODElength'})=$args->{'CODE'};
  }   }
    #
    # Edit the answer field.
    #     args->{'response'} - new answer or 'none' if blank.
    #     args->{'question'} - the question (number?)?.
    #
     } elsif ($field eq 'answer') {      } elsif ($field eq 'answer') {
  my $length=$scantron_config->{'Qlength'};   my $length=$scantron_config->{'Qlength'};
  my $off=$scantron_config->{'Qoff'};   my $off=$scantron_config->{'Qoff'};
Line 4689  sub scantron_fixup_scanline { Line 4760  sub scantron_fixup_scanline {
     }      }
     return $line;      return $line;
 }  }
   # Edit or look up  an item in the scan_data hash.
   # Parameters:
   #   scan_data   - The hash.
   #   key         - shorthand of the key to edit (actual key is
   #                 scatronfilename_key.
   #   data        - New value of the hash entry.
   #   delete      - If defined, the entry is removed from the table.
   # Returns:
   #   The new value of the hash table field (undefined if deleted).
   #
 sub scan_data {  sub scan_data {
     my ($scan_data,$key,$value,$delete)=@_;      my ($scan_data,$key,$value,$delete)=@_;
     my $filename=$env{'form.scantron_selectfile'};      my $filename=$env{'form.scantron_selectfile'};
Line 4699  sub scan_data { Line 4779  sub scan_data {
     if ($delete) { delete($scan_data->{$filename.'_'.$key}); }      if ($delete) { delete($scan_data->{$filename.'_'.$key}); }
     return $scan_data->{$filename.'_'.$key};      return $scan_data->{$filename.'_'.$key};
 }  }
   #
   #  Decode a line on the uploaded scantron file:
   #  Arguments:
   #    line             - The text of the  scantron file line to process
   #    whichline        - Line number(?)
   #    scantron_config  - Hash describing the format of the scantron lines.
   #    scan_data        - Hash being built up of the entire scantron file.
   #    justHeader       - True if should not process question answers but only
   #                       the stuff to the left of the answers.
   # Returns:
   #   Hash of data from the line?
   #
 sub scantron_parse_scanline {  sub scantron_parse_scanline {
     my ($line,$whichline,$scantron_config,$scan_data,$justHeader)=@_;      my ($line,$whichline,$scantron_config,$scan_data,$justHeader)=@_;
     my %record;      my %record;
     my $questions=substr($line,$$scantron_config{'Qstart'}-1);      my $questions=substr($line,$$scantron_config{'Qstart'}-1);  # Answers
     my $data=substr($line,0,$$scantron_config{'Qstart'}-1);      my $data=substr($line,0,$$scantron_config{'Qstart'}-1);     # earlier stuff
     if (!($$scantron_config{'CODElocation'} eq 0 ||      if (!($$scantron_config{'CODElocation'} eq 0 ||
   $$scantron_config{'CODElocation'} eq 'none')) {    $$scantron_config{'CODElocation'} eq 'none')) {
  if ($$scantron_config{'CODElocation'} < 0 ||   if ($$scantron_config{'CODElocation'} < 0 ||
Line 5456  ENDSCRIPT Line 5547  ENDSCRIPT
  $r->print("<p>Please indicate which bubble should be used for grading</p>");   $r->print("<p>Please indicate which bubble should be used for grading</p>");
  foreach my $question (@{$arg}) {   foreach my $question (@{$arg}) {
     my $selected=$$scan_record{"scantron.$question.answer"};      my $selected=$$scan_record{"scantron.$question.answer"};
     &scantron_bubble_selector($r,$scan_config,$question,split('',$selected));      &scantron_bubble_selector($r,$scan_config,$question,
         split('',$selected));
  }   }
     } elsif ($error eq 'missingbubble') {      } elsif ($error eq 'missingbubble') {
  $r->print("<p>There have been <b>no</b> bubbles scanned for some question(s)</p>\n");   $r->print("<p>There have been <b>no</b> bubbles scanned for some question(s)</p>\n");
Line 5475  ENDSCRIPT Line 5567  ENDSCRIPT
     $r->print("\n</li></ul>");      $r->print("\n</li></ul>");
   
 }  }
   #
   #  Ask the grader to select the actual bubble
   #  
   # Arguments:
   #    r           - Apache request.
   #    scan_config - Hash of the scantron format selected.
   #    quest       - Question being evaluated
   #    selected    - array of selected bubbles
   #    lines       - if present, number of bubble lines in questions.
 sub scantron_bubble_selector {  sub scantron_bubble_selector {
     my ($r,$scan_config,$quest,@selected)=@_;      my ($r,$scan_config,$quest,@selected, $lines)=@_;
     my $max=$$scan_config{'Qlength'};      my $max=$$scan_config{'Qlength'};
   
     my $scmode=$$scan_config{'Qon'};      my $scmode=$$scan_config{'Qon'};
     if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }           if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }     
   
     my @alphabet=('A'..'Z');  
     $r->print("<table border='1'><tr><td rowspan='2'>$quest</td>");      if (!defined($lines)) {
     for (my $i=0;$i<$max+1;$i++) {   $lines = 1;
  $r->print("\n".'<td align="center">');  
  if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) }  
  else { $r->print('&nbsp;'); }  
  $r->print('</td>');  
     }  
     $r->print('</tr><tr>');  
     for (my $i=0;$i<$max;$i++) {  
  $r->print("\n".  
   '<td><label><input type="radio" name="scantron_correct_Q_'.  
   $quest.'" value="'.$i.'" />'.$alphabet[$i]."</label></td>");  
     }      }
     $r->print('<td><label><input type="radio" name="scantron_correct_Q_'.      my $total_lines = $lines*2;
       my @alphabet=('A'..'Z');
       $r->print("<table border='1'><tr><td rowspan='".$total_lines."'>$quest</td>");
   
       for (my $l = 0; $l < $lines; $l++) {
    if ($l != 0) {
       $r->print('<tr>');
    }
   
    # FIXME:  This loop probably has to be considerably more clever for
    #  multiline bubbles: User can multibubble by having bubbles in
    #  several lines.  User can skip lines legitimately etc. etc.
   
    for (my $i=0;$i<$max;$i++) {
       $r->print("\n".'<td align="center">');
       if ($selected[0] eq $alphabet[$i]) { 
    $r->print('X'); 
    shift(@selected) ;
       } else { 
    $r->print('&nbsp;'); 
       }
       $r->print('</td>');
       
    }
   
    if ($l == 0) {
       my $lspan = $total_lines * 2;   #  2 table rows per bubble line.
   
       $r->print('<td rowspan='.$lspan.'><label><input type="radio" name="scantron_correct_Q_'.
       $quest.'" value="none" /> No bubble </label></td>');        $quest.'" value="none" /> No bubble </label></td>');
     $r->print('</tr></table>');  
    }
   
    $r->print('</tr><tr>');
   
    # FIXME: This may have to be a bit more clever for
    #        multiline questions (different values e.g..).
   
    for (my $i=0;$i<$max;$i++) {
       $r->print("\n".
         '<td><label><input type="radio" name="scantron_correct_Q_'.
         $quest.'" value="'.$i.'" />'.$alphabet[$i]."</label></td>");
    }
    $r->print('</tr>');
   
       
       }
       $r->print('</table>');
 }  }
   
 sub num_matches {  sub num_matches {
Removed from v.1.421  
changed lines
  Added in v.1.422

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