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