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