[LON-CAPA-cvs] cvs: loncom /interface/statistics lonproblemanalysis.pm lonstathelpers.pm lonstudentsubmissions.pm
matthew
lon-capa-cvs@mail.lon-capa.org
Tue, 16 Mar 2004 16:30:32 -0000
This is a MIME encoded message
--matthew1079454632
Content-Type: text/plain
matthew Tue Mar 16 11:30:32 2004 EDT
Modified files:
/loncom/interface/statistics lonstathelpers.pm
lonproblemanalysis.pm
lonstudentsubmissions.pm
Log:
lonstathelpers: added local caching of computed answers.
lonproblemanalysis and lonstudentsubmissions: modified to begin using the
caching of computed answers.
--matthew1079454632
Content-Type: text/plain
Content-Disposition: attachment; filename="matthew-20040316113032.txt"
Index: loncom/interface/statistics/lonstathelpers.pm
diff -u loncom/interface/statistics/lonstathelpers.pm:1.7 loncom/interface/statistics/lonstathelpers.pm:1.8
--- loncom/interface/statistics/lonstathelpers.pm:1.7 Fri Mar 12 16:05:08 2004
+++ loncom/interface/statistics/lonstathelpers.pm Tue Mar 16 11:30:31 2004
@@ -1,6 +1,6 @@
# The LearningOnline Network with CAPA
#
-# $Id: lonstathelpers.pm,v 1.7 2004/03/12 21:05:08 matthew Exp $
+# $Id: lonstathelpers.pm,v 1.8 2004/03/16 16:30:31 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -59,6 +59,8 @@
use HTML::Entities();
use Time::Local();
use Spreadsheet::WriteExcel();
+use GDBM_File;
+use Storable qw(freeze thaw);
####################################################
####################################################
@@ -369,6 +371,10 @@
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,
@@ -378,27 +384,22 @@
(my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
my %Answer=&Apache::lonnet::str2hash($Answ);
#
- if (! defined($partid)) {
- # If you do not specify a partid, you get them all.
- 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)) {
+ 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';
- $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;
- my $key = $prefix.'.answer';
- $returnvalue = &get_answer($prefix,$key,%Answer);
+ $returnvalue = $answer->{$partid}->{$respid};
}
return $returnvalue;
}
@@ -436,6 +437,191 @@
}
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
Index: loncom/interface/statistics/lonproblemanalysis.pm
diff -u loncom/interface/statistics/lonproblemanalysis.pm:1.79 loncom/interface/statistics/lonproblemanalysis.pm:1.80
--- loncom/interface/statistics/lonproblemanalysis.pm:1.79 Fri Mar 12 16:06:32 2004
+++ loncom/interface/statistics/lonproblemanalysis.pm Tue Mar 16 11:30:31 2004
@@ -1,6 +1,6 @@
# The LearningOnline Network with CAPA
#
-# $Id: lonproblemanalysis.pm,v 1.79 2004/03/12 21:06:32 matthew Exp $
+# $Id: lonproblemanalysis.pm,v 1.80 2004/03/16 16:30:31 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -160,13 +160,8 @@
$ProblemData,
\@Students);
} elsif ($current_problem->{'resptype'} eq 'numerical') {
-# if (exists($ENV{'form.ExcelOutput'})) {
-# &Apache::lonstudentsubmissions::prepare_excel_output
-# ($r,$current_problem,$ProblemData,\@Students);
-# } else {
&NumericalResponseAnalysis($r,$current_problem,
$ProblemData,\@Students);
-# }
} else {
$r->print('<h2>This analysis is not supported</h2>');
}
@@ -195,6 +190,7 @@
my $c = $r->connection();
my ($resource,$respid) = ($problem->{'resource'},
$problem->{'respid'});
+ $r->print('Response '.$respid.'</br />');
my $analysis_html;
my $PerformanceData =
&Apache::loncoursedata::get_response_data
@@ -319,11 +315,12 @@
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->print("<table>\n");
$r->rflush();
foreach my $student (@$Students) {
last if ($c->aborted());
@@ -335,8 +332,8 @@
&mt('last student'));
$student->{'answer'} = $answer;
}
+ &Apache::lonstathelpers::write_answer_cache();
return if ($c->aborted());
- $r->print("</table>\n");
$r->rflush();
# close progress window
&Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
Index: loncom/interface/statistics/lonstudentsubmissions.pm
diff -u loncom/interface/statistics/lonstudentsubmissions.pm:1.8 loncom/interface/statistics/lonstudentsubmissions.pm:1.9
--- loncom/interface/statistics/lonstudentsubmissions.pm:1.8 Fri Mar 12 16:13:11 2004
+++ loncom/interface/statistics/lonstudentsubmissions.pm Tue Mar 16 11:30:32 2004
@@ -1,6 +1,6 @@
# The LearningOnline Network with CAPA
#
-# $Id: lonstudentsubmissions.pm,v 1.8 2004/03/12 21:13:11 matthew Exp $
+# $Id: lonstudentsubmissions.pm,v 1.9 2004/03/16 16:30:32 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -295,11 +295,12 @@
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->print("<table>\n");
$r->rflush();
foreach my $student (@$Students) {
last if ($c->aborted());
@@ -311,14 +312,13 @@
&mt('last student'));
$student->{'answer'} = $answer;
}
+ &Apache::lonstathelpers::write_answer_cache();
return if ($c->aborted());
- $r->print("</table>\n");
$r->rflush();
# close progress window
&Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
return;
}
-
#########################################################
#########################################################
--matthew1079454632--