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