File:  [LON-CAPA] / loncom / interface / lonstatistics.pm
Revision 1.78.2.1: download - view: text, annotated - select for diffs
Fri Oct 3 15:34:58 2003 UTC (20 years, 7 months ago) by albertel
Branches: version_1_0_X
Diff to branchpoint 1.78: preferred, unified
- backport 1.83

    1: # The LearningOnline Network with CAPA
    2: #
    3: # $Id: lonstatistics.pm,v 1.78.2.1 2003/10/03 15:34:58 albertel 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: sub DisplayClasslist {
  803:     my ($r)=@_;
  804:     #
  805:     my @Fields = ('fullname','username','domain','id','section');
  806:     #
  807:     my $Str='';
  808:     if (! @Students) {
  809:         if ($SelectedSections[0] eq 'all') { 
  810:             if (lc($ENV{'form.Status'}) eq 'any') {
  811:                 $Str .= '<h2>There are no students in the course.</h2>';
  812:             } elsif (lc($ENV{'form.Status'}) eq 'active') {
  813:                 $Str .= '<h2>There are no currently enrolled students in '.
  814:                     'the course.</h2>';
  815:             } elsif (lc($ENV{'form.Status'}) eq 'expired') {
  816:                 $Str .= '<h2>There are no previously enrolled '.
  817:                     'students in the course.</h2>';
  818:             }
  819:         } else { 
  820:             my $sections;
  821:             if (@SelectedSections == 1) {
  822:                 $sections = 'section '.$SelectedSections[0];
  823:             } elsif (@SelectedSections > 2) {
  824:                 $sections = 'sections '.join(', ',@SelectedSections);
  825:                 $sections =~ s/, ([^,])*$/, and $1/;
  826:             } else {
  827:                 $sections = 'sections '.join(' and ',@SelectedSections);
  828:             }
  829:             if (lc($ENV{'form.Status'}) eq 'any') {
  830:                 $Str .= '<h2>There are no students in '.$sections.'.</h2>';
  831:             } elsif (lc($ENV{'form.Status'}) eq 'active') {
  832:                 $Str .= '<h2>There are no currently enrolled students '.
  833:                     'in '.$sections.'.</h2>';
  834:             } elsif (lc($ENV{'form.Status'}) eq 'expired') {
  835:                 $Str .= '<h2>There are no previously enrolled students '.
  836:                     'in '.$sections.'.</h2>';
  837:             }
  838:         }
  839:         $Str.= '<a href="/adm/statistics?reportSelected=student_assessment">'.
  840:             'Return to the chart.</a>';
  841:         $r->print($Str);
  842:         $r->rflush();
  843:         return;
  844:     }
  845: 
  846:     # "Click" is asinine but it is probably not my place to change the world.
  847:     $Str .= '<h2>Click on a students name or username to view their chart</h2>';
  848:     $Str .= '<table border="0"><tr><td bgcolor="#777777">'."\n";
  849:     $Str .= '<table border="0" cellpadding="3"><tr bgcolor="#e6ffff">'."\n";
  850:     foreach my $field (@Fields) {
  851:         $Str .= '<th><a href="/adm/statistics?reportSelected=classlist&sort='.$field.'">'.$field.
  852:             '</a></th>';
  853:     }
  854:     $Str .= '</tr>'."\n";
  855:     #
  856:     my $alternate = 0;
  857:     foreach my $student (@Students) { # @Students is a package variable
  858:         my $sname = $student->{'username'}.':'.$student->{'domain'};
  859:         if($alternate) {
  860:             $Str .= '<tr bgcolor="#ffffe6">';
  861:         } else {
  862:             $Str .= '<tr bgcolor="#ffffc6">';
  863:         }
  864:         $alternate = ($alternate + 1) % 2;
  865:         #
  866:         foreach my $field (@Fields) {
  867:             $Str .= '<td>';
  868:             if ($field eq 'fullname' || $field eq 'username') {
  869:                 $Str .= '<a href="/adm/statistics?reportSelected=';
  870:                 $Str .= &Apache::lonnet::escape('student_assessment');
  871:                 $Str .= '&sort='.&Apache::lonnet::escape($ENV{'form.sort'});
  872:                 $Str .= '&SelectedStudent=';
  873:                 $Str .= &Apache::lonnet::escape($sname).'">';
  874:                 $Str .= $student->{$field}.'&nbsp';
  875:                 $Str .= '</a>';
  876:             } else {
  877:                 $Str .= $student->{$field};
  878:             }
  879:             $Str .= '</td>';
  880:         }
  881:         $Str .= "</tr>\n";
  882:     }
  883:     $Str .= '</table></td></tr></table>'."\n";
  884:     #
  885:     $r->print($Str);
  886:     $r->rflush();
  887:     #
  888:     return;
  889: }
  890: 
  891: ##############################################
  892: ##############################################
  893: sub CreateMainMenu {
  894:     my ($status,$reports,$current)=@_;
  895:     #
  896:     my $Str = '';
  897:     #
  898:     $Str  = '<input type="hidden" name="reportSelected" value="'.$current.'">';
  899: #    $Str .= '<table border="0"><tbody><tr>'."\n";
  900: #    $Str .= '<td align="center"><b>Report:</b></td>'."\n";
  901: #    $Str .= '<td align="center">';
  902: #    $Str .= '<select name="reportSelected" '.
  903: #        'onchange="document.Statistics.submit()">'."\n";
  904: #    foreach (sort(keys(%$reports))) {
  905: #        $Str .= '<option value="'.$_.'"';
  906: #        if($current eq $_) {
  907: #            $Str .= ' selected';
  908: #        }
  909: #        $Str .= '>'.$reports->{$_}.'</option>'."\n";
  910: #    }
  911: #    $Str .= '</select></td>'."\n";
  912: #    #
  913: #    $Str .= '<td>'.('&nbsp;'x30).'</td>';
  914: #    $Str .= '<td align="center">'.
  915: #        '<input type="submit" name="ClearCache" value="Clear Caches" />'.
  916: #            "</td>\n";
  917: #    $Str .= '</tr></tbody></table>'."\n";
  918: #    $Str .= '<hr>'."\n";
  919:     #
  920:     return $Str;
  921: }
  922: 
  923: ##############################################
  924: ##############################################
  925: sub handler {
  926:     my $r=shift;
  927:     my $c = $r->connection();
  928:     #
  929:     &Apache::loncoursedata::clear_internal_caches();
  930:     #
  931:     # Check for overloading
  932:     my $loaderror=&Apache::lonnet::overloaderror($r);
  933:     if ($loaderror) { return $loaderror; }
  934:     $loaderror=
  935:        &Apache::lonnet::overloaderror($r,
  936:          $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
  937:     if ($loaderror) { return $loaderror; }
  938:     #
  939:     # Check for access
  940:     if (! &Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
  941:         $ENV{'user.error.msg'}=
  942:             $r->uri.":vgr:0:0:Cannot view grades for complete course";
  943:         if (! &Apache::lonnet::allowed('vgr',
  944:                       $ENV{'request.course.id'}.'/'.$ENV{'request.course.sec'})) {
  945:             $ENV{'user.error.msg'}=
  946:                 $r->uri.":vgr:0:0:Cannot view grades with given role";
  947:             return HTTP_NOT_ACCEPTABLE;
  948:         }
  949:     }
  950:     #
  951:     # Set document type for header only
  952:     if($r->header_only) {
  953:         if ($ENV{'browser.mathml'}) {
  954:             $r->content_type('text/xml');
  955:         } else {
  956:             $r->content_type('text/html');
  957:         }
  958:         &Apache::loncommon::no_cache($r);
  959:         $r->send_http_header;
  960:         return OK;
  961:     }
  962:     #
  963:     # Send the header
  964:     $r->content_type('text/html');
  965:     $r->send_http_header;
  966:     #
  967:     # Extract form elements from query string
  968:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
  969:                                             ['sort','reportSelected',
  970:                                              'SelectedStudent']);
  971:     if (! exists($ENV{'form.reportSelected'})) {
  972:         $ENV{'form.reportSelected'} = 'student_assessment';
  973:     }
  974:     #
  975:     # Give the LON-CAPA page header
  976:     $r->print(&Apache::lonhtmlcommon::Title('Course Statistics and Charts'));
  977:     $r->rflush();
  978:     #
  979:     if (! &Apache::lonmysql::verify_sql_connection()) {
  980:         my $serveradmin = $r->dir_config('lonAdmEMail');
  981:         $r->print(<<END);
  982: <h2><font color="Red">Unable to connect to database!</font></h2>
  983: <p>
  984: Please notify the server administrator <b>$serveradmin</b>.
  985: </p><p>
  986: Course Statistics and Charts cannot be retrieved until the database is
  987: restarted.  Your data is intact but cannot be displayed at this time.
  988: </p>
  989: </body>
  990: </html>
  991: END
  992:         return;
  993:     }
  994:     #
  995:     # Clean out the caches
  996:     if (exists($ENV{'form.ClearCache'})) {
  997:         &Apache::loncoursedata::delete_caches($ENV{'requres.course.id'});
  998:     }
  999:     #
 1000:     # Set up the statistics and chart environment
 1001:     &PrepareClasslist();
 1002:     &PrepareCourseData($r);
 1003:     #
 1004:     # Begin form output
 1005:     $r->print('<form name="Statistics" ');
 1006:     $r->print('method="post" action="/adm/statistics">');
 1007:     #
 1008:     # Print main menu
 1009:     my %reports = ('classlist'          => 'Class list',
 1010:                    'problem_statistics' => 'Problem Statistics',
 1011:                    'student_assessment' => 'Problem Status Chart',
 1012: #                   'percentage'         => 'Correct-problems Plot',
 1013: #                   'option_response'    => 'Option Response Analysis',
 1014: #                   'activitylog'        => 'Activity Log',
 1015:                    );
 1016:     $r->print(&CreateMainMenu($ENV{'form.status'},
 1017:                               \%reports,$ENV{'form.reportSelected'}));
 1018:     $r->rflush();
 1019:     #
 1020:     my $GoToPage = $ENV{'form.reportSelected'};
 1021:     if($GoToPage eq 'activitylog') {
 1022: #        &Apache::lonproblemstatistics::Activity();
 1023:     } elsif($GoToPage eq 'problem_statistics') {
 1024:         &Apache::lonproblemstatistics::BuildProblemStatisticsPage($r,$c);
 1025:     } elsif($GoToPage eq 'option_response') {
 1026: #        &Apache::lonproblemanalysis::BuildProblemAnalysisPage($r,$c);
 1027:     } elsif($GoToPage eq 'student_assessment') {
 1028:         &Apache::lonstudentassessment::BuildStudentAssessmentPage($r,$c);
 1029:     } elsif($GoToPage eq 'DoDiffGraph' || $GoToPage eq 'PercentWrongGraph') {
 1030: #        &Apache::lonproblemstatistics::BuildGraphicChart($r,$c);
 1031:     } elsif($GoToPage eq 'Correct-problems Plot') {
 1032: #	&Apache::lonpercentage::BuildPercentageGraph($r,$c);
 1033:     }
 1034:     #
 1035:     $r->print("</form>\n");
 1036:     $r->print("</body>\n</html>\n");
 1037:     $r->rflush();
 1038:     #
 1039:     return OK;
 1040: }
 1041: 
 1042: 1;
 1043: 
 1044: #######################################################
 1045: #######################################################
 1046: 
 1047: =pod
 1048: 
 1049: =back
 1050: 
 1051: =cut
 1052: 
 1053: #######################################################
 1054: #######################################################
 1055: 
 1056: __END__
 1057: 

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