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.6 and 1.10

-version 1.6, 2004/03/08 19:12:18
+version 1.10, 2004/03/31 05:24:00
  Line 59  use Apache::lonlocal;
  use HTML::Entities();
  use Time::Local();
  use Spreadsheet::WriteExcel();
+ use GDBM_File;
+ use Storable qw(freeze thaw);
  ####################################################
  ####################################################
- Line 343  sub get_prev_curr_next {
+ Line 345  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) = @_;
+     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));
+     $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 369  sub analyze_problem_as_student {
+ Line 425  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 378  sub analyze_problem_as_student {
+ Line 438  sub analyze_problem_as_student {
      (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
      my %Answer=&Apache::lonnet::str2hash($Answ);
      #
-     if (! defined($partid)) {
+     undef($answer);
-         # If you do not specify a partid, you get them all.
+     foreach my $partid (@{$resource->{'parts'}}) {
-         foreach my $partid (@{$resource->{'parts'}}) {
-             my $partdata = $resource->{'partdata'}->{$partid};
-             foreach my $respid (@{$partdata->{'ResponseIds'}}) {
-                 my $prefix = $partid.'.'.$respid;
-                 my $key = $prefix.'.answer';
-                 $returnvalue->{$key} = &get_answer($prefix,$key,%Answer);
-             }
-         }
-     } elsif (! defined($respid)) {
          my $partdata = $resource->{'partdata'}->{$partid};
          foreach my $respid (@{$partdata->{'ResponseIds'}}) {
              my $prefix = $partid.'.'.$respid;
              my $key = $prefix.'.answer';
-             $returnvalue->{$key} = &get_answer($prefix,$key,%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 {
-         my $prefix = $partid.'.'.$respid;
+         $returnvalue = $answer->{$partid}->{$respid};
-         my $key = $prefix.'.answer';
-         $returnvalue = &get_answer($prefix,$key,%Answer);
      }
      return $returnvalue;
  }
- Line 423  sub get_answer {
+ Line 478  sub get_answer {
              }
              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 437  sub get_answer {
+ Line 492  sub get_answer {
      return $returnvalue;
  }
+ #####################################################
+ #####################################################
+ =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/'.
+         'problemanalsysis_'.$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 644  sub get_problem_data {
+ Line 884  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));

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

Removed from v.1.6
changed lines
	Added in v.1.10