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.9 and 1.22

-version 1.9, 2004/03/16 16:41:26
+version 1.22, 2004/09/16 14:28:19
  Line 40  routines that are needed across multiple
  =head1 OVERVIEW
  =over 4
  =cut
- Line 109  all option response and radiobutton prob
+ Line 108  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
  Line 118  sub ProblemSelector {
      my ($AcceptedResponseTypes) = @_;
      my $Str;
      $Str = "\n<table>\n";
-     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
+     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess('all')) {
          next if ($seq->{'num_assess'}<1);
          my $seq_str = '';
          foreach my $res (@{$seq->{'contents'}}) {
  Line 169  sub ProblemSelector {
  =pod
+ =item &MultpleProblemSelector($navmap,$ResponseTypes,$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.
+ $ResponseTypes: scalar containing regular expression which matches response
+ types.  Only those problems which contain the given response type will be
+ shown.
+ $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,$ReponseTypes,$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 .=
+                 '<h1>'.&mt('Error: cannot process course structure').'</h1>';
+             return $Str;
+         }
+     }
+     my $selected = {map { ($_,1) } (&get_selected_symbs($inputname))};
+     # Header
+     $Str .= <<"END";
+ <script>
+     function checkall(value, checkName) {
+         for (i=0; i<document.forms.$formname.elements.length; i++) {
+             ele = document.forms.$formname.elements[i];
+             if (ele.name == '$inputname') {
+                 document.forms.$formname.elements[i].checked=value;
+             }
+         }
+     }
+ </script>
+ END
+     $Str .=
+         '<a href="javascript:checkall(true)">'.&mt('Select All').'</a>'.
+         ('&nbsp;'x4).
+         '<a href="javascript:checkall(false)">'.&mt('Unselect All').'</a>';
+     $Str .= $/.'<table>'.$/;
+     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.= '<tr><td colspan="2">'.
+             '<b>'.&get_title($seq->{'title'},$seq->{'src'}).'</b>'.
+             '</td></tr>'.$/;
+         $Str.= $seq->{'html'};
+     }
+     $Str .= '</table>'.$/;
+     return $Str;
+ }
+ sub get_title {
+     my ($title,$src) = @_;
+     if ($title eq '') {
+         ($title) = ($src =~ m|/([^/]+)$|);
+     } else {
+         $title =~ s/\&colon;/:/g;
+     }
+     return $title;
+ }
+ sub new_accumulator {
+     my ($title,$src,$symb,$inputname) = @_;
+     my $target;
+     return
+         sub {
+             if (@_) {
+                 my ($res,$checked) = @_;
+                 $target.='<tr><td>'.
+                     '<input type="checkbox" name="'.$inputname.'" ';
+                 if ($checked) {
+                     $target .= 'checked ';
+                 }
+                 $target.=
+                     'value="'.&Apache::lonnet::escape($res->symb).'" />'.
+                     '</td><td>'.&get_title($res->title,$res->symb).'</td>'.
+                     '</tr>'.$/;
+             } 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:
- Line 212  Returns: A hash reference, $target, cont
+ Line 367  Returns: A hash reference, $target, cont
  ####################################################
  sub get_target_from_id {
      my ($id) = @_;
-     my ($symb,$part,$respid,$resptype) = split(':',$id);
+     if (! ref($id)) {
-     return ({ symb    =>&Apache::lonnet::unescape($symb),
+         my ($symb,$part,$respid,$resptype) = split(':',$id);
-              part     =>&Apache::lonnet::unescape($part),
+         return ({ symb     => &Apache::lonnet::unescape($symb),
-              respid   =>&Apache::lonnet::unescape($respid),
+                   part     => &Apache::lonnet::unescape($part),
-              resptype =>&Apache::lonnet::unescape($resptype)});
+                   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;
+     }
  }
  ####################################################
- Line 224  sub get_target_from_id {
+ Line 391  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.
- Line 232  current resource.
+ Line 399  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
- Line 255  sub get_prev_curr_next {
+ Line 422  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,
- Line 290  sub get_prev_curr_next {
+ Line 463  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;
- Line 305  sub get_prev_curr_next {
+ Line 478  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
- Line 363  Returns: nothing
+ Line 536  Returns: nothing
  #####################################################
  #####################################################
  sub GetStudentAnswers {
-     my ($r,$problem,$Students) = @_;
+     my ($r,$problem,$Students,$formname,$inputname) = @_;
+     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'},
- Line 374  sub GetStudentAnswers {
+ Line 553  sub GetStudentAnswers {
      # Open progress window
      my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin
          ($r,'Student Answer Compilation Status',
-          'Student Answer Compilation Progress', scalar(@$Students));
+          'Student Answer Compilation Progress', scalar(@$Students),
+          $status_type,undef,$formname,$inputname);
      $r->rflush();
      foreach my $student (@$Students) {
          last if ($c->aborted());
- Line 422  keys $partid.'.'.$respid.'.answer'.
+ Line 602  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'};
- Line 478  sub get_answer {
+ Line 668  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 622  sub ensure_proper_cache {
+ Line 812  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)   ||
- Line 1001  sub get_time_limits {
+ Line 1191  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) = @_;
+     &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)
+         ) {
+         &Apache::lonstatistics::Gather_Full_Student_Data($r,$formname,
+                                                          $inputname);
+     }
+     #
+     my @Buttons =
+         ('<input type="submit" name="ClearCache" '.
+              'value="'.&mt('Clear Caches').'" />',
+          '<input type="submit" name="updatecaches" '.
+              'value="'.&mt('Update Caches').'" />'.
+          &Apache::loncommon::help_open_topic('Statistics_Cache'),
+          '<input type="hidden" name="prevsection" value="'.$sectionkey.'" />',
+          '<input type="hidden" name="prevenrollstatus" value="'.$statuskey.'" />'
+          );
+     #
+     if (! exists($ENV{'form.firstrun'})) {
+         $r->print('<input type="hidden" name="firstrun" value="yes" />');
+     } else {
+         $r->print('<input type="hidden" name="firstrun" value="no" />');
+     }
+     #
+     return @Buttons;
+ }
  ####################################################
  ####################################################

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

Removed from v.1.9
changed lines
	Added in v.1.22