Annotation of loncom/interface/lonstatistics.pm, revision 1.60
1.1 albertel 1: # The LearningOnline Network with CAPA
2: #
1.60 ! matthew 3: # $Id: lonstatistics.pm,v 1.59 2003/02/18 20:27: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;
! 54: use GDBM_File;
1.59 matthew 55:
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);
64: use Apache::lonnet();
65: use Apache::lonhomework;
1.12 minaeibi 66: use Apache::loncommon;
1.29 stredwic 67: use Apache::loncoursedata;
68: use Apache::lonhtmlcommon;
1.30 stredwic 69: use Apache::lonproblemanalysis;
70: use Apache::lonproblemstatistics;
71: use Apache::lonstudentassessment;
1.49 stredwic 72: use Apache::lonpercentage;
1.1 albertel 73: use GDBM_File;
74:
1.60 ! matthew 75: use vars qw/@FullClasslist @Students @Sections @SelectedSections
! 76: $curr_student $prev_student $next_student
! 77: $top_map @Sequences @Assessments /;
! 78:
! 79: #######################################################
! 80: #######################################################
! 81:
! 82: =pod
! 83:
! 84: =item Package Variables
! 85:
! 86: =item @FullClasslist The full classlist
! 87:
! 88: =item @Students The students we are concerned with for this invocation
! 89:
! 90: =item @Sections The sections available in this class
! 91:
! 92: =item $curr_student The student currently being examined
! 93:
! 94: =item $prev_student The student previous in the classlist
! 95:
! 96: =item $next_student The student next in the classlist
! 97:
! 98: =over
! 99:
! 100: =cut
! 101:
! 102: #######################################################
! 103: #######################################################
! 104: #
! 105: # Classlist variables
! 106: #
1.59 matthew 107: my @FullClasslist;
108: my @Students;
109: my @Sections;
1.60 ! matthew 110: my @SelectedSections;
1.59 matthew 111: my $curr_student;
112: my $prev_student;
113: my $next_student;
114:
115: #######################################################
116: #######################################################
117:
118: =pod
119:
120: =item &clear_classlist_variables()
121:
122: undef the following package variables:
123:
124: =over
125:
1.60 ! matthew 126: =item @FullClasslist
! 127:
! 128: =item @Students
1.59 matthew 129:
1.60 ! matthew 130: =item @Sections
1.59 matthew 131:
1.60 ! matthew 132: =item @SelectedSections
1.59 matthew 133:
1.60 ! matthew 134: =item $curr_student
1.59 matthew 135:
1.60 ! matthew 136: =item $prev_student
1.59 matthew 137:
1.60 ! matthew 138: =item $next_student
1.59 matthew 139:
140: =back
141:
142: =cut
143:
144: #######################################################
145: #######################################################
146: sub clear_classlist_variables {
147: undef(@FullClasslist);
148: undef(@Students);
149: undef(@Sections);
1.60 ! matthew 150: undef(@SelectedSections);
1.59 matthew 151: undef($curr_student);
152: undef($prev_student);
153: undef($next_student);
154: }
155:
156: #######################################################
157: #######################################################
158:
159: =pod
160:
161: =item &PrepareClasslist()
162:
163: Build up the classlist information. The classlist information is kept in
164: the following package variables:
165:
166: =over
167:
1.60 ! matthew 168: =item @FullClasslist
! 169:
! 170: =item @Students
1.59 matthew 171:
1.60 ! matthew 172: =item @Sections
1.59 matthew 173:
1.60 ! matthew 174: =item @SelectedSections
1.59 matthew 175:
1.60 ! matthew 176: =item $curr_student
1.59 matthew 177:
1.60 ! matthew 178: =item $prev_student
1.59 matthew 179:
1.60 ! matthew 180: =item $next_student
1.59 matthew 181:
182: =back
183:
184: $curr_student, $prev_student, and $next_student may not be defined, depending
185: upon the calling context.
186:
187: =cut
188:
189: #######################################################
190: #######################################################
191: sub PrepareClasslist {
192: my $r = shift;
193: my %Sections;
194: &clear_classlist_variables();
195: #
196: # Retrieve the classlist
197: my $cid = $ENV{'request.course.id'};
198: my $cdom = $ENV{'course.'.$cid.'.domain'};
199: my $cnum = $ENV{'course.'.$cid.'.num'};
200: my ($classlist,$field_names) = &Apache::loncoursedata::get_classlist($cid,
201: $cdom,$cnum);
1.60 ! matthew 202: if (exists($ENV{'form.Section'})) {
1.59 matthew 203: if (ref($ENV{'form.Section'})) {
1.60 ! matthew 204: @SelectedSections = @$ENV{'form.Section'};
! 205: # Remove the empty sections
! 206: for (my $i=0; $i<=$#SelectedSections; $i++) {
! 207: if ($SelectedSections[$i] =~ /^\s*$/) {
! 208: splice(@SelectedSections,$i,1);
! 209: }
1.59 matthew 210: }
211: } else {
1.60 ! matthew 212: if ($ENV{'form.Section'} !~ /^\s*$/) {
! 213: @SelectedSections = ($ENV{'form.Section'});
! 214: }
1.59 matthew 215: }
216: }
1.60 ! matthew 217: @SelectedSections = ('any') if (! @SelectedSections);
1.59 matthew 218: #
219: # Process the classlist
220: while (my ($student,$student_data) = each (%$classlist)) {
221: my $studenthash = ();
222: for (my $i=0; $i< scalar(@$field_names);$i++) {
223: $studenthash->{$field_names->[$i]}=$student_data->[$i];
224: }
225: push (@FullClasslist,$studenthash);
226: #
227: # Build up a list of sections
228: my $section = $studenthash->{'section'};
1.60 ! matthew 229: if (! defined($section) || $section =~/^\s*$/ || $section == -1) {
! 230: $studenthash->{'section'} = 'none';
! 231: $section = $studenthash->{'section'};
! 232: }
1.59 matthew 233: $Sections{$section}++;
234: #
235: # Only put in the list those students we are interested in
1.60 ! matthew 236: foreach my $sect (@SelectedSections) {
! 237: if (($sect eq 'any') || ($section eq $sect)) {
! 238: push (@Students,$studenthash);
! 239: last;
! 240: }
1.59 matthew 241: }
242: }
243: #
244: # Put the consolidated section data in the right place
1.60 ! matthew 245: @Sections = sort {$a cmp $b} keys(%Sections);
1.59 matthew 246: #
247: # Sort the Students
248: my $sortby = 'fullname';
1.60 ! matthew 249: $sortby = $ENV{'form.sort'} if (exists($ENV{'form.sort'}));
! 250: my @TmpStudents = sort { $a->{$sortby} cmp $b->{$sortby} ||
! 251: $a->{'fullname'} cmp $b->{'fullname'} } @Students;
! 252:
! 253: @Students = @TmpStudents;
1.59 matthew 254: #
255: # Now deal with that current student thing....
256: if (exists($ENV{'form.StudentAssessmentStudent'})) {
257: my ($current_uname,$current_dom) =
258: split(':',$ENV{'form.StudentAssessmentStudent'});
259: my $i;
260: for ($i = 0; $i<=$#Students; $i++) {
261: next if (($Students[$i]->{'username'} ne $current_uname) ||
262: ($Students[$i]->{'domain'} ne $current_dom));
1.60 ! matthew 263: $curr_student = $Students[$i];
1.59 matthew 264: last; # If we get here, we have our student.
265: }
266: if ($i == 0) {
267: $prev_student = 'none';
268: } else {
269: $prev_student = $Students[$i-1];
270: }
271: if ($i == $#Students) {
272: $next_student = 'none';
273: } else {
274: $next_student = $Students[$i+1];
275: }
276: }
277: }
278:
279: #######################################################
280: #######################################################
1.60 ! matthew 281: #
! 282: # Course Sequences variables
! 283: #
! 284: my $top_map;
! 285: my @Sequences;
! 286: my @Assessments;
! 287:
! 288: #######################################################
! 289: #######################################################
! 290:
! 291: =pod
! 292:
! 293: =item &clear_sequence_variables()
! 294:
! 295: =cut
! 296:
! 297: #######################################################
! 298: #######################################################
! 299: sub clear_sequence_variables {
! 300: undef($top_map);
! 301: undef(@Sequences);
! 302: undef(@Assessments);
! 303: }
! 304:
! 305: #######################################################
! 306: #######################################################
! 307:
! 308: =pod
! 309:
! 310: =item &PrepareCourseData($r)
! 311:
! 312: =cut
! 313:
! 314: #######################################################
! 315: #######################################################
! 316: sub PrepareCourseData {
! 317: my ($r) = @_;
! 318: &clear_sequence_variables();
! 319: my ($top,$sequences,$assessments) = &Apache::loncoursedata::get_sequence_assessment_data();
! 320: if (! defined($top) || ! ref($top)) {
! 321: # There has been an error, better report it
! 322: &Apache::lonnet::logthis('top is undefined');
! 323: return;
! 324: }
! 325: $top_map = $top if (ref($top));
! 326: @Sequences = @{$sequences} if (ref($sequences) eq 'ARRAY');
! 327: @Assessments = @{$assessments} if (ref($assessments) eq 'HASH');
! 328:
! 329: =pod
! 330:
! 331: ##
! 332: ## Debugging code
! 333: ##
! 334: foreach my $s (@Sequences) {
! 335: next if ($s->{'title'} ne 'Bioenergetics: Enzyme Regulation');
! 336: &Apache::lonnet::logthis('-----------------------------------');
! 337: &Apache::lonnet::logthis('title = '.$s->{'title'});
! 338: &Apache::lonnet::logthis('symb = '.$s->{'symb'});
! 339: &Apache::lonnet::logthis('num_assess = '.$s->{'num_assess'});
! 340: foreach my $a (@{$s->{'contents'}}) {
! 341: &Apache::lonnet::logthis(' --------------------------------');
! 342: &Apache::lonnet::logthis(' title = '.$a->{'title'});
! 343: &Apache::lonnet::logthis(' symb = '.$a->{'symb'});
! 344: }
! 345: }
! 346:
! 347: =cut
! 348:
! 349: return;
! 350: }
! 351:
! 352: ##############################################
! 353: ##############################################
! 354:
! 355: =pod
! 356:
! 357: =item &MapSelect($elementname,$status,$numvisible,$selected,$restriction)
! 358:
! 359: Returns html for a selection box allowing the user to choose one (or more)
! 360: of the sequences in the course. The values of the sequences are the symbs.
! 361: If the top sequence is selected, the value 'top' will result.
! 362:
! 363: =over 4
! 364:
! 365: =item $elementname The name of the HTML form element
! 366:
! 367: =item $status 'multiple' or 'single' selection box
! 368:
! 369: =item $numvisible The number of options to be visible
! 370:
! 371: =item $selected Array ref to the names of the already selected maps.
! 372: If undef, $ENV{'form.'.$elementname} is used.
! 373: If $ENV{'form.'.$elementname} is also empty, none will be selected.
! 374:
! 375: =item $restriction Code reference to subroutine which returns true or
! 376: false. The code must expect a reference to a sequence data structure.
! 377:
! 378: =back
! 379:
! 380: =cut
! 381:
! 382: ##############################################
! 383: ##############################################
! 384: sub MapSelect {
! 385: my ($elementname,$status,$numvisible,$selected,$restriction)=@_;
! 386: if ($numvisible < 1) {
! 387: return;
! 388: }
! 389: #
! 390: # Set up array of selected items
! 391: my @Selected;
! 392: if (! defined($selected)) {
! 393: if (exists($ENV{'form.'.$elementname})) {
! 394: if (ref($ENV{'form.'.$elementname})) {
! 395: @Selected = @$ENV{'form.'.$elementname};
! 396: } else {
! 397: @Selected = ($ENV{'form.'.$elementname});
! 398: }
! 399: } else {
! 400: @Selected = ();
! 401: }
! 402: } else {
! 403: if (ref($selected)) {
! 404: @Selected = @$selected;
! 405: } else {
! 406: @Selected = ($selected);
! 407: }
! 408: }
! 409: #
! 410: # Set up the restriction call
! 411: if (! defined($restriction)) {
! 412: $restriction = sub { 1; };
! 413: }
! 414: #
! 415: # Build the form element
! 416: my $Str = "\n";
! 417: $Str .= '<select name="'.$elementname.'" ';
! 418: if ($status ne 'single') {
! 419: $Str .= 'multiple="true" ';
! 420: }
! 421: $Str .= 'size="'.$numvisible.'" >'."\n";
! 422: #
! 423: # Loop through the sequences
! 424: foreach my $s (@Sequences) {
! 425: next if (! $restriction->($s));
! 426: $Str .= ' <option value="'.$s->{'symb'}.'" ';
! 427: foreach (@Selected) {
! 428: if ($s->{'symb'} eq $_) {
! 429: $Str .= 'selected ';
! 430: last;
! 431: }
! 432: }
! 433: $Str .= '>'.$s->{'title'}."</option>\n";
! 434: }
! 435: $Str .= "</select>\n";
! 436: return $Str;
! 437: }
! 438:
! 439:
! 440: ##############################################
! 441: ##############################################
! 442:
! 443: =pod
! 444:
! 445: =item &SectionSelect($elementname,$status,$numvisible)
! 446:
! 447: Returns html for a selection box allowing the user to choose one (or more)
! 448: of the sections in the course.
! 449:
! 450: =over 4
! 451:
! 452: =item $elementname The name of the HTML form element
! 453:
! 454: =item $status 'multiple' or 'single' selection box
! 455:
! 456: =item $numvisible The number of options to be visible
! 457:
! 458: =item $selected Array ref to the names of the already selected sections.
! 459: If undef, $ENV{'form.'.$elementname} is used.
! 460: If $ENV{'form.'.$elementname} is also empty, none will be selected.
! 461:
! 462: =item $restriction Code reference to subroutine which returns true or
! 463: false. The code must expect a reference to a sequence data structure.
! 464:
! 465: =back
! 466:
! 467: =cut
! 468:
! 469: ##############################################
! 470: ##############################################
! 471: sub SectionSelect {
! 472: my ($elementname,$status,$numvisible)=@_;
! 473: if ($numvisible < 1) {
! 474: return;
! 475: }
! 476: #
! 477: # Build the form element
! 478: my $Str = "\n";
! 479: $Str .= '<select name="'.$elementname.'" ';
! 480: if ($status ne 'single') {
! 481: $Str .= 'multiple="true" ';
! 482: }
! 483: $Str .= 'size="'.$numvisible.'" >'."\n";
! 484: #
! 485: # Loop through the sequences
! 486: foreach my $s (@Sections) {
! 487: $Str .= ' <option value="'.$s.'" ';
! 488: foreach (@SelectedSections) {
! 489: if ($s eq $_ || $_ =~ /^(any|all)$/) {
! 490: $Str .= 'selected ';
! 491: last;
! 492: }
! 493: }
! 494: $Str .= '>'.$s."</option>\n";
! 495: }
! 496: $Str .= "</select>\n";
! 497: return $Str;
! 498: }
! 499:
! 500: ##############################################
! 501: ##############################################
1.27 stredwic 502:
503: sub CheckFormElement {
504: my ($cache, $ENVName, $cacheName, $default)=@_;
505:
506: if(defined($ENV{'form.'.$ENVName})) {
507: $cache->{$cacheName} = $ENV{'form.'.$ENVName};
508: } elsif(!defined($cache->{$cacheName})) {
509: $cache->{$cacheName} = $default;
1.60 ! matthew 510: } else {
! 511: $ENV{'form.'.$ENVName} = $cache->{$cacheName};
1.27 stredwic 512: }
513: return;
514: }
515:
516: sub ProcessFormData{
1.29 stredwic 517: my ($cache)=@_;
1.27 stredwic 518:
1.29 stredwic 519: $cache->{'reportKey'} = 'false';
1.27 stredwic 520:
1.29 stredwic 521: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.60 ! matthew 522: ['download',
1.34 stredwic 523: 'reportSelected',
1.41 stredwic 524: 'StudentAssessmentStudent',
525: 'ProblemStatisticsSort']);
1.56 matthew 526: &CheckFormElement($cache, 'DownloadAll', 'DownloadAll', 'false');
527: if ($cache->{'DownloadAll'} ne 'false') {
528: # Clean the hell out of that cache!
529: # We cannot untie the hash at this scope (stupid libgd :( )
530: # So, remove every single key. What a waste of time....
531: # Of course, if you are doing this you are probably resigned
532: # to waiting a while.
533: &Apache::lonnet::logthis("Cleaning out the cache file");
534: while (my ($key,undef)=each(%$cache)) {
535: next if ($key eq 'DownloadAll');
536: delete($cache->{$key});
537: }
538: }
1.29 stredwic 539: &CheckFormElement($cache, 'Status', 'Status', 'Active');
540: &CheckFormElement($cache, 'postdata', 'reportSelected', 'Class list');
541: &CheckFormElement($cache, 'reportSelected', 'reportSelected',
542: 'Class list');
1.30 stredwic 543: $cache->{'reportSelected'} =
544: &Apache::lonnet::unescape($cache->{'reportSelected'});
1.29 stredwic 545: &CheckFormElement($cache, 'sort', 'sort', 'fullname');
546: &CheckFormElement($cache, 'download', 'download', 'false');
1.44 stredwic 547: &CheckFormElement($cache, 'StatisticsMaps',
548: 'StatisticsMaps', 'All Maps');
1.49 stredwic 549: &CheckFormElement($cache, 'StatisticsProblemSelect',
550: 'StatisticsProblemSelect', 'All Problems');
551: &CheckFormElement($cache, 'StatisticsPartSelect',
552: 'StatisticsPartSelect', 'All Parts');
1.44 stredwic 553: if(defined($ENV{'form.Section'})) {
554: my @sectionsSelected = (ref($ENV{'form.Section'}) ?
555: @{$ENV{'form.Section'}} :
556: ($ENV{'form.Section'}));
557: $cache->{'sectionsSelected'} = join(':', @sectionsSelected);
558: } elsif(!defined($cache->{'sectionsSelected'})) {
559: $cache->{'sectionsSelected'} = $cache->{'sectionList'};
560: }
1.29 stredwic 561:
1.38 stredwic 562: # student assessment
1.29 stredwic 563: if(defined($ENV{'form.CreateStudentAssessment'}) ||
564: defined($ENV{'form.NextStudent'}) ||
565: defined($ENV{'form.PreviousStudent'})) {
566: $cache->{'reportSelected'} = 'Student Assessment';
567: }
568: if(defined($ENV{'form.NextStudent'})) {
569: $cache->{'StudentAssessmentMove'} = 'next';
570: } elsif(defined($ENV{'form.PreviousStudent'})) {
571: $cache->{'StudentAssessmentMove'} = 'previous';
572: } else {
573: $cache->{'StudentAssessmentMove'} = 'selected';
574: }
575: &CheckFormElement($cache, 'StudentAssessmentStudent',
1.30 stredwic 576: 'StudentAssessmentStudent', 'All Students');
577: $cache->{'StudentAssessmentStudent'} =
578: &Apache::lonnet::unescape($cache->{'StudentAssessmentStudent'});
1.34 stredwic 579: &CheckFormElement($cache, 'DefaultColumns', 'DefaultColumns', 'false');
1.29 stredwic 580:
1.38 stredwic 581: # Problem analysis
582: &CheckFormElement($cache, 'Interval', 'Interval', '1');
583:
584: # ProblemStatistcs
585: &CheckFormElement($cache, 'DisplayCSVFormat',
586: 'DisplayFormat', 'Display Table Format');
587: &CheckFormElement($cache, 'ProblemStatisticsAscend',
588: 'ProblemStatisticsAscend', 'Ascending');
1.41 stredwic 589: &CheckFormElement($cache, 'ProblemStatisticsSort',
590: 'ProblemStatisticsSort', 'Homework Sets Order');
1.49 stredwic 591: &CheckFormElement($cache, 'DisplayLegend', 'DisplayLegend',
592: 'Hide Legend');
1.45 stredwic 593: &CheckFormElement($cache, 'SortProblems', 'SortProblems',
594: 'Sort Within Sequence');
1.38 stredwic 595:
596: # Search only form elements
1.34 stredwic 597: my @headingColumns=();
598: my @sequenceColumns=();
599: my $foundColumn = 0;
600: if(defined($ENV{'form.ReselectColumns'})) {
601: my @reselected = (ref($ENV{'form.ReselectColumns'}) ?
602: @{$ENV{'form.ReselectColumns'}}
603: : ($ENV{'form.ReselectColumns'}));
604: foreach (@reselected) {
605: if(/HeadingColumn/) {
606: push(@headingColumns, $_);
607: $foundColumn = 1;
608: } elsif(/SequenceColumn/) {
609: push(@sequenceColumns, $_);
610: $foundColumn = 1;
611: }
612: }
613: }
614:
1.37 stredwic 615: $cache->{'reportKey'} = 'false';
616: if($cache->{'reportSelected'} eq 'Analyze') {
617: $cache->{'reportKey'} = 'Analyze';
1.38 stredwic 618: } elsif($cache->{'reportSelected'} eq 'DoDiffGraph') {
619: $cache->{'reportKey'} = 'DoDiffGraph';
620: } elsif($cache->{'reportSelected'} eq 'PercentWrongGraph') {
621: $cache->{'reportKey'} = 'PercentWrongGraph';
622: }
623:
624: if(defined($ENV{'form.DoDiffGraph'})) {
625: $cache->{'reportSelected'} = 'DoDiffGraph';
626: $cache->{'reportKey'} = 'DoDiffGraph';
627: } elsif(defined($ENV{'form.PercentWrongGraph'})) {
628: $cache->{'reportSelected'} = 'PercentWrongGraph';
629: $cache->{'reportKey'} = 'PercentWrongGraph';
1.37 stredwic 630: }
631:
1.29 stredwic 632: foreach (keys(%ENV)) {
1.37 stredwic 633: if(/form\.Analyze/) {
634: $cache->{'reportSelected'} = 'Analyze';
635: $cache->{'reportKey'} = 'Analyze';
636: my $data;
637: (undef, $data)=split(':::', $_);
638: $cache->{'AnalyzeInfo'}=$data;
1.34 stredwic 639: } elsif(/form\.HeadingColumn/) {
640: my $value = $_;
641: $value =~ s/form\.//;
642: push(@headingColumns, $value);
643: $foundColumn=1;
644: } elsif(/form\.SequenceColumn/) {
645: my $value = $_;
646: $value =~ s/form\.//;
647: push(@sequenceColumns, $value);
648: $foundColumn=1;
1.27 stredwic 649: }
1.29 stredwic 650: }
1.27 stredwic 651:
1.34 stredwic 652: if($foundColumn) {
653: $cache->{'HeadingsFound'} = join(':', @headingColumns);
654: $cache->{'SequencesFound'} = join(':', @sequenceColumns);;
655: }
656: if(!defined($cache->{'HeadingsFound'}) ||
657: $cache->{'DefaultColumns'} ne 'false') {
658: $cache->{'HeadingsFound'}='HeadingColumnFull Name';
659: }
660: if(!defined($cache->{'SequencesFound'}) ||
661: $cache->{'DefaultColumns'} ne 'false') {
662: $cache->{'SequencesFound'}='All Sequences';
663: }
664: $cache->{'DefaultColumns'} = 'false';
665:
1.29 stredwic 666: return;
1.27 stredwic 667: }
668:
669: =pod
670:
671: =item &SortStudents()
672:
673: Determines which students to display and in which order. Which are
674: displayed are determined by their status(active/expired). The order
675: is determined by the sort button pressed (default to username). The
676: type of sorting is username, lastname, or section.
677:
678: =over 4
679:
680: Input: $students, $CacheData
681:
682: $students: A array pointer to a list of students (username:domain)
683:
684: $CacheData: A pointer to the hash tied to the cached data
685:
686: Output: \@order
687:
688: @order: An ordered list of students (username:domain)
689:
690: =back
691:
692: =cut
693:
694: sub SortStudents {
1.29 stredwic 695: my ($cache)=@_;
1.27 stredwic 696:
1.29 stredwic 697: my @students = split(':::',$cache->{'NamesOfStudents'});
1.27 stredwic 698: my @sorted1Students=();
1.29 stredwic 699: foreach (@students) {
700: if($cache->{'Status'} eq 'Any' ||
701: $cache->{$_.':Status'} eq $cache->{'Status'}) {
702: push(@sorted1Students, $_);
703: }
1.1 albertel 704: }
1.27 stredwic 705:
1.29 stredwic 706: my $sortBy = '';
707: if(defined($cache->{'sort'})) {
708: $sortBy = ':'.$cache->{'sort'};
1.54 matthew 709: } else {
710: $sortBy = ':fullname';
1.27 stredwic 711: }
1.54 matthew 712: my @order = sort { lc($cache->{$a.$sortBy}) cmp lc($cache->{$b.$sortBy}) ||
713: lc($cache->{$a.':fullname'}) cmp lc($cache->{$b.':fullname'}) }
1.29 stredwic 714: @sorted1Students;
1.27 stredwic 715:
716: return \@order;
717: }
718:
1.32 stredwic 719: =pod
720:
721: =item &SpaceColumns()
722:
723: Determines the width of all the columns in the chart. It is based on
724: the max of the data for that column and its header.
725:
726: =over 4
727:
728: Input: $students, $studentInformation, $headings, $ChartDB
729:
730: $students: An array pointer to a list of students (username:domain)
731:
732: $studentInformatin: The type of data for the student information. It is
733: used as part of the key in $CacheData.
734:
735: $headings: The name of the student information columns.
736:
737: $ChartDB: The name of the cache database which is opened for read/write.
738:
739: Output: None - All data stored in cache.
740:
741: =back
742:
743: =cut
744:
745: sub SpaceColumns {
746: my ($students,$studentInformation,$headings,$cache)=@_;
747:
748: # Initialize Lengths
749: for(my $index=0; $index<(scalar @$headings); $index++) {
750: my @titleLength=split(//,$headings->[$index]);
751: $cache->{$studentInformation->[$index].':columnWidth'}=
752: scalar @titleLength;
753: }
754:
755: foreach my $name (@$students) {
756: foreach (@$studentInformation) {
757: my @dataLength=split(//,$cache->{$name.':'.$_});
758: my $length=(scalar @dataLength);
759: if($length > $cache->{$_.':columnWidth'}) {
760: $cache->{$_.':columnWidth'}=$length;
761: }
762: }
763: }
764:
765: return;
766: }
767:
1.27 stredwic 768: sub PrepareData {
1.38 stredwic 769: my ($c, $cacheDB, $studentInformation, $headings,$r)=@_;
1.27 stredwic 770:
771: # Test for access to the cache data
772: my $courseID=$ENV{'request.course.id'};
773: my $isRecalculate=0;
1.29 stredwic 774: if(defined($ENV{'form.Recalculate'})) {
1.27 stredwic 775: $isRecalculate=1;
776: }
777:
1.55 minaeibi 778: my $isCached = &Apache::loncoursedata::TestCacheData($cacheDB,
1.29 stredwic 779: $isRecalculate);
1.27 stredwic 780: if($isCached < 0) {
781: return "Unable to tie hash to db file.";
782: }
783:
784: # Download class list information if not using cached data
785: my %cache;
1.38 stredwic 786: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
1.29 stredwic 787: return "Unable to tie hash to db file.";
788: }
789:
1.50 stredwic 790: # if(!$isCached) {
1.27 stredwic 791: my $processTopResourceMapReturn=
1.50 stredwic 792: &Apache::loncoursedata::ProcessTopResourceMap(\%cache, $c);
1.27 stredwic 793: if($processTopResourceMapReturn ne 'OK') {
794: untie(%cache);
795: return $processTopResourceMapReturn;
796: }
1.50 stredwic 797: # }
1.27 stredwic 798:
1.29 stredwic 799: if($c->aborted()) {
800: untie(%cache);
801: return 'aborted';
802: }
1.27 stredwic 803:
1.29 stredwic 804: my $classlist=&Apache::loncoursedata::DownloadClasslist($courseID,
805: $cache{'ClasslistTimestamp'},
806: $c);
807: foreach (keys(%$classlist)) {
808: if(/^(con_lost|error|no_such_host)/i) {
1.27 stredwic 809: untie(%cache);
810: return "Error getting student data.";
811: }
1.29 stredwic 812: }
1.27 stredwic 813:
1.29 stredwic 814: if($c->aborted()) {
815: untie(%cache);
816: return 'aborted';
817: }
818:
819: # Active is a temporary solution, remember to change
820: Apache::loncoursedata::ProcessClasslist(\%cache,$classlist,$courseID,$c);
821: if($c->aborted()) {
822: untie(%cache);
823: return 'aborted';
824: }
1.27 stredwic 825:
1.29 stredwic 826: &ProcessFormData(\%cache);
827: my $students = &SortStudents(\%cache);
1.32 stredwic 828: &SpaceColumns($students, $studentInformation, $headings, \%cache);
829: $cache{'updateTime:columnWidth'}=24;
1.27 stredwic 830:
1.48 stredwic 831: my $download = $cache{'download'};
832: my $downloadAll = $cache{'DownloadAll'};
833: my @allStudents=();
834: if($download ne 'false') {
1.29 stredwic 835: $cache{'download'} = 'false';
1.48 stredwic 836: } elsif($downloadAll ne 'false') {
837: $cache{'DownloadAll'} = 'false';
838: if($downloadAll eq 'sorted') {
839: @allStudents = @$students;
840: } else {
841: @allStudents = split(':::', $cache{'NamesOfStudents'});
842: }
843: }
844:
845: untie(%cache);
846:
847: if($download ne 'false') {
848: my @who = ($download);
1.55 minaeibi 849: if(&Apache::loncoursedata::DownloadStudentCourseData(\@who, 'false',
850: $cacheDB, 'true',
1.41 stredwic 851: 'false', $courseID,
852: $r, $c) ne 'OK') {
853: return 'Stop at download individual';
854: }
1.48 stredwic 855: } elsif($downloadAll ne 'false') {
1.55 minaeibi 856: if(&Apache::loncoursedata::DownloadStudentCourseData(\@allStudents,
857: 'false',
858: $cacheDB, 'true',
1.41 stredwic 859: 'true', $courseID,
860: $r, $c) ne 'OK') {
861: return 'Stop at download all';
1.27 stredwic 862: }
1.29 stredwic 863: }
864:
865: return ('OK', $students);
1.27 stredwic 866: }
867:
1.60 ! matthew 868: sub DisplayClasslist {
! 869: my ($r)=@_;
! 870: #
! 871: my @Fields = ('fullname','username','domain','id','section');
! 872: #
! 873: my $Str='';
! 874: $Str .= '<table border="0"><tr><td bgcolor="#777777">'."\n";
! 875: $Str .= '<table border="0" cellpadding="3"><tr bgcolor="#e6ffff">'."\n";
! 876: foreach my $field (@Fields) {
! 877: $Str .= '<th><a href="/adm/statistics?sort='.$field.'">'.$field.
! 878: '</a></th>';
! 879: }
! 880: $Str .= '</tr>'."\n";
! 881: #
! 882: my $alternate = 0;
! 883: foreach my $student (@Students) {
! 884: my $sname = $student->{'username'}.':'.$student->{'domain'};
! 885: if($alternate) {
! 886: $Str .= '<tr bgcolor="#ffffe6">';
! 887: } else {
! 888: $Str .= '<tr bgcolor="#ffffc6">';
! 889: }
! 890: $alternate = ($alternate + 1) % 2;
! 891: #
! 892: foreach my $field (@Fields) {
! 893: $Str .= '<td>';
! 894: if ($field eq 'fullname') {
! 895: $Str .= '<a href="/adm/statistics?reportSelected=';
! 896: $Str .= &Apache::lonnet::escape('Student Assessment');
! 897: $Str .= '&StudentAssessmentStudent=';
! 898: $Str .= &Apache::lonnet::escape($student->{$field}).'">';
! 899: $Str .= $student->{$field}.' ';
! 900: $Str .= '</a>';
! 901: } else {
! 902: $Str .= $student->{$field};
! 903: }
! 904: $Str .= '</td>';
! 905: }
! 906: $Str .= "</tr>\n";
! 907: }
! 908: $Str .= '</table></td></tr></table>'."\n";
! 909: #
! 910: $r->print($Str);
! 911: $r->rflush();
! 912: #
! 913: return;
! 914: }
! 915:
1.29 stredwic 916: sub BuildClasslist {
1.39 stredwic 917: my ($cacheDB,$students,$studentInformation,$headings,$r)=@_;
1.29 stredwic 918:
919: my %cache;
1.38 stredwic 920: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
1.29 stredwic 921: return '<html><body>Unable to tie database.</body></html>';
1.1 albertel 922: }
923:
1.55 minaeibi 924: # my $Ptr = '';
925: # $Ptr .= '<table border="0"><tbody>';
926: # $Ptr .= '<tr><td align="right"><b>Select Sections</b>';
927: # $Ptr .= '</td>'."\n";
928: # $Ptr .= '<td align="left">'."\n";
929: # my @sectionsSelected = split(':',$cache{'sectionsSelected'});
930: # my @sections = split(':',$cache{'sectionList'});
931: # $Ptr .= &Apache::lonhtmlcommon::MultipleSectionSelect(\@sections,
932: # \@sectionsSelected,
933: # 'Statistics');
934: # $Ptr .= '</td></tr></table><br>';
935: # $r->print($Ptr);
936: # $r->rflush();
937: # my %mySections = ();
938: # foreach (@sections) { $mySections{$_} = 'True'; }
939: # $r->print("<br>$cache{'sectionsSelected'}<br>");
940:
1.29 stredwic 941: my $Str='';
942: $Str .= '<table border="0"><tr><td bgcolor="#777777">'."\n";
943: $Str .= '<table border="0" cellpadding="3"><tr bgcolor="#e6ffff">'."\n";
944:
945: my $displayString = '<td align="left"><a href="/adm/statistics?';
946: $displayString .= 'sort=LINKDATA">DISPLAYDATA </a></td>'."\n";
1.55 minaeibi 947: $Str .= &Apache::lonhtmlcommon::CreateHeadings(\%cache,
1.39 stredwic 948: $studentInformation,
1.32 stredwic 949: $headings, $displayString);
1.29 stredwic 950: $Str .= '</tr>'."\n";
1.39 stredwic 951:
1.29 stredwic 952: my $alternate=0;
953: foreach (@$students) {
1.55 minaeibi 954: # if ($mySections{$cache{$_.':'.'section'}} ne 'True') {next;}
1.29 stredwic 955: my ($username, $domain) = split(':', $_);
956: if($alternate) {
1.32 stredwic 957: $Str .= '<tr bgcolor="#ffffe6">';
1.29 stredwic 958: } else {
1.32 stredwic 959: $Str .= '<tr bgcolor="#ffffc6">';
1.29 stredwic 960: }
961: $alternate = ($alternate + 1) % 2;
962: foreach my $data (@$studentInformation) {
1.32 stredwic 963: $Str .= '<td>';
1.29 stredwic 964: if($data eq 'fullname') {
965: $Str .= '<a href="/adm/statistics?reportSelected=';
1.30 stredwic 966: $Str .= &Apache::lonnet::escape('Student Assessment');
967: $Str .= '&StudentAssessmentStudent=';
968: $Str .= &Apache::lonnet::escape($cache{$_.':'.$data}).'">';
1.32 stredwic 969: $Str .= $cache{$_.':'.$data}.' ';
1.29 stredwic 970: $Str .= '</a>';
1.32 stredwic 971: } elsif($data eq 'updateTime') {
972: $Str .= '<a href="/adm/statistics?reportSelected=';
973: $Str .= &Apache::lonnet::escape('Class list');
974: $Str .= '&download='.$_.'">';
975: $Str .= $cache{$_.':'.$data}.' ';
976: $Str .= ' </a>';
977: } else {
978: $Str .= $cache{$_.':'.$data}.' ';
1.29 stredwic 979: }
980:
1.32 stredwic 981: $Str .= '</td>'."\n";
1.29 stredwic 982: }
1.1 albertel 983: }
1.29 stredwic 984:
1.32 stredwic 985: $Str .= '</tr>'."\n";
1.29 stredwic 986: $Str .= '</table></td></tr></table>'."\n";
1.39 stredwic 987: $r->print($Str);
988: $r->rflush();
1.29 stredwic 989:
1.27 stredwic 990: untie(%cache);
1.1 albertel 991:
1.39 stredwic 992: return;
1.1 albertel 993: }
994:
1.33 stredwic 995: sub CreateMainMenu {
996: my ($status, $reports)=@_;
997:
998: my $Str = '';
999:
1000: $Str .= '<table border="0"><tbody><tr>'."\n";
1001: $Str .= '<td></td><td></td>'."\n";
1.57 minaeibi 1002: $Str .= '<td align="center"><b>Select a Report</b></td>'."\n";
1003: $Str .= '<td align="center"><b>Student Status</b></td></tr>'."\n";
1.33 stredwic 1004: $Str .= '<tr>'."\n";
1005: $Str .= '<td align="center"><input type="submit" name="Refresh" ';
1006: $Str .= 'value="Refresh" /></td>'."\n";
1007: $Str .= '<td align="center"><input type="submit" name="DownloadAll" ';
1008: $Str .= 'value="Update All Student Data" /></td>'."\n";
1009: $Str .= '<td align="center">';
1010: $Str .= '<select name="reportSelected" onchange="document.';
1011: $Str .= 'Statistics.submit()">'."\n";
1012:
1013: foreach (sort(keys(%$reports))) {
1014: next if($_ eq 'reportSelected');
1015: $Str .= '<option name="'.$_.'"';
1016: if($reports->{'reportSelected'} eq $reports->{$_}) {
1017: $Str .= ' selected=""';
1018: }
1019: $Str .= '>'.$reports->{$_}.'</option>'."\n";
1020: }
1021: $Str .= '</select></td>'."\n";
1022:
1023: $Str .= '<td align="center">';
1024: $Str .= &Apache::lonhtmlcommon::StatusOptions($status, 'Statistics');
1025: $Str .= '</td>'."\n";
1026:
1027: $Str .= '</tr></tbody></table>'."\n";
1028: $Str .= '<hr>'."\n";
1029:
1030: return $Str;
1031: }
1032:
1.29 stredwic 1033: sub BuildStatistics {
1034: my ($r)=@_;
1035:
1036: my $c = $r->connection;
1.32 stredwic 1037: my @studentInformation=('fullname','section','id','domain','username',
1038: 'updateTime');
1039: my @headings=('Full Name', 'Section', 'PID', 'Domain', 'User Name',
1040: 'Last Updated');
1.55 minaeibi 1041: my $spacing = ' ';
1.52 minaeibi 1042:
1.29 stredwic 1043: my %reports = ('classlist' => 'Class list',
1044: 'problem_statistics' => 'Problem Statistics',
1045: 'student_assessment' => 'Student Assessment',
1.58 minaeibi 1046: 'percentage' => 'Correct-problems Plot',
1.40 minaeibi 1047: # 'activitylog' => 'Activity Log',
1.29 stredwic 1048: 'reportSelected' => 'Class list');
1.27 stredwic 1049:
1050: my %cache;
1.29 stredwic 1051: my $courseID=$ENV{'request.course.id'};
1052: my $cacheDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
1053: "_$ENV{'user.domain'}_$courseID\_statistics.db";
1054:
1.47 www 1055: $r->print(&Apache::lonhtmlcommon::Title('Course Statistics and Charts'));
1.41 stredwic 1056:
1.55 minaeibi 1057: my ($returnValue, $students) = &PrepareData($c, $cacheDB,
1058: \@studentInformation,
1.38 stredwic 1059: \@headings,$r);
1.29 stredwic 1060: if($returnValue ne 'OK') {
1.41 stredwic 1061: $r->print($returnValue."\n".'</body></html>');
1.29 stredwic 1062: return OK;
1063: }
1.41 stredwic 1064: if(!$c->aborted()) {
1.55 minaeibi 1065: &Apache::loncoursedata::CheckForResidualDownload($cacheDB,
1.41 stredwic 1066: 'true', 'true',
1067: $courseID,
1068: $r, $c);
1069: }
1.29 stredwic 1070:
1071: my $GoToPage;
1.38 stredwic 1072: if(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
1.29 stredwic 1073: $GoToPage = $cache{'reportSelected'};
1074: $reports{'reportSelected'} = $cache{'reportSelected'};
1.55 minaeibi 1075: if(defined($cache{'reportKey'}) &&
1076: !exists($reports{$cache{'reportKey'}}) &&
1.37 stredwic 1077: $cache{'reportKey'} ne 'false') {
1078: $reports{$cache{'reportKey'}} = $cache{'reportSelected'};
1079: }
1.29 stredwic 1080:
1081: if(defined($cache{'OptionResponses'})) {
1.46 stredwic 1082: $reports{'problem_analysis'} = 'Option Response Analysis';
1.29 stredwic 1083: }
1084:
1085: $r->print('<form name="Statistics" ');
1086: $r->print('method="post" action="/adm/statistics">');
1.33 stredwic 1087: $r->print(&CreateMainMenu($cache{'Status'}, \%reports));
1.39 stredwic 1088: $r->rflush();
1.29 stredwic 1089: untie(%cache);
1090: } else {
1.27 stredwic 1091: $r->print('<html><body>Unable to tie database.</body></html>');
1.29 stredwic 1092: return OK;
1093: }
1094:
1095: if($GoToPage eq 'Activity Log') {
1.30 stredwic 1096: &Apache::lonproblemstatistics::Activity();
1.29 stredwic 1097: } elsif($GoToPage eq 'Problem Statistics') {
1.55 minaeibi 1098: &Apache::lonproblemstatistics::BuildProblemStatisticsPage($cacheDB,
1099: $students,
1100: $courseID,
1.36 minaeibi 1101: $c,$r);
1.46 stredwic 1102: } elsif($GoToPage eq 'Option Response Analysis') {
1.39 stredwic 1103: &Apache::lonproblemanalysis::BuildProblemAnalysisPage($cacheDB, $r);
1.29 stredwic 1104: } elsif($GoToPage eq 'Student Assessment') {
1.39 stredwic 1105: &Apache::lonstudentassessment::BuildStudentAssessmentPage($cacheDB,
1.37 stredwic 1106: $students,
1107: $courseID,
1108: 'Statistics',
1109: \@headings,
1110: $spacing,
1111: \@studentInformation,
1.39 stredwic 1112: $r, $c);
1.29 stredwic 1113: } elsif($GoToPage eq 'Analyze') {
1.55 minaeibi 1114: &Apache::lonproblemanalysis::BuildAnalyzePage($cacheDB, $students,
1.39 stredwic 1115: $courseID, $r);
1.40 minaeibi 1116: } elsif($GoToPage eq 'DoDiffGraph' || $GoToPage eq 'PercentWrongGraph') {
1.43 stredwic 1117: my $courseDescription = $ENV{'course.'.$courseID.'.description'};
1118: $courseDescription =~ s/\ /"_"/eg;
1119: &Apache::lonproblemstatistics::BuildGraphicChart($GoToPage, $cacheDB,
1120: $courseDescription,
1.45 stredwic 1121: $students, $courseID,
1122: $r, $c);
1.29 stredwic 1123: } elsif($GoToPage eq 'Class list') {
1.60 ! matthew 1124: &DisplayClasslist($r);
! 1125: # &BuildClasslist($cacheDB, $students, \@studentInformation,
! 1126: # \@headings, $r);
1.58 minaeibi 1127: } elsif($GoToPage eq 'Correct-problems Plot') {
1.49 stredwic 1128: &Apache::lonpercentage::BuildPercentageGraph($cacheDB, $students,
1129: $courseID, $c, $r);
1.27 stredwic 1130: }
1131:
1132: $r->print('</form>'."\n");
1.29 stredwic 1133: $r->print("\n".'</body>'."\n".'</html>');
1134: $r->rflush();
1.27 stredwic 1135:
1.29 stredwic 1136: return OK;
1.27 stredwic 1137: }
1.1 albertel 1138:
1139: # ================================================================ Main Handler
1140:
1141: sub handler {
1.31 minaeibi 1142: my $r=shift;
1.34 stredwic 1143:
1144: # $jr = $r;
1.51 www 1145:
1146: my $loaderror=&Apache::lonnet::overloaderror($r);
1147: if ($loaderror) { return $loaderror; }
1148: $loaderror=
1149: &Apache::lonnet::overloaderror($r,
1150: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
1151: if ($loaderror) { return $loaderror; }
1.1 albertel 1152:
1.27 stredwic 1153: unless(&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
1154: $ENV{'user.error.msg'}=
1155: $r->uri.":vgr:0:0:Cannot view grades for complete course";
1.55 minaeibi 1156: return HTTP_NOT_ACCEPTABLE;
1.27 stredwic 1157: }
1158:
1159: # Set document type for header only
1160: if($r->header_only) {
1161: if ($ENV{'browser.mathml'}) {
1162: $r->content_type('text/xml');
1163: } else {
1164: $r->content_type('text/html');
1165: }
1166: &Apache::loncommon::no_cache($r);
1167: $r->send_http_header;
1168: return OK;
1169: }
1170:
1171: unless($ENV{'request.course.fn'}) {
1.1 albertel 1172: my $requrl=$r->uri;
1.27 stredwic 1173: $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
1.55 minaeibi 1174: return HTTP_NOT_ACCEPTABLE;
1.27 stredwic 1175: }
1.1 albertel 1176:
1.27 stredwic 1177: $r->content_type('text/html');
1178: $r->send_http_header;
1.1 albertel 1179:
1.60 ! matthew 1180: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
! 1181: ['sort']);
! 1182:
1.59 matthew 1183: &PrepareClasslist($r);
1.60 ! matthew 1184:
! 1185: &PrepareCourseData($r);
1.59 matthew 1186:
1.29 stredwic 1187: &BuildStatistics($r);
1.27 stredwic 1188:
1189: return OK;
1.1 albertel 1190: }
1191: 1;
1.59 matthew 1192:
1193: =pod
1194:
1195: =back
1196:
1197: =cut
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