[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.439

version 1.432, 2007/08/21 22:21:54 version 1.439, 2007/09/07 00:07:30
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 1665  sub build_section_inputs { Line 1688  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 3095  sub viewgrades { Line 3118  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 3199  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 3400  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 4419  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 4430  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 6500  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 6515  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 7105  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 7369  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 7534  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 7581  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 7694  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.439

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