Annotation of loncom/interface/lonstatistics.pm, revision 1.79

1.1       albertel    1: # The LearningOnline Network with CAPA
                      2: #
1.79    ! matthew     3: # $Id: lonstatistics.pm,v 1.78 2003/06/20 18:50:17 matthew Exp $
1.1       albertel    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
1.14      minaeibi   28: #
1.1       albertel   29: ###
                     30: 
1.59      matthew    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: 
1.60      matthew    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;
1.66      matthew    54:     use Apache::lonmysql;
1.59      matthew    55: =over 4
                     56: 
                     57: =cut
                     58: 
1.55      minaeibi   59: package Apache::lonstatistics;
1.1       albertel   60: 
1.30      stredwic   61: use strict;
1.1       albertel   62: use Apache::Constants qw(:common :http);
1.61      matthew    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: 
1.1       albertel   76: use Apache::lonnet();
                     77: use Apache::lonhomework;
1.12      minaeibi   78: use Apache::loncommon;
1.29      stredwic   79: use Apache::loncoursedata;
                     80: use Apache::lonhtmlcommon;
1.61      matthew    81: use Apache::lonproblemanalysis();
                     82: use Apache::lonproblemstatistics();
                     83: use Apache::lonstudentassessment();
1.49      stredwic   84: use Apache::lonpercentage;
1.66      matthew    85: use Apache::lonmysql;
1.65      matthew    86: use Time::HiRes;
1.60      matthew    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: #
1.59      matthew   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: 
1.60      matthew   131: =item @FullClasslist
                    132: 
                    133: =item @Students
1.59      matthew   134: 
1.60      matthew   135: =item @Sections
1.59      matthew   136: 
1.60      matthew   137: =item @SelectedSections
1.59      matthew   138: 
1.61      matthew   139: =item %StudentData
                    140: 
                    141: =item @StudentDataOrder
                    142: 
                    143: =item @SelectedStudentData
                    144: 
1.60      matthew   145: =item $curr_student
1.59      matthew   146: 
1.60      matthew   147: =item $prev_student
1.59      matthew   148: 
1.60      matthew   149: =item $next_student
1.59      matthew   150: 
                    151: =back
                    152: 
                    153: =cut
                    154: 
                    155: #######################################################
                    156: #######################################################
                    157: sub clear_classlist_variables {
                    158:     undef(@FullClasslist);
                    159:     undef(@Students);
                    160:     undef(@Sections);
1.60      matthew   161:     undef(@SelectedSections);
1.61      matthew   162:     undef(%StudentData);
                    163:     undef(@SelectedStudentData);
1.59      matthew   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: 
1.60      matthew   181: =item @FullClasslist
                    182: 
                    183: =item @Students
1.59      matthew   184: 
1.60      matthew   185: =item @Sections
1.59      matthew   186: 
1.60      matthew   187: =item @SelectedSections
1.59      matthew   188: 
1.61      matthew   189: =item %StudentData
                    190: 
                    191: =item @SelectedStudentData
                    192: 
1.60      matthew   193: =item $curr_student
1.59      matthew   194: 
1.60      matthew   195: =item $prev_student
1.59      matthew   196: 
1.60      matthew   197: =item $next_student
1.59      matthew   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);
1.60      matthew   218:     if (exists($ENV{'form.Section'})) {
1.59      matthew   219:         if (ref($ENV{'form.Section'})) {
1.61      matthew   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');
1.59      matthew   229:         }
                    230:     }
1.61      matthew   231:     #
1.69      matthew   232:     # Deal with instructors with restricted section access
1.70      matthew   233:     if ($ENV{'request.course.sec'} !~ /^\s*$/) {
1.69      matthew   234:         @SelectedSections = ($ENV{'request.course.sec'});
                    235:     }
                    236:     #
1.61      matthew   237:     # Set up %StudentData
                    238:     @StudentDataOrder = qw/fullname username domain id section status/;
                    239:     foreach my $field (@StudentDataOrder) {
                    240:         $StudentData{$field}->{'title'} = $field;
1.63      matthew   241:         $StudentData{$field}->{'base_width'} = length($field);
1.61      matthew   242:         $StudentData{$field}->{'width'} = 
                    243:                                $StudentData{$field}->{'base_width'};
                    244:     }
1.59      matthew   245:     #
1.68      matthew   246:     # get the status requested
                    247:     my $requested_status = 'Active';
                    248:     $requested_status = $ENV{'form.Status'} if (exists($ENV{'form.Status'}));
                    249:     #
1.59      matthew   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++) {
1.61      matthew   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}));
1.63      matthew   259:             my $length = length($student_data->[$i]);
1.61      matthew   260:             if ($StudentData{$field}->{'width'} < $length) {
                    261:                 $StudentData{$field}->{'width'} = $length; 
                    262:             }
1.59      matthew   263:         }
                    264:         push (@FullClasslist,$studenthash);
                    265:         #
                    266:         # Build up a list of sections
                    267:         my $section = $studenthash->{'section'};
1.60      matthew   268:         if (! defined($section) || $section =~/^\s*$/ || $section == -1) {
                    269:             $studenthash->{'section'} = 'none';
                    270:             $section = $studenthash->{'section'};
                    271:         }
1.59      matthew   272:         $Sections{$section}++;
                    273:         #
                    274:         # Only put in the list those students we are interested in
1.60      matthew   275:         foreach my $sect (@SelectedSections) {
1.68      matthew   276:             if ( (($sect eq 'all') || 
                    277:                   ($section eq $sect)) &&
                    278:                  (($studenthash->{'status'} eq $requested_status) || 
                    279:                   ($requested_status eq 'Any')) 
                    280:                  ){
1.60      matthew   281:                 push (@Students,$studenthash);
                    282:                 last;
                    283:             }
1.59      matthew   284:         }
                    285:     }
                    286:     #
                    287:     # Put the consolidated section data in the right place
1.70      matthew   288:     if ($ENV{'request.course.sec'} !~ /^\s*$/) {
1.69      matthew   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:     }
1.59      matthew   294:     #
                    295:     # Sort the Students
                    296:     my $sortby = 'fullname';
1.60      matthew   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;
1.59      matthew   301:     # 
                    302:     # Now deal with that current student thing....
1.72      matthew   303:     $curr_student = undef;
                    304:     if (exists($ENV{'form.SelectedStudent'})) {
1.59      matthew   305:         my ($current_uname,$current_dom) = 
1.72      matthew   306:             split(':',$ENV{'form.SelectedStudent'});
1.59      matthew   307:         my $i;
                    308:         for ($i = 0; $i<=$#Students; $i++) {
                    309:             next if (($Students[$i]->{'username'} ne $current_uname) || 
                    310:                      ($Students[$i]->{'domain'}   ne $current_dom));
1.60      matthew   311:             $curr_student = $Students[$i];
1.59      matthew   312:             last; # If we get here, we have our student.
                    313:         }
1.72      matthew   314:         if (defined($curr_student)) {
                    315:             if ($i == 0) {
                    316:                 $prev_student = undef;
                    317:             } else {
                    318:                 $prev_student = $Students[$i-1];
                    319:             }
                    320:             if ($i == $#Students) {
                    321:                 $next_student = undef;
                    322:             } else {
                    323:                 $next_student = $Students[$i+1];
                    324:             }
1.59      matthew   325:         }
                    326:     }
1.61      matthew   327:     #
                    328:     if (exists($ENV{'form.StudentData'})) {
                    329:         if (ref($ENV{'form.StudentData'}) eq 'ARRAY') {
                    330:             @SelectedStudentData = @{$ENV{'form.StudentData'}};
                    331:         } else {
                    332:             @SelectedStudentData = ($ENV{'form.StudentData'});
                    333:         }
                    334:     } else {
1.72      matthew   335:         @SelectedStudentData = ('username');
1.61      matthew   336:     }
                    337:     foreach (@SelectedStudentData) {
                    338:         if ($_ eq 'all') {
                    339:             @SelectedStudentData = ('all');
                    340:             last;
                    341:         }
                    342:     }
                    343:     #
                    344:     return;
                    345: }
                    346: 
1.71      matthew   347: 
                    348: #######################################################
                    349: #######################################################
                    350: 
                    351: =pod
                    352: 
                    353: =item get_students
                    354: 
                    355: Returns a list of the selected students
                    356: 
                    357: =cut
                    358: 
                    359: #######################################################
                    360: #######################################################
                    361: sub get_students {
                    362:     if (! @Students) {
                    363:         &PrepareClasslist()
                    364:     }
                    365:     return @Students;
                    366: }
                    367: 
1.61      matthew   368: #######################################################
                    369: #######################################################
                    370: 
                    371: =pod
                    372: 
                    373: =item &current_student()
                    374: 
                    375: Returns a pointer to a hash containing data about the currently
                    376: selected student.
                    377: 
                    378: =cut
                    379: 
                    380: #######################################################
                    381: #######################################################
                    382: sub current_student { 
1.72      matthew   383:     return $curr_student;
1.61      matthew   384: }
                    385: 
                    386: #######################################################
                    387: #######################################################
                    388: 
                    389: =pod
                    390: 
                    391: =item &previous_student()
                    392: 
                    393: Returns a pointer to a hash containing data about the student prior
                    394: in the list of students.  Or something.  
                    395: 
                    396: =cut
                    397: 
                    398: #######################################################
                    399: #######################################################
                    400: sub previous_student { 
1.72      matthew   401:     return $prev_student;
1.59      matthew   402: }
                    403: 
                    404: #######################################################
                    405: #######################################################
1.61      matthew   406: 
                    407: =pod
                    408: 
                    409: =item &next_student()
                    410: 
                    411: Returns a pointer to a hash containing data about the next student
                    412: to be viewed.
                    413: 
                    414: =cut
                    415: 
                    416: #######################################################
                    417: #######################################################
                    418: sub next_student { 
1.72      matthew   419:     return $next_student;
1.61      matthew   420: }
1.60      matthew   421: 
                    422: #######################################################
                    423: #######################################################
                    424: 
                    425: =pod
                    426: 
                    427: =item &clear_sequence_variables()
                    428: 
                    429: =cut
                    430: 
                    431: #######################################################
                    432: #######################################################
                    433: sub clear_sequence_variables {
                    434:     undef($top_map);
                    435:     undef(@Sequences);
                    436:     undef(@Assessments);
                    437: }
                    438: 
                    439: #######################################################
                    440: #######################################################
                    441: 
                    442: =pod
                    443: 
1.61      matthew   444: =item &SetSelectedMaps($elementname)
                    445: 
                    446: Sets the @SelectedMaps array from $ENV{'form.'.$elementname};
                    447: 
                    448: =cut
                    449: 
                    450: #######################################################
                    451: #######################################################
                    452: sub SetSelectedMaps {
                    453:     my $elementname = shift;
                    454:     if (exists($ENV{'form.'.$elementname})) {
                    455:         if (ref($ENV{'form.'.$elementname})) {
                    456:             @SelectedMaps = @{$ENV{'form.'.$elementname}};
                    457:         } else {
                    458:             @SelectedMaps = ($ENV{'form.'.$elementname});
                    459:         }
                    460:     } else {
                    461:         @SelectedMaps = ('all');
                    462:     }
1.64      matthew   463: }
                    464: 
                    465: 
                    466: #######################################################
                    467: #######################################################
                    468: 
                    469: =pod
                    470: 
                    471: =item &Sequences_with_Assess()
                    472: 
                    473: Returns an array containing the subset of @Sequences which contain
                    474: assessments.
                    475: 
                    476: =cut
                    477: 
                    478: #######################################################
                    479: #######################################################
                    480: sub Sequences_with_Assess {
                    481:     my @Sequences_to_Show;
                    482:     foreach my $map_symb (@SelectedMaps) {
                    483:         foreach my $sequence (@Sequences) {
                    484:             next if ($sequence->{'symb'} ne $map_symb && $map_symb ne 'all');
                    485:             next if ($sequence->{'num_assess'} < 1);
                    486:             push (@Sequences_to_Show,$sequence);
                    487:         }
                    488:     }
                    489:     return @Sequences_to_Show;
1.61      matthew   490: }
                    491: 
                    492: #######################################################
                    493: #######################################################
                    494: 
                    495: =pod
                    496: 
1.60      matthew   497: =item &PrepareCourseData($r)
                    498: 
                    499: =cut
                    500: 
                    501: #######################################################
                    502: #######################################################
                    503: sub PrepareCourseData {
                    504:     my ($r) = @_;
                    505:     &clear_sequence_variables();
1.61      matthew   506:     my ($top,$sequences,$assessments) = 
                    507:         &Apache::loncoursedata::get_sequence_assessment_data();
1.60      matthew   508:     if (! defined($top) || ! ref($top)) {
                    509:         # There has been an error, better report it
                    510:         &Apache::lonnet::logthis('top is undefined');
                    511:         return;
                    512:     }
                    513:     $top_map = $top if (ref($top));
                    514:     @Sequences = @{$sequences} if (ref($sequences) eq 'ARRAY');
1.61      matthew   515:     @Assessments = @{$assessments} if (ref($assessments) eq 'ARRAY');
                    516:     #
                    517:     # Compute column widths
                    518:     foreach my $seq (@Sequences) {
1.63      matthew   519:         my $name_length = length($seq->{'title'});
1.61      matthew   520:         my $num_parts = $seq->{'num_assess_parts'};
                    521:         #
1.75      matthew   522:         # Use 3 digits for each the sum and total, which means 7 total...
                    523:         my $num_col = $num_parts+7;
1.61      matthew   524:         if ($num_col < $name_length) {
                    525:             $num_col = $name_length;
                    526:         }
                    527:         $seq->{'base_width'} = $name_length;
                    528:         $seq->{'width'} = $num_col;
                    529:     }
                    530:     return;
                    531: }
                    532: 
                    533: #######################################################
                    534: #######################################################
1.60      matthew   535: 
                    536: =pod
                    537: 
1.61      matthew   538: =item &log_sequence($sequence,$recursive,$padding)
                    539: 
                    540: Write data about the sequence to a logfile.  If $recursive is not
                    541: undef the data is written recursively.  $padding is used for recursive
                    542: calls.
                    543: 
                    544: =cut
                    545: 
                    546: #######################################################
                    547: #######################################################
                    548: sub log_sequence {
                    549:     my ($seq,$recursive,$padding) = @_;
                    550:     $padding = '' if (! defined($padding));
                    551:     if (ref($seq) ne 'HASH') {
                    552:         &Apache::lonnet::logthis('log_sequence passed bad sequnce');
                    553:         return;
                    554:     }
                    555:     &Apache::lonnet::logthis($padding.'sequence '.$seq->{'title'});
                    556:     while (my($key,$value) = each(%$seq)) {
                    557:         next if ($key eq 'contents');
                    558:         if (ref($value) eq 'ARRAY') {
                    559:             for (my $i=0;$i< scalar(@$value);$i++) {
                    560:                 &Apache::lonnet::logthis($padding.$key.'['.$i.']='.
                    561:                                          $value->[$i]);
                    562:             }
                    563:         } else {
                    564:             &Apache::lonnet::logthis($padding.$key.'='.$value);
                    565:         }
                    566:     }
                    567:     if (defined($recursive)) {
                    568:         &Apache::lonnet::logthis($padding.'-'x20);
                    569:         &Apache::lonnet::logthis($padding.'contains:');
                    570:         foreach my $item (@{$seq->{'contents'}}) {
                    571:             if ($item->{'type'} eq 'container') {
                    572:                 &log_sequence($item,$recursive,$padding.'    ');
                    573:             } else {
                    574:                 &Apache::lonnet::logthis($padding.'title = '.$item->{'title'});
                    575:                 while (my($key,$value) = each(%$item)) {
                    576:                     next if ($key eq 'title');
                    577:                     if (ref($value) eq 'ARRAY') {
                    578:                         for (my $i=0;$i< scalar(@$value);$i++) {
                    579:                             &Apache::lonnet::logthis($padding.$key.'['.$i.']='.
                    580:                                                      $value->[$i]);
                    581:                         }
                    582:                     } else {
                    583:                         &Apache::lonnet::logthis($padding.$key.'='.$value);
                    584:                     }
                    585:                 }
                    586:             }
1.60      matthew   587:         }
1.61      matthew   588:         &Apache::lonnet::logthis($padding.'end contents of '.$seq->{'title'});
                    589:         &Apache::lonnet::logthis($padding.'-'x20);
1.60      matthew   590:     }
1.61      matthew   591:     return;
                    592: }
                    593: 
                    594: ##############################################
                    595: ##############################################
                    596: 
                    597: =pod 
                    598: 
                    599: =item &StudentDataSelect($elementname,$status,$numvisible,$selected)
                    600: 
                    601: Returns html for a selection box allowing the user to choose one (or more) 
                    602: of the fields of student data available (fullname, username, id, section, etc)
                    603: 
                    604: =over 4
                    605: 
                    606: =item $elementname The name of the HTML form element
                    607: 
                    608: =item $status 'multiple' or 'single' selection box
                    609: 
                    610: =item $numvisible The number of options to be visible
                    611: 
                    612: =back
1.60      matthew   613: 
                    614: =cut
                    615: 
1.61      matthew   616: ##############################################
                    617: ##############################################
                    618: sub StudentDataSelect {
                    619:     my ($elementname,$status,$numvisible)=@_;
                    620:     if ($numvisible < 1) {
                    621:         return;
                    622:     }
                    623:     #
                    624:     # Build the form element
                    625:     my $Str = "\n";
                    626:     $Str .= '<select name="'.$elementname.'" ';
                    627:     if ($status ne 'single') {
                    628:         $Str .= 'multiple="true" ';
                    629:     }
                    630:     $Str .= 'size="'.$numvisible.'" >'."\n";
                    631:     #
                    632:     # Deal with 'all'
                    633:     $Str .= '    <option value="all" ';
                    634:     foreach (@SelectedStudentData) {
                    635:         if ($_ eq 'all') {
                    636:             $Str .= 'selected ';
                    637:             last;
                    638:         }
                    639:     }
                    640:     $Str .= ">all</option>\n";
                    641:     #
                    642:     # Loop through the student data fields
                    643:     foreach my $item (@StudentDataOrder) {
                    644:         $Str .= '    <option value="'.$item.'" ';
                    645:         foreach (@SelectedStudentData) {
                    646:             if ($item eq $_ ) {
                    647:                 $Str .= 'selected ';
                    648:                 last;
                    649:             }
                    650:         }
                    651:         $Str .= '>'.$item."</option>\n";
                    652:     }
                    653:     $Str .= "</select>\n";
                    654:     return $Str;
1.60      matthew   655: }
                    656: 
                    657: ##############################################
                    658: ##############################################
                    659: 
                    660: =pod 
                    661: 
1.61      matthew   662: =item &MapSelect($elementname,$status,$numvisible,$restriction) 
1.60      matthew   663: 
                    664: Returns html for a selection box allowing the user to choose one (or more) 
                    665: of the sequences in the course.  The values of the sequences are the symbs.
                    666: If the top sequence is selected, the value 'top' will result.
                    667: 
                    668: =over 4
                    669: 
                    670: =item $elementname The name of the HTML form element
                    671: 
                    672: =item $status 'multiple' or 'single' selection box
                    673: 
                    674: =item $numvisible The number of options to be visible
                    675: 
                    676: =item $restriction Code reference to subroutine which returns true or 
                    677: false.  The code must expect a reference to a sequence data structure.
                    678: 
                    679: =back
                    680: 
                    681: =cut
                    682: 
                    683: ##############################################
                    684: ##############################################
                    685: sub MapSelect {
1.61      matthew   686:     my ($elementname,$status,$numvisible,$restriction)=@_;
1.60      matthew   687:     if ($numvisible < 1) {
                    688:         return;
                    689:     }
                    690:     #
                    691:     # Set up array of selected items
1.61      matthew   692:     &SetSelectedMaps($elementname);
1.60      matthew   693:     #
                    694:     # Set up the restriction call
                    695:     if (! defined($restriction)) {
                    696:         $restriction = sub { 1; };
                    697:     }
                    698:     #
                    699:     # Build the form element
                    700:     my $Str = "\n";
                    701:     $Str .= '<select name="'.$elementname.'" ';
                    702:     if ($status ne 'single') {
                    703:         $Str .= 'multiple="true" ';
                    704:     }
                    705:     $Str .= 'size="'.$numvisible.'" >'."\n";
                    706:     #
1.61      matthew   707:     # Deal with 'all'
                    708:     foreach (@SelectedMaps) {
                    709:         if ($_ eq 'all') {
                    710:             @SelectedMaps = ('all');
                    711:             last;
                    712:         }
                    713:     }
                    714:     #
                    715:     # Put in option for 'all'
                    716:     $Str .= '    <option value="all" ';
                    717:     foreach (@SelectedMaps) {
                    718:         if ($_ eq 'all') {
                    719:             $Str .= 'selected ';
                    720:             last;
                    721:         }
                    722:     }
                    723:     $Str .= ">all</option>\n";
                    724:     #
1.60      matthew   725:     # Loop through the sequences
1.61      matthew   726:     foreach my $seq (@Sequences) {
                    727:         next if (! $restriction->($seq));
                    728:         $Str .= '    <option value="'.$seq->{'symb'}.'" ';
                    729:         foreach (@SelectedMaps) {
                    730:             if ($seq->{'symb'} eq $_) {
1.60      matthew   731:                 $Str .= 'selected ';
                    732:                 last;
                    733:             }
                    734:         }
1.61      matthew   735:         $Str .= '>'.$seq->{'title'}."</option>\n";
1.60      matthew   736:     }
                    737:     $Str .= "</select>\n";
                    738:     return $Str;
                    739: }
                    740: 
                    741: ##############################################
                    742: ##############################################
                    743: 
                    744: =pod 
                    745: 
                    746: =item &SectionSelect($elementname,$status,$numvisible) 
                    747: 
                    748: Returns html for a selection box allowing the user to choose one (or more) 
                    749: of the sections in the course.  
                    750: 
1.71      matthew   751: Uses the package variables @Sections and @SelectedSections
1.60      matthew   752: =over 4
                    753: 
                    754: =item $elementname The name of the HTML form element
                    755: 
                    756: =item $status 'multiple' or 'single' selection box
                    757: 
                    758: =item $numvisible The number of options to be visible
                    759: 
                    760: =back
                    761: 
                    762: =cut
                    763: 
                    764: ##############################################
                    765: ##############################################
                    766: sub SectionSelect {
                    767:     my ($elementname,$status,$numvisible)=@_;
                    768:     if ($numvisible < 1) {
                    769:         return;
                    770:     }
                    771:     #
1.71      matthew   772:     # Make sure we have the data we need to continue
                    773:     if (! @Sections) {
                    774:         &PrepareClasslist()
                    775:     }
                    776:     #
1.60      matthew   777:     # Build the form element
                    778:     my $Str = "\n";
                    779:     $Str .= '<select name="'.$elementname.'" ';
                    780:     if ($status ne 'single') {
                    781:         $Str .= 'multiple="true" ';
                    782:     }
                    783:     $Str .= 'size="'.$numvisible.'" >'."\n";
                    784:     #
                    785:     # Loop through the sequences
                    786:     foreach my $s (@Sections) {
                    787:         $Str .= '    <option value="'.$s.'" ';
                    788:         foreach (@SelectedSections) {
1.61      matthew   789:             if ($s eq $_) {
1.60      matthew   790:                 $Str .= 'selected ';
                    791:                 last;
                    792:             }
                    793:         }
                    794:         $Str .= '>'.$s."</option>\n";
                    795:     }
                    796:     $Str .= "</select>\n";
                    797:     return $Str;
1.79    ! matthew   798: }
        !           799: 
        !           800: ###############################################
        !           801: ###############################################
        !           802: 
        !           803: =pod 
        !           804: 
        !           805: =item &Gather_Student_Data()
        !           806: 
        !           807: Ensures all student data is up to date.
        !           808: 
        !           809: =cut
        !           810: 
        !           811: ###############################################
        !           812: ###############################################
        !           813: sub Gather_Student_Data {
        !           814:     my ($r) = @_;
        !           815:     my $c = $r->connection();
        !           816:     #
        !           817:     my @Sequences = &Apache::lonstatistics::Sequences_with_Assess();
        !           818:     #
        !           819:     my @Students = @Apache::lonstatistics::Students;
        !           820:     #
        !           821:     # Open the progress window
        !           822:     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin
        !           823:         ($r,'Statistics Compilation Status',
        !           824:          'Statistics Compilation Progress', scalar(@Students));
        !           825:     #
        !           826:     while (my $student = shift @Students) {
        !           827:         return if ($c->aborted());
        !           828:         my ($status,undef) = &Apache::loncoursedata::ensure_current_data
        !           829:             ($student->{'username'},$student->{'domain'},
        !           830:              $ENV{'request.course.id'});
        !           831:         &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
        !           832:                                                  'last student');
        !           833:     }
        !           834:     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
        !           835:     $r->rflush();
1.60      matthew   836: }
                    837: 
1.61      matthew   838: ##################################################
                    839: ##################################################
1.60      matthew   840: sub DisplayClasslist {
                    841:     my ($r)=@_;
                    842:     #
                    843:     my @Fields = ('fullname','username','domain','id','section');
                    844:     #
                    845:     my $Str='';
1.78      matthew   846:     if (! @Students) {
                    847:         if ($SelectedSections[0] eq 'all') { 
                    848:             if (lc($ENV{'form.Status'}) eq 'any') {
                    849:                 $Str .= '<h2>There are no students in the course.</h2>';
                    850:             } elsif (lc($ENV{'form.Status'}) eq 'active') {
                    851:                 $Str .= '<h2>There are no currently enrolled students in '.
                    852:                     'the course.</h2>';
                    853:             } elsif (lc($ENV{'form.Status'}) eq 'expired') {
                    854:                 $Str .= '<h2>There are no previously enrolled '.
                    855:                     'students in the course.</h2>';
                    856:             }
                    857:         } else { 
                    858:             my $sections;
                    859:             if (@SelectedSections == 1) {
                    860:                 $sections = 'section '.$SelectedSections[0];
                    861:             } elsif (@SelectedSections > 2) {
                    862:                 $sections = 'sections '.join(', ',@SelectedSections);
                    863:                 $sections =~ s/, ([^,])*$/, and $1/;
                    864:             } else {
                    865:                 $sections = 'sections '.join(' and ',@SelectedSections);
                    866:             }
                    867:             if (lc($ENV{'form.Status'}) eq 'any') {
                    868:                 $Str .= '<h2>There are no students in '.$sections.'.</h2>';
                    869:             } elsif (lc($ENV{'form.Status'}) eq 'active') {
                    870:                 $Str .= '<h2>There are no currently enrolled students '.
                    871:                     'in '.$sections.'.</h2>';
                    872:             } elsif (lc($ENV{'form.Status'}) eq 'expired') {
                    873:                 $Str .= '<h2>There are no previously enrolled students '.
                    874:                     'in '.$sections.'.</h2>';
                    875:             }
                    876:         }
                    877:         $Str.= '<a href="/adm/statistics?reportSelected=student_assessment">'.
                    878:             'Return to the chart.</a>';
                    879:         $r->print($Str);
                    880:         $r->rflush();
                    881:         return;
                    882:     }
                    883: 
1.76      matthew   884:     # "Click" is asinine but it is probably not my place to change the world.
1.78      matthew   885:     $Str .= '<h2>Click on a students name or username to view their chart</h2>';
1.60      matthew   886:     $Str .= '<table border="0"><tr><td bgcolor="#777777">'."\n";
                    887:     $Str .= '<table border="0" cellpadding="3"><tr bgcolor="#e6ffff">'."\n";
                    888:     foreach my $field (@Fields) {
1.65      matthew   889:         $Str .= '<th><a href="/adm/statistics?reportSelected=classlist&sort='.$field.'">'.$field.
1.60      matthew   890:             '</a></th>';
                    891:     }
                    892:     $Str .= '</tr>'."\n";
                    893:     #
                    894:     my $alternate = 0;
1.65      matthew   895:     foreach my $student (@Students) { # @Students is a package variable
1.60      matthew   896:         my $sname = $student->{'username'}.':'.$student->{'domain'};
                    897:         if($alternate) {
                    898:             $Str .= '<tr bgcolor="#ffffe6">';
                    899:         } else {
                    900:             $Str .= '<tr bgcolor="#ffffc6">';
                    901:         }
                    902:         $alternate = ($alternate + 1) % 2;
                    903:         #
                    904:         foreach my $field (@Fields) {
                    905:             $Str .= '<td>';
1.78      matthew   906:             if ($field eq 'fullname' || $field eq 'username') {
1.60      matthew   907:                 $Str .= '<a href="/adm/statistics?reportSelected=';
1.65      matthew   908:                 $Str .= &Apache::lonnet::escape('student_assessment');
1.72      matthew   909:                 $Str .= '&sort='.&Apache::lonnet::escape($ENV{'form.sort'});
                    910:                 $Str .= '&SelectedStudent=';
1.61      matthew   911:                 $Str .= &Apache::lonnet::escape($sname).'">';
1.60      matthew   912:                 $Str .= $student->{$field}.'&nbsp';
                    913:                 $Str .= '</a>';
                    914:             } else {
                    915:                 $Str .= $student->{$field};
                    916:             }
                    917:             $Str .= '</td>';
                    918:         }
                    919:         $Str .= "</tr>\n";
                    920:     }
                    921:     $Str .= '</table></td></tr></table>'."\n";
                    922:     #
                    923:     $r->print($Str);
                    924:     $r->rflush();
                    925:     #
                    926:     return;
                    927: }
                    928: 
1.65      matthew   929: ##############################################
                    930: ##############################################
1.33      stredwic  931: sub CreateMainMenu {
1.65      matthew   932:     my ($status,$reports,$current)=@_;
                    933:     #
1.33      stredwic  934:     my $Str = '';
1.65      matthew   935:     #
1.77      matthew   936:     $Str  = '<input type="hidden" name="reportSelected" value="'.$current.'">';
                    937: #    $Str .= '<table border="0"><tbody><tr>'."\n";
                    938: #    $Str .= '<td align="center"><b>Report:</b></td>'."\n";
                    939: #    $Str .= '<td align="center">';
                    940: #    $Str .= '<select name="reportSelected" '.
                    941: #        'onchange="document.Statistics.submit()">'."\n";
                    942: #    foreach (sort(keys(%$reports))) {
                    943: #        $Str .= '<option value="'.$_.'"';
                    944: #        if($current eq $_) {
                    945: #            $Str .= ' selected';
                    946: #        }
                    947: #        $Str .= '>'.$reports->{$_}.'</option>'."\n";
                    948: #    }
                    949: #    $Str .= '</select></td>'."\n";
                    950: #    #
                    951: #    $Str .= '<td>'.('&nbsp;'x30).'</td>';
                    952: #    $Str .= '<td align="center">'.
                    953: #        '<input type="submit" name="ClearCache" value="Clear Caches" />'.
                    954: #            "</td>\n";
                    955: #    $Str .= '</tr></tbody></table>'."\n";
                    956: #    $Str .= '<hr>'."\n";
1.65      matthew   957:     #
1.33      stredwic  958:     return $Str;
                    959: }
                    960: 
1.65      matthew   961: ##############################################
                    962: ##############################################
1.1       albertel  963: sub handler {
1.31      minaeibi  964:     my $r=shift;
1.65      matthew   965:     my $c = $r->connection();
                    966:     #
                    967:     # Check for overloading
1.51      www       968:     my $loaderror=&Apache::lonnet::overloaderror($r);
                    969:     if ($loaderror) { return $loaderror; }
                    970:     $loaderror=
                    971:        &Apache::lonnet::overloaderror($r,
                    972:          $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
                    973:     if ($loaderror) { return $loaderror; }
1.65      matthew   974:     #
                    975:     # Check for access
1.69      matthew   976:     if (! &Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
1.27      stredwic  977:         $ENV{'user.error.msg'}=
1.69      matthew   978:             $r->uri.":vgr:0:0:Cannot view grades for complete course";
                    979:         if (! &Apache::lonnet::allowed('vgr',
                    980:                       $ENV{'request.course.id'}.'/'.$ENV{'request.course.sec'})) {
                    981:             $ENV{'user.error.msg'}=
                    982:                 $r->uri.":vgr:0:0:Cannot view grades with given role";
                    983:             return HTTP_NOT_ACCEPTABLE;
                    984:         }
1.27      stredwic  985:     }
1.65      matthew   986:     #
1.27      stredwic  987:     # Set document type for header only
                    988:     if($r->header_only) {
                    989:         if ($ENV{'browser.mathml'}) {
                    990:             $r->content_type('text/xml');
                    991:         } else {
                    992:             $r->content_type('text/html');
                    993:         }
                    994:         &Apache::loncommon::no_cache($r);
                    995:         $r->send_http_header;
                    996:         return OK;
                    997:     }
1.65      matthew   998:     #
                    999:     # Send the header
1.27      stredwic 1000:     $r->content_type('text/html');
                   1001:     $r->send_http_header;
1.65      matthew  1002:     #
                   1003:     # Extract form elements from query string
1.60      matthew  1004:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.65      matthew  1005:                                             ['sort','reportSelected',
1.72      matthew  1006:                                              'SelectedStudent']);
1.65      matthew  1007:     if (! exists($ENV{'form.reportSelected'})) {
                   1008:         $ENV{'form.reportSelected'} = 'student_assessment';
                   1009:     }
                   1010:     #
                   1011:     # Give the LON-CAPA page header
                   1012:     $r->print(&Apache::lonhtmlcommon::Title('Course Statistics and Charts'));
                   1013:     $r->rflush();
                   1014:     #
1.66      matthew  1015:     if (! &Apache::lonmysql::verify_sql_connection()) {
                   1016:         my $serveradmin = $r->dir_config('lonAdmEMail');
                   1017:         $r->print(<<END);
                   1018: <h2><font color="Red">Unable to connect to database!</font></h2>
                   1019: <p>
                   1020: Please notify the server administrator <b>$serveradmin</b>.
                   1021: </p><p>
                   1022: Course Statistics and Charts cannot be retrieved until the database is
                   1023: restarted.  Your data is intact but cannot be displayed at this time.
                   1024: </p>
                   1025: </body>
                   1026: </html>
                   1027: END
                   1028:         return;
1.67      matthew  1029:     }
                   1030:     #
                   1031:     # Clean out the caches
                   1032:     if (exists($ENV{'form.ClearCache'})) {
                   1033:         &Apache::loncoursedata::delete_caches($ENV{'requres.course.id'});
1.66      matthew  1034:     }
                   1035:     #
1.65      matthew  1036:     # Set up the statistics and chart environment
1.71      matthew  1037:     &PrepareClasslist();
1.60      matthew  1038:     &PrepareCourseData($r);
1.65      matthew  1039:     #
                   1040:     # Begin form output
                   1041:     $r->print('<form name="Statistics" ');
                   1042:     $r->print('method="post" action="/adm/statistics">');
                   1043:     #
                   1044:     # Print main menu
                   1045:     my %reports = ('classlist'          => 'Class list',
                   1046:                    'problem_statistics' => 'Problem Statistics',
1.66      matthew  1047:                    'student_assessment' => 'Problem Status Chart',
1.74      matthew  1048: #                   'percentage'         => 'Correct-problems Plot',
                   1049: #                   'option_response'    => 'Option Response Analysis',
1.65      matthew  1050: #                   'activitylog'        => 'Activity Log',
                   1051:                    );
                   1052:     $r->print(&CreateMainMenu($ENV{'form.status'},
                   1053:                               \%reports,$ENV{'form.reportSelected'}));
                   1054:     $r->rflush();
                   1055:     #
                   1056:     my $GoToPage = $ENV{'form.reportSelected'};
                   1057:     if($GoToPage eq 'activitylog') {
                   1058: #        &Apache::lonproblemstatistics::Activity();
                   1059:     } elsif($GoToPage eq 'problem_statistics') {
                   1060:         &Apache::lonproblemstatistics::BuildProblemStatisticsPage($r,$c);
                   1061:     } elsif($GoToPage eq 'option_response') {
                   1062: #        &Apache::lonproblemanalysis::BuildProblemAnalysisPage($r,$c);
                   1063:     } elsif($GoToPage eq 'student_assessment') {
                   1064:         &Apache::lonstudentassessment::BuildStudentAssessmentPage($r,$c);
                   1065:     } elsif($GoToPage eq 'DoDiffGraph' || $GoToPage eq 'PercentWrongGraph') {
                   1066: #        &Apache::lonproblemstatistics::BuildGraphicChart($r,$c);
                   1067:     } elsif($GoToPage eq 'Correct-problems Plot') {
                   1068: #	&Apache::lonpercentage::BuildPercentageGraph($r,$c);
                   1069:     }
                   1070:     #
                   1071:     $r->print("</form>\n");
                   1072:     $r->print("</body>\n</html>\n");
                   1073:     $r->rflush();
                   1074:     #
1.27      stredwic 1075:     return OK;
1.1       albertel 1076: }
1.65      matthew  1077: 
1.1       albertel 1078: 1;
1.59      matthew  1079: 
1.65      matthew  1080: #######################################################
                   1081: #######################################################
                   1082: 
1.59      matthew  1083: =pod
                   1084: 
                   1085: =back
                   1086: 
                   1087: =cut
1.65      matthew  1088: 
                   1089: #######################################################
                   1090: #######################################################
1.59      matthew  1091: 
1.1       albertel 1092: __END__
1.31      minaeibi 1093: 

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