File:  [LON-CAPA] / loncom / interface / lonstatistics.pm
Revision 1.80: download - view: text, annotated - select for diffs
Fri Aug 29 21:11:25 2003 UTC (20 years, 9 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
Moved CreateAndParseOutputSelector from lonproblemstatistics to
lonstatistics as I intend to use it elsewhere in the statistics universe.

    1: # The LearningOnline Network with CAPA
    2: #
    3: # $Id: lonstatistics.pm,v 1.80 2003/08/29 21:11:25 matthew Exp $
    4: #
    5: # Copyright Michigan State University Board of Trustees
    6: #
    7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    8: #
    9: # LON-CAPA is free software; you can redistribute it and/or modify
   10: # it under the terms of the GNU General Public License as published by
   11: # the Free Software Foundation; either version 2 of the License, or
   12: # (at your option) any later version.
   13: #
   14: # LON-CAPA is distributed in the hope that it will be useful,
   15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   17: # GNU General Public License for more details.
   18: #
   19: # You should have received a copy of the GNU General Public License
   20: # along with LON-CAPA; if not, write to the Free Software
   21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   22: #
   23: # /home/httpd/html/adm/gpl.txt
   24: #
   25: # http://www.lon-capa.org/
   26: #
   27: # (Navigate problems for statistical reports
   28: #
   29: ###
   30: 
   31: =pod
   32: 
   33: =head1 NAME
   34: 
   35: lonstatistics
   36: 
   37: =head1 SYNOPSIS
   38: 
   39: Main handler for statistics and chart.
   40: 
   41: =head1 PACKAGES USED
   42: 
   43:     use strict;
   44:     use Apache::Constants qw(:common :http);
   45:     use Apache::lonnet();
   46:     use Apache::lonhomework;
   47:     use Apache::loncommon;
   48:     use Apache::loncoursedata;
   49:     use Apache::lonhtmlcommon;
   50:     use Apache::lonproblemanalysis;
   51:     use Apache::lonproblemstatistics;
   52:     use Apache::lonstudentassessment;
   53:     use Apache::lonpercentage;
   54:     use Apache::lonmysql;
   55: =over 4
   56: 
   57: =cut
   58: 
   59: package Apache::lonstatistics;
   60: 
   61: use strict;
   62: use Apache::Constants qw(:common :http);
   63: use vars qw(
   64:     @FullClasslist 
   65:     @Students
   66:     @Sections 
   67:     @SelectedSections
   68:     %StudentData
   69:     @StudentDataOrder
   70:     @SelectedStudentData
   71:     $top_map 
   72:     @Sequences 
   73:     @SelectedMaps
   74:     @Assessments);
   75: 
   76: use Apache::lonnet();
   77: use Apache::lonhomework;
   78: use Apache::loncommon;
   79: use Apache::loncoursedata;
   80: use Apache::lonhtmlcommon;
   81: use Apache::lonproblemanalysis();
   82: use Apache::lonproblemstatistics();
   83: use Apache::lonstudentassessment();
   84: use Apache::lonpercentage;
   85: use Apache::lonmysql;
   86: use Time::HiRes;
   87: 
   88: #######################################################
   89: #######################################################
   90: 
   91: =pod
   92: 
   93: =item Package Variables
   94: 
   95: =item @FullClasslist The full classlist
   96: 
   97: =item @Students The students we are concerned with for this invocation
   98: 
   99: =item @Sections The sections available in this class
  100: 
  101: =item $curr_student The student currently being examined
  102: 
  103: =item $prev_student The student previous in the classlist
  104: 
  105: =item $next_student The student next in the classlist
  106: 
  107: =over
  108: 
  109: =cut 
  110: 
  111: #######################################################
  112: #######################################################
  113: #
  114: # Classlist variables
  115: #
  116: my $curr_student;
  117: my $prev_student;
  118: my $next_student;
  119: 
  120: #######################################################
  121: #######################################################
  122: 
  123: =pod
  124: 
  125: =item &clear_classlist_variables()
  126: 
  127: undef the following package variables:
  128: 
  129: =over
  130: 
  131: =item @FullClasslist
  132: 
  133: =item @Students
  134: 
  135: =item @Sections
  136: 
  137: =item @SelectedSections
  138: 
  139: =item %StudentData
  140: 
  141: =item @StudentDataOrder
  142: 
  143: =item @SelectedStudentData
  144: 
  145: =item $curr_student
  146: 
  147: =item $prev_student
  148: 
  149: =item $next_student
  150: 
  151: =back
  152: 
  153: =cut
  154: 
  155: #######################################################
  156: #######################################################
  157: sub clear_classlist_variables {
  158:     undef(@FullClasslist);
  159:     undef(@Students);
  160:     undef(@Sections);
  161:     undef(@SelectedSections);
  162:     undef(%StudentData);
  163:     undef(@SelectedStudentData);
  164:     undef($curr_student);
  165:     undef($prev_student);
  166:     undef($next_student);
  167: }
  168: 
  169: #######################################################
  170: #######################################################
  171: 
  172: =pod
  173: 
  174: =item &PrepareClasslist()
  175: 
  176: Build up the classlist information.  The classlist information is kept in
  177: the following package variables:
  178: 
  179: =over
  180: 
  181: =item @FullClasslist
  182: 
  183: =item @Students
  184: 
  185: =item @Sections
  186: 
  187: =item @SelectedSections
  188: 
  189: =item %StudentData
  190: 
  191: =item @SelectedStudentData
  192: 
  193: =item $curr_student
  194: 
  195: =item $prev_student
  196: 
  197: =item $next_student
  198: 
  199: =back
  200: 
  201: $curr_student, $prev_student, and $next_student may not be defined, depending
  202: upon the calling context.
  203: 
  204: =cut
  205: 
  206: #######################################################
  207: #######################################################
  208: sub PrepareClasslist {
  209:     my %Sections;
  210:     &clear_classlist_variables();
  211:     #
  212:     # Retrieve the classlist
  213:     my $cid  = $ENV{'request.course.id'};
  214:     my $cdom = $ENV{'course.'.$cid.'.domain'};
  215:     my $cnum = $ENV{'course.'.$cid.'.num'};
  216:     my ($classlist,$field_names) = &Apache::loncoursedata::get_classlist($cid,
  217:                                                                   $cdom,$cnum);
  218:     if (exists($ENV{'form.Section'})) {
  219:         if (ref($ENV{'form.Section'})) {
  220:             @SelectedSections = @{$ENV{'form.Section'}};
  221:         } elsif ($ENV{'form.Section'} !~ /^\s*$/) {
  222:             @SelectedSections = ($ENV{'form.Section'});
  223:         }
  224:     }
  225:     @SelectedSections = ('all') if (! @SelectedSections);
  226:     foreach (@SelectedSections) {
  227:         if ($_ eq 'all') {
  228:             @SelectedSections = ('all');
  229:         }
  230:     }
  231:     #
  232:     # Deal with instructors with restricted section access
  233:     if ($ENV{'request.course.sec'} !~ /^\s*$/) {
  234:         @SelectedSections = ($ENV{'request.course.sec'});
  235:     }
  236:     #
  237:     # Set up %StudentData
  238:     @StudentDataOrder = qw/fullname username domain id section status/;
  239:     foreach my $field (@StudentDataOrder) {
  240:         $StudentData{$field}->{'title'} = $field;
  241:         $StudentData{$field}->{'base_width'} = length($field);
  242:         $StudentData{$field}->{'width'} = 
  243:                                $StudentData{$field}->{'base_width'};
  244:     }
  245:     #
  246:     # get the status requested
  247:     my $requested_status = 'Active';
  248:     $requested_status = $ENV{'form.Status'} if (exists($ENV{'form.Status'}));
  249:     #
  250:     # Process the classlist
  251:     while (my ($student,$student_data) = each (%$classlist)) {
  252:         my $studenthash = ();
  253:         for (my $i=0; $i< scalar(@$field_names);$i++) {
  254:             my $field = $field_names->[$i];
  255:             # Store the data
  256:             $studenthash->{$field}=$student_data->[$i];
  257:             # Keep track of the width of the fields
  258:             next if (! exists($StudentData{$field}));
  259:             my $length = length($student_data->[$i]);
  260:             if ($StudentData{$field}->{'width'} < $length) {
  261:                 $StudentData{$field}->{'width'} = $length; 
  262:             }
  263:         }
  264:         push (@FullClasslist,$studenthash);
  265:         #
  266:         # Build up a list of sections
  267:         my $section = $studenthash->{'section'};
  268:         if (! defined($section) || $section =~/^\s*$/ || $section == -1) {
  269:             $studenthash->{'section'} = 'none';
  270:             $section = $studenthash->{'section'};
  271:         }
  272:         $Sections{$section}++;
  273:         #
  274:         # Only put in the list those students we are interested in
  275:         foreach my $sect (@SelectedSections) {
  276:             if ( (($sect eq 'all') || 
  277:                   ($section eq $sect)) &&
  278:                  (($studenthash->{'status'} eq $requested_status) || 
  279:                   ($requested_status eq 'Any')) 
  280:                  ){
  281:                 push (@Students,$studenthash);
  282:                 last;
  283:             }
  284:         }
  285:     }
  286:     #
  287:     # Put the consolidated section data in the right place
  288:     if ($ENV{'request.course.sec'} !~ /^\s*$/) {
  289:         @Sections = ($ENV{'request.course.sec'});
  290:     } else {
  291:         @Sections = sort {$a cmp $b} keys(%Sections);
  292:         unshift(@Sections,'all'); # Put 'all' at the front of the list
  293:     }
  294:     #
  295:     # Sort the Students
  296:     my $sortby = 'fullname';
  297:     $sortby = $ENV{'form.sort'} if (exists($ENV{'form.sort'}));
  298:     my @TmpStudents = sort { $a->{$sortby} cmp $b->{$sortby} ||
  299:                              $a->{'fullname'} cmp $b->{'fullname'} } @Students;
  300:     @Students = @TmpStudents;
  301:     # 
  302:     # Now deal with that current student thing....
  303:     $curr_student = undef;
  304:     if (exists($ENV{'form.SelectedStudent'})) {
  305:         my ($current_uname,$current_dom) = 
  306:             split(':',$ENV{'form.SelectedStudent'});
  307:         my $i;
  308:         for ($i = 0; $i<=$#Students; $i++) {
  309:             next if (($Students[$i]->{'username'} ne $current_uname) || 
  310:                      ($Students[$i]->{'domain'}   ne $current_dom));
  311:             $curr_student = $Students[$i];
  312:             last; # If we get here, we have our student.
  313:         }
  314:         if (defined($curr_student)) {
  315:             if ($i == 0) {
  316:                 $prev_student = undef;
  317:             } else {
  318:                 $prev_student = $Students[$i-1];
  319:             }
  320:             if ($i == $#Students) {
  321:                 $next_student = undef;
  322:             } else {
  323:                 $next_student = $Students[$i+1];
  324:             }
  325:         }
  326:     }
  327:     #
  328:     if (exists($ENV{'form.StudentData'})) {
  329:         if (ref($ENV{'form.StudentData'}) eq 'ARRAY') {
  330:             @SelectedStudentData = @{$ENV{'form.StudentData'}};
  331:         } else {
  332:             @SelectedStudentData = ($ENV{'form.StudentData'});
  333:         }
  334:     } else {
  335:         @SelectedStudentData = ('username');
  336:     }
  337:     foreach (@SelectedStudentData) {
  338:         if ($_ eq 'all') {
  339:             @SelectedStudentData = ('all');
  340:             last;
  341:         }
  342:     }
  343:     #
  344:     return;
  345: }
  346: 
  347: 
  348: #######################################################
  349: #######################################################
  350: 
  351: =pod
  352: 
  353: =item get_students
  354: 
  355: Returns a list of the selected students
  356: 
  357: =cut
  358: 
  359: #######################################################
  360: #######################################################
  361: sub get_students {
  362:     if (! @Students) {
  363:         &PrepareClasslist()
  364:     }
  365:     return @Students;
  366: }
  367: 
  368: #######################################################
  369: #######################################################
  370: 
  371: =pod
  372: 
  373: =item &current_student()
  374: 
  375: Returns a pointer to a hash containing data about the currently
  376: selected student.
  377: 
  378: =cut
  379: 
  380: #######################################################
  381: #######################################################
  382: sub current_student { 
  383:     return $curr_student;
  384: }
  385: 
  386: #######################################################
  387: #######################################################
  388: 
  389: =pod
  390: 
  391: =item &previous_student()
  392: 
  393: Returns a pointer to a hash containing data about the student prior
  394: in the list of students.  Or something.  
  395: 
  396: =cut
  397: 
  398: #######################################################
  399: #######################################################
  400: sub previous_student { 
  401:     return $prev_student;
  402: }
  403: 
  404: #######################################################
  405: #######################################################
  406: 
  407: =pod
  408: 
  409: =item &next_student()
  410: 
  411: Returns a pointer to a hash containing data about the next student
  412: to be viewed.
  413: 
  414: =cut
  415: 
  416: #######################################################
  417: #######################################################
  418: sub next_student { 
  419:     return $next_student;
  420: }
  421: 
  422: #######################################################
  423: #######################################################
  424: 
  425: =pod
  426: 
  427: =item &clear_sequence_variables()
  428: 
  429: =cut
  430: 
  431: #######################################################
  432: #######################################################
  433: sub clear_sequence_variables {
  434:     undef($top_map);
  435:     undef(@Sequences);
  436:     undef(@Assessments);
  437: }
  438: 
  439: #######################################################
  440: #######################################################
  441: 
  442: =pod
  443: 
  444: =item &SetSelectedMaps($elementname)
  445: 
  446: Sets the @SelectedMaps array from $ENV{'form.'.$elementname};
  447: 
  448: =cut
  449: 
  450: #######################################################
  451: #######################################################
  452: sub SetSelectedMaps {
  453:     my $elementname = shift;
  454:     if (exists($ENV{'form.'.$elementname})) {
  455:         if (ref($ENV{'form.'.$elementname})) {
  456:             @SelectedMaps = @{$ENV{'form.'.$elementname}};
  457:         } else {
  458:             @SelectedMaps = ($ENV{'form.'.$elementname});
  459:         }
  460:     } else {
  461:         @SelectedMaps = ('all');
  462:     }
  463: }
  464: 
  465: 
  466: #######################################################
  467: #######################################################
  468: 
  469: =pod
  470: 
  471: =item &Sequences_with_Assess()
  472: 
  473: Returns an array containing the subset of @Sequences which contain
  474: assessments.
  475: 
  476: =cut
  477: 
  478: #######################################################
  479: #######################################################
  480: sub Sequences_with_Assess {
  481:     my @Sequences_to_Show;
  482:     foreach my $map_symb (@SelectedMaps) {
  483:         foreach my $sequence (@Sequences) {
  484:             next if ($sequence->{'symb'} ne $map_symb && $map_symb ne 'all');
  485:             next if ($sequence->{'num_assess'} < 1);
  486:             push (@Sequences_to_Show,$sequence);
  487:         }
  488:     }
  489:     return @Sequences_to_Show;
  490: }
  491: 
  492: #######################################################
  493: #######################################################
  494: 
  495: =pod
  496: 
  497: =item &PrepareCourseData($r)
  498: 
  499: =cut
  500: 
  501: #######################################################
  502: #######################################################
  503: sub PrepareCourseData {
  504:     my ($r) = @_;
  505:     &clear_sequence_variables();
  506:     my ($top,$sequences,$assessments) = 
  507:         &Apache::loncoursedata::get_sequence_assessment_data();
  508:     if (! defined($top) || ! ref($top)) {
  509:         # There has been an error, better report it
  510:         &Apache::lonnet::logthis('top is undefined');
  511:         return;
  512:     }
  513:     $top_map = $top if (ref($top));
  514:     @Sequences = @{$sequences} if (ref($sequences) eq 'ARRAY');
  515:     @Assessments = @{$assessments} if (ref($assessments) eq 'ARRAY');
  516:     #
  517:     # Compute column widths
  518:     foreach my $seq (@Sequences) {
  519:         my $name_length = length($seq->{'title'});
  520:         my $num_parts = $seq->{'num_assess_parts'};
  521:         #
  522:         # Use 3 digits for each the sum and total, which means 7 total...
  523:         my $num_col = $num_parts+7;
  524:         if ($num_col < $name_length) {
  525:             $num_col = $name_length;
  526:         }
  527:         $seq->{'base_width'} = $name_length;
  528:         $seq->{'width'} = $num_col;
  529:     }
  530:     return;
  531: }
  532: 
  533: #######################################################
  534: #######################################################
  535: 
  536: =pod
  537: 
  538: =item &log_sequence($sequence,$recursive,$padding)
  539: 
  540: Write data about the sequence to a logfile.  If $recursive is not
  541: undef the data is written recursively.  $padding is used for recursive
  542: calls.
  543: 
  544: =cut
  545: 
  546: #######################################################
  547: #######################################################
  548: sub log_sequence {
  549:     my ($seq,$recursive,$padding) = @_;
  550:     $padding = '' if (! defined($padding));
  551:     if (ref($seq) ne 'HASH') {
  552:         &Apache::lonnet::logthis('log_sequence passed bad sequnce');
  553:         return;
  554:     }
  555:     &Apache::lonnet::logthis($padding.'sequence '.$seq->{'title'});
  556:     while (my($key,$value) = each(%$seq)) {
  557:         next if ($key eq 'contents');
  558:         if (ref($value) eq 'ARRAY') {
  559:             for (my $i=0;$i< scalar(@$value);$i++) {
  560:                 &Apache::lonnet::logthis($padding.$key.'['.$i.']='.
  561:                                          $value->[$i]);
  562:             }
  563:         } else {
  564:             &Apache::lonnet::logthis($padding.$key.'='.$value);
  565:         }
  566:     }
  567:     if (defined($recursive)) {
  568:         &Apache::lonnet::logthis($padding.'-'x20);
  569:         &Apache::lonnet::logthis($padding.'contains:');
  570:         foreach my $item (@{$seq->{'contents'}}) {
  571:             if ($item->{'type'} eq 'container') {
  572:                 &log_sequence($item,$recursive,$padding.'    ');
  573:             } else {
  574:                 &Apache::lonnet::logthis($padding.'title = '.$item->{'title'});
  575:                 while (my($key,$value) = each(%$item)) {
  576:                     next if ($key eq 'title');
  577:                     if (ref($value) eq 'ARRAY') {
  578:                         for (my $i=0;$i< scalar(@$value);$i++) {
  579:                             &Apache::lonnet::logthis($padding.$key.'['.$i.']='.
  580:                                                      $value->[$i]);
  581:                         }
  582:                     } else {
  583:                         &Apache::lonnet::logthis($padding.$key.'='.$value);
  584:                     }
  585:                 }
  586:             }
  587:         }
  588:         &Apache::lonnet::logthis($padding.'end contents of '.$seq->{'title'});
  589:         &Apache::lonnet::logthis($padding.'-'x20);
  590:     }
  591:     return;
  592: }
  593: 
  594: ##############################################
  595: ##############################################
  596: 
  597: =pod 
  598: 
  599: =item &StudentDataSelect($elementname,$status,$numvisible,$selected)
  600: 
  601: Returns html for a selection box allowing the user to choose one (or more) 
  602: of the fields of student data available (fullname, username, id, section, etc)
  603: 
  604: =over 4
  605: 
  606: =item $elementname The name of the HTML form element
  607: 
  608: =item $status 'multiple' or 'single' selection box
  609: 
  610: =item $numvisible The number of options to be visible
  611: 
  612: =back
  613: 
  614: =cut
  615: 
  616: ##############################################
  617: ##############################################
  618: sub StudentDataSelect {
  619:     my ($elementname,$status,$numvisible)=@_;
  620:     if ($numvisible < 1) {
  621:         return;
  622:     }
  623:     #
  624:     # Build the form element
  625:     my $Str = "\n";
  626:     $Str .= '<select name="'.$elementname.'" ';
  627:     if ($status ne 'single') {
  628:         $Str .= 'multiple="true" ';
  629:     }
  630:     $Str .= 'size="'.$numvisible.'" >'."\n";
  631:     #
  632:     # Deal with 'all'
  633:     $Str .= '    <option value="all" ';
  634:     foreach (@SelectedStudentData) {
  635:         if ($_ eq 'all') {
  636:             $Str .= 'selected ';
  637:             last;
  638:         }
  639:     }
  640:     $Str .= ">all</option>\n";
  641:     #
  642:     # Loop through the student data fields
  643:     foreach my $item (@StudentDataOrder) {
  644:         $Str .= '    <option value="'.$item.'" ';
  645:         foreach (@SelectedStudentData) {
  646:             if ($item eq $_ ) {
  647:                 $Str .= 'selected ';
  648:                 last;
  649:             }
  650:         }
  651:         $Str .= '>'.$item."</option>\n";
  652:     }
  653:     $Str .= "</select>\n";
  654:     return $Str;
  655: }
  656: 
  657: ##############################################
  658: ##############################################
  659: 
  660: =pod 
  661: 
  662: =item &MapSelect($elementname,$status,$numvisible,$restriction) 
  663: 
  664: Returns html for a selection box allowing the user to choose one (or more) 
  665: of the sequences in the course.  The values of the sequences are the symbs.
  666: If the top sequence is selected, the value 'top' will result.
  667: 
  668: =over 4
  669: 
  670: =item $elementname The name of the HTML form element
  671: 
  672: =item $status 'multiple' or 'single' selection box
  673: 
  674: =item $numvisible The number of options to be visible
  675: 
  676: =item $restriction Code reference to subroutine which returns true or 
  677: false.  The code must expect a reference to a sequence data structure.
  678: 
  679: =back
  680: 
  681: =cut
  682: 
  683: ##############################################
  684: ##############################################
  685: sub MapSelect {
  686:     my ($elementname,$status,$numvisible,$restriction)=@_;
  687:     if ($numvisible < 1) {
  688:         return;
  689:     }
  690:     #
  691:     # Set up array of selected items
  692:     &SetSelectedMaps($elementname);
  693:     #
  694:     # Set up the restriction call
  695:     if (! defined($restriction)) {
  696:         $restriction = sub { 1; };
  697:     }
  698:     #
  699:     # Build the form element
  700:     my $Str = "\n";
  701:     $Str .= '<select name="'.$elementname.'" ';
  702:     if ($status ne 'single') {
  703:         $Str .= 'multiple="true" ';
  704:     }
  705:     $Str .= 'size="'.$numvisible.'" >'."\n";
  706:     #
  707:     # Deal with 'all'
  708:     foreach (@SelectedMaps) {
  709:         if ($_ eq 'all') {
  710:             @SelectedMaps = ('all');
  711:             last;
  712:         }
  713:     }
  714:     #
  715:     # Put in option for 'all'
  716:     $Str .= '    <option value="all" ';
  717:     foreach (@SelectedMaps) {
  718:         if ($_ eq 'all') {
  719:             $Str .= 'selected ';
  720:             last;
  721:         }
  722:     }
  723:     $Str .= ">all</option>\n";
  724:     #
  725:     # Loop through the sequences
  726:     foreach my $seq (@Sequences) {
  727:         next if (! $restriction->($seq));
  728:         $Str .= '    <option value="'.$seq->{'symb'}.'" ';
  729:         foreach (@SelectedMaps) {
  730:             if ($seq->{'symb'} eq $_) {
  731:                 $Str .= 'selected ';
  732:                 last;
  733:             }
  734:         }
  735:         $Str .= '>'.$seq->{'title'}."</option>\n";
  736:     }
  737:     $Str .= "</select>\n";
  738:     return $Str;
  739: }
  740: 
  741: ##############################################
  742: ##############################################
  743: 
  744: =pod 
  745: 
  746: =item &SectionSelect($elementname,$status,$numvisible) 
  747: 
  748: Returns html for a selection box allowing the user to choose one (or more) 
  749: of the sections in the course.  
  750: 
  751: Uses the package variables @Sections and @SelectedSections
  752: =over 4
  753: 
  754: =item $elementname The name of the HTML form element
  755: 
  756: =item $status 'multiple' or 'single' selection box
  757: 
  758: =item $numvisible The number of options to be visible
  759: 
  760: =back
  761: 
  762: =cut
  763: 
  764: ##############################################
  765: ##############################################
  766: sub SectionSelect {
  767:     my ($elementname,$status,$numvisible)=@_;
  768:     if ($numvisible < 1) {
  769:         return;
  770:     }
  771:     #
  772:     # Make sure we have the data we need to continue
  773:     if (! @Sections) {
  774:         &PrepareClasslist()
  775:     }
  776:     #
  777:     # Build the form element
  778:     my $Str = "\n";
  779:     $Str .= '<select name="'.$elementname.'" ';
  780:     if ($status ne 'single') {
  781:         $Str .= 'multiple="true" ';
  782:     }
  783:     $Str .= 'size="'.$numvisible.'" >'."\n";
  784:     #
  785:     # Loop through the sequences
  786:     foreach my $s (@Sections) {
  787:         $Str .= '    <option value="'.$s.'" ';
  788:         foreach (@SelectedSections) {
  789:             if ($s eq $_) {
  790:                 $Str .= 'selected ';
  791:                 last;
  792:             }
  793:         }
  794:         $Str .= '>'.$s."</option>\n";
  795:     }
  796:     $Str .= "</select>\n";
  797:     return $Str;
  798: }
  799: 
  800: #######################################################
  801: #######################################################
  802: 
  803: =pod
  804: 
  805: =item &CreateAndParseOutputSelector()
  806: 
  807: Construct a selection list of options for output and parse output selections.
  808: 
  809: =cut
  810: 
  811: #######################################################
  812: #######################################################
  813: sub OutputDescriptions {
  814:     my (@OutputOptions) = @_;
  815:     my $Str = '';
  816:     $Str .= "<h2>Output Modes</h2>\n";
  817:     $Str .= "<dl>\n";
  818:     foreach my $outputmode (@OutputOptions) {
  819: 	$Str .="    <dt>".$outputmode->{'name'}."</dt>\n";
  820: 	$Str .="        <dd>".$outputmode->{'description'}."</dd>\n";
  821:     }
  822:     $Str .= "</dl>\n";
  823:     return $Str;
  824: }
  825: 
  826: sub CreateAndParseOutputSelector {
  827:     my ($elementname,$default,@OutputOptions) = @_;
  828:     my $output_mode;
  829:     my $show;
  830:     my $Str = '';
  831:     #
  832:     # Format for output options is 'mode, restrictions';
  833:     my $selected = $default;
  834:     if (exists($ENV{'form.'.$elementname})) {
  835:         if (ref($ENV{'form.'.$elementname} eq 'ARRAY')) {
  836:             $selected = $ENV{'form.'.$elementname}->[0];
  837:         } else {
  838:             $selected = $ENV{'form.'.$elementname};
  839:         }
  840:     }
  841:     #
  842:     # Set package variables describing output mode
  843:     $output_mode = 'html';
  844:     $show        = 'all';
  845:     foreach my $option (@OutputOptions) {
  846:         next if ($option->{'value'} ne $selected);
  847:         $output_mode = $option->{'mode'};
  848:         $show        = $option->{'show'};
  849:     }
  850:     #
  851:     # Build the form element
  852:     $Str = qq/<select size="5" name="$elementname">/;
  853:     foreach my $option (@OutputOptions) {
  854:         if (exists($option->{'special'}) && 
  855:             $option->{'special'} =~ /do not show/) {
  856:             next;
  857:         }
  858:         $Str .= "\n".'    <option value="'.$option->{'value'}.'"';
  859:         $Str .= " selected " if ($option->{'value'} eq $selected);
  860:         $Str .= ">".$option->{'name'}."<\/option>";
  861:     }
  862:     $Str .= "\n</select>";
  863:     return ($Str,$output_mode,$show);
  864: }
  865: 
  866: ###############################################
  867: ###############################################
  868: 
  869: =pod 
  870: 
  871: =item &Gather_Student_Data()
  872: 
  873: Ensures all student data is up to date.
  874: 
  875: =cut
  876: 
  877: ###############################################
  878: ###############################################
  879: sub Gather_Student_Data {
  880:     my ($r) = @_;
  881:     my $c = $r->connection();
  882:     #
  883:     my @Sequences = &Apache::lonstatistics::Sequences_with_Assess();
  884:     #
  885:     my @Students = @Apache::lonstatistics::Students;
  886:     #
  887:     # Open the progress window
  888:     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin
  889:         ($r,'Statistics Compilation Status',
  890:          'Statistics Compilation Progress', scalar(@Students));
  891:     #
  892:     while (my $student = shift @Students) {
  893:         return if ($c->aborted());
  894:         my ($status,undef) = &Apache::loncoursedata::ensure_current_data
  895:             ($student->{'username'},$student->{'domain'},
  896:              $ENV{'request.course.id'});
  897:         &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
  898:                                                  'last student');
  899:     }
  900:     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
  901:     $r->rflush();
  902: }
  903: 
  904: ##################################################
  905: ##################################################
  906: sub DisplayClasslist {
  907:     my ($r)=@_;
  908:     #
  909:     my @Fields = ('fullname','username','domain','id','section');
  910:     #
  911:     my $Str='';
  912:     if (! @Students) {
  913:         if ($SelectedSections[0] eq 'all') { 
  914:             if (lc($ENV{'form.Status'}) eq 'any') {
  915:                 $Str .= '<h2>There are no students in the course.</h2>';
  916:             } elsif (lc($ENV{'form.Status'}) eq 'active') {
  917:                 $Str .= '<h2>There are no currently enrolled students in '.
  918:                     'the course.</h2>';
  919:             } elsif (lc($ENV{'form.Status'}) eq 'expired') {
  920:                 $Str .= '<h2>There are no previously enrolled '.
  921:                     'students in the course.</h2>';
  922:             }
  923:         } else { 
  924:             my $sections;
  925:             if (@SelectedSections == 1) {
  926:                 $sections = 'section '.$SelectedSections[0];
  927:             } elsif (@SelectedSections > 2) {
  928:                 $sections = 'sections '.join(', ',@SelectedSections);
  929:                 $sections =~ s/, ([^,])*$/, and $1/;
  930:             } else {
  931:                 $sections = 'sections '.join(' and ',@SelectedSections);
  932:             }
  933:             if (lc($ENV{'form.Status'}) eq 'any') {
  934:                 $Str .= '<h2>There are no students in '.$sections.'.</h2>';
  935:             } elsif (lc($ENV{'form.Status'}) eq 'active') {
  936:                 $Str .= '<h2>There are no currently enrolled students '.
  937:                     'in '.$sections.'.</h2>';
  938:             } elsif (lc($ENV{'form.Status'}) eq 'expired') {
  939:                 $Str .= '<h2>There are no previously enrolled students '.
  940:                     'in '.$sections.'.</h2>';
  941:             }
  942:         }
  943:         $Str.= '<a href="/adm/statistics?reportSelected=student_assessment">'.
  944:             'Return to the chart.</a>';
  945:         $r->print($Str);
  946:         $r->rflush();
  947:         return;
  948:     }
  949: 
  950:     # "Click" is asinine but it is probably not my place to change the world.
  951:     $Str .= '<h2>Click on a students name or username to view their chart</h2>';
  952:     $Str .= '<table border="0"><tr><td bgcolor="#777777">'."\n";
  953:     $Str .= '<table border="0" cellpadding="3"><tr bgcolor="#e6ffff">'."\n";
  954:     foreach my $field (@Fields) {
  955:         $Str .= '<th><a href="/adm/statistics?reportSelected=classlist&sort='.$field.'">'.$field.
  956:             '</a></th>';
  957:     }
  958:     $Str .= '</tr>'."\n";
  959:     #
  960:     my $alternate = 0;
  961:     foreach my $student (@Students) { # @Students is a package variable
  962:         my $sname = $student->{'username'}.':'.$student->{'domain'};
  963:         if($alternate) {
  964:             $Str .= '<tr bgcolor="#ffffe6">';
  965:         } else {
  966:             $Str .= '<tr bgcolor="#ffffc6">';
  967:         }
  968:         $alternate = ($alternate + 1) % 2;
  969:         #
  970:         foreach my $field (@Fields) {
  971:             $Str .= '<td>';
  972:             if ($field eq 'fullname' || $field eq 'username') {
  973:                 $Str .= '<a href="/adm/statistics?reportSelected=';
  974:                 $Str .= &Apache::lonnet::escape('student_assessment');
  975:                 $Str .= '&sort='.&Apache::lonnet::escape($ENV{'form.sort'});
  976:                 $Str .= '&SelectedStudent=';
  977:                 $Str .= &Apache::lonnet::escape($sname).'">';
  978:                 $Str .= $student->{$field}.'&nbsp';
  979:                 $Str .= '</a>';
  980:             } else {
  981:                 $Str .= $student->{$field};
  982:             }
  983:             $Str .= '</td>';
  984:         }
  985:         $Str .= "</tr>\n";
  986:     }
  987:     $Str .= '</table></td></tr></table>'."\n";
  988:     #
  989:     $r->print($Str);
  990:     $r->rflush();
  991:     #
  992:     return;
  993: }
  994: 
  995: ##############################################
  996: ##############################################
  997: sub CreateMainMenu {
  998:     my ($status,$reports,$current)=@_;
  999:     #
 1000:     my $Str = '';
 1001:     #
 1002:     $Str  = '<input type="hidden" name="reportSelected" value="'.$current.'">';
 1003: #    $Str .= '<table border="0"><tbody><tr>'."\n";
 1004: #    $Str .= '<td align="center"><b>Report:</b></td>'."\n";
 1005: #    $Str .= '<td align="center">';
 1006: #    $Str .= '<select name="reportSelected" '.
 1007: #        'onchange="document.Statistics.submit()">'."\n";
 1008: #    foreach (sort(keys(%$reports))) {
 1009: #        $Str .= '<option value="'.$_.'"';
 1010: #        if($current eq $_) {
 1011: #            $Str .= ' selected';
 1012: #        }
 1013: #        $Str .= '>'.$reports->{$_}.'</option>'."\n";
 1014: #    }
 1015: #    $Str .= '</select></td>'."\n";
 1016: #    #
 1017: #    $Str .= '<td>'.('&nbsp;'x30).'</td>';
 1018: #    $Str .= '<td align="center">'.
 1019: #        '<input type="submit" name="ClearCache" value="Clear Caches" />'.
 1020: #            "</td>\n";
 1021: #    $Str .= '</tr></tbody></table>'."\n";
 1022: #    $Str .= '<hr>'."\n";
 1023:     #
 1024:     return $Str;
 1025: }
 1026: 
 1027: ##############################################
 1028: ##############################################
 1029: sub handler {
 1030:     my $r=shift;
 1031:     my $c = $r->connection();
 1032:     #
 1033:     # Check for overloading
 1034:     my $loaderror=&Apache::lonnet::overloaderror($r);
 1035:     if ($loaderror) { return $loaderror; }
 1036:     $loaderror=
 1037:        &Apache::lonnet::overloaderror($r,
 1038:          $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
 1039:     if ($loaderror) { return $loaderror; }
 1040:     #
 1041:     # Check for access
 1042:     if (! &Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
 1043:         $ENV{'user.error.msg'}=
 1044:             $r->uri.":vgr:0:0:Cannot view grades for complete course";
 1045:         if (! &Apache::lonnet::allowed('vgr',
 1046:                       $ENV{'request.course.id'}.'/'.$ENV{'request.course.sec'})) {
 1047:             $ENV{'user.error.msg'}=
 1048:                 $r->uri.":vgr:0:0:Cannot view grades with given role";
 1049:             return HTTP_NOT_ACCEPTABLE;
 1050:         }
 1051:     }
 1052:     #
 1053:     # Set document type for header only
 1054:     if($r->header_only) {
 1055:         if ($ENV{'browser.mathml'}) {
 1056:             $r->content_type('text/xml');
 1057:         } else {
 1058:             $r->content_type('text/html');
 1059:         }
 1060:         &Apache::loncommon::no_cache($r);
 1061:         $r->send_http_header;
 1062:         return OK;
 1063:     }
 1064:     #
 1065:     # Send the header
 1066:     $r->content_type('text/html');
 1067:     $r->send_http_header;
 1068:     #
 1069:     # Extract form elements from query string
 1070:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
 1071:                                             ['sort','reportSelected',
 1072:                                              'SelectedStudent']);
 1073:     if (! exists($ENV{'form.reportSelected'})) {
 1074:         $ENV{'form.reportSelected'} = 'student_assessment';
 1075:     }
 1076:     #
 1077:     # Give the LON-CAPA page header
 1078:     $r->print(&Apache::lonhtmlcommon::Title('Course Statistics and Charts'));
 1079:     $r->rflush();
 1080:     #
 1081:     if (! &Apache::lonmysql::verify_sql_connection()) {
 1082:         my $serveradmin = $r->dir_config('lonAdmEMail');
 1083:         $r->print(<<END);
 1084: <h2><font color="Red">Unable to connect to database!</font></h2>
 1085: <p>
 1086: Please notify the server administrator <b>$serveradmin</b>.
 1087: </p><p>
 1088: Course Statistics and Charts cannot be retrieved until the database is
 1089: restarted.  Your data is intact but cannot be displayed at this time.
 1090: </p>
 1091: </body>
 1092: </html>
 1093: END
 1094:         return;
 1095:     }
 1096:     #
 1097:     # Clean out the caches
 1098:     if (exists($ENV{'form.ClearCache'})) {
 1099:         &Apache::loncoursedata::delete_caches($ENV{'requres.course.id'});
 1100:     }
 1101:     #
 1102:     # Set up the statistics and chart environment
 1103:     &PrepareClasslist();
 1104:     &PrepareCourseData($r);
 1105:     #
 1106:     # Begin form output
 1107:     $r->print('<form name="Statistics" ');
 1108:     $r->print('method="post" action="/adm/statistics">');
 1109:     #
 1110:     # Print main menu
 1111:     my %reports = ('classlist'          => 'Class list',
 1112:                    'problem_statistics' => 'Problem Statistics',
 1113:                    'student_assessment' => 'Problem Status Chart',
 1114: #                   'percentage'         => 'Correct-problems Plot',
 1115: #                   'option_response'    => 'Option Response Analysis',
 1116: #                   'activitylog'        => 'Activity Log',
 1117:                    );
 1118:     $r->print(&CreateMainMenu($ENV{'form.status'},
 1119:                               \%reports,$ENV{'form.reportSelected'}));
 1120:     $r->rflush();
 1121:     #
 1122:     my $GoToPage = $ENV{'form.reportSelected'};
 1123:     if($GoToPage eq 'activitylog') {
 1124: #        &Apache::lonproblemstatistics::Activity();
 1125:     } elsif($GoToPage eq 'problem_statistics') {
 1126:         &Apache::lonproblemstatistics::BuildProblemStatisticsPage($r,$c);
 1127:     } elsif($GoToPage eq 'option_response') {
 1128: #        &Apache::lonproblemanalysis::BuildProblemAnalysisPage($r,$c);
 1129:     } elsif($GoToPage eq 'student_assessment') {
 1130:         &Apache::lonstudentassessment::BuildStudentAssessmentPage($r,$c);
 1131:     } elsif($GoToPage eq 'DoDiffGraph' || $GoToPage eq 'PercentWrongGraph') {
 1132: #        &Apache::lonproblemstatistics::BuildGraphicChart($r,$c);
 1133:     } elsif($GoToPage eq 'Correct-problems Plot') {
 1134: #	&Apache::lonpercentage::BuildPercentageGraph($r,$c);
 1135:     }
 1136:     #
 1137:     $r->print("</form>\n");
 1138:     $r->print("</body>\n</html>\n");
 1139:     $r->rflush();
 1140:     #
 1141:     return OK;
 1142: }
 1143: 
 1144: 1;
 1145: 
 1146: #######################################################
 1147: #######################################################
 1148: 
 1149: =pod
 1150: 
 1151: =back
 1152: 
 1153: =cut
 1154: 
 1155: #######################################################
 1156: #######################################################
 1157: 
 1158: __END__
 1159: 

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