File:  [LON-CAPA] / loncom / interface / lonstatistics.pm
Revision 1.71: download - view: text, annotated - select for diffs
Tue May 27 14:51:24 2003 UTC (21 years ago) by matthew
Branches: MAIN
CVS tags: HEAD
Added &get_students which returns the student list.  Added initialization
checking to &SectionSelector.  Removed $r as a parameter to &PrepareClasslist
All of this is to allow Spreadsheet::classcalc to use the statistics student
handling subroutines.  We *should* move most of these routines to another
module, but not until after the 1.0 release.

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

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