[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.44 and 1.53

version 1.44, 2005/03/14 20:28:22 version 1.53, 2006/05/30 12:46:50
Line 49  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 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->src,&escape($resource->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) = @_;      my ($AcceptedResponseTypes,$sequence_addendum) = @_;
     my $Str;      my $Str;
     $Str = "\n<table>\n";      $Str = "\n<table>\n";
     my $rb_count =0;      my $rb_count =0;
Line 154  sub problem_selector { Line 157  sub problem_selector {
                                                      respid=>$respid,                                                       respid=>$respid,
                                                      resptype=>$resptype});                                                       resptype=>$resptype});
                         my $checked = '';                          my $checked = '';
                         if ($ENV{'form.problemchoice'} eq $value) {                          if ($env{'form.problemchoice'} eq $value) {
                             $checked = 'checked ';                              $checked = 'checked ';
                         }                          }
                         my $title = $res->compTitle;                          my $title = $res->compTitle;
Line 169  sub problem_selector { Line 172  sub problem_selector {
                             $seq_str .= &mt('response').' '.$respid;                              $seq_str .= &mt('response').' '.$respid;
                         }                          }
                         my $link = $res->src.'?symb='.                          my $link = $res->src.'?symb='.
                             &Apache::lonnet::escape($res->symb);                              &escape($res->symb);
                         $seq_str .= ('&nbsp;'x2).                          $seq_str .= ('&nbsp;'x2).
                             qq{<a target="preview" href="$link">view</a>};                              qq{<a target="preview" href="$link">view</a>};
                         $seq_str .= "</td></tr>\n";                          $seq_str .= "</td></tr>\n";
Line 179  sub problem_selector { Line 182  sub problem_selector {
             }              }
         }          }
         if ($seq_str ne '') {          if ($seq_str ne '') {
             $Str .= '<tr><td>&nbsp</td><td colspan="2"><b>'.$seq->compTitle.'</b></td>'.              $Str .= '<tr><td>&nbsp</td>'.
                   '<td colspan="2"><b>'.$seq->compTitle.'</b></td>'.
                 "</tr>\n".$seq_str;                  "</tr>\n".$seq_str;
               if (defined($sequence_addendum)) {
                   $Str .= '<tr>'.
                       ('<td>&nbsp</td>'x2).
                       '<td align="right">'.$sequence_addendum.'</td>'.
                       "</tr>\n";
               }
         }          }
     }      }
     $Str .= "</table>\n";      $Str .= "</table>\n";
Line 214  and their contents.  A checkbox is provi Line 224  and their contents.  A checkbox is provi
 ####################################################  ####################################################
 sub MultipleProblemSelector {  sub MultipleProblemSelector {
     my ($navmap,$inputname,$formname)=@_;      my ($navmap,$inputname,$formname)=@_;
     my $cid = $ENV{'request.course.id'};      my $cid = $env{'request.course.id'};
     my $Str;      my $Str;
     # Massage the input as needed.      # Massage the input as needed.
     if (! defined($navmap)) {      if (! defined($navmap)) {
Line 255  END Line 265  END
     my $iterator = $navmap->getIterator(undef, undef, undef, 1);      my $iterator = $navmap->getIterator(undef, undef, undef, 1);
     my $sequence_string;      my $sequence_string;
     my $seq_id = 0;      my $seq_id = 0;
     my @Accumulator = (&new_accumulator($ENV{'course.'.$cid.'.description'},      my @Accumulator = (&new_accumulator($env{'course.'.$cid.'.description'},
                                         '',                                          '',
                                         '',                                          '',
                                         $seq_id++,                                          $seq_id++,
Line 316  sub new_accumulator { Line 326  sub new_accumulator {
                 }                  }
                 $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->src.'?symb='.
                          &Apache::lonnet::escape($res->symb).'">view</a>'.                           &escape($res->symb).'">view</a>'.
                     '</td></tr>'.$/;                      '</td></tr>'.$/;
             } else {               } else { 
                 if (defined($target)) {                  if (defined($target)) {
Line 338  sub new_accumulator { Line 348  sub new_accumulator {
 sub get_selected_symbs {  sub get_selected_symbs {
     my ($inputfield) = @_;      my ($inputfield) = @_;
     my $field = 'form.'.$inputfield;      my $field = 'form.'.$inputfield;
     my @Symbs;      my @symbs = (map {
     if (exists($ENV{$field})) {                       &unescape($_);
         if (! ref($ENV{$field})) {                       } &Apache::loncommon::get_env_multiple($field));
             @Symbs = (&Apache::lonnet::unescape($ENV{$field}));      return @symbs;
         } else {  
             @Symbs = (map {&Apache::lonnet::unescape($_);} @{$ENV{$field}});  
         }  
     }  
     return @Symbs;  
 }  }
   
 ####################################################  ####################################################
Line 371  Used by Apache::lonstathelpers::ProblemS Line 376  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 399  sub get_target_from_id { Line 404  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 429  current resource. Line 434  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 465  sub get_prev_curr_next { Line 470  sub get_prev_curr_next {
                             part     => $part,                              part     => $part,
                             resource => $res,                              resource => $res,
                         } );                          } );
    } elsif ($res->is_task($part) && ($granularity eq 'part_task')){
                       push (@Resource,
                             { symb     => $res->symb,
                               part     => $part,
                               resource => $res,
                           } );
                 } elsif ($granularity eq 'part') {                  } elsif ($granularity eq 'part') {
                     push (@Resource,                      push (@Resource,
                           { symb     => $res->symb,                            { symb     => $res->symb,
Line 497  sub get_prev_curr_next { Line 508  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 512  sub get_prev_curr_next { Line 523  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 644  sub analyze_problem_as_student { Line 655  sub analyze_problem_as_student {
     my $symb = $resource->{'symb'};      my $symb = $resource->{'symb'};
     my $analysis = &get_from_analysis_cache($sname,$sdom,$symb);      my $analysis = &get_from_analysis_cache($sname,$sdom,$symb);
     if (! defined($analysis)) {      if (! defined($analysis)) {
         my $courseid = $ENV{'request.course.id'};          my $courseid = $env{'request.course.id'};
         my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze',          my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze',
                                             'grade_domain' => $sdom,                                              'grade_domain' => $sdom,
                                             'grade_username' => $sname,                                              'grade_username' => $sname,
Line 787  sub load_analysis_cache { Line 798  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 839  Writes the in memory cache to disk so th Line 850  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 868  prior to every analysis lookup. Line 879  prior to every analysis lookup.
 #####################################################  #####################################################
 sub ensure_proper_cache {  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/'.
         'problemanalysis_'.$cid.'_analysis_cache.db';          'problemanalysis_'.$cid.'_analysis_cache.db';
     if (! defined($cache_filename) ||      if (! defined($cache_filename) ||
Line 1133  sub get_problem_data { Line 1144  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;
Line 1257  sub limit_by_time_form { Line 1268  sub limit_by_time_form {
     }       } 
     $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 1265  sub limit_by_time_form { Line 1276  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 1281  sub get_time_limits { Line 1292  sub get_time_limits {
     return ($starttime,$endtime);      return ($starttime,$endtime);
 }  }
   
   
   
 ####################################################  
 ####################################################  
   
 =pod  
   
 =item sections_description   
   
 Inputs: @Sections, an array of sections  
   
 Returns: A plaintext description of the sections selected.  
   
 =cut  
   
 ####################################################  
 ####################################################  
 sub sections_description {  
     my @Sections = @_;  
     my $sectionstring = '';  
     if (scalar(@Sections) > 1) {  
         if (scalar(@Sections) > 2) {  
             my $last = pop(@Sections);  
             $sectionstring = "Sections ".join(', ',@Sections).', and '.$last;  
         } else {  
             $sectionstring = "Sections ".join(' and ',@Sections);  
         }  
     } else {  
         if ($Sections[0] eq 'all') {  
             $sectionstring = "All sections";  
         } else {  
             $sectionstring = "Section ".$Sections[0];  
         }  
     }  
     return $sectionstring;  
 }  
   
 ####################################################  ####################################################
 ####################################################  ####################################################
   
Line 1339  sub manage_caches { Line 1313  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;
     if (exists($ENV{'form.ClearCache'}) ||       if (exists($env{'form.ClearCache'}) || 
         exists($ENV{'form.updatecaches'}) ||           exists($env{'form.updatecaches'}) || 
         (exists($ENV{'form.firstrun'}) && $ENV{'form.firstrun'} ne 'no') ||          (exists($env{'form.firstrun'}) && $env{'form.firstrun'} ne 'no') ||
         (exists($ENV{'form.prevsection'}) &&          (exists($env{'form.prevsection'}) &&
             $ENV{'form.prevsection'} ne $sectionkey) ||              $env{'form.prevsection'} ne $sectionkey) ||
         (exists($ENV{'form.prevenrollstatus'}) &&          (exists($env{'form.prevenrollstatus'}) &&
             $ENV{'form.prevenrollstatus'} ne $statuskey)              $env{'form.prevenrollstatus'} ne $statuskey)
         ) {          ) {
         if (defined($update_message)) {          if (defined($update_message)) {
             $r->print($update_message);              $r->print($update_message);
Line 1370  sub manage_caches { Line 1344  sub manage_caches {
          '<input type="hidden" name="prevenrollstatus" value="'.$statuskey.'" />'           '<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" />');
Line 1403  sub gather_full_student_data { Line 1377  sub gather_full_student_data {
         return if ($c->aborted());          return if ($c->aborted());
         my $status = &Apache::loncoursedata::ensure_current_full_data          my $status = &Apache::loncoursedata::ensure_current_full_data
             ($student->{'username'},$student->{'domain'},              ($student->{'username'},$student->{'domain'},
              $ENV{'request.course.id'});               $env{'request.course.id'});
         &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,          &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
                                                  &mt('last student'));                                                   &mt('last student'));
     }      }
Line 1450  sub submission_report_form { Line 1424  sub submission_report_form {
     my $output_selector = $/.'<select name="output">'.$/;      my $output_selector = $/.'<select name="output">'.$/;
     foreach ('HTML','Excel','CSV') {      foreach ('HTML','Excel','CSV') {
         $output_selector .= '    <option value="'.lc($_).'"';          $output_selector .= '    <option value="'.lc($_).'"';
         if ($ENV{'form.output'} eq lc($_)) {          if ($env{'form.output'} eq lc($_)) {
             $output_selector .= ' selected ';              $output_selector .= ' selected ';
         }          }
         $output_selector .='>'.&mt($_).'</option>'.$/;          $output_selector .='>'.&mt($_).'</option>'.$/;
Removed from v.1.44  
changed lines
  Added in v.1.53

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