--- loncom/interface/statistics/lonstathelpers.pm 2004/03/08 19:12:18 1.6
+++ loncom/interface/statistics/lonstathelpers.pm 2004/12/02 21:53:33 1.32
@@ -1,6 +1,6 @@
# The LearningOnline Network with CAPA
#
-# $Id: lonstathelpers.pm,v 1.6 2004/03/08 19:12:18 matthew Exp $
+# $Id: lonstathelpers.pm,v 1.32 2004/12/02 21:53:33 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -40,7 +40,6 @@ routines that are needed across multiple
=head1 OVERVIEW
-
=over 4
=cut
@@ -59,6 +58,8 @@ use Apache::lonlocal;
use HTML::Entities();
use Time::Local();
use Spreadsheet::WriteExcel();
+use GDBM_File;
+use Storable qw(freeze thaw);
####################################################
####################################################
@@ -107,6 +108,7 @@ 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
@@ -116,7 +118,8 @@ sub ProblemSelector {
my ($AcceptedResponseTypes) = @_;
my $Str;
$Str = "\n
\n";
- foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
+ my $rb_count =0;
+ foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess('all')) {
next if ($seq->{'num_assess'}<1);
my $seq_str = '';
foreach my $res (@{$seq->{'contents'}}) {
@@ -139,16 +142,17 @@ sub ProblemSelector {
if (! defined($title) || $title eq '') {
($title) = ($res->{'src'} =~ m:/([^/]*)$:);
}
- $seq_str .= ''.
- ' '.
- ' '.
- $resptype.' '.
- ''.$title.' ';
-# ''.$resptype.' '.$res->{'title'}.' ';
+ $seq_str .= ' '.
+ qq{ }.
+ ''.$resptype.' '.
+ ''.$title.' ';
if (scalar(@{$partdata->{'ResponseIds'}}) > 1) {
$seq_str .= &mt('response').' '.$respid;
}
+ $seq_str .= (' 'x2).
+ qq{view };
$seq_str .= " \n";
+ $rb_count++;
}
}
}
@@ -167,6 +171,177 @@ sub ProblemSelector {
=pod
+=item &MultipleProblemSelector($navmap,$selected,$inputname)
+
+Generate HTML with checkboxes for problem selection.
+
+Input:
+
+$navmap: a navmap object. If undef, navmaps will be called to create a
+new object.
+
+$selected: Scalar, Array, or hash reference of currently selected items.
+
+$inputname: The name of the form elements to use for the checkboxs.
+
+Returns: A string containing html for a table which lists the sequences
+and their contents. A checkbox is provided for each problem.
+
+=cut
+
+####################################################
+####################################################
+sub MultipleProblemSelector {
+ my ($navmap,$inputname,$formname)=@_;
+ my $cid = $ENV{'request.course.id'};
+ my $Str;
+ # Massage the input as needed.
+ if (! defined($navmap)) {
+ $navmap = Apache::lonnavmaps::navmap->new();
+ if (! defined($navmap)) {
+ $Str .=
+ ''.&mt('Error: cannot process course structure').' ';
+ return $Str;
+ }
+ }
+ my $selected = {map { ($_,1) } (&get_selected_symbs($inputname))};
+ # Header
+ $Str .= <<"END";
+
+END
+ $Str .=
+ ''.&mt('Select All').' '.
+ (' 'x4).
+ ''.&mt('Unselect All').' ';
+ $Str .= $/.''.$/;
+ my $iterator = $navmap->getIterator(undef, undef, undef, 1);
+ my $sequence_string;
+ my $seq_id = 0;
+ my @Accumulator = (&new_accumulator($ENV{'course.'.$cid.'.description'},
+ '',
+ '',
+ $seq_id++,
+ $inputname));
+ my @Sequence_Data;
+ while (my $curRes = $iterator->next()) {
+ if ($curRes == $iterator->END_MAP) {
+ if (ref($Accumulator[-1]) eq 'CODE') {
+ my $old_accumulator = pop(@Accumulator);
+ push(@Sequence_Data,&{$old_accumulator}());
+ }
+ } elsif ($curRes == $iterator->BEGIN_MAP) {
+ # Not much to do here.
+ }
+ next if (! ref($curRes));
+ if ($curRes->is_map) {
+ push(@Accumulator,&new_accumulator($curRes->compTitle,
+ $curRes->src,
+ $curRes->symb,
+ $seq_id++,
+ $inputname));
+ } elsif ($curRes->is_problem) {
+ if (@Accumulator && $Accumulator[-1] ne '') {
+ &{$Accumulator[-1]}($curRes,
+ exists($selected->{$curRes->symb}));
+ }
+ }
+ }
+ my $course_seq = pop(@Sequence_Data);
+ foreach my $seq ($course_seq,@Sequence_Data) {
+ #my $seq = pop(@Sequence_Data);
+ next if (! defined($seq) || ref($seq) ne 'HASH');
+ $Str.= ''.
+ ''.$seq->{'title'}.' '.(' 'x2).
+ ''.
+ &mt('Select').' '.(' 'x2).
+ ''.
+ &mt('Unselect').' '.(' 'x2).
+ ' '.$/;
+ $Str.= $seq->{'html'};
+ }
+ $Str .= '
'.$/;
+ return $Str;
+}
+
+sub get_title {
+ my ($title,$src) = @_;
+ if ($title eq '') {
+ ($title) = ($src =~ m|/([^/]+)$|);
+ } else {
+ $title =~ s/\:/:/g;
+ }
+ return $title;
+}
+
+sub new_accumulator {
+ my ($title,$src,$symb,$seq_id,$inputname) = @_;
+ my $target;
+ my $item_id=0;
+ return
+ sub {
+ if (@_) {
+ my ($res,$checked) = @_;
+ $target.=''.
+ ' symb).'" />'.
+ ' '.$res->compTitle.' '.
+ (' 'x2).'src.'">view '.
+ ' '.$/;
+ } else {
+ if (defined($target)) {
+ return { title => $title,
+ symb => $symb,
+ src => $src,
+ id => $seq_id,
+ html => $target, };
+ }
+ return undef;
+ }
+ };
+}
+
+sub get_selected_symbs {
+ my ($inputfield) = @_;
+ my $field = 'form.'.$inputfield;
+ my @Symbs;
+ if (exists($ENV{$field})) {
+ if (! ref($ENV{$field})) {
+ @Symbs = (&Apache::lonnet::unescape($ENV{$field}));
+ } else {
+ @Symbs = (map {&Apache::lonnet::unescape($_);} @{$ENV{$field}});
+ }
+ }
+ return @Symbs;
+}
+
+####################################################
+####################################################
+
+=pod
+
=item &make_target_id($target)
Inputs: Hash ref with the following entries:
@@ -210,11 +385,23 @@ Returns: A hash reference, $target, cont
####################################################
sub get_target_from_id {
my ($id) = @_;
- my ($symb,$part,$respid,$resptype) = split(':',$id);
- return ({ symb =>&Apache::lonnet::unescape($symb),
- part =>&Apache::lonnet::unescape($part),
- respid =>&Apache::lonnet::unescape($respid),
- resptype =>&Apache::lonnet::unescape($resptype)});
+ if (! ref($id)) {
+ my ($symb,$part,$respid,$resptype) = split(':',$id);
+ return ({ symb => &Apache::lonnet::unescape($symb),
+ part => &Apache::lonnet::unescape($part),
+ respid => &Apache::lonnet::unescape($respid),
+ resptype => &Apache::lonnet::unescape($resptype)});
+ } elsif (ref($id) eq 'ARRAY') {
+ my @Return;
+ foreach my $selected (@$id) {
+ my ($symb,$part,$respid,$resptype) = split(':',$selected);
+ push(@Return,{ symb => &Apache::lonnet::unescape($symb),
+ part => &Apache::lonnet::unescape($part),
+ respid => &Apache::lonnet::unescape($respid),
+ resptype => &Apache::lonnet::unescape($resptype)});
+ }
+ return \@Return;
+ }
}
####################################################
@@ -222,7 +409,7 @@ 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.
@@ -230,7 +417,7 @@ 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
@@ -253,12 +440,18 @@ 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'} && ($granularity eq 'part_survey')){
+ push (@Resource,
+ { symb => $res->{symb},
+ part => $part,
+ resource => $res,
+ } );
+ } elsif ($granularity eq 'part') {
push (@Resource,
{ symb => $res->{symb},
part => $part,
@@ -288,7 +481,7 @@ 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;
@@ -303,7 +496,7 @@ 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
@@ -343,15 +536,126 @@ 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 %answers;
+ 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::get_student_answer
+ ($resource,$sname,$sdom,$partid,$respid);
+ &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
+ &mt('last student'));
+ $answers{$answer}++;
+ $student->{'answer'} = $answer;
+ }
+ &Apache::lonstathelpers::write_analysis_cache();
+ return if ($c->aborted());
+ $r->rflush();
+ # close progress window
+ &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
+ return \%answers;
+}
+
+#####################################################
+#####################################################
+
+=pod
+
=item analyze_problem_as_student
-Analyzes a homework problem for a student and returns the correct answer
-for the student. Attempts to put together an answer for problem types
-that do not natively support it.
+Analyzes a homework problem for a student
Inputs: $resource: a resource object
$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
If $partid and $respid are specified, $answer is simply a scalar containing
@@ -364,41 +668,39 @@ keys $partid.'.'.$respid.'.answer'.
#####################################################
#####################################################
-sub analyze_problem_as_student {
+sub get_student_answer {
my ($resource,$sname,$sdom,$partid,$respid) = @_;
- my $returnvalue;
- my $url = $resource->{'src'};
- my $symb = $resource->{'symb'};
- 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);
#
- 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);
- }
+ 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)];
}
- } elsif (! defined($respid)) {
+ }
+ #
+ my $analysis =
+ &analyze_problem_as_student($resource,$sname,$sdom);
+ my $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,%$analysis);
}
+ }
+ my $returnvalue;
+ 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;
}
@@ -423,11 +725,11 @@ sub get_answer {
}
foreach my $foil (@{$Answer{$prefix.'.shown'}}) {
if (ref($values{$foil}) eq 'ARRAY') {
- $returnvalue.=&HTML::Entities::encode($foil).'='.
- join(',',map {&HTML::Entities::encode($_)} @{$values{$foil}}).'&';
+ $returnvalue.=&HTML::Entities::encode($foil,'<>&"').'='.
+ join(',',map {&HTML::Entities::encode($_,'<>&"')} @{$values{$foil}}).'&';
} else {
- $returnvalue.=&HTML::Entities::encode($foil).'='.
- &HTML::Entities::encode($values{$foil}).'&';
+ $returnvalue.=&HTML::Entities::encode($foil,'<>&"').'='.
+ &HTML::Entities::encode($values{$foil},'<>&"').'&';
}
}
$returnvalue =~ s/ /\%20/g;
@@ -437,6 +739,168 @@ sub get_answer {
return $returnvalue;
}
+#####################################################
+#####################################################
+
+=pod
+
+=item Caching routines
+
+=over 4
+
+=item &load_analysis_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_analysis_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_analysis_cache($sname,$sdom,$symb,$partid,$respid)
+
+Returns the appropriate data from the cache, or undef if no data exists.
+
+=cut
+
+#####################################################
+#####################################################
+sub get_from_analysis_cache {
+ my ($sname,$sdom,$symb) = @_;
+ &ensure_proper_cache($symb);
+ my $returnvalue;
+ if (exists($cache{$sname.':'.$sdom})) {
+ $returnvalue = $cache{$sname.':'.$sdom};
+ } else {
+ $returnvalue = undef;
+ }
+ return $returnvalue;
+}
+
+#####################################################
+#####################################################
+
+=pod
+
+=item &write_analysis_cache($symb)
+
+Writes the in memory cache to disk so that it can be read in with
+&load_analysis_cache($symb).
+
+=cut
+
+#####################################################
+#####################################################
+sub write_analysis_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 analysis lookup.
+
+=cut
+
+#####################################################
+#####################################################
+sub ensure_proper_cache {
+ my ($symb) = @_;
+ my $cid = $ENV{'request.course.id'};
+ my $new_filename = '/home/httpd/perl/tmp/'.
+ 'problemanalysis_'.$cid.'_analysis_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_analysis_cache to load in a new
+ # symb cache.
+ &load_analysis_cache($symb);
+ $current_symb = $symb;
+ }
+}
+
+#####################################################
+#####################################################
+
+=pod
+
+=item &store_analysis($sname,$sdom,$symb,$partid,$respid,$dataset)
+
+Stores the analysis data in the in memory cache.
+
+=cut
+
+#####################################################
+#####################################################
+sub store_analysis {
+ my ($sname,$sdom,$symb,$dataset) = @_;
+ return if ($symb ne $current_symb);
+ $cache{$sname.':'.$sdom}=$dataset;
+ return;
+}
+
+}
+#####################################################
+#####################################################
+
+=pod
+
+=back
+
+=cut
+
+#####################################################
+#####################################################
+
##
## The following is copied from datecalc1.pl, part of the
## Spreadsheet::WriteExcel CPAN module.
@@ -644,7 +1108,7 @@ 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));
@@ -660,13 +1124,15 @@ sub get_problem_data {
$Partdata{$part}->{'_Options'}=$value;
} elsif ($key eq 'concepts') {
$Partdata{$part}->{'_Concepts'}=$value;
+ } elsif ($key eq 'items') {
+ $Partdata{$part}->{'_Items'}=$value;
} elsif ($key =~ /^concept\.(.*)$/) {
my $concept = $1;
foreach my $foil (@$value) {
$Partdata{$part}->{'_Foils'}->{$foil}->{'_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;
}
} else {
@@ -678,13 +1144,51 @@ sub get_problem_data {
} elsif ($key =~ /^foil\.value\.(.*)$/) {
my $foil = $1;
$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;
}
+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.'"');
+ }
+ }
+}
####################################################
####################################################
@@ -761,6 +1265,106 @@ 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,$update_message) = @_;
+ &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)
+ ) {
+ if (defined($update_message)) {
+ $r->print($update_message);
+ }
+ &Apache::lonstatistics::Gather_Full_Student_Data($r,$formname,
+ $inputname);
+
+ }
+ #
+ my @Buttons =
+ (' ',
+ ' '.
+ &Apache::loncommon::help_open_topic('Statistics_Cache'),
+ ' ',
+ ' '
+ );
+ #
+ if (! exists($ENV{'form.firstrun'})) {
+ $r->print(' ');
+ } else {
+ $r->print(' ');
+ }
+ #
+ return @Buttons;
+}
+
+
+
+
####################################################
####################################################