[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.12 and 1.22

version 1.12, 2004/06/04 21:42:18 version 1.22, 2004/09/16 14:28:19
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 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  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 169  sub ProblemSelector { Line 169  sub ProblemSelector {
   
 =pod  =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)  =item &make_target_id($target)
   
 Inputs: Hash ref with the following entries:  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 {  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 224  sub get_target_from_id { Line 391  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 232  current resource. Line 399  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 260  sub get_prev_curr_next { Line 427  sub get_prev_curr_next {
             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 290  sub get_prev_curr_next { Line 463  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 305  sub get_prev_curr_next { Line 478  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 429  keys $partid.'.'.$respid.'.answer'. Line 602  keys $partid.'.'.$respid.'.answer'.
 #####################################################  #####################################################
 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'};
Line 629  sub ensure_proper_cache { Line 812  sub ensure_proper_cache {
     my ($symb) = @_;      my ($symb) = @_;
     my $cid = $ENV{'request.course.id'};      my $cid = $ENV{'request.course.id'};
     my $new_filename =  '/home/httpd/perl/tmp/'.      my $new_filename =  '/home/httpd/perl/tmp/'.
         'problemanalsysis_'.$cid.'answer_cache.db';          'problemanalysis_'.$cid.'_answer_cache.db';
     if (! defined($cache_filename) ||      if (! defined($cache_filename) ||
         $cache_filename ne $new_filename ||          $cache_filename ne $new_filename ||
         ! defined($current_symb)   ||          ! defined($current_symb)   ||
Line 1063  Returns: An array of scalars containing Line 1246  Returns: An array of scalars containing
 sub manage_caches {  sub manage_caches {
     my ($r,$formname,$inputname) = @_;      my ($r,$formname,$inputname) = @_;
     &Apache::loncoursedata::clear_internal_caches();      &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'}) ||       if (exists($ENV{'form.ClearCache'}) || 
         exists($ENV{'form.updatecaches'}) ||          exists($ENV{'form.updatecaches'}) || 
         (exists($ENV{'form.firstrun'}) &&          (exists($ENV{'form.firstrun'}) && $ENV{'form.firstrun'} ne 'no') ||
          $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,          &Apache::lonstatistics::Gather_Full_Student_Data($r,$formname,
                                                          $inputname);                                                           $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'})) {      if (! exists($ENV{'form.firstrun'})) {
         $r->print('<input type="hidden" name="firstrun" value="yes" />');          $r->print('<input type="hidden" name="firstrun" value="yes" />');
     } else {      } else {
         $r->print('<input type="hidden" name="firstrun" value="no" />');          $r->print('<input type="hidden" name="firstrun" value="no" />');
     }      }
     my @Buttons =   
         ('<input type="submit" name="ClearCache" '.  
              'value="'.&mt('Clear Caches').'" />',  
          '<input type="submit" name="updatecaches" '.  
              'value="'.&mt('Update Caches').'" />');  
     #      #
     return @Buttons;      return @Buttons;
 }  }
Removed from v.1.12  
changed lines
  Added in v.1.22

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