Diff for /loncom/interface/statistics/lonstathelpers.pm between versions 1.24 and 1.36

version 1.24, 2004/09/23 14:35:25 version 1.36, 2005/02/01 15:15:28
Line 86  sub render_resource { Line 86  sub render_resource {
     ($base,undef) = ($resource->{'src'} =~ m|(.*/)[^/]*$|);      ($base,undef) = ($resource->{'src'} =~ m|(.*/)[^/]*$|);
     $base = "http://".$ENV{'SERVER_NAME'}.$base;      $base = "http://".$ENV{'SERVER_NAME'}.$base;
     my $rendered_problem =       my $rendered_problem = 
         &Apache::lonnet::ssi_body($resource->{'src'});          &Apache::lonnet::ssi_body($resource->{'src'}.'?symb='.&Apache::lonnet::escape($resource->{'symb'}));
     $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 118  sub ProblemSelector { Line 118  sub ProblemSelector {
     my ($AcceptedResponseTypes) = @_;      my ($AcceptedResponseTypes) = @_;
     my $Str;      my $Str;
     $Str = "\n<table>\n";      $Str = "\n<table>\n";
       my $rb_count =0;
     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess('all')) {      foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess('all')) {
         next if ($seq->{'num_assess'}<1);          next if ($seq->{'num_assess'}<1);
         my $seq_str = '';          my $seq_str = '';
Line 141  sub ProblemSelector { Line 142  sub ProblemSelector {
                         if (! defined($title) || $title eq '') {                          if (! defined($title) || $title eq '') {
                             ($title) = ($res->{'src'} =~ m:/([^/]*)$:);                              ($title) = ($res->{'src'} =~ m:/([^/]*)$:);
                         }                          }
                         $seq_str .= '<tr><td>'.                          $seq_str .= '<tr>'.
   '<input type="radio" name="problemchoice" value="'.$value.'" '.$checked.'/>'.                              qq{<td><input type="radio" id="$rb_count" name="problemchoice" value="$value" $checked /></td>}.
   '</td><td>'.                                        '<td><label for="'.$rb_count.'">'.$resptype.'</label></td>'.
   $resptype.'</td><td>'.                              '<td><label for="'.$rb_count.'">'.$title.'</label>';
   '<a href="'.$res->{'src'}.'">'.$title.'</a> ';  
 #  '<a href="'.$res->{'src'}.'">'.$resptype.' '.$res->{'title'}.'</a> ';  
                         if (scalar(@{$partdata->{'ResponseIds'}}) > 1) {                          if (scalar(@{$partdata->{'ResponseIds'}}) > 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).
                               qq{<a target="preview" href="$link">view</a>};
                         $seq_str .= "</td></tr>\n";                          $seq_str .= "</td></tr>\n";
                           $rb_count++;
                     }                      }
                 }                  }
             }              }
Line 205  sub MultipleProblemSelector { Line 209  sub MultipleProblemSelector {
     my $selected = {map { ($_,1) } (&get_selected_symbs($inputname))};      my $selected = {map { ($_,1) } (&get_selected_symbs($inputname))};
     # Header      # Header
     $Str .= <<"END";      $Str .= <<"END";
 <script>  <script language="JavaScript" type="text/javascript">
     function checkall(value) {      function checkall(value,seqid) {
         for (i=0; i<document.forms.$formname.elements.length; i++) {          for (i=0; i<document.forms.$formname.elements.length; i++) {
             ele = document.forms.$formname.elements[i];              ele = document.forms.$formname.elements[i];
             if (ele.name == '$inputname') {              if (ele.name == '$inputname') {
                 document.forms.$formname.elements[i].checked=value;                  if (seqid != null) {
                       itemid = document.forms.$formname.elements[i].id;
                       thing = itemid.split(':');
                       if (thing[0] == seqid) {
                           document.forms.$formname.elements[i].checked=value;
                       }
                   } else {
                       document.forms.$formname.elements[i].checked=value;
                   }
             }              }
         }          }
     }      }
Line 223  END Line 235  END
     $Str .= $/.'<table>'.$/;      $Str .= $/.'<table>'.$/;
     my $iterator = $navmap->getIterator(undef, undef, undef, 1);      my $iterator = $navmap->getIterator(undef, undef, undef, 1);
     my $sequence_string;      my $sequence_string;
       my $seq_id = 0;
     my @Accumulator = (&new_accumulator($ENV{'course.'.$cid.'.description'},      my @Accumulator = (&new_accumulator($ENV{'course.'.$cid.'.description'},
                                         '',                                          '',
                                         '',                                          '',
                                           $seq_id++,
                                         $inputname));                                          $inputname));
     my @Sequence_Data;      my @Sequence_Data;
     while (my $curRes = $iterator->next()) {      while (my $curRes = $iterator->next()) {
Line 242  END Line 256  END
             push(@Accumulator,&new_accumulator($curRes->compTitle,              push(@Accumulator,&new_accumulator($curRes->compTitle,
                                                $curRes->src,                                                 $curRes->src,
                                                $curRes->symb,                                                 $curRes->symb,
                                                  $seq_id++,
                                                $inputname));                                                 $inputname));
         } elsif ($curRes->is_problem) {          } elsif ($curRes->is_problem) {
             if (@Accumulator && $Accumulator[-1] ne '') {              if (@Accumulator && $Accumulator[-1] ne '') {
Line 255  END Line 270  END
         #my $seq = pop(@Sequence_Data);          #my $seq = pop(@Sequence_Data);
         next if (! defined($seq) || ref($seq) ne 'HASH');          next if (! defined($seq) || ref($seq) ne 'HASH');
         $Str.= '<tr><td colspan="2">'.          $Str.= '<tr><td colspan="2">'.
             '<b>'.$seq->{'title'}.'</b>'.              '<b>'.$seq->{'title'}.'</b>'.('&nbsp;'x2).
               '<a href="javascript:checkall(true,'.$seq->{'id'}.')">'.
                                     &mt('Select').'</a>'.('&nbsp;'x2).
               '<a href="javascript:checkall(false,'.$seq->{'id'}.')">'.
                                     &mt('Unselect').'</a>'.('&nbsp;'x2).
             '</td></tr>'.$/;              '</td></tr>'.$/;
         $Str.= $seq->{'html'};          $Str.= $seq->{'html'};
     }      }
Line 263  END Line 282  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,$inputname) = @_;      my ($title,$src,$symb,$seq_id,$inputname) = @_;
     my $target;      my $target;
       my $item_id=0;
     return       return 
         sub {          sub {
             if (@_) {               if (@_) { 
Line 285  sub new_accumulator { Line 295  sub new_accumulator {
                 if ($checked) {                  if ($checked) {
                     $target .= 'checked ';                      $target .= 'checked ';
                 }                  }
                   $target .= 'id="'.$seq_id.':'.$item_id++.'" ';
                 $target.=                   $target.= 
                     'value="'.&Apache::lonnet::escape($res->symb).'" />'.                      'value="'.&Apache::lonnet::escape($res->symb).'" />'.
                     '&nbsp;'.$res->compTitle.'</label></td>'.                      '&nbsp;'.$res->compTitle.'</label>'.
                     '</tr>'.$/;                      ('&nbsp;'x2).'<a target="preview" '.
                       'href="'.$res->src.'?symb='.
                            &Apache::lonnet::escape($res->{'symb'}).'">view</a>'.
                       '</td></tr>'.$/;
             } else {               } else { 
                 if (defined($target)) {                  if (defined($target)) {
                     return { title => $title,                      return { title => $title,
                              symb  => $symb,                               symb  => $symb,
                              src   => $src,                               src   => $src,
                                id    => $seq_id,
                              html  => $target, };                                html  => $target, }; 
                 }                  }
                 return undef;                  return undef;
Line 533  Returns: nothing Line 548  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 556  sub GetStudentAnswers { Line 572  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 577  sub GetStudentAnswers { Line 594  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 596  keys $partid.'.'.$respid.'.answer'. Line 661  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 608  sub analyze_problem_as_student { Line 674  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 678  sub get_answer { Line 732  sub get_answer {
     return $returnvalue;      return $returnvalue;
 }  }
   
   
 #####################################################  #####################################################
 #####################################################  #####################################################
   
Line 688  sub get_answer { Line 741  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 703  Only should be called by &ensure_proper_ Line 756  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 726  sub load_answer_cache { Line 779  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 765  sub get_from_answer_cache { Line 804  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 798  sub write_answer_cache { Line 837  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 808  sub ensure_proper_cache { Line 847  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 827  sub ensure_proper_cache { Line 866  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 1086  sub get_problem_data { Line 1117  sub get_problem_data {
                     $Partdata{$part}->{'_Options'}=$value;                      $Partdata{$part}->{'_Options'}=$value;
                 } elsif ($key eq 'concepts') {                  } elsif ($key eq 'concepts') {
                     $Partdata{$part}->{'_Concepts'}=$value;                      $Partdata{$part}->{'_Concepts'}=$value;
                   } elsif ($key eq 'items') {
                       $Partdata{$part}->{'_Items'}=$value;
                 } elsif ($key =~ /^concept\.(.*)$/) {                  } elsif ($key =~ /^concept\.(.*)$/) {
                     my $concept = $1;                      my $concept = $1;
                     foreach my $foil (@$value) {                      foreach my $foil (@$value) {
                         $Partdata{$part}->{'_Foils'}->{$foil}->{'_Concept'}=                          $Partdata{$part}->{'_Foils'}->{$foil}->{'_Concept'}=
                                                                       $concept;                                                                        $concept;
                     }                      }
                 } elsif ($key =~ /^(incorrect|answer|ans_low|ans_high)$/) {                  } elsif ($key =~ /^(unit|incorrect|answer|ans_low|ans_high|str_type)$/) {
                     $Partdata{$part}->{$key}=$value;                      $Partdata{$part}->{$key}=$value;
                 }                  }
             } else {              } else {
Line 1104  sub get_problem_data { Line 1137  sub get_problem_data {
                 } elsif ($key =~ /^foil\.value\.(.*)$/) {                  } elsif ($key =~ /^foil\.value\.(.*)$/) {
                     my $foil = $1;                      my $foil = $1;
                     $Partdata{$part}->{'_Foils'}->{$foil}->{'value'}=$value;                      $Partdata{$part}->{'_Foils'}->{$foil}->{'value'}=$value;
                   } elsif ($key eq 'answercomputed') {
                       $Partdata{$part}->{'answercomputed'} = $value;
                 }                  }
             }              }
         }          }
     }      }
       # Further debugging code
       if (0) {
           &Apache::lonnet::logthis('lonstathelpers::get_problem_data');
           &log_hash_ref(\%Partdata);
       }
     return %Partdata;      return %Partdata;
 }  }
   
   sub log_array_ref {
       my ($arrayref,$prefix) = @_;
       return if (ref($arrayref) ne 'ARRAY');
       if (! defined($prefix)) { $prefix = ''; };
       foreach my $v (@$arrayref) {
           if (ref($v) eq 'ARRAY') {
               &log_array_ref($v,$prefix.'  ');
           } elsif (ref($v) eq 'HASH') {
               &log_hash_ref($v,$prefix.'  ');
           } else {
               &Apache::lonnet::logthis($prefix.'"'.$v.'"');
           }
       }
   }
   
   sub log_hash_ref {
       my ($hashref,$prefix) = @_;
       return if (ref($hashref) ne 'HASH');
       if (! defined($prefix)) { $prefix = ''; };
       while (my ($k,$v) = each(%$hashref)) {
           if (ref($v) eq 'ARRAY') {
               &Apache::lonnet::logthis($prefix.'"'.$k.'" = array');
               &log_array_ref($v,$prefix.'  ');
           } elsif (ref($v) eq 'HASH') {
               &Apache::lonnet::logthis($prefix.'"'.$k.'" = hash');
               &log_hash_ref($v,$prefix.'  ');
           } else {
               &Apache::lonnet::logthis($prefix.'"'.$k.'" => "'.$v.'"');
           }
       }
   }
 ####################################################  ####################################################
 ####################################################  ####################################################
   
Line 1260  sub manage_caches { Line 1331  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,          &gather_full_student_data($r,$formname,$inputname);
                                                          $inputname);  
               
     }      }
     #      #
     my @Buttons =       my @Buttons = 
Line 1284  sub manage_caches { Line 1353  sub manage_caches {
     return @Buttons;      return @Buttons;
 }  }
   
   sub gather_full_student_data {
       &Apache::lonnet::logthis('called 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;
   }
   
   
 ####################################################  ####################################################

Removed from v.1.24  
changed lines
  Added in v.1.36


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