Diff for /loncom/interface/statistics/lonstathelpers.pm between versions 1.51 and 1.62

version 1.51, 2005/11/12 03:58:55 version 1.62, 2010/06/10 16:14:39
Line 60  use Time::Local(); Line 60  use Time::Local();
 use Spreadsheet::WriteExcel();  use Spreadsheet::WriteExcel();
 use GDBM_File;  use GDBM_File;
 use Storable qw(freeze thaw);  use Storable qw(freeze thaw);
   use lib '/home/httpd/lib/perl/';
   use LONCAPA;
    
   
 ####################################################  ####################################################
 ####################################################  ####################################################
Line 83  sub render_resource { Line 86  sub render_resource {
     ## Render the problem      ## Render the problem
     my ($base) = ($resource->src =~ m|^(.*/)[^/]*$|);      my ($base) = ($resource->src =~ m|^(.*/)[^/]*$|);
     $base="http://".$ENV{'SERVER_NAME'}.$base;      $base="http://".$ENV{'SERVER_NAME'}.$base;
     my ($src,$symb)=($resource->src,&Apache::lonnet::escape($resource->symb));      my ($src,$symb)=($resource->link,&escape($resource->shown_symb));
     my $rendered_problem = &Apache::lonnet::ssi_body($src.'?symb='.$symb);      my $rendered_problem = &Apache::lonnet::ssi_body($src.'?symb='.$symb);
     $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;
Line 132  Skips 'survey' problems. Line 135  Skips 'survey' problems.
 ####################################################  ####################################################
 ####################################################  ####################################################
 sub problem_selector {  sub problem_selector {
     my ($AcceptedResponseTypes,$sequence_addendum) = @_;      my ($AcceptedResponseTypes,$sequence_addendum,$symbmode) = @_;
     my $Str;      my $Str;
     $Str = "\n<table>\n";      $Str = &Apache::loncommon::start_data_table();
     my $rb_count =0;      my $rb_count =0;
     my ($navmap,@sequences) =       my ($navmap,@sequences) = 
         &Apache::lonstatistics::selected_sequences_with_assessments('all');          &Apache::lonstatistics::selected_sequences_with_assessments('all');
Line 155  sub problem_selector { Line 158  sub problem_selector {
                                                      resptype=>$resptype});                                                       resptype=>$resptype});
                         my $checked = '';                          my $checked = '';
                         if ($env{'form.problemchoice'} eq $value) {                          if ($env{'form.problemchoice'} eq $value) {
                             $checked = 'checked ';                              $checked = ' checked="checked"';
                         }                          }
                         my $title = $res->compTitle;                          my $title = $res->compTitle;
                         if (! defined($title) || $title eq '') {                          if (! defined($title) || $title eq '') {
                             ($title) = ($res->src =~ m:/([^/]*)$:);                              ($title) = ($res->src =~ m:/([^/]*)$:);
                         }                          }
                         $seq_str .= '<tr>'.                          $seq_str .=  &Apache::loncommon::start_data_table_row().
                             qq{<td><input type="radio" id="$rb_count" name="problemchoice" value="$value" $checked /></td>}.                              ($symbmode?
                                '<td><input type="radio" id="'.$rb_count.'" name="symb" value="'.&HTML::Entities::encode($res->symb,'<>&"').'" '.$checked.' /></td>'
                               :qq{<td><input type="radio" id="$rb_count" name="problemchoice" value="$value"$checked /></td>}).
                             '<td><label for="'.$rb_count.'">'.$resptype.'</label></td>'.                              '<td><label for="'.$rb_count.'">'.$resptype.'</label></td>'.
                             '<td><label for="'.$rb_count.'">'.$title.'</label>';                              '<td><label for="'.$rb_count.'">'.$title.'</label>';
                         if (scalar(@response_ids) > 1) {                          if (scalar(@response_ids) > 1) {
                             $seq_str .= &mt('response').' '.$respid;                              $seq_str .= &mt('response').' '.$respid;
                         }                          }
                         my $link = $res->src.'?symb='.                          my $link = $res->link.'?symb='.&escape($res->shown_symb);
                             &Apache::lonnet::escape($res->symb);  
                         $seq_str .= ('&nbsp;'x2).                          $seq_str .= ('&nbsp;'x2).
                             qq{<a target="preview" href="$link">view</a>};                              '<a target="preview" href="'.$link.'">'.&mt('view').'</a>';
                         $seq_str .= "</td></tr>\n";                          $seq_str .= "</td>". &Apache::loncommon::end_data_table_row()."\n";
                         $rb_count++;                          $rb_count++;
                     }                      }
                 }                  }
             }              }
         }          }
         if ($seq_str ne '') {          if ($seq_str ne '') {
             $Str .= '<tr><td>&nbsp</td>'.              $Str .= &Apache::loncommon::start_data_table_header_row().
                 '<td colspan="2"><b>'.$seq->compTitle.'</b></td>'.                  '<th colspan="3">'.$seq->compTitle.'</th>'.
                 "</tr>\n".$seq_str;                  &Apache::loncommon::end_data_table_header_row()."\n".$seq_str;
             if (defined($sequence_addendum)) {              if (defined($sequence_addendum)) {
                 $Str .= '<tr>'.                  $Str .= &Apache::loncommon::start_data_table_header_row().
                     ('<td>&nbsp</td>'x2).                      ('<td>&nbsp;</td>'x2).
                     '<td align="right">'.$sequence_addendum.'</td>'.                      '<td align="right">'.$sequence_addendum.'</td>'.
                     "</tr>\n";                      &Apache::loncommon::end_data_table_header_row()."\n";
             }              }
         }          }
     }      }
     $Str .= "</table>\n";      $Str .= &Apache::loncommon::end_data_table()."\n";
     return $Str;      return $Str;
 }  }
   
Line 227  sub MultipleProblemSelector { Line 231  sub MultipleProblemSelector {
     if (! defined($navmap)) {      if (! defined($navmap)) {
         $navmap = Apache::lonnavmaps::navmap->new();          $navmap = Apache::lonnavmaps::navmap->new();
         if (! defined($navmap)) {          if (! defined($navmap)) {
             $Str .=               $Str .= '<div class="LC_error">'
                 '<h1>'.&mt('Error: cannot process course structure').'</h1>';                     .&mt('Error: cannot process course structure')
                      .'</div>';
             return $Str;              return $Str;
         }          }
     }      }
     my $selected = {map { ($_,1) } (&get_selected_symbs($inputname))};      my $selected = {map { ($_,1) } (&get_selected_symbs($inputname))};
     # Header      # Header
     $Str .= <<"END";      $Str .= <<"END";
 <script language="JavaScript" type="text/javascript">  <script type="text/javascript" language="JavaScript">
     function checkall(value,seqid) {      function checkall(value,seqid) {
         for (i=0; i<document.forms.$formname.elements.length; i++) {          for (i=0; i<document.forms.$formname.elements.length; i++) {
             ele = document.forms.$formname.elements[i];              ele = document.forms.$formname.elements[i];
Line 319  sub new_accumulator { Line 324  sub new_accumulator {
                 $target.='<tr><td><label>'.                  $target.='<tr><td><label>'.
                     '<input type="checkbox" name="'.$inputname.'" ';                      '<input type="checkbox" name="'.$inputname.'" ';
                 if ($checked) {                  if ($checked) {
                     $target .= 'checked ';                      $target .= 'checked="checked" ';
                 }                  }
                 $target .= 'id="'.$seq_id.':'.$item_id++.'" ';                  $target .= 'id="'.$seq_id.':'.$item_id++.'" ';
                 $target.=                   $target.= 
                     'value="'.&Apache::lonnet::escape($res->symb).'" />'.                      'value="'.&escape($res->symb).'" />'.
                     '&nbsp;'.$res->compTitle.'</label>'.                      '&nbsp;'.$res->compTitle.'</label>'.
                     ('&nbsp;'x2).'<a target="preview" '.                      ('&nbsp;'x2).'<a target="preview" '.
                     'href="'.$res->src.'?symb='.                      'href="'.$res->link.'?symb='.
                          &Apache::lonnet::escape($res->symb).'">view</a>'.                      &escape($res->shown_symb).'">'.&mt('view').'</a>'.
                     '</td></tr>'.$/;                      '</td></tr>'.$/;
             } else {               } else { 
                 if (defined($target)) {                  if (defined($target)) {
Line 346  sub get_selected_symbs { Line 351  sub get_selected_symbs {
     my ($inputfield) = @_;      my ($inputfield) = @_;
     my $field = 'form.'.$inputfield;      my $field = 'form.'.$inputfield;
     my @symbs = (map {      my @symbs = (map {
                      &Apache::lonnet::unescape($_);                       &unescape($_);
                      } &Apache::loncommon::get_env_multiple($field));                       } &Apache::loncommon::get_env_multiple($field));
     return @symbs;      return @symbs;
 }  }
Line 373  Used by Apache::lonstathelpers::ProblemS Line 378  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 401  sub get_target_from_id { Line 406  sub get_target_from_id {
     my ($id) = @_;      my ($id) = @_;
     if (! ref($id)) {      if (! ref($id)) {
         my ($symb,$part,$respid,$resptype) = split(':',$id);          my ($symb,$part,$respid,$resptype) = split(':',$id);
         return ({ symb     => &Apache::lonnet::unescape($symb),          return ({ symb     => &unescape($symb),
                   part     => &Apache::lonnet::unescape($part),                    part     => &unescape($part),
                   respid   => &Apache::lonnet::unescape($respid),                    respid   => &unescape($respid),
                   resptype => &Apache::lonnet::unescape($resptype)});                    resptype => &unescape($resptype)});
     } elsif (ref($id) eq 'ARRAY') {      } elsif (ref($id) eq 'ARRAY') {
         my @Return;          my @Return;
         foreach my $selected (@$id) {          foreach my $selected (@$id) {
             my ($symb,$part,$respid,$resptype) = split(':',$selected);              my ($symb,$part,$respid,$resptype) = split(':',$selected);
             push(@Return,{ symb     => &Apache::lonnet::unescape($symb),              push(@Return,{ symb     => &unescape($symb),
                            part     => &Apache::lonnet::unescape($part),                             part     => &unescape($part),
                            respid   => &Apache::lonnet::unescape($respid),                             respid   => &unescape($respid),
                            resptype => &Apache::lonnet::unescape($resptype)});                             resptype => &unescape($resptype)});
         }          }
         return \@Return;          return \@Return;
     }      }
Line 431  current resource. Line 436  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', 'response', or 'part_survey'    $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 461  sub get_prev_curr_next { Line 466  sub get_prev_curr_next {
         my @resources = &get_resources($navmap,$seq);          my @resources = &get_resources($navmap,$seq);
         foreach my $res (@resources) {          foreach my $res (@resources) {
             foreach my $part (@{$res->parts}) {              foreach my $part (@{$res->parts}) {
                 if ($res->is_survey($part) && ($granularity eq 'part_survey')){                  if (($res->is_survey($part) || ($res->is_anonsurvey($part))) && 
                       ($granularity eq 'part_survey')) {
                       push (@Resource,
                             { symb     => $res->symb,
                               part     => $part,
                               resource => $res,
                           } );
    } elsif ($res->is_task($part) && ($granularity eq 'part_task')){
                     push (@Resource,                      push (@Resource,
                           { symb     => $res->symb,                            { symb     => $res->symb,
                             part     => $part,                              part     => $part,
Line 499  sub get_prev_curr_next { Line 511  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' || $granularity eq 'part_survey') {          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 514  sub get_prev_curr_next { Line 526  sub get_prev_curr_next {
         }          }
     }      }
     my $curr_item = $Resource[$curr_idx];      my $curr_item = $Resource[$curr_idx];
     if ($granularity eq 'part' || $granularity eq 'part_survey') {      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 600  sub GetStudentAnswers { Line 612  sub GetStudentAnswers {
         my $answer = &Apache::lonstathelpers::get_student_answer          my $answer = &Apache::lonstathelpers::get_student_answer
             ($resource,$sname,$sdom,$partid,$respid);              ($resource,$sname,$sdom,$partid,$respid);
         &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,          &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
                                                  &mt('last student'));                                                       'last student');
         $answers{$answer}++;          $answers{$answer}++;
         $student->{'answer'} = $answer;          $student->{'answer'} = $answer;
     }      }
Line 727  sub get_answer { Line 739  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 789  sub load_analysis_cache { Line 806  sub load_analysis_cache {
         my $storedstring;          my $storedstring;
         my %cache_db;          my %cache_db;
         if (tie(%cache_db,'GDBM_File',$cache_filename,&GDBM_READER(),0640)) {          if (tie(%cache_db,'GDBM_File',$cache_filename,&GDBM_READER(),0640)) {
             $storedstring = $cache_db{&Apache::lonnet::escape($symb)};              $storedstring = $cache_db{&escape($symb)};
             untie(%cache_db);              untie(%cache_db);
         }          }
         if (defined($storedstring)) {          if (defined($storedstring)) {
Line 841  Writes the in memory cache to disk so th Line 858  Writes the in memory cache to disk so th
 sub write_analysis_cache {  sub write_analysis_cache {
     return if (! defined($current_symb) || ! defined($cache_filename));      return if (! defined($current_symb) || ! defined($cache_filename));
     my %cache_db;      my %cache_db;
     my $key = &Apache::lonnet::escape($current_symb);      my $key = &escape($current_symb);
     if (tie(%cache_db,'GDBM_File',$cache_filename,&GDBM_WRCREAT(),0640)) {      if (tie(%cache_db,'GDBM_File',$cache_filename,&GDBM_WRCREAT(),0640)) {
         my $storestring = freeze(\%cache);          my $storestring = freeze(\%cache);
         $cache_db{$key}=$storestring;          $cache_db{$key}=$storestring;
Line 1241  sub limit_by_time_form { Line 1258  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 1304  sub manage_caches { Line 1321  sub manage_caches {
     my $sectionkey =       my $sectionkey = 
         join(',',          join(',',
              map {               map {
                      &Apache::lonnet::escape($_);                       &escape($_);
                  } sort(&Apache::lonstatistics::get_selected_sections())                   } sort(&Apache::lonstatistics::get_selected_sections())
              );               );
     my $statuskey = $Apache::lonstatistics::enrollment_status;      my $statuskey = $Apache::lonstatistics::enrollment_status;
Line 1406  sub submission_report_form { Line 1423  sub submission_report_form {
              ' enough input.');               ' enough input.');
     }      }
     my $html = $/.      my $html = $/.
         '<script type="Text/JavaScript">'.          '<script type="text/javascript" language="JavaScript">'.
         "document.Statistics.reportSelected.value='$original_report';".          "document.Statistics.reportSelected.value='$original_report';".
         '</script>'.          '</script>'.
         '<input type="hidden" name="correctans" value="true" />'.          '<input type="hidden" name="correctans" value="true" />'.

Removed from v.1.51  
changed lines
  Added in v.1.62


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