File:  [LON-CAPA] / loncom / interface / lonstatistics.pm
Revision 1.81: download - view: text, annotated - select for diffs
Mon Sep 29 16:20:18 2003 UTC (20 years, 9 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
Localization of lonproblemstatistics.pm.

    1: # The LearningOnline Network with CAPA
    2: #
    3: # $Id: lonstatistics.pm,v 1.81 2003/09/29 16:20:18 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 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:     my @Sequences = &Apache::lonstatistics::Sequences_with_Assess();
  885:     #
  886:     my @Students = @Apache::lonstatistics::Students;
  887:     #
  888:     # Open the progress window
  889:     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin
  890:         ($r,'Statistics Compilation Status',
  891:          'Statistics Compilation Progress', scalar(@Students));
  892:     #
  893:     while (my $student = shift @Students) {
  894:         return if ($c->aborted());
  895:         my ($status,undef) = &Apache::loncoursedata::ensure_current_data
  896:             ($student->{'username'},$student->{'domain'},
  897:              $ENV{'request.course.id'});
  898:         &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
  899:                                                  'last student');
  900:     }
  901:     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
  902:     $r->rflush();
  903: }
  904: 
  905: ##################################################
  906: ##################################################
  907: sub DisplayClasslist {
  908:     my ($r)=@_;
  909:     #
  910:     my @Fields = ('fullname','username','domain','id','section');
  911:     #
  912:     my $Str='';
  913:     if (! @Students) {
  914:         if ($SelectedSections[0] eq 'all') { 
  915:             if (lc($ENV{'form.Status'}) eq 'any') {
  916:                 $Str .= '<h2>There are no students in the course.</h2>';
  917:             } elsif (lc($ENV{'form.Status'}) eq 'active') {
  918:                 $Str .= '<h2>There are no currently enrolled students in '.
  919:                     'the course.</h2>';
  920:             } elsif (lc($ENV{'form.Status'}) eq 'expired') {
  921:                 $Str .= '<h2>There are no previously enrolled '.
  922:                     'students in the course.</h2>';
  923:             }
  924:         } else { 
  925:             my $sections;
  926:             if (@SelectedSections == 1) {
  927:                 $sections = 'section '.$SelectedSections[0];
  928:             } elsif (@SelectedSections > 2) {
  929:                 $sections = 'sections '.join(', ',@SelectedSections);
  930:                 $sections =~ s/, ([^,])*$/, and $1/;
  931:             } else {
  932:                 $sections = 'sections '.join(' and ',@SelectedSections);
  933:             }
  934:             if (lc($ENV{'form.Status'}) eq 'any') {
  935:                 $Str .= '<h2>There are no students in '.$sections.'.</h2>';
  936:             } elsif (lc($ENV{'form.Status'}) eq 'active') {
  937:                 $Str .= '<h2>There are no currently enrolled students '.
  938:                     'in '.$sections.'.</h2>';
  939:             } elsif (lc($ENV{'form.Status'}) eq 'expired') {
  940:                 $Str .= '<h2>There are no previously enrolled students '.
  941:                     'in '.$sections.'.</h2>';
  942:             }
  943:         }
  944:         $Str.= '<a href="/adm/statistics?reportSelected=student_assessment">'.
  945:             'Return to the chart.</a>';
  946:         $r->print($Str);
  947:         $r->rflush();
  948:         return;
  949:     }
  950: 
  951:     # "Click" is asinine but it is probably not my place to change the world.
  952:     $Str .= '<h2>Click on a students name or username to view their chart</h2>';
  953:     $Str .= '<table border="0"><tr><td bgcolor="#777777">'."\n";
  954:     $Str .= '<table border="0" cellpadding="3"><tr bgcolor="#e6ffff">'."\n";
  955:     foreach my $field (@Fields) {
  956:         $Str .= '<th><a href="/adm/statistics?reportSelected=classlist&sort='.$field.'">'.$field.
  957:             '</a></th>';
  958:     }
  959:     $Str .= '</tr>'."\n";
  960:     #
  961:     my $alternate = 0;
  962:     foreach my $student (@Students) { # @Students is a package variable
  963:         my $sname = $student->{'username'}.':'.$student->{'domain'};
  964:         if($alternate) {
  965:             $Str .= '<tr bgcolor="#ffffe6">';
  966:         } else {
  967:             $Str .= '<tr bgcolor="#ffffc6">';
  968:         }
  969:         $alternate = ($alternate + 1) % 2;
  970:         #
  971:         foreach my $field (@Fields) {
  972:             $Str .= '<td>';
  973:             if ($field eq 'fullname' || $field eq 'username') {
  974:                 $Str .= '<a href="/adm/statistics?reportSelected=';
  975:                 $Str .= &Apache::lonnet::escape('student_assessment');
  976:                 $Str .= '&sort='.&Apache::lonnet::escape($ENV{'form.sort'});
  977:                 $Str .= '&SelectedStudent=';
  978:                 $Str .= &Apache::lonnet::escape($sname).'">';
  979:                 $Str .= $student->{$field}.'&nbsp';
  980:                 $Str .= '</a>';
  981:             } else {
  982:                 $Str .= $student->{$field};
  983:             }
  984:             $Str .= '</td>';
  985:         }
  986:         $Str .= "</tr>\n";
  987:     }
  988:     $Str .= '</table></td></tr></table>'."\n";
  989:     #
  990:     $r->print($Str);
  991:     $r->rflush();
  992:     #
  993:     return;
  994: }
  995: 
  996: ##############################################
  997: ##############################################
  998: sub CreateMainMenu {
  999:     my ($status,$reports,$current)=@_;
 1000:     #
 1001:     my $Str = '';
 1002:     #
 1003:     $Str  = '<input type="hidden" name="reportSelected" value="'.$current.'">';
 1004: #    $Str .= '<table border="0"><tbody><tr>'."\n";
 1005: #    $Str .= '<td align="center"><b>Report:</b></td>'."\n";
 1006: #    $Str .= '<td align="center">';
 1007: #    $Str .= '<select name="reportSelected" '.
 1008: #        'onchange="document.Statistics.submit()">'."\n";
 1009: #    foreach (sort(keys(%$reports))) {
 1010: #        $Str .= '<option value="'.$_.'"';
 1011: #        if($current eq $_) {
 1012: #            $Str .= ' selected';
 1013: #        }
 1014: #        $Str .= '>'.$reports->{$_}.'</option>'."\n";
 1015: #    }
 1016: #    $Str .= '</select></td>'."\n";
 1017: #    #
 1018: #    $Str .= '<td>'.('&nbsp;'x30).'</td>';
 1019: #    $Str .= '<td align="center">'.
 1020: #        '<input type="submit" name="ClearCache" value="Clear Caches" />'.
 1021: #            "</td>\n";
 1022: #    $Str .= '</tr></tbody></table>'."\n";
 1023: #    $Str .= '<hr>'."\n";
 1024:     #
 1025:     return $Str;
 1026: }
 1027: 
 1028: ##############################################
 1029: ##############################################
 1030: sub handler {
 1031:     my $r=shift;
 1032:     my $c = $r->connection();
 1033:     #
 1034:     # Check for overloading
 1035:     my $loaderror=&Apache::lonnet::overloaderror($r);
 1036:     if ($loaderror) { return $loaderror; }
 1037:     $loaderror=
 1038:        &Apache::lonnet::overloaderror($r,
 1039:          $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
 1040:     if ($loaderror) { return $loaderror; }
 1041:     #
 1042:     # Check for access
 1043:     if (! &Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
 1044:         $ENV{'user.error.msg'}=
 1045:             $r->uri.":vgr:0:0:Cannot view grades for complete course";
 1046:         if (! &Apache::lonnet::allowed('vgr',
 1047:                       $ENV{'request.course.id'}.'/'.$ENV{'request.course.sec'})) {
 1048:             $ENV{'user.error.msg'}=
 1049:                 $r->uri.":vgr:0:0:Cannot view grades with given role";
 1050:             return HTTP_NOT_ACCEPTABLE;
 1051:         }
 1052:     }
 1053:     #
 1054:     # Set document type for header only
 1055:     if($r->header_only) {
 1056:         if ($ENV{'browser.mathml'}) {
 1057:             $r->content_type('text/xml');
 1058:         } else {
 1059:             $r->content_type('text/html');
 1060:         }
 1061:         &Apache::loncommon::no_cache($r);
 1062:         $r->send_http_header;
 1063:         return OK;
 1064:     }
 1065:     #
 1066:     # Send the header
 1067:     $r->content_type('text/html');
 1068:     $r->send_http_header;
 1069:     #
 1070:     # Extract form elements from query string
 1071:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
 1072:                                             ['sort','reportSelected',
 1073:                                              'SelectedStudent']);
 1074:     if (! exists($ENV{'form.reportSelected'})) {
 1075:         $ENV{'form.reportSelected'} = 'student_assessment';
 1076:     }
 1077:     #
 1078:     # Give the LON-CAPA page header
 1079:     $r->print(&Apache::lonhtmlcommon::Title('Course Statistics and Charts'));
 1080:     $r->rflush();
 1081:     #
 1082:     if (! &Apache::lonmysql::verify_sql_connection()) {
 1083:         my $serveradmin = $r->dir_config('lonAdmEMail');
 1084:         $r->print(<<END);
 1085: <h2><font color="Red">Unable to connect to database!</font></h2>
 1086: <p>
 1087: Please notify the server administrator <b>$serveradmin</b>.
 1088: </p><p>
 1089: Course Statistics and Charts cannot be retrieved until the database is
 1090: restarted.  Your data is intact but cannot be displayed at this time.
 1091: </p>
 1092: </body>
 1093: </html>
 1094: END
 1095:         return;
 1096:     }
 1097:     #
 1098:     # Clean out the caches
 1099:     if (exists($ENV{'form.ClearCache'})) {
 1100:         &Apache::loncoursedata::delete_caches($ENV{'requres.course.id'});
 1101:     }
 1102:     #
 1103:     # Set up the statistics and chart environment
 1104:     &PrepareClasslist();
 1105:     &PrepareCourseData($r);
 1106:     #
 1107:     # Begin form output
 1108:     $r->print('<form name="Statistics" ');
 1109:     $r->print('method="post" action="/adm/statistics">');
 1110:     #
 1111:     # Print main menu
 1112:     my %reports = ('classlist'          => 'Class list',
 1113:                    'problem_statistics' => 'Problem Statistics',
 1114:                    'student_assessment' => 'Problem Status Chart',
 1115: #                   'percentage'         => 'Correct-problems Plot',
 1116: #                   'option_response'    => 'Option Response Analysis',
 1117: #                   'activitylog'        => 'Activity Log',
 1118:                    );
 1119:     $r->print(&CreateMainMenu($ENV{'form.status'},
 1120:                               \%reports,$ENV{'form.reportSelected'}));
 1121:     $r->rflush();
 1122:     #
 1123:     my $GoToPage = $ENV{'form.reportSelected'};
 1124:     if($GoToPage eq 'activitylog') {
 1125: #        &Apache::lonproblemstatistics::Activity();
 1126:     } elsif($GoToPage eq 'problem_statistics') {
 1127:         &Apache::lonproblemstatistics::BuildProblemStatisticsPage($r,$c);
 1128:     } elsif($GoToPage eq 'option_response') {
 1129: #        &Apache::lonproblemanalysis::BuildProblemAnalysisPage($r,$c);
 1130:     } elsif($GoToPage eq 'student_assessment') {
 1131:         &Apache::lonstudentassessment::BuildStudentAssessmentPage($r,$c);
 1132:     } elsif($GoToPage eq 'DoDiffGraph' || $GoToPage eq 'PercentWrongGraph') {
 1133: #        &Apache::lonproblemstatistics::BuildGraphicChart($r,$c);
 1134:     } elsif($GoToPage eq 'Correct-problems Plot') {
 1135: #	&Apache::lonpercentage::BuildPercentageGraph($r,$c);
 1136:     }
 1137:     #
 1138:     $r->print("</form>\n");
 1139:     $r->print("</body>\n</html>\n");
 1140:     $r->rflush();
 1141:     #
 1142:     return OK;
 1143: }
 1144: 
 1145: 1;
 1146: 
 1147: #######################################################
 1148: #######################################################
 1149: 
 1150: =pod
 1151: 
 1152: =back
 1153: 
 1154: =cut
 1155: 
 1156: #######################################################
 1157: #######################################################
 1158: 
 1159: __END__
 1160: 

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