[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.7 and 1.76.2.4

version 1.7, 2004/03/12 21:05:08 version 1.76.2.4, 2020/09/12 20:36:11
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 50  routines that are needed across multiple Line 49  routines that are needed across multiple
 package Apache::lonstathelpers;  package Apache::lonstathelpers;
   
 use strict;  use strict;
 use Apache::lonnet();  use Apache::lonnet;
 use Apache::loncommon();  use Apache::loncommon();
 use Apache::lonhtmlcommon();  use Apache::lonhtmlcommon();
 use Apache::loncoursedata();  use Apache::loncoursedata();
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);
   use lib '/home/httpd/lib/perl/';
   use LONCAPA;
    
   
 ####################################################  ####################################################
 ####################################################  ####################################################
Line 67  use Spreadsheet::WriteExcel(); Line 71  use Spreadsheet::WriteExcel();
   
 =item &render_resource($resource)  =item &render_resource($resource)
   
 Input: a resource generated from   Input: a navmaps resource
 &Apache::loncoursedata::get_sequence_assessment_data().  
   
 Retunrs: a scalar containing html for a rendering of the problem  Retunrs: a scalar containing html for a rendering of the problem
 within a table.  within a table.
Line 81  sub render_resource { Line 84  sub render_resource {
     my ($resource) = @_;      my ($resource) = @_;
     ##      ##
     ## Render the problem      ## Render the problem
     my $base;      my ($base) = ($resource->src =~ m|^(.*/)[^/]*$|);
     ($base,undef) = ($resource->{'src'} =~ m|(.*/)[^/]*$|);      $base="http://".$ENV{'SERVER_NAME'}.$base;
     $base = "http://".$ENV{'SERVER_NAME'}.$base;      my ($src,$symb)=($resource->link,&escape($resource->shown_symb));
     my $rendered_problem =       my $rendered_problem = &Apache::lonnet::ssi_body($src.'?symb='.$symb);
         &Apache::lonnet::ssi_body($resource->{'src'});  
     $rendered_problem =~ s/<\s*form\s*/<nop /g;      $rendered_problem =~ s/<\s*form\s*/<nop /g;
     $rendered_problem =~ s|(<\s*/form\s*>)|<\/nop>|g;      $rendered_problem =~ s|(<\s*/form\s*>)|<\/nop>|g;
     return '<table bgcolor="ffffff"><tr><td>'.      return '<div class="LC_Box">'.
         '<base href="'.$base.'" />'.          '<h4 class="LC_hcell">'.&mt('Problem').'</h4>'.
         $rendered_problem.          '<base href="'.$base.'" />'.$rendered_problem.
         '</td></tr></table>';          '</div>';
 }  }
   
 ####################################################  ####################################################
Line 99  sub render_resource { Line 101  sub render_resource {
   
 =pod  =pod
   
 =item &ProblemSelector($AcceptedResponseTypes)  =item &get_resources
   
   =cut
   
   ####################################################
   ####################################################
   sub get_resources {
       my ($navmap,$sequence) = @_;
       my @resources = $navmap->retrieveResources($sequence,
                                                  sub { shift->is_problem(); },
                                                  0,0,0);
       return @resources;
   }
   
   ####################################################
   ####################################################
   
   =pod
   
   =item &problem_selector($AcceptedResponseTypes)
   
 Input: scalar containing regular expression which matches response  Input: scalar containing regular expression which matches response
 types to show.  '.' will yield all, '(option|radiobutton)' will match  types to show.  '.' will yield all, '(option|radiobutton)' will match
Line 107  all option response and radiobutton prob Line 128  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
   
 ####################################################  ####################################################
 ####################################################  ####################################################
 sub ProblemSelector {  sub problem_selector {
     my ($AcceptedResponseTypes) = @_;      my ($AcceptedResponseTypes,$sequence_addendum,$symbmode,$all,$prefix,
           $byres,$include_tools,$smallbox,$onclick) = @_;
   # all: also make sequences selectable
   # prefix: prefix for all form names
   # byres: radiobutton shown per resource
   # include_tools: external tools included 
   # smallbox: use smaller box
   # onclick: javascript to execute when clicked
     my $Str;      my $Str;
     $Str = "\n<table>\n";      my $jsadd='';
     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {      if ($onclick) {
         next if ($seq->{'num_assess'}<1);          $jsadd="onclick='$onclick'";
       }
       $Str =  &Apache::loncommon::start_scrollbox(($smallbox?'420px':'620px'),
                                                   ($smallbox?'400px':'600px'),
                                                   ($smallbox?'60px':'300px')).
               &Apache::loncommon::start_data_table();
       my $rb_count =0;
       my ($navmap,@sequences) = 
           &Apache::lonstatistics::selected_sequences_with_assessments('all');
       return $navmap if (! ref($navmap)); # error
       foreach my $seq (@sequences) {
         my $seq_str = '';          my $seq_str = '';
         foreach my $res (@{$seq->{'contents'}}) {          foreach my $res (&get_resources($navmap,$seq)) {
             next if ($res->{'type'} ne 'assessment');              if ($res->src() eq '/res/lib/templates/simpleproblem.problem') {
             foreach my $part (@{$res->{'parts'}}) {                  next if (grep(/^placeholder$/,@{$res->parts}));
                 my $partdata = $res->{'partdata'}->{$part};              }
                 for (my $i=0;$i<scalar(@{$partdata->{'ResponseTypes'}});$i++){              my $title = $res->compTitle;
                     my $respid = $partdata->{'ResponseIds'}->[$i];              if (! defined($title) || $title eq '') {
                     my $resptype = $partdata->{'ResponseTypes'}->[$i];                  ($title) = ($res->src =~ m:/([^/]*)$:);
               }
               my $totalresps = 0;
               if ($byres) {
                   foreach my $part (@{$res->parts}) {
                       $totalresps += scalar($res->responseIds($part));
                   }
                   my $value = &HTML::Entities::encode($res->symb(),'<>&"');
                   my $checked;
                   if ($env{'form.problemchoice'} eq $res->symb()) {
                       $checked = ' checked="checked"';
                   }
                   my $rowspan;
                   if ($totalresps > 1) {
                       $rowspan = ' rowspan="'.$totalresps.'"';
                   }
                   $seq_str .= &Apache::loncommon::start_data_table_row().
                               '<td'.$rowspan.' style="vertical-align:top">'.
                               '<label><input type="radio" name="symb" value="'.$value.'"'.$checked.' />'.
                               $title.'</label>';
                   my $link = $res->link.'?symb='.&escape($res->shown_symb);
                   $seq_str .= ('&nbsp;'x2).
                               '<a target="preview" href="'.$link.'">'.&mt('view').'</a></td>';
               }
               my %partsseen;
               foreach my $part (@{$res->parts}) {
                   my @response_ids   = $res->responseIds($part);
                   my @response_types = $res->responseType($part);
                   for (my $i=0;$i<scalar(@response_types);$i++){
                       my $respid = $response_ids[$i];
                       my $resptype = $response_types[$i];
                     if ($resptype =~ m/$AcceptedResponseTypes/) {                      if ($resptype =~ m/$AcceptedResponseTypes/) {
                         my $value = &make_target_id({symb=>$res->{'symb'},                          if ($byres) {
                                                      part=>$part,                              if (exists($partsseen{$part})) {
                                                      respid=>$respid,                                  $seq_str .= &Apache::loncommon::continue_data_table_row();
                                                      resptype=>$resptype});                              } else {
                         my $checked = '';                                  my $parttitle = $part;
                         if ($ENV{'form.problemchoice'} eq $value) {                                  if ($part eq '0') {
                             $checked = 'checked ';                                      $parttitle = '';
                         }                                  }
                         my $title = $res->{'title'};                                  if ($parttitle ne '') {
                         if (! defined($title) || $title eq '') {                                      $parttitle = ('&nbsp;'x2).&mt('part').':&nbsp;'.$parttitle;
                             ($title) = ($res->{'src'} =~ m:/([^/]*)$:);                                  }
                         }                                  if (keys(%partsseen)) {
                         $seq_str .= '<tr><td>'.                                      $seq_str .= &Apache::loncommon::continue_data_table_row();
   '<input type="radio" name="problemchoice" value="'.$value.'" '.$checked.'/>'.                                  }
   '</td><td>'.                                            unless ($partsseen{$part}) {
   $resptype.'</td><td>'.                                      my $resprowspan;
   '<a href="'.$res->{'src'}.'">'.$title.'</a> ';                                      if (scalar(@response_ids) > 1) {
 #  '<a href="'.$res->{'src'}.'">'.$resptype.' '.$res->{'title'}.'</a> ';                                          $resprowspan = ' rowspan="'.scalar(@response_ids).'"';
                         if (scalar(@{$partdata->{'ResponseIds'}}) > 1) {                                      }
                             $seq_str .= &mt('response').' '.$respid;                                      $seq_str .= '<td'.$resprowspan.' style="vertical-align:top">'.
                                                   $parttitle.'</td>';
                                       $partsseen{$part} = scalar(@response_ids);
                                   }
                               }
                               $seq_str .= '<td>'.$resptype;
                               if (scalar(@response_ids) > 1) {
                                   $seq_str .= '&nbsp;'.&mt('id').':&nbsp;'.$respid;
                               }
                               $seq_str .= '</td>'. &Apache::loncommon::end_data_table_row()."\n";
                           } else {
                               my $value = &make_target_id({symb=>$res->symb,
                                                            part=>$part,
                                                            respid=>$respid,
                                                            resptype=>$resptype});
                               my $checked = '';
                               if ($env{'form.problemchoice'} eq $value) {
                                   $checked = ' checked="checked"';
                               }
                               $seq_str .= &Apache::loncommon::start_data_table_row().
                                   ($symbmode?
                                    '<td><input type="radio" id="'.$prefix.$rb_count.'" name="'.$prefix.'symb" value="'.&HTML::Entities::encode($res->symb,'<>&"').'" '.$checked.' '.
                                    $jsadd.
                                    ' /></td>'
                                    :qq{<td><input type="radio" id="$rb_count" name="problemchoice" value="$value"$checked /></td>}).
                                   '<td><label for="'.$prefix.$rb_count.'">'.$resptype.'</label></td>'.
                                   '<td><label for="'.$prefix.$rb_count.'">'.$title.'</label>';
                               if (scalar(@response_ids) > 1) {
                                   $seq_str .= &mt('response').' '.$respid;
                               }
                               my $link = $res->link.'?symb='.&escape($res->shown_symb);
                               $seq_str .= ('&nbsp;'x2).
                                           '<a target="preview" href="'.$link.'">'.&mt('view').'</a>';
                               $seq_str .= "</td>". &Apache::loncommon::end_data_table_row()."\n";
                         }                          }
                         $seq_str .= "</td></tr>\n";                          $rb_count++;
                     }                      }
                 }                  }
             }              }
         }          }
         if ($seq_str ne '') {          if ($seq_str ne '') {
             $Str .= '<tr><td>&nbsp</td><td colspan="2"><b>'.$seq->{'title'}.'</b></td>'.              if ($byres) {
                 "</tr>\n".$seq_str;                  $Str .= &Apache::loncommon::start_data_table_header_row().
                           '<th colspan="3">'.$seq->compTitle.'</th>'.
                           &Apache::loncommon::end_data_table_header_row().
                           $seq_str;
               } else {
                   $Str .= &Apache::loncommon::start_data_table_header_row().
                       '<th colspan="3">'.
                       ($all?'<input type="radio" id="'.$prefix.'s'.$rb_count.'" name="'.$prefix.'symb" value="'.&HTML::Entities::encode($seq->symb,'<>&').'" '.$jsadd.' />':'').
                       $seq->compTitle.'</th>'.
                       &Apache::loncommon::end_data_table_header_row()."\n".$seq_str;
                   if (defined($sequence_addendum)) {
                       $Str .= &Apache::loncommon::start_data_table_header_row().
                           ('<td>&nbsp;</td>'x2).
                           '<td align="right">'.$sequence_addendum.'</td>'.
                           &Apache::loncommon::end_data_table_header_row()."\n";
                   }
               }
           }
       }
       $Str .= &Apache::loncommon::end_data_table().&Apache::loncommon::end_scrollbox()."\n";
       if (!$rb_count) {
           if ($byres) {
               $Str = '<p class="LC_info">'.&mt('No gradable problems found').'</p>';
           } elsif ($AcceptedResponseTypes eq '.') {
               $Str = '<p class="LC_info">'.&mt('No problems found').'</p>';
           } else {
               $Str = '<p class="LC_info">'.&mt('No analyzable problems found').'</p>';
         }          }
     }      }
     $Str .= "</table>\n";  
     return $Str;      return $Str;
 }  }
   
Line 167  sub ProblemSelector { Line 294  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,$anoncounter)=@_;
       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 .= '<div class="LC_error">'
                      .&mt('Error: cannot process course structure')
                      .'</div>';
               return $Str;
           }
       }
       my $selected = {map { ($_,1) } (&get_selected_symbs($inputname))};
       # Header
       $Str .= <<"END";
   <script type="text/javascript" language="JavaScript">
       function checkall(value,seqid) {
           for (i=0; i<document.forms.$formname.elements.length; i++) {
               ele = document.forms.$formname.elements[i];
               if (ele.name == '$inputname') {
                   if (seqid != null) {
                       itemid = document.forms.$formname.elements[i].id;
                       thing = itemid.split(':');
                       if (thing[0] == seqid) {
                           document.forms.$formname.elements[i].checked=value;
                       }
                   } else {
                       document.forms.$formname.elements[i].checked=value;
                   }
               }
           }
       }
   </script>
   END
       my $checkanonjs = <<"END";
    
   <script type="text/javascript" language="JavaScript">
       function checkanon() {
           return true;
       }
   </script>
   
   END
       if (ref($anoncounter) eq 'HASH') {
           if (keys(%{$anoncounter}) > 0) {
               my $anonwarning = &mt('Your selection includes both problems with and without anonymous submissions.')."\n".&mt('You must select either only anonymous or only named problems.')."\n\n".&mt('If a selection contains both anonymous and named parts,[_1]use the Anonymous/Named buttons to ensure selections will be either all anonymous[_1]or all named.',"\n");
               &js_escape(\$anonwarning);
               $checkanonjs = <<"END";
   
   <script type="text/javascript" language="JavaScript">
       function checkanon() {
           anoncount = 0;
           namedcount = 0;
           for (i=0; i<document.forms.$formname.elements.length; i++) {
               ele = document.forms.$formname.elements[i];
               if (ele.name == '$inputname') {
                   itemid = document.forms.$formname.elements[i].id;
                   if (document.forms.$formname.elements[i].checked) {
                       anonid = 'anonymous_'+itemid;
                       mixid = 'mixed_'+itemid;
                       anonele = document.getElementById(anonid);
                       mixele = document.getElementById(mixid);
                       if (anonele.value > 0) {
                           if (mixele.value == 'none') {
                               anoncount ++;
                           } else {
                               if (mixele.value == '0') {
                                   if (mixele.checked) {
                                       anoncount ++; 
                                   } else {
                                       namedcount ++;
                                   } 
                               } else {
                                   namedcount ++;
                               }
                           }
                       } else {
                           namedcount ++;
                       }
                   }
               }
           }
           if (anoncount > 0 && namedcount > 0) {
               alert("$anonwarning");
               return false;
           } 
       }
   </script>
   
   END
           }
       }
       $Str .= $checkanonjs.
           '<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 $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) {
               my $anonpart = 0;
               my $namedpart = 0;
               my @parts = @{$curRes->parts()};
               if (ref($anoncounter) eq 'HASH') {
                   if (keys(%{$anoncounter}) > 0) {
                       my @parts = @{$curRes->parts()};
                       my $symb = $curRes->symb();
                       foreach my $part (@parts) {
                           if ((exists($anoncounter->{$symb."\0".$part})) ||
                               $curRes->is_anonsurvey($part)) {
                               $anonpart ++;
                           } else {
                               $namedpart ++ 
                           }
                       }
                   }
               }
               if (@Accumulator && $Accumulator[-1] ne '') {
                   &{$Accumulator[-1]}($curRes,
                                       exists($selected->{$curRes->symb}),
                                       $anonpart,$namedpart);
               }
           }
       }
       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>'.('&nbsp;'x2).
               '<a href="javascript:checkall(true,'.$seq->{'id'}.')">'.
                                     &mt('Select').'</a>'.('&nbsp;'x2).
               '<a href="javascript:checkall(false,'.$seq->{'id'}.')">'.
                                     &mt('Unselect').'</a>'.('&nbsp;'x2).
               '</td></tr>'.$/;
           $Str.= $seq->{'html'};
       }
       $Str .= '</table>'.$/;
       return $Str;
   }
   
   sub new_accumulator {
       my ($title,$src,$symb,$seq_id,$inputname) = @_;
       my $target;
       my $item_id=0;
       return 
           sub {
               if (@_) { 
                   my ($res,$checked,$anonpart,$namedpart) = @_;
                   $target.='<tr><td><label>'.
                       '<input type="checkbox" name="'.$inputname.'" ';
                   if ($checked) {
                       $target .= 'checked="checked" ';
                   }
                   my $anon_id = $item_id;
                   $target .= 'id="'.$seq_id.':'.$item_id++.'" ';
                   my $esc_symb = &escape($res->symb);
                   $target.= 
                       'value="'.$esc_symb.'" />'.
                       '&nbsp;'.$res->compTitle.'</label>'.
                       ('&nbsp;'x2).'<a target="preview" '.
                       'href="'.$res->link.'?symb='.
                       &escape($res->shown_symb).'">'.&mt('view').'</a>'.
                       '<input type="hidden" id="anonymous_'.$seq_id.':'.$anon_id.'" name="hidden_'.$seq_id.':'.$anon_id.'" value="'.$anonpart.'" />';
                   my $mixed = '<input type="hidden" id="mixed_'.$seq_id.':'.$anon_id.'" value="none" name="mixed_'.$seq_id.':'.$anon_id.'" />';
                   if ($anonpart) {
                       if ($namedpart) {
                           my $checknamed = '';
                           my $checkedanon = ' checked="checked"';
                           if ($env{'form.mixed_'.$seq_id.':'.$anon_id} eq $esc_symb) {
                               $checknamed = $checkedanon;
                               $checkedanon = '';
                           }
                           $mixed = '&nbsp;('.
       &mt('Both anonymous and named submissions -- display: [_1]Anonymous [_2]Named[_3]',
       '<span class="LC_nobreak"><label>'.
       '<input type="radio" name="mixed_'.$seq_id.':'.$anon_id.
       '" value="0" id="mixed_'.$seq_id.':'.$anon_id.'"'.$checkedanon.' />',
       '</label></span>'.('&nbsp;'x2).' <span class="LC_nobreak">'.
       '<label><input type="radio" name="mixed_'.$seq_id.':'.$anon_id.
       '" value="symb_'.$esc_symb.'" id="named_'.$seq_id.':'.$anon_id.'"'.$checknamed.' />',
       '</label></span>').')';
                       } else {
                           $target .= '&nbsp;'.&mt('(Anonymous Survey)');
                       }
                   }
                   $target.= $mixed.'</td></tr>'.$/;
               } 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 = (map {
                        &unescape($_);
                        } &Apache::loncommon::get_env_multiple($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 184  Used by Apache::lonstathelpers::ProblemS Line 570  Used by Apache::lonstathelpers::ProblemS
 ####################################################  ####################################################
 sub make_target_id {  sub make_target_id {
     my ($target) = @_;      my ($target) = @_;
     my $id = &Apache::lonnet::escape($target->{'symb'}).':'.      my $id = &escape($target->{'symb'}).':'.
              &Apache::lonnet::escape($target->{'part'}).':'.               &escape($target->{'part'}).':'.
              &Apache::lonnet::escape($target->{'respid'}).':'.               &escape($target->{'respid'}).':'.
              &Apache::lonnet::escape($target->{'resptype'});               &escape($target->{'resptype'});
     return $id;      return $id;
 }  }
   
Line 210  Returns: A hash reference, $target, cont Line 596  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     => &unescape($symb),
              respid   =>&Apache::lonnet::unescape($respid),                    part     => &unescape($part),
              resptype =>&Apache::lonnet::unescape($resptype)});                    respid   => &unescape($respid),
                     resptype => &unescape($resptype)});
       } elsif (ref($id) eq 'ARRAY') {
           my @Return;
           foreach my $selected (@$id) {
               my ($symb,$part,$respid,$resptype) = split(':',$selected);
               push(@Return,{ symb     => &unescape($symb),
                              part     => &unescape($part),
                              respid   => &unescape($respid),
                              resptype => &unescape($resptype)});
           }
           return \@Return;
       }
 }  }
   
 ####################################################  ####################################################
Line 222  sub get_target_from_id { Line 620  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 628  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', 'part_survey', or 'part_task'
   
 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 651  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()) {      my ($navmap,@sequences) = 
         foreach my $res (@{$seq->{'contents'}}) {          &Apache::lonstatistics::selected_sequences_with_assessments('all');
             next if ($res->{'type'} ne 'assessment');      return $navmap if (! ref($navmap));
             foreach my $part (@{$res->{'parts'}}) {      foreach my $seq (@sequences) {
                 my $partdata = $res->{'partdata'}->{$part};          my @resources = &get_resources($navmap,$seq);
                 if ($granularity eq 'part') {          foreach my $res (@resources) {
               foreach my $part (@{$res->parts}) {
                   if (($res->is_survey($part) || ($res->is_anonsurvey($part))) && 
                       ($granularity eq 'part_survey')) {
                     push (@Resource,                      push (@Resource,
                           { symb     => $res->{symb},                            { symb     => $res->symb,
                               part     => $part,
                               resource => $res,
                           } );
    } elsif ($res->is_task($part) && ($granularity eq 'part_task')){
                       push (@Resource,
                             { symb     => $res->symb,
                               part     => $part,
                               resource => $res,
                           } );
                   } elsif ($granularity eq 'part') {
                       push (@Resource,
                             { symb     => $res->symb,
                             part     => $part,                              part     => $part,
                             resource => $res,                              resource => $res,
                         } );                          } );
                 } elsif ($granularity eq 'response') {                  } elsif ($granularity eq 'response') {
                       my @response_ids   = $res->responseIds($part);
                       my @response_types = $res->responseType($part);
                     for (my $i=0;                      for (my $i=0;
                          $i<scalar(@{$partdata->{'ResponseTypes'}});                           $i<scalar(@response_ids);
                          $i++){                           $i++){
                         my $respid = $partdata->{'ResponseIds'}->[$i];                          my $respid   = $response_ids[$i];
                         my $resptype = $partdata->{'ResponseTypes'}->[$i];                          my $resptype = $response_types[$i];
                         next if ($resptype !~ m/$AcceptableResponseTypes/);                          next if ($resptype !~ m/$AcceptableResponseTypes/);
                         push (@Resource,                          push (@Resource,
                               { symb     => $res->{symb},                                { symb     => $res->symb,
                                 part     => $part,                                  part     => $part,
                                 respid   => $partdata->{'ResponseIds'}->[$i],                                  respid   => $respid,
                                   resptype => $resptype,
                                 resource => $res,                                  resource => $res,
                                 resptype => $resptype  
                                 } );                                  } );
                     }                      }
                 }                  }
Line 288  sub get_prev_curr_next { Line 703  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 =~ /^(part|part_survey|part_task)$/) {
             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 718  sub get_prev_curr_next {
         }          }
     }      }
     my $curr_item = $Resource[$curr_idx];      my $curr_item = $Resource[$curr_idx];
     if ($granularity eq 'part') {      if ($granularity =~ /^(part|part_survey|part_task)$/) {
         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 334  sub get_prev_curr_next { Line 749  sub get_prev_curr_next {
         $curr = $Resource[$curr_idx  ];          $curr = $Resource[$curr_idx  ];
         $next = $Resource[$curr_idx+1];          $next = $Resource[$curr_idx+1];
     }      }
     return ($prev,$curr,$next);      return ($navmap,$prev,$curr,$next);
 }  }
   
   
Line 343  sub get_prev_curr_next { Line 758  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 %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,scalar(@$Students));
       $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,
                                                        '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  =item analyze_problem_as_student
   
 Analyzes a homework problem for a student and returns the correct answer  Analyzes a homework problem for a student
 for the student.  Attempts to put together an answer for problem types   
 that do not natively support it.  
   
 Inputs: $resource: a resource object  Inputs: $resource: a resource object
         $sname, $sdom, $partid, $respid          $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  Returns: $answer
   
 If $partid and $respid are specified, $answer is simply a scalar containing  If $partid and $respid are specified, $answer is simply a scalar containing
Line 364  keys $partid.'.'.$respid.'.answer'. Line 887  keys $partid.'.'.$respid.'.answer'.
   
 #####################################################  #####################################################
 #####################################################  #####################################################
 sub analyze_problem_as_student {  sub get_student_answer {
     my ($resource,$sname,$sdom,$partid,$respid) = @_;      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 (ref($resource) ne 'HASH') {
         # If you do not specify a partid, you get them all.          my $res = $resource;
         foreach my $partid (@{$resource->{'parts'}}) {          $resource = { 'src' => $res->src,
             my $partdata = $resource->{'partdata'}->{$partid};                        'symb' => $res->symb,
             foreach my $respid (@{$partdata->{'ResponseIds'}}) {                        'parts' => $res->parts };
                 my $prefix = $partid.'.'.$respid;          foreach my $part (@{$resource->{'parts'}}) {
                 my $key = $prefix.'.answer';              $resource->{'partdata'}->{$part}->{'ResponseIds'}=
                 $returnvalue->{$key} = &get_answer($prefix,$key,%Answer);                  [$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};          my $partdata = $resource->{'partdata'}->{$partid};
         foreach my $respid (@{$partdata->{'ResponseIds'}}) {          foreach my $respid (@{$partdata->{'ResponseIds'}}) {
             my $prefix = $partid.'.'.$respid;              my $prefix = $partid.'.'.$respid;
             my $key = $prefix.'.answer';              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 {      } else {
         my $prefix = $partid.'.'.$respid;          $returnvalue = $answer->{$partid}->{$respid};
         my $key = $prefix.'.answer';  
         $returnvalue = &get_answer($prefix,$key,%Answer);  
     }      }
     return $returnvalue;      return $returnvalue;
 }  }
Line 407  sub get_answer { Line 928  sub get_answer {
     my ($prefix,$key,%Answer) = @_;      my ($prefix,$key,%Answer) = @_;
     my $returnvalue;      my $returnvalue;
     if (exists($Answer{$key})) {      if (exists($Answer{$key})) {
         my $student_answer = $Answer{$key}->[0];   if (ref($Answer{$key}) eq 'HASH') {
         if (! defined($student_answer)) {      my $which = 'INTERNAL';
             $student_answer = $Answer{$key}->[1];      if (!exists($Answer{$key}{$which})) {
         }   $which = (sort(keys(%{ $Answer{$key} })))[0];
         $returnvalue = $student_answer;      }
       my $student_answer = $Answer{$key}{$which}[0][0];
       $returnvalue = $student_answer; 
    } else {
       &Apache::lonnet::logthis("error analyzing problem. got a answer of type ".ref($Answer{$key}));
    }
     } else {      } else {
         if (exists($Answer{$prefix.'.shown'})) {          if (exists($Answer{$prefix.'.shown'})) {
             # The response has foils              # The response has foils
Line 423  sub get_answer { Line 949  sub get_answer {
             }              }
             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 437  sub get_answer { Line 963  sub get_answer {
     return $returnvalue;      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{&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 = &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 = LONCAPA::tempdir() .
           '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   ## The following is copied from datecalc1.pl, part of the 
 ## Spreadsheet::WriteExcel CPAN module.  ## Spreadsheet::WriteExcel CPAN module.
Line 653  sub get_problem_data { Line 1341  sub get_problem_data {
                 }                  }
             }              }
             # End of logging code              # End of logging code
             next if ($key !~ /^$part/);              next if ($key !~ /^\Q$part\E/);
             $key =~ s/^$part\.//;              $key =~ s/^\Q$part\E\.//;
             if (ref($value) eq 'ARRAY') {              if (ref($value) eq 'ARRAY') {
                 if ($key eq 'options') {                  if ($key eq 'options') {
                     $Partdata{$part}->{'_Options'}=$value;                      $Partdata{$part}->{'_Options'}=$value;
                 } elsif ($key eq 'concepts') {                  } elsif ($key eq 'concepts') {
                     $Partdata{$part}->{'_Concepts'}=$value;                      $Partdata{$part}->{'_Concepts'}=$value;
                   } elsif ($key eq 'items') {
                       $Partdata{$part}->{'_Items'}=$value;
                 } elsif ($key =~ /^concept\.(.*)$/) {                  } elsif ($key =~ /^concept\.(.*)$/) {
                     my $concept = $1;                      my $concept = $1;
                     foreach my $foil (@$value) {                      foreach my $foil (@$value) {
                         $Partdata{$part}->{'_Foils'}->{$foil}->{'_Concept'}=                          $Partdata{$part}->{'_Foils'}->{$foil}->{'_Concept'}=
                                                                       $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;                      $Partdata{$part}->{$key}=$value;
                 }                  }
             } else {              } else {
Line 678  sub get_problem_data { Line 1368  sub get_problem_data {
                 } elsif ($key =~ /^foil\.value\.(.*)$/) {                  } elsif ($key =~ /^foil\.value\.(.*)$/) {
                     my $foil = $1;                      my $foil = $1;
                     $Partdata{$part}->{'_Foils'}->{$foil}->{'value'}=$value;                      $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;      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.'"');
           }
       }
   }
 ####################################################  ####################################################
 ####################################################  ####################################################
   
Line 719  sub limit_by_time_form { Line 1447  sub limit_by_time_form {
     my $enddateform = &Apache::lonhtmlcommon::date_setter      my $enddateform = &Apache::lonhtmlcommon::date_setter
         ('Statistics','limitby_enddate',$endtime,undef,undef,$state);          ('Statistics','limitby_enddate',$endtime,undef,undef,$state);
     my $Str;      my $Str;
     $Str .= '<script language="Javascript" >';      $Str .= '<script type="text/javascript" language="JavaScript">';
     $Str .= 'function toggle_limitby_activity(state) {';      $Str .= 'function toggle_limitby_activity(state) {';
     $Str .= '    if (state) {';      $Str .= '    if (state) {';
     $Str .= '        limitby_startdate_enable();';      $Str .= '        limitby_startdate_enable();';
Line 733  sub limit_by_time_form { Line 1461  sub limit_by_time_form {
     $Str .= '<fieldset>';      $Str .= '<fieldset>';
     my $timecheckbox = '<input type="checkbox" name="limit_by_time" ';      my $timecheckbox = '<input type="checkbox" name="limit_by_time" ';
     if (&limit_by_time()) {      if (&limit_by_time()) {
         $timecheckbox .= ' checked ';          $timecheckbox .= 'checked="checked" ';
     }       } 
     $timecheckbox .= 'OnChange="javascript:toggle_limitby_activity(this.checked);" ';      $timecheckbox .= 'onchange="javascript:toggle_limitby_activity(this.checked);" ';
     $timecheckbox .= ' />';      $timecheckbox .= ' />';
     $Str .= '<legend>'.&mt('[_1] Limit by time',$timecheckbox).'</legend>';      $Str .= '<legend><label>'.&mt('[_1] Limit by time',$timecheckbox).'</label></legend>';
     $Str .= &mt('Start Time: [_1]',$startdateform).'<br />';      $Str .= &mt('Start Time: [_1]',$startdateform).'<br />';
     $Str .= &mt('&nbsp;End Time: [_1]',$enddateform).'<br />';      $Str .= &mt('&nbsp;End Time: [_1]',$enddateform).'<br />';
     $Str .= '</fieldset>';      $Str .= '</fieldset>';
Line 745  sub limit_by_time_form { Line 1473  sub limit_by_time_form {
 }  }
   
 sub limit_by_time {  sub limit_by_time {
     if (exists($ENV{'form.limit_by_time'}) &&      if (exists($env{'form.limit_by_time'}) &&
         $ENV{'form.limit_by_time'} ne '' ) {          $env{'form.limit_by_time'} ne '' ) {
         return 1;          return 1;
     } else {      } else {
         return 0;          return 0;
Line 762  sub get_time_limits { Line 1490  sub get_time_limits {
 }  }
   
 ####################################################  ####################################################
   ####################################################
   
   =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 {
                        &escape($_);
                    } sort(&Apache::lonstatistics::get_selected_sections())
                );
       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);
           }
           if (0) {
               &Apache::lonnet::logthis('Updating mysql student data caches');
           }
           &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;
   }
   
   sub gather_full_student_data {
       my ($r,$formname,$inputname) = @_;
       my $status_type;
       if (defined($formname)) {
           $status_type = 'inline';
       } else {
           $status_type = 'popup';
       }
       my $c = $r->connection();
       #
       &Apache::loncoursedata::clear_internal_caches();
       #
       my @Students = @Apache::lonstatistics::Students;
       #
       # Open the progress window
       my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,scalar(@Students));
       #
       while (my $student = shift @Students) {
           return if ($c->aborted());
           my $status = &Apache::loncoursedata::ensure_current_full_data
               ($student->{'username'},$student->{'domain'},
                $env{'request.course.id'});
           &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
                                                    &mt('last student'));
       }
       &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
       $r->rflush();
       return;
   }
   
   ####################################################
   ####################################################
   
   =pod
   
   =item &submission_report_form
   
   Input: The originating reportSelected value for the current stats page.
   
   Output: Scalar containing HTML with needed form elements and a link to 
   the student submission reports page.
   
   =cut
   
   ####################################################
   ####################################################
   sub submission_report_form {
       my ($original_report) = @_;
       # Note: In the link below we change the reportSelected value.  If
       # the user hits the 'back' button on the browser after getting their
       # student submissions report, this value may still be around.  So we
       # output a script block to set it properly.  If the $original_report
       # value is unset, you are just asking for trouble.
       if (! defined($original_report)) {
           &Apache::lonnet::logthis
               ('someone called lonstathelpers::submission_report_form without '.
                ' enough input.');
       }
       my $html = $/.
           '<script type="text/javascript" language="JavaScript">'.
           "document.Statistics.reportSelected.value='$original_report';".
           '</script>'.
           '<input type="hidden" name="correctans" value="true" />'.
           '<input type="hidden" name="prob_status" value="true" />'.
           '<input type="hidden" name="all_sub" value="true" />';
       my $output_selector = $/.'<select name="output">'.$/;
       foreach ('HTML','Excel','CSV') {
           $output_selector .= '    <option value="'.lc($_).'"';
           if ($env{'form.output'} eq lc($_)) {
               $output_selector .= ' selected ';
           }
           $output_selector .='>'.&mt($_).'</option>'.$/;
       } 
       $output_selector .= '</select>'.$/;
       my $link = '<a href="javascript:'.
          q{document.Statistics.reportSelected.value='student_submission_reports';}.
          'document.Statistics.submit();">';
       $html.= &mt('View data as [_1] [_2]go[_3]',$output_selector,
                   $link,'</a>').$/;
       return $html
   }
   
   ####################################################
 ####################################################  ####################################################
   
 =pod  =pod
Removed from v.1.7  
changed lines
  Added in v.1.76.2.4

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