[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.4 and 1.24

version 1.4, 2004/02/19 20:17:01 version 1.24, 2004/09/23 14:35:25
Line 40  routines that are needed across multiple Line 40  routines that are needed across multiple
   
 =head1 OVERVIEW  =head1 OVERVIEW
   
   
 =over 4  =over 4
   
 =cut  =cut
Line 59  use Apache::lonlocal; Line 58  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 107  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  Returns: A string containing html for a table which lists the sequences
 and their contents.  A radiobutton is provided for each problem.  and their contents.  A radiobutton is provided for each problem.
   Skips 'survey' problems.
   
 =cut  =cut
   
Line 116  sub ProblemSelector { Line 118  sub ProblemSelector {
     my ($AcceptedResponseTypes) = @_;      my ($AcceptedResponseTypes) = @_;
     my $Str;      my $Str;
     $Str = "\n<table>\n";      $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);          next if ($seq->{'num_assess'}<1);
         my $seq_str = '';          my $seq_str = '';
         foreach my $res (@{$seq->{'contents'}}) {          foreach my $res (@{$seq->{'contents'}}) {
Line 145  sub ProblemSelector { Line 147  sub ProblemSelector {
   $resptype.'</td><td>'.    $resptype.'</td><td>'.
   '<a href="'.$res->{'src'}.'">'.$title.'</a> ';    '<a href="'.$res->{'src'}.'">'.$title.'</a> ';
 #  '<a href="'.$res->{'src'}.'">'.$resptype.' '.$res->{'title'}.'</a> ';  #  '<a href="'.$res->{'src'}.'">'.$resptype.' '.$res->{'title'}.'</a> ';
                         if ($partdata->{'option'} > 1) {                          if (scalar(@{$partdata->{'ResponseIds'}}) > 1) {
                             $seq_str .= &mt('response').' '.$respid;                              $seq_str .= &mt('response').' '.$respid;
                         }                          }
                         $seq_str .= "</td></tr>\n";                          $seq_str .= "</td></tr>\n";
Line 167  sub ProblemSelector { Line 169  sub ProblemSelector {
   
 =pod  =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 .= 
                   '<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) {
           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') {
                   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,
                                                  $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>'.$seq->{'title'}.'</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><label>'.
                       '<input type="checkbox" name="'.$inputname.'" ';
                   if ($checked) {
                       $target .= 'checked ';
                   }
                   $target.= 
                       'value="'.&Apache::lonnet::escape($res->symb).'" />'.
                       '&nbsp;'.$res->compTitle.'</label></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)  =item &make_target_id($target)
   
 Inputs: Hash ref with the following entries:  Inputs: Hash ref with the following entries:
Line 210  Returns: A hash reference, $target, cont Line 363  Returns: A hash reference, $target, cont
 ####################################################  ####################################################
 sub get_target_from_id {  sub get_target_from_id {
     my ($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 222  sub get_target_from_id { Line 387  sub get_target_from_id {
   
 =pod  =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  Determine the problem parts or responses preceeding and following the
 current resource.  current resource.
Line 230  current resource. Line 395  current resource.
 Inputs: $target (see &Apache::lonstathelpers::get_target_from_id())  Inputs: $target (see &Apache::lonstathelpers::get_target_from_id())
   $AcceptableResponseTypes, regular expression matching acceptable    $AcceptableResponseTypes, regular expression matching acceptable
                             response types,                              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  Returns: three hash references, $prev, $curr, $next, which refer to the
 preceeding, current, or following problem parts or responses, depending  preceeding, current, or following problem parts or responses, depending
Line 253  sub get_prev_curr_next { Line 418  sub get_prev_curr_next {
     #      #
     # Build an array with the data we need to search through      # Build an array with the data we need to search through
     my @Resource;      my @Resource;
     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {      foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess('all')) {
         foreach my $res (@{$seq->{'contents'}}) {          foreach my $res (@{$seq->{'contents'}}) {
             next if ($res->{'type'} ne 'assessment');              next if ($res->{'type'} ne 'assessment');
             foreach my $part (@{$res->{'parts'}}) {              foreach my $part (@{$res->{'parts'}}) {
                 my $partdata = $res->{'partdata'}->{$part};                  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,                      push (@Resource,
                           { symb     => $res->{symb},                            { symb     => $res->{symb},
                             part     => $part,                              part     => $part,
Line 288  sub get_prev_curr_next { Line 459  sub get_prev_curr_next {
     my $curr_idx;      my $curr_idx;
     for ($curr_idx=0;$curr_idx<$#Resource;$curr_idx++) {      for ($curr_idx=0;$curr_idx<$#Resource;$curr_idx++) {
         my $curr_item = $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'} &&              if ($curr_item->{'symb'} eq $target->{'symb'} &&
                 $curr_item->{'part'} eq $target->{'part'}) {                  $curr_item->{'part'} eq $target->{'part'}) {
                 last;                  last;
Line 303  sub get_prev_curr_next { Line 474  sub get_prev_curr_next {
         }          }
     }      }
     my $curr_item = $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'}     ne $target->{'symb'} ||          if ($curr_item->{'symb'}     ne $target->{'symb'} ||
             $curr_item->{'part'}     ne $target->{'part'}) {              $curr_item->{'part'}     ne $target->{'part'}) {
             # bogus symb - return nothing              # bogus symb - return nothing
Line 343  sub get_prev_curr_next { Line 514  sub get_prev_curr_next {
   
 =pod  =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 $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::analyze_problem_as_student
               ($resource,$sname,$sdom,$partid,$respid);
           &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
                                                    &mt('last student'));
           $student->{'answer'} = $answer;
       }
       &Apache::lonstathelpers::write_answer_cache();
       return if ($c->aborted());
       $r->rflush();
       # close progress window
       &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
       return;
   }
   
   #####################################################
   #####################################################
   
   =pod
   
 =item analyze_problem_as_student  =item analyze_problem_as_student
   
 Analyzes a homework problem for a student and returns the correct answer  Analyzes a homework problem for a student and returns the correct answer
Line 354  Inputs: $resource: a resource object Line 586  Inputs: $resource: a resource object
   
 Returns: $answer  Returns: $answer
   
   If $partid and $respid are specified, $answer is simply a scalar containing
   the correct answer for the response.
   
   If $partid or $respid are undefined, $answer will be a hash reference with
   keys $partid.'.'.$respid.'.answer'.
   
 =cut  =cut
   
 #####################################################  #####################################################
 #####################################################  #####################################################
 sub analyze_problem_as_student {  sub analyze_problem_as_student {
     my ($resource,$sname,$sdom,$partid,$respid) = @_;      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 $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 371  sub analyze_problem_as_student { Line 623  sub analyze_problem_as_student {
                                         'grade_courseid' => $courseid));                                          'grade_courseid' => $courseid));
     (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);
     my $prefix = $partid.'.'.$respid;      #
     my $key = $prefix.'.answer';      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';
               $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 {
           $returnvalue = $answer->{$partid}->{$respid};
       }
       return $returnvalue;
   }
   
   sub get_answer {
       my ($prefix,$key,%Answer) = @_;
       my $returnvalue;
     if (exists($Answer{$key})) {      if (exists($Answer{$key})) {
         my $student_answer = $Answer{$key}->[0];          my $student_answer = $Answer{$key}->[0];
         if (! defined($student_answer)) {          if (! defined($student_answer)) {
Line 390  sub analyze_problem_as_student { Line 664  sub analyze_problem_as_student {
             }              }
             foreach my $foil (@{$Answer{$prefix.'.shown'}}) {              foreach my $foil (@{$Answer{$prefix.'.shown'}}) {
                 if (ref($values{$foil}) eq 'ARRAY') {                  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 {                  } 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;              $returnvalue =~ s/ /\%20/g;
Line 405  sub analyze_problem_as_student { Line 679  sub analyze_problem_as_student {
 }  }
   
   
   #####################################################
   #####################################################
   
   =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/'.
           'problemanalysis_'.$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.
Line 612  sub get_problem_data { Line 1070  sub get_problem_data {
         while (my($key,$value) = each(%Answer)) {          while (my($key,$value) = each(%Answer)) {
             #              #
             # Logging code:              # Logging code:
             if (1) {              if (0) {
                 &Apache::lonnet::logthis($part.' got key "'.$key.'"');                  &Apache::lonnet::logthis($part.' got key "'.$key.'"');
                 if (ref($value) eq 'ARRAY') {                  if (ref($value) eq 'ARRAY') {
                     &Apache::lonnet::logthis('    @'.join(',',@$value));                      &Apache::lonnet::logthis('    @'.join(',',@$value));
Line 655  sub get_problem_data { Line 1113  sub get_problem_data {
   
 ####################################################  ####################################################
 ####################################################  ####################################################
   
   =pod
   
   =item &limit_by_time()
   
   =cut
   
   ####################################################
   ####################################################
   sub limit_by_time_form {
       my $Starttime_form = '';
       my $starttime = &Apache::lonhtmlcommon::get_date_from_form
           ('limitby_startdate');
       my $endtime = &Apache::lonhtmlcommon::get_date_from_form
           ('limitby_enddate');
       if (! defined($endtime)) {
           $endtime = time;
       }
       if (! defined($starttime)) {
           $starttime = $endtime - 60*60*24*7;
       }
       my $state;
       if (&limit_by_time()) {
           $state = '';
       } else {
           $state = 'disabled';
       }
       my $startdateform = &Apache::lonhtmlcommon::date_setter
           ('Statistics','limitby_startdate',$starttime,undef,undef,$state);
       my $enddateform = &Apache::lonhtmlcommon::date_setter
           ('Statistics','limitby_enddate',$endtime,undef,undef,$state);
       my $Str;
       $Str .= '<script language="Javascript" >';
       $Str .= 'function toggle_limitby_activity(state) {';
       $Str .= '    if (state) {';
       $Str .= '        limitby_startdate_enable();';
       $Str .= '        limitby_enddate_enable();';
       $Str .= '    } else {';
       $Str .= '        limitby_startdate_disable();';
       $Str .= '        limitby_enddate_disable();';
       $Str .= '    }';    
       $Str .= '}';
       $Str .= '</script>';
       $Str .= '<fieldset>';
       my $timecheckbox = '<input type="checkbox" name="limit_by_time" ';
       if (&limit_by_time()) {
           $timecheckbox .= ' checked ';
       } 
       $timecheckbox .= 'OnChange="javascript:toggle_limitby_activity(this.checked);" ';
       $timecheckbox .= ' />';
       $Str .= '<legend>'.&mt('[_1] Limit by time',$timecheckbox).'</legend>';
       $Str .= &mt('Start Time: [_1]',$startdateform).'<br />';
       $Str .= &mt('&nbsp;End Time: [_1]',$enddateform).'<br />';
       $Str .= '</fieldset>';
       return $Str;
   }
   
   sub limit_by_time {
       if (exists($ENV{'form.limit_by_time'}) &&
           $ENV{'form.limit_by_time'} ne '' ) {
           return 1;
       } else {
           return 0;
       }
   }
   
   sub get_time_limits {
       my $starttime = &Apache::lonhtmlcommon::get_date_from_form
           ('limitby_startdate');
       my $endtime = &Apache::lonhtmlcommon::get_date_from_form
           ('limitby_enddate');
       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 = 
           ('<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;
   }
   
   
   
   
   ####################################################
   ####################################################
   
 =pod  =pod
   
Removed from v.1.4  
changed lines
  Added in v.1.24

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