Annotation of loncom/interface/lonstatistics.pm, revision 1.71
1.1 albertel 1: # The LearningOnline Network with CAPA
2: #
1.71 ! matthew 3: # $Id: lonstatistics.pm,v 1.70 2003/05/13 14:30:26 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....
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));
1.60 matthew 310: $curr_student = $Students[$i];
1.59 matthew 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: }
1.61 matthew 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:
1.71 ! matthew 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:
1.61 matthew 365: #######################################################
366: #######################################################
367:
368: =pod
369:
370: =item ¤t_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: }
1.59 matthew 407: }
408:
409: #######################################################
410: #######################################################
1.61 matthew 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: }
1.60 matthew 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:
1.61 matthew 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: }
1.64 matthew 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;
1.61 matthew 499: }
500:
501: #######################################################
502: #######################################################
503:
504: =pod
505:
1.60 matthew 506: =item &PrepareCourseData($r)
507:
508: =cut
509:
510: #######################################################
511: #######################################################
512: sub PrepareCourseData {
513: my ($r) = @_;
514: &clear_sequence_variables();
1.61 matthew 515: my ($top,$sequences,$assessments) =
516: &Apache::loncoursedata::get_sequence_assessment_data();
1.60 matthew 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');
1.61 matthew 524: @Assessments = @{$assessments} if (ref($assessments) eq 'ARRAY');
525: #
526: # Compute column widths
527: foreach my $seq (@Sequences) {
1.63 matthew 528: my $name_length = length($seq->{'title'});
1.61 matthew 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
1.63 matthew 533: my $sum_length = 1+1+2*(length($num_parts));
1.61 matthew 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: #######################################################
1.60 matthew 546:
547: =pod
548:
1.61 matthew 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: }
1.60 matthew 598: }
1.61 matthew 599: &Apache::lonnet::logthis($padding.'end contents of '.$seq->{'title'});
600: &Apache::lonnet::logthis($padding.'-'x20);
1.60 matthew 601: }
1.61 matthew 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
1.60 matthew 624:
625: =cut
626:
1.61 matthew 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;
1.60 matthew 666: }
667:
668: ##############################################
669: ##############################################
670:
671: =pod
672:
1.61 matthew 673: =item &MapSelect($elementname,$status,$numvisible,$restriction)
1.60 matthew 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 {
1.61 matthew 697: my ($elementname,$status,$numvisible,$restriction)=@_;
1.60 matthew 698: if ($numvisible < 1) {
699: return;
700: }
701: #
702: # Set up array of selected items
1.61 matthew 703: &SetSelectedMaps($elementname);
1.60 matthew 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: #
1.61 matthew 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: #
1.60 matthew 736: # Loop through the sequences
1.61 matthew 737: foreach my $seq (@Sequences) {
738: next if (! $restriction->($seq));
739: $Str .= ' <option value="'.$seq->{'symb'}.'" ';
740: foreach (@SelectedMaps) {
741: if ($seq->{'symb'} eq $_) {
1.60 matthew 742: $Str .= 'selected ';
743: last;
744: }
745: }
1.61 matthew 746: $Str .= '>'.$seq->{'title'}."</option>\n";
1.60 matthew 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:
1.71 ! matthew 762: Uses the package variables @Sections and @SelectedSections
1.60 matthew 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: #
1.71 ! matthew 783: # Make sure we have the data we need to continue
! 784: if (! @Sections) {
! 785: &PrepareClasslist()
! 786: }
! 787: #
1.60 matthew 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) {
1.61 matthew 800: if ($s eq $_) {
1.60 matthew 801: $Str .= 'selected ';
802: last;
803: }
804: }
805: $Str .= '>'.$s."</option>\n";
806: }
807: $Str .= "</select>\n";
808: return $Str;
809: }
810:
1.61 matthew 811: ##################################################
812: ##################################################
1.60 matthew 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) {
1.65 matthew 822: $Str .= '<th><a href="/adm/statistics?reportSelected=classlist&sort='.$field.'">'.$field.
1.60 matthew 823: '</a></th>';
824: }
825: $Str .= '</tr>'."\n";
826: #
827: my $alternate = 0;
1.65 matthew 828: foreach my $student (@Students) { # @Students is a package variable
1.60 matthew 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=';
1.65 matthew 841: $Str .= &Apache::lonnet::escape('student_assessment');
1.60 matthew 842: $Str .= '&StudentAssessmentStudent=';
1.61 matthew 843: $Str .= &Apache::lonnet::escape($sname).'">';
1.60 matthew 844: $Str .= $student->{$field}.' ';
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:
1.65 matthew 861: ##############################################
862: ##############################################
1.33 stredwic 863: sub CreateMainMenu {
1.65 matthew 864: my ($status,$reports,$current)=@_;
865: #
1.33 stredwic 866: my $Str = '';
1.65 matthew 867: #
1.33 stredwic 868: $Str .= '<table border="0"><tbody><tr>'."\n";
1.63 matthew 869: $Str .= '<td></td>'."\n";
1.67 matthew 870: $Str .= '<td></td>'."\n";
1.57 minaeibi 871: $Str .= '<td align="center"><b>Select a Report</b></td>'."\n";
1.33 stredwic 872: $Str .= '<tr>'."\n";
1.65 matthew 873: #
1.67 matthew 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";
1.65 matthew 880: #
1.33 stredwic 881: $Str .= '<td align="center">';
1.65 matthew 882: $Str .= '<select name="reportSelected" >'."\n";
1.33 stredwic 883: foreach (sort(keys(%$reports))) {
1.65 matthew 884: $Str .= '<option value="'.$_.'"';
885: if($current eq $_) {
886: $Str .= ' selected';
1.33 stredwic 887: }
888: $Str .= '>'.$reports->{$_}.'</option>'."\n";
889: }
890: $Str .= '</select></td>'."\n";
1.65 matthew 891: #
1.33 stredwic 892: $Str .= '</tr></tbody></table>'."\n";
893: $Str .= '<hr>'."\n";
1.65 matthew 894: #
1.33 stredwic 895: return $Str;
896: }
897:
1.65 matthew 898: ##############################################
899: ##############################################
1.1 albertel 900: sub handler {
1.31 minaeibi 901: my $r=shift;
1.65 matthew 902: my $c = $r->connection();
903: #
904: # Check for overloading
1.51 www 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; }
1.65 matthew 911: #
912: # Check for access
1.69 matthew 913: if (! &Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
1.27 stredwic 914: $ENV{'user.error.msg'}=
1.69 matthew 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: }
1.27 stredwic 922: }
1.65 matthew 923: #
1.27 stredwic 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: }
1.65 matthew 935: #
936: # Send the header
1.27 stredwic 937: $r->content_type('text/html');
938: $r->send_http_header;
1.65 matthew 939: #
940: # Extract form elements from query string
1.60 matthew 941: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.65 matthew 942: ['sort','reportSelected',
1.61 matthew 943: 'StudentAssessmentStudent']);
1.65 matthew 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: #
1.66 matthew 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;
1.67 matthew 966: }
967: #
968: # Clean out the caches
969: if (exists($ENV{'form.ClearCache'})) {
970: &Apache::loncoursedata::delete_caches($ENV{'requres.course.id'});
1.66 matthew 971: }
972: #
1.65 matthew 973: # Set up the statistics and chart environment
1.71 ! matthew 974: &PrepareClasslist();
1.60 matthew 975: &PrepareCourseData($r);
1.65 matthew 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',
1.66 matthew 984: 'student_assessment' => 'Problem Status Chart',
1.65 matthew 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: #
1.27 stredwic 1014: return OK;
1.1 albertel 1015: }
1.65 matthew 1016:
1.1 albertel 1017: 1;
1.59 matthew 1018:
1.65 matthew 1019: #######################################################
1020: #######################################################
1021:
1.59 matthew 1022: =pod
1023:
1024: =back
1025:
1026: =cut
1.65 matthew 1027:
1028: #######################################################
1029: #######################################################
1.59 matthew 1030:
1.1 albertel 1031: __END__
1.31 minaeibi 1032:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonstatistics.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface