[BACK]Return to lonstathelpers.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface / statistics

Diff for /loncom/interface/statistics/lonstathelpers.pm between versions 1.28 and 1.44

version 1.28, 2004/10/04 19:11:38 version 1.44, 2005/03/14 20:28:22
Line 68  use Storable qw(freeze thaw); Line 68  use Storable qw(freeze thaw);
   
 =item &render_resource($resource)  =item &render_resource($resource)
   
 Input: a resource generated from   Input: a navmaps resource
 &Apache::loncoursedata::get_sequence_assessment_data().  
   
 Retunrs: a scalar containing html for a rendering of the problem  Retunrs: a scalar containing html for a rendering of the problem
 within a table.  within a table.
Line 82  sub render_resource { Line 81  sub render_resource {
     my ($resource) = @_;      my ($resource) = @_;
     ##      ##
     ## Render the problem      ## Render the problem
     my $base;      my ($base) = ($resource->src =~ m|^(.*/)[^/]*$|);
     ($base,undef) = ($resource->{'src'} =~ m|(.*/)[^/]*$|);      $base="http://".$ENV{'SERVER_NAME'}.$base;
     $base = "http://".$ENV{'SERVER_NAME'}.$base;      my ($src,$symb)=($resource->src,&Apache::lonnet::escape($resource->symb));
     my $rendered_problem =       my $rendered_problem = &Apache::lonnet::ssi_body($src.'?symb='.$symb);
         &Apache::lonnet::ssi_body($resource->{'src'});  
     $rendered_problem =~ s/<\s*form\s*/<nop /g;      $rendered_problem =~ s/<\s*form\s*/<nop /g;
     $rendered_problem =~ s|(<\s*/form\s*>)|<\/nop>|g;      $rendered_problem =~ s|(<\s*/form\s*>)|<\/nop>|g;
     return '<table bgcolor="ffffff"><tr><td>'.      return '<table bgcolor="ffffff"><tr><td>'.
Line 100  sub render_resource { Line 98  sub render_resource {
   
 =pod  =pod
   
 =item &ProblemSelector($AcceptedResponseTypes)  =item &get_resources
   
   =cut
   
   ####################################################
   ####################################################
   sub get_resources {
       my ($navmap,$sequence) = @_;
       my @resources = $navmap->retrieveResources($sequence,
                                                  sub { shift->is_problem(); },
                                                  0,0,0);
       return @resources;
   }
   
   ####################################################
   ####################################################
   
   =pod
   
   =item &problem_selector($AcceptedResponseTypes)
   
 Input: scalar containing regular expression which matches response  Input: scalar containing regular expression which matches response
 types to show.  '.' will yield all, '(option|radiobutton)' will match  types to show.  '.' will yield all, '(option|radiobutton)' will match
Line 114  Skips 'survey' problems. Line 131  Skips 'survey' problems.
   
 ####################################################  ####################################################
 ####################################################  ####################################################
 sub ProblemSelector {  sub problem_selector {
     my ($AcceptedResponseTypes) = @_;      my ($AcceptedResponseTypes) = @_;
     my $Str;      my $Str;
     $Str = "\n<table>\n";      $Str = "\n<table>\n";
     my $rb_count =0;      my $rb_count =0;
     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess('all')) {      my ($navmap,@sequences) = 
         next if ($seq->{'num_assess'}<1);          &Apache::lonstatistics::selected_sequences_with_assessments('all');
       return $navmap if (! ref($navmap)); # error
       foreach my $seq (@sequences) {
         my $seq_str = '';          my $seq_str = '';
         foreach my $res (@{$seq->{'contents'}}) {          foreach my $res (&get_resources($navmap,$seq)) {
             next if ($res->{'type'} ne 'assessment');              foreach my $part (@{$res->parts}) {
             foreach my $part (@{$res->{'parts'}}) {                  my @response_ids   = $res->responseIds($part);
                 my $partdata = $res->{'partdata'}->{$part};                  my @response_types = $res->responseType($part);
                 for (my $i=0;$i<scalar(@{$partdata->{'ResponseTypes'}});$i++){                  for (my $i=0;$i<scalar(@response_types);$i++){
                     my $respid = $partdata->{'ResponseIds'}->[$i];                      my $respid = $response_ids[$i];
                     my $resptype = $partdata->{'ResponseTypes'}->[$i];                      my $resptype = $response_types[$i];
                     if ($resptype =~ m/$AcceptedResponseTypes/) {                      if ($resptype =~ m/$AcceptedResponseTypes/) {
                         my $value = &make_target_id({symb=>$res->{'symb'},                          my $value = &make_target_id({symb=>$res->symb,
                                                      part=>$part,                                                       part=>$part,
                                                      respid=>$respid,                                                       respid=>$respid,
                                                      resptype=>$resptype});                                                       resptype=>$resptype});
Line 138  sub ProblemSelector { Line 157  sub ProblemSelector {
                         if ($ENV{'form.problemchoice'} eq $value) {                          if ($ENV{'form.problemchoice'} eq $value) {
                             $checked = 'checked ';                              $checked = 'checked ';
                         }                          }
                         my $title = $res->{'title'};                          my $title = $res->compTitle;
                         if (! defined($title) || $title eq '') {                          if (! defined($title) || $title eq '') {
                             ($title) = ($res->{'src'} =~ m:/([^/]*)$:);                              ($title) = ($res->src =~ m:/([^/]*)$:);
                         }                          }
                         $seq_str .= '<tr>'.                          $seq_str .= '<tr>'.
                             qq{<td><input type="radio" id="$rb_count" name="problemchoice" value="$value" $checked /></td>}.                              qq{<td><input type="radio" id="$rb_count" name="problemchoice" value="$value" $checked /></td>}.
                             '<td><label for="'.$rb_count.'">'.$resptype.'</label></td>'.                              '<td><label for="'.$rb_count.'">'.$resptype.'</label></td>'.
                             '<td><label for="'.$rb_count.'">'.$title.'</label>';                              '<td><label for="'.$rb_count.'">'.$title.'</label>';
                         if (scalar(@{$partdata->{'ResponseIds'}}) > 1) {                          if (scalar(@response_ids) > 1) {
                             $seq_str .= &mt('response').' '.$respid;                              $seq_str .= &mt('response').' '.$respid;
                         }                          }
                           my $link = $res->src.'?symb='.
                               &Apache::lonnet::escape($res->symb);
                         $seq_str .= ('&nbsp;'x2).                          $seq_str .= ('&nbsp;'x2).
                             qq{<a target="preview" href="$res->{'src'}">view</a>};                              qq{<a target="preview" href="$link">view</a>};
                         $seq_str .= "</td></tr>\n";                          $seq_str .= "</td></tr>\n";
                         $rb_count++;                          $rb_count++;
                     }                      }
Line 158  sub ProblemSelector { Line 179  sub ProblemSelector {
             }              }
         }          }
         if ($seq_str ne '') {          if ($seq_str ne '') {
             $Str .= '<tr><td>&nbsp</td><td colspan="2"><b>'.$seq->{'title'}.'</b></td>'.              $Str .= '<tr><td>&nbsp</td><td colspan="2"><b>'.$seq->compTitle.'</b></td>'.
                 "</tr>\n".$seq_str;                  "</tr>\n".$seq_str;
         }          }
     }      }
Line 280  END Line 301  END
     return $Str;      return $Str;
 }  }
   
 sub get_title {  
     my ($title,$src) = @_;  
     if ($title eq '') {  
         ($title) = ($src =~ m|/([^/]+)$|);  
     } else {  
         $title =~ s/\&colon;/:/g;  
     }  
     return $title;  
 }  
   
 sub new_accumulator {  sub new_accumulator {
     my ($title,$src,$symb,$seq_id,$inputname) = @_;      my ($title,$src,$symb,$seq_id,$inputname) = @_;
     my $target;      my $target;
Line 308  sub new_accumulator { Line 319  sub new_accumulator {
                     'value="'.&Apache::lonnet::escape($res->symb).'" />'.                      'value="'.&Apache::lonnet::escape($res->symb).'" />'.
                     '&nbsp;'.$res->compTitle.'</label>'.                      '&nbsp;'.$res->compTitle.'</label>'.
                     ('&nbsp;'x2).'<a target="preview" '.                      ('&nbsp;'x2).'<a target="preview" '.
                     'href="'.$res->src.'">view</a>'.                      'href="'.$res->src.'?symb='.
                            &Apache::lonnet::escape($res->symb).'">view</a>'.
                     '</td></tr>'.$/;                      '</td></tr>'.$/;
             } else {               } else { 
                 if (defined($target)) {                  if (defined($target)) {
Line 440  sub get_prev_curr_next { Line 452  sub get_prev_curr_next {
     #      #
     # Build an array with the data we need to search through      # Build an array with the data we need to search through
     my @Resource;      my @Resource;
     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess('all')) {      my ($navmap,@sequences) = 
         foreach my $res (@{$seq->{'contents'}}) {          &Apache::lonstatistics::selected_sequences_with_assessments('all');
             next if ($res->{'type'} ne 'assessment');      return $navmap if (! ref($navmap));
             foreach my $part (@{$res->{'parts'}}) {      foreach my $seq (@sequences) {
                 my $partdata = $res->{'partdata'}->{$part};          my @resources = &get_resources($navmap,$seq);
                 if ($partdata->{'Survey'} && ($granularity eq 'part_survey')){          foreach my $res (@resources) {
               foreach my $part (@{$res->parts}) {
                   if ($res->is_survey($part) && ($granularity eq 'part_survey')){
                     push (@Resource,                      push (@Resource,
                           { symb     => $res->{symb},                            { symb     => $res->symb,
                             part     => $part,                              part     => $part,
                             resource => $res,                              resource => $res,
                         } );                          } );
                 } elsif ($granularity eq 'part') {                  } elsif ($granularity eq 'part') {
                     push (@Resource,                      push (@Resource,
                           { symb     => $res->{symb},                            { symb     => $res->symb,
                             part     => $part,                              part     => $part,
                             resource => $res,                              resource => $res,
                         } );                          } );
                 } elsif ($granularity eq 'response') {                  } elsif ($granularity eq 'response') {
                       my @response_ids   = $res->responseIds($part);
                       my @response_types = $res->responseType($part);
                     for (my $i=0;                      for (my $i=0;
                          $i<scalar(@{$partdata->{'ResponseTypes'}});                           $i<scalar(@response_ids);
                          $i++){                           $i++){
                         my $respid = $partdata->{'ResponseIds'}->[$i];                          my $respid   = $response_ids[$i];
                         my $resptype = $partdata->{'ResponseTypes'}->[$i];                          my $resptype = $response_types[$i];
                         next if ($resptype !~ m/$AcceptableResponseTypes/);                          next if ($resptype !~ m/$AcceptableResponseTypes/);
                         push (@Resource,                          push (@Resource,
                               { symb     => $res->{symb},                                { symb     => $res->symb,
                                 part     => $part,                                  part     => $part,
                                 respid   => $partdata->{'ResponseIds'}->[$i],                                  respid   => $respid,
                                   resptype => $resptype,
                                 resource => $res,                                  resource => $res,
                                 resptype => $resptype  
                                 } );                                  } );
                     }                      }
                 }                  }
Line 527  sub get_prev_curr_next { Line 543  sub get_prev_curr_next {
         $curr = $Resource[$curr_idx  ];          $curr = $Resource[$curr_idx  ];
         $next = $Resource[$curr_idx+1];          $next = $Resource[$curr_idx+1];
     }      }
     return ($prev,$curr,$next);      return ($navmap,$prev,$curr,$next);
 }  }
   
   
Line 555  Returns: nothing Line 571  Returns: nothing
 #####################################################  #####################################################
 sub GetStudentAnswers {  sub GetStudentAnswers {
     my ($r,$problem,$Students,$formname,$inputname) = @_;      my ($r,$problem,$Students,$formname,$inputname) = @_;
       my %answers;
     my $status_type;      my $status_type;
     if (defined($formname)) {      if (defined($formname)) {
         $status_type = 'inline';          $status_type = 'inline';
Line 578  sub GetStudentAnswers { Line 595  sub GetStudentAnswers {
         last if ($c->aborted());          last if ($c->aborted());
         my $sname = $student->{'username'};          my $sname = $student->{'username'};
         my $sdom = $student->{'domain'};          my $sdom = $student->{'domain'};
         my $answer = &Apache::lonstathelpers::analyze_problem_as_student          my $answer = &Apache::lonstathelpers::get_student_answer
             ($resource,$sname,$sdom,$partid,$respid);              ($resource,$sname,$sdom,$partid,$respid);
         &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,          &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
                                                  &mt('last student'));                                                   &mt('last student'));
           $answers{$answer}++;
         $student->{'answer'} = $answer;          $student->{'answer'} = $answer;
     }      }
     &Apache::lonstathelpers::write_answer_cache();      &Apache::lonstathelpers::write_analysis_cache();
     return if ($c->aborted());      return if ($c->aborted());
     $r->rflush();      $r->rflush();
     # close progress window      # close progress window
     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);      &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
     return;      return \%answers;
 }  }
   
 #####################################################  #####################################################
Line 599  sub GetStudentAnswers { Line 617  sub GetStudentAnswers {
   
 =item analyze_problem_as_student  =item analyze_problem_as_student
   
 Analyzes a homework problem for a student and returns the correct answer  Analyzes a homework problem for a student
 for the student.  Attempts to put together an answer for problem types   
 that do not natively support it.  
   
 Inputs: $resource: a resource object  Inputs: $resource: a resource object
         $sname, $sdom, $partid, $respid          $sname, $sdom, $partid, $respid
   
   Returns: the problem analysis hash
   
   =cut
   
   #####################################################
   #####################################################
   sub analyze_problem_as_student {
       my ($resource,$sname,$sdom) = @_;
       if (ref($resource) ne 'HASH') {
           my $res = $resource;
           $resource = { 'src' => $res->src,
                         'symb' => $res->symb,
                         'parts' => $res->parts };
           foreach my $part (@{$resource->{'parts'}}) {
               $resource->{'partdata'}->{$part}->{'ResponseIds'}=
                   [$res->responseIds($part)];
           }
       }
       my $url = $resource->{'src'};
       my $symb = $resource->{'symb'};
       my $analysis = &get_from_analysis_cache($sname,$sdom,$symb);
       if (! defined($analysis)) {
           my $courseid = $ENV{'request.course.id'};
           my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze',
                                               'grade_domain' => $sdom,
                                               'grade_username' => $sname,
                                               'grade_symb' => $symb,
                                               'grade_courseid' => $courseid));
           (my $garbage,$analysis)=split(/_HASH_REF__/,$Answ,2);
           &store_analysis($sname,$sdom,$symb,$analysis);
       }
       my %Answer=&Apache::lonnet::str2hash($analysis);
       #
       return \%Answer;
   }
   
   #####################################################
   #####################################################
   
   =pod
   
   =item get_student_answer
   
   Analyzes a homework problem for a particular student and returns the correct 
   answer.  Attempts to put together an answer for problem types 
   that do not natively support it.
   
   Inputs: $resource: a resource object (from navmaps or hash from loncoursedata)
           $sname, $sdom, $partid, $respid
   
 Returns: $answer  Returns: $answer
   
 If $partid and $respid are specified, $answer is simply a scalar containing  If $partid and $respid are specified, $answer is simply a scalar containing
Line 618  keys $partid.'.'.$respid.'.answer'. Line 684  keys $partid.'.'.$respid.'.answer'.
   
 #####################################################  #####################################################
 #####################################################  #####################################################
 sub analyze_problem_as_student {  sub get_student_answer {
     my ($resource,$sname,$sdom,$partid,$respid) = @_;      my ($resource,$sname,$sdom,$partid,$respid) = @_;
       #
     if (ref($resource) ne 'HASH') {      if (ref($resource) ne 'HASH') {
         my $res = $resource;          my $res = $resource;
         $resource = { 'src' => $res->src,          $resource = { 'src' => $res->src,
Line 630  sub analyze_problem_as_student { Line 697  sub analyze_problem_as_student {
                 [$res->responseIds($part)];                  [$res->responseIds($part)];
         }          }
     }      }
     my $returnvalue;  
     my $url = $resource->{'src'};  
     my $symb = $resource->{'symb'};  
     my $answer = &get_from_answer_cache($sname,$sdom,$symb,$partid,$respid);  
     if (defined($answer)) {  
         return($answer);  
     }  
     my $courseid = $ENV{'request.course.id'};  
     my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze',  
                                         'grade_domain' => $sdom,  
                                         'grade_username' => $sname,  
                                         'grade_symb' => $symb,  
                                         'grade_courseid' => $courseid));  
     (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);  
     my %Answer=&Apache::lonnet::str2hash($Answ);  
     #      #
     undef($answer);      my $analysis = 
           &analyze_problem_as_student($resource,$sname,$sdom);
       my $answer;
     foreach my $partid (@{$resource->{'parts'}}) {      foreach my $partid (@{$resource->{'parts'}}) {
         my $partdata = $resource->{'partdata'}->{$partid};          my $partdata = $resource->{'partdata'}->{$partid};
         foreach my $respid (@{$partdata->{'ResponseIds'}}) {          foreach my $respid (@{$partdata->{'ResponseIds'}}) {
             my $prefix = $partid.'.'.$respid;              my $prefix = $partid.'.'.$respid;
             my $key = $prefix.'.answer';              my $key = $prefix.'.answer';
             $answer->{$partid}->{$respid} = &get_answer($prefix,$key,%Answer);              $answer->{$partid}->{$respid} = 
                   &get_answer($prefix,$key,%$analysis);
         }          }
     }      }
     &store_answer($sname,$sdom,$symb,undef,undef,$answer);      my $returnvalue;
     if (! defined($partid)) {      if (! defined($partid)) {
         $returnvalue = $answer;          $returnvalue = $answer;
     } elsif (! defined($respid)) {      } elsif (! defined($respid)) {
Line 700  sub get_answer { Line 755  sub get_answer {
     return $returnvalue;      return $returnvalue;
 }  }
   
   
 #####################################################  #####################################################
 #####################################################  #####################################################
   
Line 710  sub get_answer { Line 764  sub get_answer {
   
 =over 4  =over 4
   
 =item &load_answer_cache($symb)  =item &load_analysis_cache($symb)
   
 Loads the cache for the given symb into memory from disk.    Loads the cache for the given symb into memory from disk.  
 Requires the cache filename be set.    Requires the cache filename be set.  
Line 725  Only should be called by &ensure_proper_ Line 779  Only should be called by &ensure_proper_
     my $current_symb = undef;      my $current_symb = undef;
     my %cache;      my %cache;
   
 sub load_answer_cache {  sub load_analysis_cache {
     my ($symb) = @_;      my ($symb) = @_;
     return if (! defined($cache_filename));      return if (! defined($cache_filename));
     if (! defined($current_symb) || $current_symb ne $symb) {      if (! defined($current_symb) || $current_symb ne $symb) {
Line 748  sub load_answer_cache { Line 802  sub load_answer_cache {
   
 =pod  =pod
   
 =item &get_from_answer_cache($sname,$sdom,$symb,$partid,$respid)  =item &get_from_analysis_cache($sname,$sdom,$symb,$partid,$respid)
   
 Returns the appropriate data from the cache, or undef if no data exists.  Returns the appropriate data from the cache, or undef if no data exists.
 If $respid is undefined, a hash ref containing the answers for the given   
 $partid is returned.  If $partid is undefined, a hash ref containing answers  
 for all of the parts is returned.  
   
 =cut  =cut
   
 #####################################################  #####################################################
 #####################################################  #####################################################
 sub get_from_answer_cache {  sub get_from_analysis_cache {
     my ($sname,$sdom,$symb,$partid,$respid) = @_;      my ($sname,$sdom,$symb) = @_;
     &ensure_proper_cache($symb);      &ensure_proper_cache($symb);
     my $returnvalue;      my $returnvalue;
     if (exists($cache{$sname.':'.$sdom}) &&      if (exists($cache{$sname.':'.$sdom})) {
         ref($cache{$sname.':'.$sdom}) eq 'HASH') {          $returnvalue = $cache{$sname.':'.$sdom};
         if (defined($partid) &&  
             exists($cache{$sname.':'.$sdom}->{$partid})) {  
             if (defined($respid) &&  
                 exists($cache{$sname.':'.$sdom}->{$partid}->{$respid})) {  
                 $returnvalue = $cache{$sname.':'.$sdom}->{$partid}->{$respid};  
             } else {  
                 $returnvalue = $cache{$sname.':'.$sdom}->{$partid};  
             }  
         } else {  
             $returnvalue = $cache{$sname.':'.$sdom};  
         }  
     } else {      } else {
         $returnvalue = undef;          $returnvalue = undef;
     }      }
Line 787  sub get_from_answer_cache { Line 827  sub get_from_answer_cache {
   
 =pod  =pod
   
 =item &write_answer_cache($symb)  =item &write_analysis_cache($symb)
   
 Writes the in memory cache to disk so that it can be read in with  Writes the in memory cache to disk so that it can be read in with
 &load_answer_cache($symb).  &load_analysis_cache($symb).
   
 =cut  =cut
   
 #####################################################  #####################################################
 #####################################################  #####################################################
 sub write_answer_cache {  sub write_analysis_cache {
     return if (! defined($current_symb) || ! defined($cache_filename));      return if (! defined($current_symb) || ! defined($cache_filename));
     my %cache_db;      my %cache_db;
     my $key = &Apache::lonnet::escape($current_symb);      my $key = &Apache::lonnet::escape($current_symb);
Line 820  sub write_answer_cache { Line 860  sub write_answer_cache {
 =item &ensure_proper_cache($symb)  =item &ensure_proper_cache($symb)
   
 Called to make sure we have the proper cache set up.  This is called  Called to make sure we have the proper cache set up.  This is called
 prior to every answer lookup.  prior to every analysis lookup.
   
 =cut  =cut
   
Line 830  sub ensure_proper_cache { Line 870  sub ensure_proper_cache {
     my ($symb) = @_;      my ($symb) = @_;
     my $cid = $ENV{'request.course.id'};      my $cid = $ENV{'request.course.id'};
     my $new_filename =  '/home/httpd/perl/tmp/'.      my $new_filename =  '/home/httpd/perl/tmp/'.
         'problemanalysis_'.$cid.'_answer_cache.db';          'problemanalysis_'.$cid.'_analysis_cache.db';
     if (! defined($cache_filename) ||      if (! defined($cache_filename) ||
         $cache_filename ne $new_filename ||          $cache_filename ne $new_filename ||
         ! defined($current_symb)   ||          ! defined($current_symb)   ||
         $current_symb ne $symb) {          $current_symb ne $symb) {
         $cache_filename = $new_filename;          $cache_filename = $new_filename;
         # Notice: $current_symb is not set to $symb until after the cache is          # Notice: $current_symb is not set to $symb until after the cache is
         # loaded.  This is what tells &load_answer_cache to load in a new          # loaded.  This is what tells &load_analysis_cache to load in a new
         # symb cache.          # symb cache.
         &load_answer_cache($symb);          &load_analysis_cache($symb);
         $current_symb = $symb;          $current_symb = $symb;
     }      }
 }  }
Line 849  sub ensure_proper_cache { Line 889  sub ensure_proper_cache {
   
 =pod  =pod
   
 =item &store_answer($sname,$sdom,$symb,$partid,$respid,$dataset)  =item &store_analysis($sname,$sdom,$symb,$partid,$respid,$dataset)
   
 Stores the answer data in the in memory cache.  Stores the analysis data in the in memory cache.
   
 =cut  =cut
   
 #####################################################  #####################################################
 #####################################################  #####################################################
 sub store_answer {  sub store_analysis {
     my ($sname,$sdom,$symb,$partid,$respid,$dataset) = @_;      my ($sname,$sdom,$symb,$dataset) = @_;
     return if ($symb ne $current_symb);      return if ($symb ne $current_symb);
     if (defined($partid)) {      $cache{$sname.':'.$sdom}=$dataset;
         if (defined($respid)) {  
             $cache{$sname.':'.$sdom}->{$partid}->{$respid} = $dataset;  
         } else {  
             $cache{$sname.':'.$sdom}->{$partid} = $dataset;  
         }  
     } else {  
         $cache{$sname.':'.$sdom}=$dataset;  
     }  
     return;      return;
 }  }
   
Line 1116  sub get_problem_data { Line 1148  sub get_problem_data {
                         $Partdata{$part}->{'_Foils'}->{$foil}->{'_Concept'}=                          $Partdata{$part}->{'_Foils'}->{$foil}->{'_Concept'}=
                                                                       $concept;                                                                        $concept;
                     }                      }
                 } elsif ($key =~ /^(incorrect|answer|ans_low|ans_high|str_type)$/) {                  } elsif ($key =~ /^(unit|incorrect|answer|ans_low|ans_high|str_type)$/) {
                     $Partdata{$part}->{$key}=$value;                      $Partdata{$part}->{$key}=$value;
                 }                  }
             } else {              } else {
Line 1260  sub get_time_limits { Line 1292  sub get_time_limits {
   
 Inputs: @Sections, an array of sections  Inputs: @Sections, an array of sections
   
 Returns: A text description of the sections selected.  Returns: A plaintext description of the sections selected.
   
 =cut  =cut
   
Line 1308  sub manage_caches { Line 1340  sub manage_caches {
         join(',',          join(',',
              map {               map {
                      &Apache::lonnet::escape($_);                       &Apache::lonnet::escape($_);
                  } sort(@Apache::lonstatistics::SelectedSections)                   } sort(&Apache::lonstatistics::get_selected_sections())
              );               );
     my $statuskey = $Apache::lonstatistics::enrollment_status;      my $statuskey = $Apache::lonstatistics::enrollment_status;
     if (exists($ENV{'form.ClearCache'}) ||       if (exists($ENV{'form.ClearCache'}) || 
Line 1322  sub manage_caches { Line 1354  sub manage_caches {
         if (defined($update_message)) {          if (defined($update_message)) {
             $r->print($update_message);              $r->print($update_message);
         }          }
         &Apache::lonstatistics::Gather_Full_Student_Data($r,$formname,          if (0) {
                                                          $inputname);              &Apache::lonnet::logthis('Updating mysql student data caches');
                       }
           &gather_full_student_data($r,$formname,$inputname);
     }      }
     #      #
     my @Buttons =       my @Buttons = 
Line 1346  sub manage_caches { Line 1379  sub manage_caches {
     return @Buttons;      return @Buttons;
 }  }
   
   sub gather_full_student_data {
       my ($r,$formname,$inputname) = @_;
       my $status_type;
       if (defined($formname)) {
           $status_type = 'inline';
       } else {
           $status_type = 'popup';
       }
       my $c = $r->connection();
       #
       &Apache::loncoursedata::clear_internal_caches();
       #
       my @Students = @Apache::lonstatistics::Students;
       #
       # Open the progress window
       my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin
           ($r,&mt('Student Data Compilation Status'),
            &mt('Student Data Compilation Progress'), scalar(@Students),
            $status_type,undef,$formname,$inputname);
       #
       while (my $student = shift @Students) {
           return if ($c->aborted());
           my $status = &Apache::loncoursedata::ensure_current_full_data
               ($student->{'username'},$student->{'domain'},
                $ENV{'request.course.id'});
           &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
                                                    &mt('last student'));
       }
       &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
       $r->rflush();
       return;
   }
   
   ####################################################
   ####################################################
   
   =pod
   
   =item &submission_report_form
   
   Input: The originating reportSelected value for the current stats page.
   
   Output: Scalar containing HTML with needed form elements and a link to 
   the student submission reports page.
   
   =cut
   
   ####################################################
   ####################################################
   sub submission_report_form {
       my ($original_report) = @_;
       # Note: In the link below we change the reportSelected value.  If
       # the user hits the 'back' button on the browser after getting their
       # student submissions report, this value may still be around.  So we
       # output a script block to set it properly.  If the $original_report
       # value is unset, you are just asking for trouble.
       if (! defined($original_report)) {
           &Apache::lonnet::logthis
               ('someone called lonstathelpers::submission_report_form without '.
                ' enough input.');
       }
       my $html = $/.
           '<script type="Text/JavaScript">'.
           "document.Statistics.reportSelected.value='$original_report';".
           '</script>'.
           '<input type="hidden" name="correctans" value="true" />'.
           '<input type="hidden" name="prob_status" value="true" />'.
           '<input type="hidden" name="all_sub" value="true" />';
       my $output_selector = $/.'<select name="output">'.$/;
       foreach ('HTML','Excel','CSV') {
           $output_selector .= '    <option value="'.lc($_).'"';
           if ($ENV{'form.output'} eq lc($_)) {
               $output_selector .= ' selected ';
           }
           $output_selector .='>'.&mt($_).'</option>'.$/;
       } 
       $output_selector .= '</select>'.$/;
       my $link = '<a href="javascript:'.
          q{document.Statistics.reportSelected.value='student_submission_reports';}.
          'document.Statistics.submit();">';
       $html.= &mt('View data as [_1] [_2]go[_3]',$output_selector,
                   $link,'</a>').$/;
       return $html
   }
   
 ####################################################  ####################################################
 ####################################################  ####################################################
Removed from v.1.28  
changed lines
  Added in v.1.44

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