[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.7 and 1.8

version 1.7, 2004/03/12 21:05:08 version 1.8, 2004/03/16 16:30:31
Line 59  use Apache::lonlocal; Line 59  use Apache::lonlocal;
 use HTML::Entities();  use HTML::Entities();
 use Time::Local();  use Time::Local();
 use Spreadsheet::WriteExcel();  use Spreadsheet::WriteExcel();
   use GDBM_File;
   use Storable qw(freeze thaw);
   
 ####################################################  ####################################################
 ####################################################  ####################################################
Line 369  sub analyze_problem_as_student { Line 371  sub analyze_problem_as_student {
     my $returnvalue;      my $returnvalue;
     my $url = $resource->{'src'};      my $url = $resource->{'src'};
     my $symb = $resource->{'symb'};      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 $courseid = $ENV{'request.course.id'};
     my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze',      my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze',
                                         'grade_domain' => $sdom,                                          'grade_domain' => $sdom,
Line 378  sub analyze_problem_as_student { Line 384  sub analyze_problem_as_student {
     (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);      (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
     my %Answer=&Apache::lonnet::str2hash($Answ);      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};          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';
             $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 {      } else {
         my $prefix = $partid.'.'.$respid;          $returnvalue = $answer->{$partid}->{$respid};
         my $key = $prefix.'.answer';  
         $returnvalue = &get_answer($prefix,$key,%Answer);  
     }      }
     return $returnvalue;      return $returnvalue;
 }  }
Line 437  sub get_answer { Line 438  sub get_answer {
     return $returnvalue;      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   ## The following is copied from datecalc1.pl, part of the 
 ## Spreadsheet::WriteExcel CPAN module.  ## Spreadsheet::WriteExcel CPAN module.
Removed from v.1.7  
changed lines
  Added in v.1.8

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