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