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