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

Diff for /loncom/homework/grades.pm between versions 1.432 and 1.441

version 1.432, 2007/08/21 22:21:54 version 1.441, 2007/09/27 19:44:51
Line 45  use LONCAPA; Line 45  use LONCAPA;
   
 use POSIX qw(floor);  use POSIX qw(floor);
   
   
 my %perm=();  my %perm=();
   my %bubble_lines_per_response;     # no. bubble lines for each response.
                                      # index is "symb.part_id"
   
   
 # ----- These first few routines are general use routines.----  # ----- These first few routines are general use routines.----
 #  #
 # --- Retrieve the parts from the metadata file.---  # --- Retrieve the parts from the metadata file.---
 sub getpartlist {  sub getpartlist {
     my ($symb) = @_;      my ($symb) = @_;
     my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);  
     my $partorder = &Apache::lonnet::metadata($url, 'partorder');      my $navmap   = Apache::lonnavmaps::navmap->new();
     my @parts;      my $res      = $navmap->getBySymb($symb);
     if ($partorder) {      my $partlist = $res->parts();
  for my $part (split (/,/,$partorder)) {      my $url      = $res->src();
     if (!&Apache::loncommon::check_if_partid_hidden($part,$symb)) {      my @metakeys = split(/,/,&Apache::lonnet::metadata($url,'keys'));
  push(@parts, $part);  
     }  
  }      
     } else {  
  my $metadata = &Apache::lonnet::metadata($url, 'packages');  
  foreach (split(/\,/,$metadata)) {  
     if ($_ =~ /^part_(.*)$/) {  
  if (!&Apache::loncommon::check_if_partid_hidden($1,$symb)) {  
     push(@parts, $1);  
  }  
     }  
  }  
     }  
     my @stores;      my @stores;
     foreach my $part (@parts) {      foreach my $part (@{ $partlist }) {
  my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys'));  
  foreach my $key (@metakeys) {   foreach my $key (@metakeys) {
     if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); }      if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); }
  }   }
Line 194  sub showResourceInfo { Line 185  sub showResourceInfo {
     return $result,$responseType,$hdgrade,$partlist,$handgrade;      return $result,$responseType,$hdgrade,$partlist,$handgrade;
 }  }
   
   sub reset_caches {
       &reset_analyze_cache();
       &reset_perm();
   }
   
   {
       my %analyze_cache;
   
 sub get_order {      sub reset_analyze_cache {
     my ($partid,$respid,$symb,$uname,$udom)=@_;   undef(%analyze_cache);
     my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);      }
     $url=&Apache::lonnet::clutter($url);  
     my $subresult=&Apache::lonnet::ssi($url,      sub get_analyze {
        ('grade_target' => 'analyze'),   my ($symb,$uname,$udom)=@_;
        ('grade_domain' => $udom),   my $key = "$symb\0$uname\0$udom";
        ('grade_symb' => $symb),   return $analyze_cache{$key} if (exists($analyze_cache{$key}));
        ('grade_courseid' =>   
         $env{'request.course.id'}),   my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);
        ('grade_username' => $uname));   $url=&Apache::lonnet::clutter($url);
     (undef,$subresult)=split(/_HASH_REF__/,$subresult,2);   my $subresult=&Apache::lonnet::ssi($url,
     my %analyze=&Apache::lonnet::str2hash($subresult);     ('grade_target' => 'analyze'),
     return ($analyze{"$partid.$respid.shown"});     ('grade_domain' => $udom),
      ('grade_symb' => $symb),
      ('grade_courseid' => 
       $env{'request.course.id'}),
      ('grade_username' => $uname));
    (undef,$subresult)=split(/_HASH_REF__/,$subresult,2);
    my %analyze=&Apache::lonnet::str2hash($subresult);
    return $analyze_cache{$key} = \%analyze;
       }
   
       sub get_order {
    my ($partid,$respid,$symb,$uname,$udom)=@_;
    my $analyze = &get_analyze($symb,$uname,$udom);
    return $analyze->{"$partid.$respid.shown"};
       }
   
       sub get_radiobutton_correct_foil {
    my ($partid,$respid,$symb,$uname,$udom)=@_;
    my $analyze = &get_analyze($symb,$uname,$udom);
    foreach my $foil (@{&get_order($partid,$respid,$symb,$uname,$udom)}) {
       if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') {
    return $foil;
       }
    }
       }
 }  }
   
 #--- Clean response type for display  #--- Clean response type for display
 #--- Currently filters option/rank/radiobutton/match/essay/Task  #--- Currently filters option/rank/radiobutton/match/essay/Task
 #        response types only.  #        response types only.
Line 258  sub cleanRecord { Line 281  sub cleanRecord {
     } elsif ($response eq 'radiobutton') {      } elsif ($response eq 'radiobutton') {
  my %answer=&Apache::lonnet::str2hash($answer);   my %answer=&Apache::lonnet::str2hash($answer);
  my ($toprow,$bottomrow);   my ($toprow,$bottomrow);
  my $correct=($order->[0])+1;   my $correct = 
  for (my $i=1;$i<=$#$order;$i++) {      &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom);
     my $foil=$order->[$i];   foreach my $foil (@$order) {
     if (exists($answer{$foil})) {      if (exists($answer{$foil})) {
  if ($i == $correct) {   if ($foil eq $correct) {
     $toprow.='<td><b>true</b></td>';      $toprow.='<td><b>true</b></td>';
  } else {   } else {
     $toprow.='<td><i>true</i></td>';      $toprow.='<td><i>true</i></td>';
Line 326  sub cleanRecord { Line 349  sub cleanRecord {
     $result.='</ul>';      $result.='</ul>';
     return $result;      return $result;
  }   }
              } elsif ( $response =~ m/(?:numerical|formula)/) {
    $answer = 
       &Apache::loncommon::format_previous_attempt_value('submission',
         $answer);
     }      }
     return $answer;      return $answer;
 }  }
Line 1665  sub build_section_inputs { Line 1691  sub build_section_inputs {
         $section_inputs .= '<input type="hidden" name="section" value="all" />'."\n";          $section_inputs .= '<input type="hidden" name="section" value="all" />'."\n";
     } else {      } else {
         my @sections = &Apache::loncommon::get_env_multiple('form.section');          my @sections = &Apache::loncommon::get_env_multiple('form.section');
         foreach my $section(@sections) {          foreach my $section (@sections) {
             $section_inputs .= '<input type="hidden" name="section" value="'.$section.'" />'."\n";              $section_inputs .= '<input type="hidden" name="section" value="'.$section.'" />'."\n";
         }          }
     }      }
Line 1680  sub submission { Line 1706  sub submission {
     $udom = ($udom eq '' ? $env{'user.domain'} : $udom); #has form.userdom changed for a student?      $udom = ($udom eq '' ? $env{'user.domain'} : $udom); #has form.userdom changed for a student?
     my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'});      my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'});
     $env{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $env{'form.fullname'} eq '';      $env{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $env{'form.fullname'} eq '';
   
     my $symb = &get_symb($request);       my $symb = &get_symb($request); 
     if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; }      if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; }
   
Line 1733  sub submission { Line 1758  sub submission {
     &Apache::lonxml::clear_problem_counter();      &Apache::lonxml::clear_problem_counter();
     $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode));      $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode));
  }   }
   
  # kwclr is the only variable that is guaranteed to be non blank    # kwclr is the only variable that is guaranteed to be non blank 
         # if this subroutine has been called once.          # if this subroutine has been called once.
  my %keyhash = ();   my %keyhash = ();
Line 1818  KEYWORDS Line 1843  KEYWORDS
         }          }
     }      }
   
   # This is where output for one specific student would start
       my $bgcolor='#DDEEDD';
       if (int($counter/2) eq $counter) { $bgcolor='#DDDDEE'; }
       $request->print("\n\n".
                       '<p><table border="2"><tr><th bgcolor="'.$bgcolor.'">'.$env{'form.fullname'}.'</th></tr><tr><td bgcolor="'.$bgcolor.'">');
   
     if ($env{'form.vProb'} eq 'all' or $env{'form.vAns'} eq 'all') {      if ($env{'form.vProb'} eq 'all' or $env{'form.vAns'} eq 'all') {
  $request->print('<br /><br /><br />') if ($counter > 0);  
  my $mode;   my $mode;
  if ($env{'form.vProb'} eq 'all' && $env{'form.vAns'} eq 'all') {   if ($env{'form.vProb'} eq 'all' && $env{'form.vAns'} eq 'all') {
     $mode='both';      $mode='both';
Line 2089  KEYWORDS Line 2119  KEYWORDS
     }      }
     $request->print($result.'</td></tr></table></td></tr></table>'."\n");      $request->print($result.'</td></tr></table></td></tr></table>'."\n");
   
   # Done with printing info for one student
   
       $request->print('</td></tr></table></p>');
   
   
     # print end of form      # print end of form
     if ($counter == $total) {      if ($counter == $total) {
  my $endform='<table border="0"><tr><td>'."\n";   my $endform='<table border="0"><tr><td>'."\n";
Line 3095  sub viewgrades { Line 3130  sub viewgrades {
  'onClick="javascript:submit();" target="_self" /></form>'."\n";   'onClick="javascript:submit();" target="_self" /></form>'."\n";
     if (scalar(%$fullname) eq 0) {      if (scalar(%$fullname) eq 0) {
  my $colspan=3+scalar(@parts);   my $colspan=3+scalar(@parts);
  $result='<span class="LC_warning">There are no students in section "'.$env{'form.section'}.   my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section'));
     '" with enrollment status "'.$env{'form.Status'}.'" to modify or grade.</span>';   $result='<span class="LC_warning">'.
       &mt('There are no students in section(s) [_1] with enrollment status [_2] to modify or grade',
           $section_display, $env{'form.Status'}).
       '</span>';
     }      }
     $result.=&show_grading_menu_form($symb);      $result.=&show_grading_menu_form($symb);
     return $result;      return $result;
Line 3173  sub editgrades { Line 3211  sub editgrades {
     my ($request) = @_;      my ($request) = @_;
   
     my $symb=&get_symb($request);      my $symb=&get_symb($request);
     my $title='<h3><span class="LC_info">Current Grade Status</span></h3>';      my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section'));
     $title.='<h4><b>Current Resource: </b>'.$env{'form.probTitle'}.'</h4><br />'."\n";      my $title='<h3><span class="LC_info">'.&mt('Current Grade Status').'</span></h3>';
     $title.='<h4><b>Section: </b>'.$env{'form.section'}.'</h4>'."\n";      $title.='<h4>'.&mt('<b>Current Resource: </b>[_1]',$env{'form.probTitle'}).'</h4><br />'."\n";
       $title.='<h4>'.&mt('<b>Section: </b>[_1]',$section_display).'</h4>'."\n";
   
     my $result= '<table border="0"><tr><td bgcolor="#777777">'."\n";      my $result= '<table border="0"><tr><td bgcolor="#777777">'."\n";
     $result.= '<table border="0"><tr bgcolor="#deffff">'.      $result.= '<table border="0"><tr bgcolor="#deffff">'.
Line 3373  sub split_part_type { Line 3412  sub split_part_type {
     my ($partstr) = @_;      my ($partstr) = @_;
     my ($temp,@allparts)=split(/_/,$partstr);      my ($temp,@allparts)=split(/_/,$partstr);
     my $type=pop(@allparts);      my $type=pop(@allparts);
     my $part=join('.',@allparts);      my $part=join('_',@allparts);
     return ($part,$type);      return ($part,$type);
 }  }
   
Line 4392  one of the predefined configurations for Line 4431  one of the predefined configurations for
 like.  like.
   
 Next each scanline is checked for any errors of either 'missing  Next each scanline is checked for any errors of either 'missing
 bubbles' (it's an error because it may have been missed scanned  bubbles' (it's an error because it may have been mis-scanned
 because too light bubbling), 'double bubble' (each bubble line should  because too light bubbling), 'double bubble' (each bubble line should
 have no more that one letter picked), invalid or duplicated CODE,  have no more that one letter picked), invalid or duplicated CODE,
 invalid student ID  invalid student ID
Line 4403  username:domain. Line 4442  username:domain.
   
 During the validation phase the instructor can choose to skip scanlines.   During the validation phase the instructor can choose to skip scanlines. 
   
 After the validation phase, there is now 3 bubble sheet files  After the validation phase, there are now 3 bubble sheet files
   
   scantron_original_filename (unmodified original file)    scantron_original_filename (unmodified original file)
   scantron_corrected_filename (file where the corrected information has replaced the original information)    scantron_corrected_filename (file where the corrected information has replaced the original information)
Line 6473  sub scantron_validate_doublebubble { Line 6512  sub scantron_validate_doublebubble {
 =cut  =cut
   
 sub scantron_get_maxbubble {      sub scantron_get_maxbubble {    
   
     if (defined($env{'form.scantron_maxbubble'}) &&      if (defined($env{'form.scantron_maxbubble'}) &&
  $env{'form.scantron_maxbubble'}) {   $env{'form.scantron_maxbubble'}) {
  return $env{'form.scantron_maxbubble'};   return $env{'form.scantron_maxbubble'};
Line 6487  sub scantron_get_maxbubble { Line 6527  sub scantron_get_maxbubble {
   
     &Apache::lonxml::clear_problem_counter();      &Apache::lonxml::clear_problem_counter();
   
       my $uname       = $env{'form.student'};
       my $udom        = $env{'form.userdom'};
       my $cid         = $env{'request.course.id'};
       my $total_lines = 0;
       %bubble_lines_per_response = ();
   
     foreach my $resource (@resources) {      foreach my $resource (@resources) {
    my $symb = $resource->symb();
  my $result=&Apache::lonnet::ssi($resource->src(),   my $result=&Apache::lonnet::ssi($resource->src(),
  ('symb' => $resource->symb()));   ('symb' => $resource->symb()),
    ('grade_target' => 'analyze'),
    ('grade_courseid' => $cid),
    ('grade_domain' => $udom),
    ('grade_username' => $uname));
    my (undef, $an) =
       split(/_HASH_REF__/,$result, 2);
   
    my %analysis = &Apache::lonnet::str2hash($an);
   
   
   
    foreach my $part_id (@{$analysis{'parts'}}) {
       my $bubble_lines = $analysis{"$part_id.bubble_lines"}[0];
       if (!$bubble_lines) {
    $bubble_lines = 1;
       }
       $bubble_lines_per_response{"$symb.$part_id"} = $bubble_lines;
       $total_lines = $total_lines + $bubble_lines;
    }
   
     }      }
     &Apache::lonnet::delenv('scantron\.');      &Apache::lonnet::delenv('scantron\.');
     $env{'form.scantron_maxbubble'} =      $env{'form.scantron_maxbubble'} =
  &Apache::lonxml::get_problem_counter()-1;   $total_lines;
   
     return $env{'form.scantron_maxbubble'};      return $env{'form.scantron_maxbubble'};
 }  }
   
Line 7051  sub gather_clicker_ids { Line 7117  sub gather_clicker_ids {
     # Set up a couple variables.      # Set up a couple variables.
     my $username_idx = &Apache::loncoursedata::CL_SNAME();      my $username_idx = &Apache::loncoursedata::CL_SNAME();
     my $domain_idx   = &Apache::loncoursedata::CL_SDOM();      my $domain_idx   = &Apache::loncoursedata::CL_SDOM();
       my $status_idx   = &Apache::loncoursedata::CL_STATUS();
   
     foreach my $student (keys(%$classlist)) {      foreach my $student (keys(%$classlist)) {
           if ($classlist->{$student}->[$status_idx] ne 'Active') { next; }
         my $username = $classlist->{$student}->[$username_idx];          my $username = $classlist->{$student}->[$username_idx];
         my $domain   = $classlist->{$student}->[$domain_idx];          my $domain   = $classlist->{$student}->[$domain_idx];
         my $clickers =          my $clickers =
Line 7314  ENDHEADER Line 7381  ENDHEADER
           $result.="\n".'<input type="hidden" name="correct:'.$correct_count.':'.$correct_ids{$id}.'" value="'.$responses{$id}.'" />';            $result.="\n".'<input type="hidden" name="correct:'.$correct_count.':'.$correct_ids{$id}.'" value="'.$responses{$id}.'" />';
           $correct_count++;            $correct_count++;
        } elsif ($clicker_ids{$id}) {         } elsif ($clicker_ids{$id}) {
           $result.="\n".'<input type="hidden" name="student:'.$clicker_ids{$id}.'" value="'.$responses{$id}.'" />';            if ($clicker_ids{$id}=~/\,/) {
           $student_count++;  # More than one user with the same clicker!
                $result.="\n<hr />".&mt('Clicker registered more than once').": <tt>".$id."</tt><br />";
                $result.="\n".'<input type="hidden" name="unknown:'.$id.'" value="'.$responses{$id}.'" />'.
                              "<select name='multi".$id."'>";
                foreach my $reguser (sort(split(/\,/,$clicker_ids{$id}))) {
                    $result.="<option value='".$reguser."'>".&Apache::loncommon::plainname(split(/\:/,$reguser)).' ('.$reguser.')</option>';
                }
                $result.='</select>';
                $unknown_count++;
             } else {
   # Good: found one and only one user with the right clicker
                $result.="\n".'<input type="hidden" name="student:'.$clicker_ids{$id}.'" value="'.$responses{$id}.'" />';
                $student_count++;
             }
        } else {         } else {
           $result.="\n<hr />".&mt('Unregistered Clicker')." <tt>".$id."</tt><br />";            $result.="\n<hr />".&mt('Unregistered Clicker')." <tt>".$id."</tt><br />";
           $result.="\n".'<input type="hidden" name="unknown:'.$id.'" value="'.$responses{$id}.'" />'.            $result.="\n".'<input type="hidden" name="unknown:'.$id.'" value="'.$responses{$id}.'" />'.
Line 7466  ENDHEADER Line 7546  ENDHEADER
           my $id=$1;            my $id=$1;
           if (($env{'form.uname'.$id}) && ($env{'form.udom'.$id})) {            if (($env{'form.uname'.$id}) && ($env{'form.udom'.$id})) {
              $user=$env{'form.uname'.$id}.':'.$env{'form.udom'.$id};               $user=$env{'form.uname'.$id}.':'.$env{'form.udom'.$id};
             } elsif ($env{'form.multi'.$id}) {
                $user=$env{'form.multi'.$id};
           }            }
        }         }
        if ($user) {          if ($user) { 
Line 7511  ENDHEADER Line 7593  ENDHEADER
 sub handler {  sub handler {
     my $request=$_[0];      my $request=$_[0];
   
     &reset_perm();      &reset_caches();
     if ($env{'browser.mathml'}) {      if ($env{'browser.mathml'}) {
  &Apache::loncommon::content_type($request,'text/xml');   &Apache::loncommon::content_type($request,'text/xml');
     } else {      } else {
Line 7624  sub handler { Line 7706  sub handler {
  }   }
     }      }
     $request->print(&Apache::loncommon::end_page());      $request->print(&Apache::loncommon::end_page());
       &reset_caches();
     return '';      return '';
 }  }
   
Removed from v.1.432  
changed lines
  Added in v.1.441

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