--- loncom/interface/statistics/lonstathelpers.pm 2004/06/15 14:22:45 1.13
+++ loncom/interface/statistics/lonstathelpers.pm 2004/09/16 21:54:22 1.23
@@ -1,6 +1,6 @@
# The LearningOnline Network with CAPA
#
-# $Id: lonstathelpers.pm,v 1.13 2004/06/15 14:22:45 matthew Exp $
+# $Id: lonstathelpers.pm,v 1.23 2004/09/16 21:54:22 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -40,7 +40,6 @@ routines that are needed across multiple
=head1 OVERVIEW
-
=over 4
=cut
@@ -109,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
@@ -169,6 +169,158 @@ sub ProblemSelector {
=pod
+=item &MultpleProblemSelector($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 @Accumulator = (&new_accumulator($ENV{'course.'.$cid.'.description'},
+ '',
+ '',
+ $inputname));
+ my @Sequence_Data;
+ while (my $curRes = $iterator->next()) {
+ if ($curRes == $iterator->END_MAP) {
+ if (ref($Accumulator[-1]) eq 'CODE') {
+ push(@Sequence_Data,&{$Accumulator[-1]}());
+ pop(@Accumulator);
+ }
+ } elsif ($curRes == $iterator->BEGIN_MAP) {
+ # Not much to do here.
+ }
+ next if (! ref($curRes));
+ if ($curRes->is_map) {
+ push(@Accumulator,&new_accumulator($curRes->title,
+ $curRes->src,
+ $curRes->symb,
+ $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.= ''.
+ ''.&get_title($seq->{'title'},$seq->{'src'}).' '.
+ ' '.$/;
+ $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,$inputname) = @_;
+ my $target;
+ return
+ sub {
+ if (@_) {
+ my ($res,$checked) = @_;
+ $target.=''.
+ ' symb).'" />'.
+ ' '.
+ &get_title($res->title,$res->symb).' '.
+ ' '.$/;
+ } else {
+ if (defined($target)) {
+ return { title => $title,
+ symb => $symb,
+ src => $src,
+ 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:
@@ -212,11 +364,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;
+ }
}
####################################################
@@ -260,7 +424,7 @@ sub get_prev_curr_next {
next if ($res->{'type'} ne 'assessment');
foreach my $part (@{$res->{'parts'}}) {
my $partdata = $res->{'partdata'}->{$part};
- if ($granularity eq 'part_survey' && $partdata->{'Survey'}){
+ if ($partdata->{'Survey'} && ($granularity eq 'part_survey')){
push (@Resource,
{ symb => $res->{symb},
part => $part,
@@ -435,6 +599,16 @@ keys $partid.'.'.$respid.'.answer'.
#####################################################
sub analyze_problem_as_student {
my ($resource,$sname,$sdom,$partid,$respid) = @_;
+ 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 $returnvalue;
my $url = $resource->{'src'};
my $symb = $resource->{'symb'};
@@ -635,7 +809,7 @@ sub ensure_proper_cache {
my ($symb) = @_;
my $cid = $ENV{'request.course.id'};
my $new_filename = '/home/httpd/perl/tmp/'.
- 'problemanalsysis_'.$cid.'answer_cache.db';
+ 'problemanalysis_'.$cid.'_answer_cache.db';
if (! defined($cache_filename) ||
$cache_filename ne $new_filename ||
! defined($current_symb) ||
@@ -1067,26 +1241,46 @@ Returns: An array of scalars containing
####################################################
####################################################
sub manage_caches {
- my ($r,$formname,$inputname) = @_;
+ 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.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(' ');
}
- my @Buttons =
- (' ',
- ' ');
#
return @Buttons;
}