loncom/interface/statistics/lonstathelpers.pm - diff

Return to lonstathelpers.pm CVS log

Up to [LON-CAPA] / loncom / interface / statistics

Diff for /loncom/interface/statistics/lonstathelpers.pm between versions 1.5 and 1.18

-version 1.5, 2004/03/03 22:57:31
+version 1.18, 2004/08/03 19:53:12
  Line 59  use Apache::lonlocal;
  use HTML::Entities();
  use Time::Local();
  use Spreadsheet::WriteExcel();
+ use GDBM_File;
+ use Storable qw(freeze thaw);
  ####################################################
  ####################################################
- Line 107  all option response and radiobutton prob
+ Line 109  all option response and radiobutton prob
  Returns: A string containing html for a table which lists the sequences
  and their contents.  A radiobutton is provided for each problem.
+ Skips 'survey' problems.
  =cut
- Line 116  sub ProblemSelector {
+ Line 119  sub ProblemSelector {
      my ($AcceptedResponseTypes) = @_;
      my $Str;
      $Str = "\n<table>\n";
-     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
+     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess('all')) {
          next if ($seq->{'num_assess'}<1);
          my $seq_str = '';
          foreach my $res (@{$seq->{'contents'}}) {
              next if ($res->{'type'} ne 'assessment');
              foreach my $part (@{$res->{'parts'}}) {
                  my $partdata = $res->{'partdata'}->{$part};
+                 next if ($partdata->{'Survey'});
                  for (my $i=0;$i<scalar(@{$partdata->{'ResponseTypes'}});$i++){
                      my $respid = $partdata->{'ResponseIds'}->[$i];
                      my $resptype = $partdata->{'ResponseTypes'}->[$i];
- Line 222  sub get_target_from_id {
+ Line 226  sub get_target_from_id {
  =pod
- =item &get_prev_curr_next($target)
+ =item &get_prev_curr_next($target,$AcceptableResponseTypes,$granularity)
  Determine the problem parts or responses preceeding and following the
  current resource.
- Line 230  current resource.
+ Line 234  current resource.
  Inputs: $target (see &Apache::lonstathelpers::get_target_from_id())
    $AcceptableResponseTypes, regular expression matching acceptable
                              response types,
-   $granularity, either 'part' or 'response'
+   $granularity, either 'part', 'response', or 'part_survey'
  Returns: three hash references, $prev, $curr, $next, which refer to the
  preceeding, current, or following problem parts or responses, depending
- Line 253  sub get_prev_curr_next {
+ Line 257  sub get_prev_curr_next {
      #
      # Build an array with the data we need to search through
      my @Resource;
-     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
+     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess('all')) {
          foreach my $res (@{$seq->{'contents'}}) {
              next if ($res->{'type'} ne 'assessment');
              foreach my $part (@{$res->{'parts'}}) {
                  my $partdata = $res->{'partdata'}->{$part};
-                 if ($granularity eq 'part') {
+                 if ($partdata->{'Survey'}) {
+                     if ($granularity eq 'part_survey'){
+                         push (@Resource,
+                               { symb     => $res->{symb},
+                                 part     => $part,
+                                 resource => $res,
+                             } );
+                     }
+                 } elsif ($granularity eq 'part') {
                      push (@Resource,
                            { symb     => $res->{symb},
                              part     => $part,
- Line 288  sub get_prev_curr_next {
+ Line 300  sub get_prev_curr_next {
      my $curr_idx;
      for ($curr_idx=0;$curr_idx<$#Resource;$curr_idx++) {
          my $curr_item = $Resource[$curr_idx];
-         if ($granularity eq 'part') {
+         if ($granularity eq 'part' || $granularity eq 'part_survey') {
              if ($curr_item->{'symb'} eq $target->{'symb'} &&
                  $curr_item->{'part'} eq $target->{'part'}) {
                  last;
- Line 303  sub get_prev_curr_next {
+ Line 315  sub get_prev_curr_next {
          }
      }
      my $curr_item = $Resource[$curr_idx];
-     if ($granularity eq 'part') {
+     if ($granularity eq 'part' || $granularity eq 'part_survey') {
          if ($curr_item->{'symb'}     ne $target->{'symb'} ||
              $curr_item->{'part'}     ne $target->{'part'}) {
              # bogus symb - return nothing
- Line 343  sub get_prev_curr_next {
+ Line 355  sub get_prev_curr_next {
  =pod
+ =item GetStudentAnswers($r,$problem,$Students)
+ Determines the correct answer for a set of students on a given problem.
+ The students answers are stored in the student hashes pointed to by the
+ array @$Students under the key 'answer'.
+ Inputs: $r
+ $problem: hash reference containing the keys 'resource', 'part', and 'respid'.
+ $Students: reference to array containing student hashes (need 'username',
+     'domain').
+ Returns: nothing
+ =cut
+ #####################################################
+ #####################################################
+ sub GetStudentAnswers {
+     my ($r,$problem,$Students,$formname,$inputname) = @_;
+     my $status_type;
+     if (defined($formname)) {
+         $status_type = 'inline';
+     } else {
+         $status_type = 'popup';
+     }
+     my $c = $r->connection();
+     my %Answers;
+     my ($resource,$partid,$respid) = ($problem->{'resource'},
+                                       $problem->{'part'},
+                                       $problem->{'respid'});
+     # Read in the cache (if it exists) before we start timing things.
+     &Apache::lonstathelpers::ensure_proper_cache($resource->{'symb'});
+     # Open progress window
+     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin
+         ($r,'Student Answer Compilation Status',
+          'Student Answer Compilation Progress', scalar(@$Students),
+          $status_type,undef,$formname,$inputname);
+     $r->rflush();
+     foreach my $student (@$Students) {
+         last if ($c->aborted());
+         my $sname = $student->{'username'};
+         my $sdom = $student->{'domain'};
+         my $answer = &Apache::lonstathelpers::analyze_problem_as_student
+             ($resource,$sname,$sdom,$partid,$respid);
+         &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
+                                                  &mt('last student'));
+         $student->{'answer'} = $answer;
+     }
+     &Apache::lonstathelpers::write_answer_cache();
+     return if ($c->aborted());
+     $r->rflush();
+     # close progress window
+     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
+     return;
+ }
+ #####################################################
+ #####################################################
+ =pod
  =item analyze_problem_as_student
  Analyzes a homework problem for a student and returns the correct answer
- Line 354  Inputs: $resource: a resource object
+ Line 427  Inputs: $resource: a resource object
  Returns: $answer
+ If $partid and $respid are specified, $answer is simply a scalar containing
+ the correct answer for the response.
+ If $partid or $respid are undefined, $answer will be a hash reference with
+ keys $partid.'.'.$respid.'.answer'.
  =cut
  #####################################################
- Line 363  sub analyze_problem_as_student {
+ Line 442  sub analyze_problem_as_student {
      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,
- Line 371  sub analyze_problem_as_student {
+ Line 454  sub analyze_problem_as_student {
                                          'grade_courseid' => $courseid));
      (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
      my %Answer=&Apache::lonnet::str2hash($Answ);
-     my $prefix = $partid.'.'.$respid;
+     #
-     my $key = $prefix.'.answer';
+     undef($answer);
+     foreach my $partid (@{$resource->{'parts'}}) {
+         my $partdata = $resource->{'partdata'}->{$partid};
+         foreach my $respid (@{$partdata->{'ResponseIds'}}) {
+             my $prefix = $partid.'.'.$respid;
+             my $key = $prefix.'.answer';
+             $answer->{$partid}->{$respid} = &get_answer($prefix,$key,%Answer);
+         }
+     }
+     &store_answer($sname,$sdom,$symb,undef,undef,$answer);
+     if (! defined($partid)) {
+         $returnvalue = $answer;
+     } elsif (! defined($respid)) {
+         $returnvalue = $answer->{$partid};
+     } else {
+         $returnvalue = $answer->{$partid}->{$respid};
+     }
+     return $returnvalue;
+ }
+ sub get_answer {
+     my ($prefix,$key,%Answer) = @_;
+     my $returnvalue;
      if (exists($Answer{$key})) {
          my $student_answer = $Answer{$key}->[0];
          if (! defined($student_answer)) {
- Line 390  sub analyze_problem_as_student {
+ Line 495  sub analyze_problem_as_student {
              }
              foreach my $foil (@{$Answer{$prefix.'.shown'}}) {
                  if (ref($values{$foil}) eq 'ARRAY') {
-                     $returnvalue.=&HTML::Entities::encode($foil).'='.
+                     $returnvalue.=&HTML::Entities::encode($foil,'<>&"').'='.
-                         join(',',map {&HTML::Entities::encode($_)} @{$values{$foil}}).'&';
+                         join(',',map {&HTML::Entities::encode($_,'<>&"')} @{$values{$foil}}).'&';
                  } else {
-                     $returnvalue.=&HTML::Entities::encode($foil).'='.
+                     $returnvalue.=&HTML::Entities::encode($foil,'<>&"').'='.
-                         &HTML::Entities::encode($values{$foil}).'&';
+                         &HTML::Entities::encode($values{$foil},'<>&"').'&';
                  }
              }
              $returnvalue =~ s/ /\%20/g;
- Line 405  sub analyze_problem_as_student {
+ Line 510  sub analyze_problem_as_student {
  }
+ #####################################################
+ #####################################################
+ =pod
+ =item Caching routines
+ =over 4
+ =item &load_answer_cache($symb)
+ Loads the cache for the given symb into memory from disk.
+ Requires the cache filename be set.
+ Only should be called by &ensure_proper_cache.
+ =cut
+ #####################################################
+ #####################################################
+ {
+     my $cache_filename = undef;
+     my $current_symb = undef;
+     my %cache;
+ sub load_answer_cache {
+     my ($symb) = @_;
+     return if (! defined($cache_filename));
+     if (! defined($current_symb) || $current_symb ne $symb) {
+         undef(%cache);
+         my $storedstring;
+         my %cache_db;
+         if (tie(%cache_db,'GDBM_File',$cache_filename,&GDBM_READER(),0640)) {
+             $storedstring = $cache_db{&Apache::lonnet::escape($symb)};
+             untie(%cache_db);
+         }
+         if (defined($storedstring)) {
+             %cache = %{thaw($storedstring)};
+         }
+     }
+     return;
+ }
+ #####################################################
+ #####################################################
+ =pod
+ =item &get_from_answer_cache($sname,$sdom,$symb,$partid,$respid)
+ 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
+ #####################################################
+ #####################################################
+ sub get_from_answer_cache {
+     my ($sname,$sdom,$symb,$partid,$respid) = @_;
+     &ensure_proper_cache($symb);
+     my $returnvalue;
+     if (exists($cache{$sname.':'.$sdom}) &&
+         ref($cache{$sname.':'.$sdom}) eq 'HASH') {
+         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 {
+         $returnvalue = undef;
+     }
+     return $returnvalue;
+ }
+ #####################################################
+ #####################################################
+ =pod
+ =item &write_answer_cache($symb)
+ Writes the in memory cache to disk so that it can be read in with
+ &load_answer_cache($symb).
+ =cut
+ #####################################################
+ #####################################################
+ sub write_answer_cache {
+     return if (! defined($current_symb) || ! defined($cache_filename));
+     my %cache_db;
+     my $key = &Apache::lonnet::escape($current_symb);
+     if (tie(%cache_db,'GDBM_File',$cache_filename,&GDBM_WRCREAT(),0640)) {
+         my $storestring = freeze(\%cache);
+         $cache_db{$key}=$storestring;
+         $cache_db{$key.'.time'}=time;
+         untie(%cache_db);
+     }
+     undef(%cache);
+     undef($current_symb);
+     undef($cache_filename);
+     return;
+ }
+ #####################################################
+ #####################################################
+ =pod
+ =item &ensure_proper_cache($symb)
+ Called to make sure we have the proper cache set up.  This is called
+ prior to every answer lookup.
+ =cut
+ #####################################################
+ #####################################################
+ sub ensure_proper_cache {
+     my ($symb) = @_;
+     my $cid = $ENV{'request.course.id'};
+     my $new_filename =  '/home/httpd/perl/tmp/'.
+         'problemanalysis_'.$cid.'_answer_cache.db';
+     if (! defined($cache_filename) ||
+         $cache_filename ne $new_filename ||
+         ! defined($current_symb)   ||
+         $current_symb ne $symb) {
+         $cache_filename = $new_filename;
+         # 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
+         # symb cache.
+         &load_answer_cache($symb);
+         $current_symb = $symb;
+     }
+ }
+ #####################################################
+ #####################################################
+ =pod
+ =item &store_answer($sname,$sdom,$symb,$partid,$respid,$dataset)
+ Stores the answer data in the in memory cache.
+ =cut
+ #####################################################
+ #####################################################
+ sub store_answer {
+     my ($sname,$sdom,$symb,$partid,$respid,$dataset) = @_;
+     return if ($symb ne $current_symb);
+     if (defined($partid)) {
+         if (defined($respid)) {
+             $cache{$sname.':'.$sdom}->{$partid}->{$respid} = $dataset;
+         } else {
+             $cache{$sname.':'.$sdom}->{$partid} = $dataset;
+         }
+     } else {
+         $cache{$sname.':'.$sdom}=$dataset;
+     }
+     return;
+ }
+ }
+ #####################################################
+ #####################################################
+ =pod
+ =back
+ =cut
+ #####################################################
+ #####################################################
  ##
  ## The following is copied from datecalc1.pl, part of the
  ## Spreadsheet::WriteExcel CPAN module.
- Line 612  sub get_problem_data {
+ Line 901  sub get_problem_data {
          while (my($key,$value) = each(%Answer)) {
              #
              # Logging code:
-             if (1) {
+             if (0) {
                  &Apache::lonnet::logthis($part.' got key "'.$key.'"');
                  if (ref($value) eq 'ARRAY') {
                      &Apache::lonnet::logthis('    @'.join(',',@$value));
- Line 729  sub get_time_limits {
+ Line 1018  sub get_time_limits {
      return ($starttime,$endtime);
  }
+ ####################################################
+ ####################################################
+ =pod
+ =item sections_description
+ Inputs: @Sections, an array of sections
+ Returns: A text description of the sections selected.
+ =cut
+ ####################################################
+ ####################################################
+ sub sections_description {
+     my @Sections = @_;
+     my $sectionstring = '';
+     if (scalar(@Sections) > 1) {
+         if (scalar(@Sections) > 2) {
+             my $last = pop(@Sections);
+             $sectionstring = "Sections ".join(', ',@Sections).', and '.$last;
+         } else {
+             $sectionstring = "Sections ".join(' and ',@Sections);
+         }
+     } else {
+         if ($Sections[0] eq 'all') {
+             $sectionstring = "All sections";
+         } else {
+             $sectionstring = "Section ".$Sections[0];
+         }
+     }
+     return $sectionstring;
+ }
+ ####################################################
+ ####################################################
+ =pod
+ =item &manage_caches
+ Inputs: $r, apache request object
+ Returns: An array of scalars containing html for buttons.
+ =cut
+ ####################################################
+ ####################################################
+ sub manage_caches {
+     my ($r,$formname,$inputname) = @_;
+     &Apache::loncoursedata::clear_internal_caches();
+     my $sectionkey =
+         join(',',
+              map {
+                      &Apache::lonnet::escape($_);
+                  } sort(@Apache::lonstatistics::SelectedSections)
+              );
+     my $statuskey = $Apache::lonstatistics::enrollment_status;
+     if (exists($ENV{'form.ClearCache'}) ||
+         exists($ENV{'form.updatecaches'}) ||
+         (exists($ENV{'form.firstrun'}) && $ENV{'form.firstrun'} ne 'no') ||
+         (exists($ENV{'form.prevsection'}) &&
+             $ENV{'form.prevsection'} ne $sectionkey) ||
+         (exists($ENV{'form.prevenrollstatus'}) &&
+             $ENV{'form.prevenrollstatus'} ne $statuskey)
+         ) {
+         &Apache::lonstatistics::Gather_Full_Student_Data($r,$formname,
+                                                          $inputname);
+     }
+     #
+     my @Buttons =
+         ('<input type="submit" name="ClearCache" '.
+              'value="'.&mt('Clear Caches').'" />',
+          '<input type="submit" name="updatecaches" '.
+              'value="'.&mt('Update Caches').'" />'.
+          &Apache::loncommon::help_open_topic('Statistics_Cache'),
+          '<input type="hidden" name="prevsection" value="'.$sectionkey.'" />',
+          '<input type="hidden" name="prevenrollstatus" value="'.$statuskey.'" />'
+          );
+     #
+     if (! exists($ENV{'form.firstrun'})) {
+         $r->print('<input type="hidden" name="firstrun" value="yes" />');
+     } else {
+         $r->print('<input type="hidden" name="firstrun" value="no" />');
+     }
+     #
+     return @Buttons;
+ }
  ####################################################
  ####################################################

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

Removed from v.1.5
changed lines
	Added in v.1.18