File:  [LON-CAPA] / loncom / interface / lonstatistics.pm
Revision 1.86: download - view: text, annotated - select for diffs
Wed Oct 15 18:01:10 2003 UTC (20 years, 7 months ago) by www
Branches: MAIN
CVS tags: HEAD
I was going to work on something else ... anyway, more i18n.

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

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