Annotation of loncom/interface/lonchart.pm, revision 1.58
1.1 www 1: # The LearningOnline Network with CAPA
1.25 minaeibi 2: # (Publication Handler
3: #
1.58 ! stredwic 4: # $Id: lonchart.pm,v 1.57 2002/07/08 15:03:25 stredwic Exp $
1.25 minaeibi 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.1 www 28: # Homework Performance Chart
29: #
30: # (Navigate Maps Handler
31: #
32: # (Page Handler
33: #
34: # (TeX Content Handler
1.27 minaeibi 35: # YEAR=2000
1.1 www 36: # 05/29/00,05/30 Gerd Kortemeyer)
37: # 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23,
38: # 10/02,10/10,10/14,10/16,10/18,10/19,10/31,11/6,11/14,11/16 Gerd Kortemeyer)
1.27 minaeibi 39: # YEAR=2001
1.14 minaeibi 40: # 3/1/1,6/1,17/1,29/1,30/1,31/1 Gerd Kortemeyer)
1.5 minaeibi 41: # 7/10/01 Behrouz Minaei
1.6 www 42: # 9/8 Gerd Kortemeyer
1.27 minaeibi 43: # 10/1, 10/19, 11/17, 11/22, 11/24, 11/28 12/18 Behrouz Minaei
44: # YEAR=2002
1.33 minaeibi 45: # 2/1, 2/6, 2/19, 2/28 Behrouz Minaei
1.26 minaeibi 46: #
47: ###
1.1 www 48:
1.51 stredwic 49: =pod
50:
1.55 stredwic 51: =head1 NAME
52:
53: lonchart
54:
55: =head1 SYNOPSIS
56:
57: Quick display of students grades for a course in a compressed table format.
58:
59: =head1 DESCRIPTION
60:
61: This module process all student grades for a course and turns them into a
62: table like structure.
63:
64: This is part of the LearningOnline Network with CAPA project
65: described at http://www.lon-capa.org
66:
67: lonchart presents the user with a condensed view all a course's data. The
68: class title, the number of students, and the date for the last update of the
69: displayed data. There is also a legend that describes the chart values.
70:
71: For each valid grade for a student is linked with a submission record for that
72: problem. The ability to add and remove columns of data from the chart was
73: added for reducing the burden of having to scroll through large quantities
74: of data. The interface also allows for sorting of students by username,
75: last name, and section number of class. Active and expired students are
76: also available.
77:
78: The interface is controlled by three primary buttons: Recalculate Chart,
79: Refresh Chart, and Reset Selections. Recalculate Chart will update
80: the chart to the most recent data and keep the display settings for the chart
81: the same. Refresh Chart is used to redisplay the chart after selecting
82: different output formatting. Reset Selections is used to set the chart
83: display options back to default values.
84:
85: =head1 CODE LAYOUT DESCRIPTION
86:
87: The code is broken down into five components: formatting data for printing,
88: downloading data from servers, processing data, helper functions,
89: and the central processing functions. The module is broken into chunks
90: for each component.
91:
92: =head1 PACKAGES USED
93:
94: Apache::Constants qw(:common :http)
95: Apache::lonnet()
96: Apache::loncommon()
97: HTML::TokeParser
98: GDBM_File
99:
1.51 stredwic 100: =cut
101:
1.1 www 102: package Apache::lonchart;
103:
104: use strict;
105: use Apache::Constants qw(:common :http);
106: use Apache::lonnet();
1.28 albertel 107: use Apache::loncommon();
1.1 www 108: use HTML::TokeParser;
109: use GDBM_File;
110:
1.51 stredwic 111: #my $jr;
1.55 stredwic 112:
113: =pod
114:
115: =head1 FORMAT DATA FOR PRINTING
116:
117: =cut
118:
1.44 stredwic 119: # ----- FORMAT PRINT DATA ----------------------------------------------
1.1 www 120:
1.55 stredwic 121: =pod
122:
123: =item &FormatStudentInformation()
124:
125: This function produces a formatted string of the student's information:
126: username, domain, section, full name, and PID.
127:
128: =over 4
129:
130: Input: $cache, $name, $studentInformation, $spacePadding
131:
132: $cache: This is a pointer to a hash that is tied to the cached data
133:
134: $name: The name and domain of the current student in name:domain format
135:
136: $studentInformation: A pointer to an array holding the names used to
137:
138: remove data from the hash. They represent the name of the data to be removed.
139:
140: $spacePadding: Extra spaces that represent the space between columns
141:
142: Output: $Str
143:
144: $Str: Formatted string.
145:
146: =back
147:
148: =cut
149:
1.44 stredwic 150: sub FormatStudentInformation {
1.51 stredwic 151: my ($cache,$name,$studentInformation,$spacePadding)=@_;
1.50 stredwic 152: my $Str='';
1.44 stredwic 153:
1.49 stredwic 154: for(my $index=0; $index<(scalar @$studentInformation); $index++) {
1.51 stredwic 155: if(!&ShouldShowColumn($cache, 'heading'.$index)) {
1.49 stredwic 156: next;
157: }
158: my $data=$cache->{$name.':'.$studentInformation->[$index]};
1.44 stredwic 159: $Str .= $data;
160:
161: my @dataLength=split(//,$data);
162: my $length=scalar @dataLength;
1.49 stredwic 163: $Str .= (' 'x($cache->{$studentInformation->[$index].'Length'}-
164: $length));
1.44 stredwic 165: $Str .= $spacePadding;
166: }
167:
168: return $Str;
169: }
170:
1.55 stredwic 171: =pod
172:
173: =item &FormatStudentData()
174:
175: First, FormatStudentInformation is called and prefixes the course information.
176: This function produces a formatted string of the student's course information.
177: Each column of data represents all the problems for a given sequence. For
178: valid grade data, a link is created for that problem to a submission record
179: for that problem.
180:
181: =over 4
182:
183: Input: $name, $studentInformation, $spacePadding, $ChartDB
184:
185: $name: The name and domain of the current student in name:domain format
186:
187: $studentInformation: A pointer to an array holding the names used to
188: remove data from the hash. They represent
189: the name of the data to be removed.
190:
191: $spacePadding: Extra spaces that represent the space between columns
192:
193: $ChartDB: The name of the cached data database which will be tied to that
194: database.
195:
196: Output: $Str
197:
198: $Str: Formatted string that is an entire row of the chart. It is a
199: concatenation of student information and student course information.
200:
201: =back
202:
203: =cut
204:
1.44 stredwic 205: sub FormatStudentData {
1.55 stredwic 206: my ($name,$studentInformation,$spacePadding,$ChartDB)=@_;
1.43 stredwic 207: my ($sname,$sdom) = split(/\:/,$name);
208: my $Str;
1.44 stredwic 209: my %CacheData;
1.43 stredwic 210:
1.44 stredwic 211: unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) {
212: return '';
213: }
1.43 stredwic 214: # Handle Student information ------------------------------------------
1.44 stredwic 215: # Handle user data
216: $Str=&FormatStudentInformation(\%CacheData, $name, $studentInformation,
1.51 stredwic 217: $spacePadding);
1.44 stredwic 218:
1.43 stredwic 219: # Handle errors
1.44 stredwic 220: if($CacheData{$name.':error'} =~ /environment/) {
1.50 stredwic 221: $Str .= '<br>';
1.44 stredwic 222: untie(%CacheData);
223: return $Str;
224: }
1.43 stredwic 225:
1.44 stredwic 226: if($CacheData{$name.':error'} =~ /course/) {
1.50 stredwic 227: $Str .= '<br>';
1.44 stredwic 228: untie(%CacheData);
1.50 stredwic 229: return $Str;
1.40 stredwic 230: }
231:
1.43 stredwic 232: # Handle problem data ------------------------------------------------
1.44 stredwic 233: my $Version;
234: my $problemsCorrect = 0;
235: my $totalProblems = 0;
236: my $problemsSolved = 0;
237: my $numberOfParts = 0;
238: foreach my $sequence (split(/\:/,$CacheData{'orderedSequences'})) {
1.51 stredwic 239: if(!&ShouldShowColumn(\%CacheData, 'sequence'.$sequence)) {
1.49 stredwic 240: next;
241: }
242:
1.44 stredwic 243: my $characterCount=0;
244: foreach my $problemID (split(/\:/,$CacheData{$sequence.':problems'})) {
245: my $problem = $CacheData{$problemID.':problem'};
246: my $LatestVersion = $CacheData{$name.":version:$problem"};
247:
1.58 ! stredwic 248: # Output blanks for all the parts of this problem if there
! 249: # is no version information about the current problem.
1.44 stredwic 250: if(!$LatestVersion) {
251: foreach my $part (split(/\:/,$CacheData{$sequence.':'.
252: $problemID.
253: ':parts'})) {
254: $Str .= ' ';
255: $totalProblems++;
256: $characterCount++;
257: }
258: next;
259: }
260:
261: my %partData=undef;
1.58 ! stredwic 262: # Initialize part data, display skips correctly
! 263: # Skip refers to when a student made no submissions on that
! 264: # part/problem.
1.44 stredwic 265: foreach my $part (split(/\:/,$CacheData{$sequence.':'.
266: $problemID.
267: ':parts'})) {
268: $partData{$part.':tries'}=0;
269: $partData{$part.':code'}=' ';
270: }
1.58 ! stredwic 271:
! 272: # Looping through all the versions of each part, starting with the
! 273: # oldest version. Basically, it gets the most recent
! 274: # set of grade data for each part.
1.44 stredwic 275: for(my $Version=1; $Version<=$LatestVersion; $Version++) {
276: foreach my $part (split(/\:/,$CacheData{$sequence.':'.
277: $problemID.
278: ':parts'})) {
279:
280: if(!defined($CacheData{$name.":$Version:$problem".
281: ":resource.$part.solved"})) {
1.58 ! stredwic 282: # No grade for this submission, so skip
1.44 stredwic 283: next;
284: }
285:
286: my $tries=0;
287: my $code=' ';
288:
289: $tries = $CacheData{$name.":$Version:$problem".
290: ":resource.$part.tries"};
291: $partData{$part.':tries'}=($tries) ? $tries : 0;
292:
293: my $val = $CacheData{$name.":$Version:$problem".
294: ":resource.$part.solved"};
295: if ($val eq 'correct_by_student') {$code = '*';}
296: elsif ($val eq 'correct_by_override') {$code = '+';}
297: elsif ($val eq 'incorrect_attempted') {$code = '.';}
298: elsif ($val eq 'incorrect_by_override'){$code = '-';}
299: elsif ($val eq 'excused') {$code = 'x';}
300: elsif ($val eq 'ungraded_attempted') {$code = '#';}
301: else {$code = ' ';}
302: $partData{$part.':code'}=$code;
303: }
304: }
305:
1.58 ! stredwic 306: # All grades (except for versionless parts) are displayed as links
! 307: # to their submission record. Loop through all the parts for the
! 308: # current problem in the correct order and prepare the output links
1.44 stredwic 309: $Str.='<a href="/adm/grades?symb='.
310: &Apache::lonnet::escape($problem).
311: '&student='.$sname.'&domain='.$sdom.'&command=submission">';
312: foreach(split(/\:/,$CacheData{$sequence.':'.$problemID.
313: ':parts'})) {
314: if($partData{$_.':code'} eq '*') {
315: $problemsCorrect++;
316: if (($partData{$_.':tries'}<10) &&
317: ($partData{$_.':tries'} ne '')) {
318: $partData{$_.':code'}=$partData{$_.':tries'};
319: }
320: } elsif($partData{$_.':code'} eq '+') {
321: $problemsCorrect++;
322: }
323:
324: $Str .= $partData{$_.':code'};
325: $characterCount++;
326:
327: if($partData{$_.':code'} ne 'x') {
328: $totalProblems++;
329: }
330: }
331: $Str.='</a>';
332: }
333:
1.58 ! stredwic 334: # Output the number of correct answers for the current sequence.
! 335: # This part takes up 6 character slots, but is formated right
! 336: # justified.
1.44 stredwic 337: my $spacesNeeded=$CacheData{$sequence.':columnWidth'}-$characterCount;
338: $spacesNeeded -= 3;
339: $Str .= (' 'x$spacesNeeded);
340:
341: my $outputProblemsCorrect = sprintf( "%3d", $problemsCorrect );
342: $Str .= '<font color="#007700">'.$outputProblemsCorrect.'</font>';
343: $problemsSolved += $problemsCorrect;
344: $problemsCorrect=0;
345:
346: $Str .= $spacePadding;
347: }
1.11 minaeibi 348:
1.58 ! stredwic 349: # Output the total correct problems over the total number of problems.
! 350: # I don't like this type of formatting, but it is a solution. Need
! 351: # a way to dynamically determine the space requirements.
1.51 stredwic 352: my $outputProblemsSolved = sprintf( "%4d", $problemsSolved );
353: my $outputTotalProblems = sprintf( "%4d", $totalProblems );
354: $Str .= '<font color="#000088">'.$outputProblemsSolved.
355: ' / '.$outputTotalProblems.'</font><br>';
1.39 stredwic 356:
1.44 stredwic 357: untie(%CacheData);
358: return $Str;
359: }
1.43 stredwic 360:
1.55 stredwic 361: =pod
362:
363: =item &CreateTableHeadings()
364:
365: This function generates the column headings for the chart.
366:
367: =over 4
368:
369: Inputs: $CacheData, $studentInformation, $headings, $spacePadding
370:
371: $CacheData: pointer to a hash tied to the cached data database
372:
373: $studentInformation: a pointer to an array containing the names of the data
374: held in a column and is used as part of a key into $CacheData
375:
376: $headings: The names of the headings for the student information
377:
378: $spacePadding: The spaces to go between columns
379:
380: Output: $Str
381:
382: $Str: A formatted string of the table column headings.
383:
384: =back
385:
386: =cut
387:
1.44 stredwic 388: sub CreateTableHeadings {
1.51 stredwic 389: my ($CacheData,$studentInformation,$headings,$spacePadding)=@_;
1.53 stredwic 390: my $Str='<tr>';
1.43 stredwic 391:
1.44 stredwic 392: for(my $index=0; $index<(scalar @$headings); $index++) {
1.51 stredwic 393: if(!&ShouldShowColumn($CacheData, 'heading'.$index)) {
1.49 stredwic 394: next;
395: }
396:
1.53 stredwic 397: $Str .= '<td align="left"><pre>';
1.44 stredwic 398: my $data=$$headings[$index];
399: $Str .= $data;
400:
401: my @dataLength=split(//,$data);
402: my $length=scalar @dataLength;
403: $Str .= (' 'x($CacheData->{$$studentInformation[$index].'Length'}-
404: $length));
405: $Str .= $spacePadding;
1.53 stredwic 406: $Str .= '</pre></td>';
1.44 stredwic 407: }
408:
409: foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
1.51 stredwic 410: if(!&ShouldShowColumn($CacheData, 'sequence'.$sequence)) {
1.49 stredwic 411: next;
412: }
413:
1.53 stredwic 414: $Str .= '<td align="left"><pre>';
1.49 stredwic 415: my $name = $CacheData->{$sequence.':title'};
416: $Str .= $name;
1.44 stredwic 417: my @titleLength=split(//,$CacheData->{$sequence.':title'});
418: my $leftover=$CacheData->{$sequence.':columnWidth'}-
419: (scalar @titleLength);
420: $Str .= (' 'x$leftover);
421: $Str .= $spacePadding;
1.53 stredwic 422: $Str .= '</pre></td>';
1.1 www 423: }
1.39 stredwic 424:
1.54 stredwic 425: $Str .= '<td><pre>Total Solved/Total Problems</pre></td>';
1.55 stredwic 426: $Str .= '</tr>';
1.11 minaeibi 427:
1.43 stredwic 428: return $Str;
429: }
430:
1.55 stredwic 431: =pod
432:
433: =item &CreateColumnSelectionBox()
434:
435: If there are columns not being displayed then this selection box is created
436: with a list of those columns. When selections are made and the page
437: refreshed, the columns will be removed from this box and the column is
438: put back in the chart. If there is no columns to select, no row is added
439: to the interface table.
440:
441: =over 4
442: Input: $CacheData, $headings
443:
444:
445: $CacheData: A pointer to a hash tied to the cached data
446:
447: $headings: An array of the names of the columns for the student information.
448: They are used for displaying which columns are missing.
449:
450: Output: $notThere
451:
452: $notThere: The string contains one row of a table. The first column has the
453: name of the selection box. The second contains the selection box
454: which has a size of four.
455:
456: =back
457:
458: =cut
459:
1.49 stredwic 460: sub CreateColumnSelectionBox {
1.55 stredwic 461: my ($CacheData,$headings)=@_;
1.46 stredwic 462:
1.49 stredwic 463: my $missing=0;
1.50 stredwic 464: my $notThere='<tr><td align="right"><b>Select column to view:</b>';
1.49 stredwic 465: my $name;
1.50 stredwic 466: $notThere .= '<td align="left">';
1.49 stredwic 467: $notThere .= '<select name="reselect" size="4" multiple="true">'."\n";
1.46 stredwic 468:
469: for(my $index=0; $index<(scalar @$headings); $index++) {
1.51 stredwic 470: if(&ShouldShowColumn($CacheData, 'heading'.$index)) {
1.49 stredwic 471: next;
472: }
473: $name = $headings->[$index];
474: $notThere .= '<option value="heading'.$index.'">';
475: $notThere .= $name.'</option>'."\n";
476: $missing++;
477: }
478:
479: foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
1.51 stredwic 480: if(&ShouldShowColumn($CacheData, 'sequence'.$sequence)) {
1.49 stredwic 481: next;
482: }
483: $name = $CacheData->{$sequence.':title'};
484: $notThere .= '<option value="sequence'.$sequence.'">';
485: $notThere .= $name.'</option>'."\n";
486: $missing++;
487: }
488:
489: if($missing) {
1.50 stredwic 490: $notThere .= '</select>';
1.49 stredwic 491: } else {
1.50 stredwic 492: $notThere='<tr><td>';
1.49 stredwic 493: }
494:
1.55 stredwic 495: return $notThere.'</td></tr>';
1.49 stredwic 496: }
497:
1.55 stredwic 498: =pod
499:
500: =item &CreateColumnSelectors()
501:
502: This function generates the checkboxes above the column headings. The
503: column will be removed if the checkbox is unchecked.
504:
505: =over 4
506:
507: Input: $CacheData, $headings
508:
509: $CacheData: A pointer to a hash tied to the cached data
510:
511: $headings: An array of the names of the columns for the student
512: information. They are used to know what are the student information columns
513:
514: Output: $present
515:
516: $present: The string contains the first row of a table. Each column contains
517: a checkbox which is left justified. Currently left justification is used
518: for consistency of location over the column in which it presides.
519:
520: =back
521:
522: =cut
523:
1.49 stredwic 524: sub CreateColumnSelectors {
1.55 stredwic 525: my ($CacheData,$headings)=@_;
1.46 stredwic 526:
1.49 stredwic 527: my $found=0;
528: my ($name, $length, $position);
1.54 stredwic 529:
1.55 stredwic 530: my $present = '<tr>';
1.49 stredwic 531: for(my $index=0; $index<(scalar @$headings); $index++) {
1.51 stredwic 532: if(!&ShouldShowColumn($CacheData, 'heading'.$index)) {
1.49 stredwic 533: next;
534: }
1.54 stredwic 535: $present .= '<td align="left">';
1.49 stredwic 536: $present .= '<input type="checkbox" checked="on" ';
1.54 stredwic 537: $present .= 'name="heading'.$index.'" />';
1.53 stredwic 538: $present .= '</td>';
1.49 stredwic 539: $found++;
1.46 stredwic 540: }
541:
542: foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
1.51 stredwic 543: if(!&ShouldShowColumn($CacheData, 'sequence'.$sequence)) {
1.49 stredwic 544: next;
545: }
1.54 stredwic 546: $present .= '<td align="left">';
1.49 stredwic 547: $present .= '<input type="checkbox" checked="on" ';
1.54 stredwic 548: $present .= 'name="sequence'.$sequence.'" />';
1.53 stredwic 549: $present .= '</td>';
1.49 stredwic 550: $found++;
551: }
552:
1.54 stredwic 553: if(!$found) {
554: $present = '';
1.46 stredwic 555: }
556:
1.54 stredwic 557: return $present.'<td></td></tr></form>'."\n";;
1.46 stredwic 558: }
559:
1.55 stredwic 560: =pod
561:
562: =item &CreateForm()
563:
564: The interface for this module consists primarily of the controls in this
565: function. The student status selection (active, expired, any) is set here.
566: The sort buttons: username, last name, and section are set here. The
567: other buttons are Recalculate Chart, Refresh Chart, and Reset Selections.
568: These controls are in a table to clean up the interface.
569:
570: =over 4
571:
572: Input: $CacheData
573:
574: $CacheData is a hash pointer to tied database for cached data.
575:
576: Output: $Ptr
577:
578: $Ptr is a string containing all the html for the above mentioned buttons.
579:
580: =back
581:
582: =cut
583:
1.43 stredwic 584: sub CreateForm {
1.51 stredwic 585: my ($CacheData)=@_;
1.43 stredwic 586: my $OpSel1='';
587: my $OpSel2='';
588: my $OpSel3='';
1.51 stredwic 589: my $Status = $CacheData->{'form.status'};
1.43 stredwic 590: if ( $Status eq 'Any' ) { $OpSel3='selected'; }
591: elsif ($Status eq 'Expired' ) { $OpSel2 = 'selected'; }
592: else { $OpSel1 = 'selected'; }
593:
1.50 stredwic 594: my $Ptr .= '<form name="stat" method="post" action="/adm/chart" >'."\n";
595: $Ptr .= '<tr><td align="right">';
596: $Ptr .= '</td><td align="left">';
1.51 stredwic 597: $Ptr .= '<input type="submit" name="recalculate" ';
1.50 stredwic 598: $Ptr .= 'value="Recalculate Chart"/>'."\n";
1.43 stredwic 599: $Ptr .= ' ';
1.50 stredwic 600: $Ptr .= '<input type="submit" name="refresh" ';
1.51 stredwic 601: $Ptr .= 'value="Refresh Chart"/>'."\n";
602: $Ptr .= ' ';
603: $Ptr .= '<input type="submit" name="reset" ';
604: $Ptr .= 'value="Reset Selections"/></td>'."\n";
1.50 stredwic 605: $Ptr .= '</tr><tr><td align="right">';
606: $Ptr .= '<b> Sort by: </b>'."\n";
607: $Ptr .= '</td><td align="left">';
1.44 stredwic 608: $Ptr .= '<input type="submit" name="sort" value="User Name" />'."\n";
1.43 stredwic 609: $Ptr .= ' ';
1.44 stredwic 610: $Ptr .= '<input type="submit" name="sort" value="Last Name" />'."\n";
1.43 stredwic 611: $Ptr .= ' ';
1.44 stredwic 612: $Ptr .= '<input type="submit" name="sort" value="Section"/>'."\n";
1.50 stredwic 613: $Ptr .= '</td></tr><tr><td align="right">';
1.43 stredwic 614: $Ptr .= '<b> Student Status: </b>'."\n".
1.50 stredwic 615: '</td><td align="left">'.
1.43 stredwic 616: '<select name="status">'.
617: '<option '.$OpSel1.' >Active</option>'."\n".
618: '<option '.$OpSel2.' >Expired</option>'."\n".
619: '<option '.$OpSel3.' >Any</option> </select> '."\n";
1.50 stredwic 620: $Ptr .= '</td></tr>';
1.44 stredwic 621:
622: return $Ptr;
623: }
624:
1.55 stredwic 625: =pod
626:
627: =item &CreateLegend()
628:
629: This function returns a formatted string containing the legend for the
630: chart. The legend describes the symbols used to represent grades for
631: problems.
632:
633: =cut
634:
1.44 stredwic 635: sub CreateLegend {
1.50 stredwic 636: my $Str = "<p><pre>".
637: "1..9: correct by student in 1..9 tries\n".
1.44 stredwic 638: " *: correct by student in more than 9 tries\n".
639: " +: correct by override\n".
640: " -: incorrect by override\n".
641: " .: incorrect attempted\n".
642: " #: ungraded attempted\n".
643: " : not attempted\n".
1.50 stredwic 644: " x: excused".
645: "</pre><p>";
1.44 stredwic 646: return $Str;
647: }
648:
1.55 stredwic 649: =pod
650:
651: =item &StartDocument()
652:
653: Returns a string containing the header information for the chart: title,
654: logo, and course title.
655:
656: =cut
657:
1.44 stredwic 658: sub StartDocument {
659: my $Str = '';
660: $Str .= '<html>';
661: $Str .= '<head><title>';
662: $Str .= 'LON-CAPA Assessment Chart</title></head>';
663: $Str .= '<body bgcolor="#FFFFFF">';
664: $Str .= '<script>window.focus();</script>';
665: $Str .= '<img align=right src=/adm/lonIcons/lonlogos.gif>';
1.52 stredwic 666: $Str .= '<h1>Assessment Chart</h1>';
1.50 stredwic 667: $Str .= '<h1>'.$ENV{'course.'.$ENV{'request.course.id'}.'.description'};
668: $Str .= '</h1>';
1.44 stredwic 669:
670: return $Str;
671: }
672:
673: # ----- END FORMAT PRINT DATA ------------------------------------------
674:
1.55 stredwic 675: =pod
676:
677: =head1 DOWNLOAD INFORMATION
678:
679: This section contains all the files that get data from other servers
680: and/or itself. There is one function that has a call to get remote
681: information but isn't included here which is ProcessTopLevelMap. The
682: usage was small enough to be ignored, but that portion may be moved
683: here in the future.
684:
685: =cut
686:
1.44 stredwic 687: # ----- DOWNLOAD INFORMATION -------------------------------------------
688:
1.55 stredwic 689: =pod
690:
691: =item &DownloadPrerequisiteData()
692:
1.56 stredwic 693: Collects lastname, generation, middlename, firstname, PID, and section for each
1.55 stredwic 694: student from their environment database. The list of students is built from
695: collecting a classlist for the course that is to be displayed.
696:
697: =over 4
698:
699: Input: $courseID, $c
700:
701: $courseID: The id of the course
702:
703: $c: The connection class that can determine if the browser has aborted. It
704: is used to short circuit this function so that it doesn't continue to
705: get information when there is no need.
706:
707: Output: \%classlist
708:
709: \%classlist: A pointer to a hash containing the following data:
710:
711: -A list of student name:domain (as keys) (known below as $name)
712:
713: -A hash pointer for each student containing lastname, generation, firstname,
714: middlename, and PID : Key is $name.'studentInformation'
715:
716: -A hash pointer to each students section data : Key is $name.section
717:
718: =back
719:
720: =cut
721:
1.44 stredwic 722: sub DownloadPrerequisiteData {
723: my ($courseID, $c)=@_;
724: my ($courseDomain,$courseNumber)=split(/\_/,$courseID);
725:
726: my %classlist=&Apache::lonnet::dump('classlist',$courseDomain,
727: $courseNumber);
728: my ($checkForError)=keys (%classlist);
729: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
730: return \%classlist;
731: }
732:
733: foreach my $name (keys(%classlist)) {
734: if($c->aborted()) {
735: $classlist{'error'}='aborted';
736: return \%classlist;
737: }
738:
739: my ($studentName,$studentDomain) = split(/\:/,$name);
740: # Download student environment data, specifically the full name and id.
741: my %studentInformation=&Apache::lonnet::get('environment',
742: ['lastname','generation',
743: 'firstname','middlename',
744: 'id'],
745: $studentDomain,
746: $studentName);
747: $classlist{$name.':studentInformation'}=\%studentInformation;
748:
749: if($c->aborted()) {
750: $classlist{'error'}='aborted';
751: return \%classlist;
752: }
753:
754: #Section
755: my %section=&Apache::lonnet::dump('roles',$studentDomain,$studentName);
756: $classlist{$name.':section'}=\%section;
757: }
758:
759: return \%classlist;
1.1 www 760: }
761:
1.55 stredwic 762: =pod
763:
764: =item &DownloadStudentCourseInformation()
765:
766: Dump of all the course information for a single student. There is no
767: pruning of data, it is all stored in a hash and returned.
768:
769: =over 4
770:
771: Input: $name, $courseID
772:
773: $name: student name:domain
774:
775: $courseID: The id of the course
776:
777: Output: \%courseData
778:
779: \%courseData: A hash pointer to the raw data from the student's course
780: database.
781:
782: =back
783:
784: =cut
785:
1.44 stredwic 786: sub DownloadStudentCourseInformation {
787: my ($name,$courseID)=@_;
788: my ($studentName,$studentDomain) = split(/\:/,$name);
789:
790: # Download student course data
791: my %courseData=&Apache::lonnet::dump($courseID,$studentDomain,
792: $studentName);
793: return \%courseData;
794: }
795:
796: # ----- END DOWNLOAD INFORMATION ---------------------------------------
797:
1.55 stredwic 798: =pod
799:
800: =head1 PROCESSING FUNCTIONS
801:
802: These functions process all the data for all the students. Also, they
803: are the only functions that access the cache database for writing. Thus
804: they are the only functions that cache data. The downloading and caching
805: were separated to reduce problems with stopping downloading then can't
806: tie hash to database later.
807:
808: =cut
809:
810: # ----- PROCESSING FUNCTIONS ---------------------------------------
811:
812: =pod
813:
1.56 stredwic 814: =item &ProcessTopResourceMap()
815:
816: Trace through the "big hash" created in rat/lonuserstate.pm::loadmap.
817: Basically, this function organizes a subset of the data and stores it in
818: cached data. The data stored is the problems, sequences, sequence titles,
819: parts of problems, and their ordering. Column width information is also
820: partially handled here on a per sequence basis.
821:
822: =over 4
823:
824: Input: $ChartDB, $c
825:
826: $ChartDB: The name of the cache database file
827:
828: $c: The connection class used to determine if an abort has been sent to the
829: browser
830:
831: Output: A string that contains an error message or "OK" if everything went
832: smoothly.
833:
834: =back
835:
1.55 stredwic 836: =cut
1.44 stredwic 837:
838: sub ProcessTopResourceMap {
839: my ($ChartDB,$c)=@_;
840: my %hash;
841: my $fn=$ENV{'request.course.fn'};
842: if(-e "$fn.db") {
843: my $tieTries=0;
844: while($tieTries < 3) {
845: if(tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
846: last;
847: }
848: $tieTries++;
849: sleep 1;
1.43 stredwic 850: }
1.44 stredwic 851: if($tieTries >= 3) {
852: return 'Coursemap undefined.';
853: }
854: } else {
855: return 'Can not open Coursemap.';
1.43 stredwic 856: }
857:
1.44 stredwic 858: my %CacheData;
859: unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
860: untie(%hash);
861: return 'Could not tie cache hash.';
862: }
863:
1.58 ! stredwic 864: # Initialize state machine. Set information pointing to top level map.
1.44 stredwic 865: my (@sequences, @currentResource, @finishResource);
866: my ($currentSequence, $currentResourceID, $lastResourceID);
867:
868: $currentResourceID=$hash{'ids_/res/'.$ENV{'request.course.uri'}};
1.46 stredwic 869: push(@currentResource, $currentResourceID);
1.44 stredwic 870: $lastResourceID=-1;
871: $currentSequence=-1;
872: my $topLevelSequenceNumber = $currentSequence;
873:
874: while(1) {
875: if($c->aborted()) {
876: last;
877: }
878: # HANDLE NEW SEQUENCE!
879: #if page || sequence
880: if(defined($hash{'map_pc_'.$hash{'src_'.$currentResourceID}})) {
881: push(@sequences, $currentSequence);
882: push(@currentResource, $currentResourceID);
883: push(@finishResource, $lastResourceID);
884:
885: $currentSequence=$hash{'map_pc_'.$hash{'src_'.$currentResourceID}};
1.51 stredwic 886:
887: # Mark sequence as containing problems. If it doesn't, then
888: # it will be removed when processing for this sequence is
889: # complete. This allows the problems in a sequence
890: # to be outputed before problems in the subsequences
891: if(!defined($CacheData{'orderedSequences'})) {
892: $CacheData{'orderedSequences'}=$currentSequence;
893: } else {
894: $CacheData{'orderedSequences'}.=':'.$currentSequence;
895: }
896:
1.44 stredwic 897: $lastResourceID=$hash{'map_finish_'.
898: $hash{'src_'.$currentResourceID}};
899: $currentResourceID=$hash{'map_start_'.
900: $hash{'src_'.$currentResourceID}};
901:
902: if(!($currentResourceID) || !($lastResourceID)) {
903: $currentSequence=pop(@sequences);
904: $currentResourceID=pop(@currentResource);
905: $lastResourceID=pop(@finishResource);
906: if($currentSequence eq $topLevelSequenceNumber) {
907: last;
908: }
909: }
910: }
911:
912: # Handle gradable resources: exams, problems, etc
913: $currentResourceID=~/(\d+)\.(\d+)/;
914: my $partA=$1;
915: my $partB=$2;
916: if($hash{'src_'.$currentResourceID}=~
917: /\.(problem|exam|quiz|assess|survey|form)$/ &&
918: $partA eq $currentSequence) {
919: my $Problem = &Apache::lonnet::symbclean(
920: &Apache::lonnet::declutter($hash{'map_id_'.$partA}).
921: '___'.$partB.'___'.
922: &Apache::lonnet::declutter($hash{'src_'.
923: $currentResourceID}));
924:
925: $CacheData{$currentResourceID.':problem'}=$Problem;
926: if(!defined($CacheData{$currentSequence.':problems'})) {
927: $CacheData{$currentSequence.':problems'}=$currentResourceID;
928: } else {
929: $CacheData{$currentSequence.':problems'}.=
930: ':'.$currentResourceID;
931: }
932:
1.58 ! stredwic 933: # Get Parts for problem
1.44 stredwic 934: my $meta=$hash{'src_'.$currentResourceID};
935: foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {
936: if($_=~/^stores\_(\d+)\_tries$/) {
937: my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
938: if(!defined($CacheData{$currentSequence.':'.
939: $currentResourceID.':parts'})) {
940: $CacheData{$currentSequence.':'.$currentResourceID.
941: ':parts'}=$Part;
942: } else {
943: $CacheData{$currentSequence.':'.$currentResourceID.
944: ':parts'}.=':'.$Part;
945: }
946: }
947: }
948: }
949:
1.58 ! stredwic 950: # if resource == finish resource, then it is the end of a sequence/page
1.44 stredwic 951: if($currentResourceID eq $lastResourceID) {
1.58 ! stredwic 952: # pop off last resource of sequence
1.44 stredwic 953: $currentResourceID=pop(@currentResource);
954: $lastResourceID=pop(@finishResource);
955:
956: if(defined($CacheData{$currentSequence.':problems'})) {
957: # Capture sequence information here
958: $CacheData{$currentSequence.':title'}=
959: $hash{'title_'.$currentResourceID};
960:
961: my $totalProblems=0;
1.47 stredwic 962: foreach my $currentProblem (split(/\:/,
963: $CacheData{$currentSequence.
1.44 stredwic 964: ':problems'})) {
1.47 stredwic 965: foreach (split(/\:/,$CacheData{$currentSequence.':'.
966: $currentProblem.
967: ':parts'})) {
1.44 stredwic 968: $totalProblems++;
969: }
970: }
971: my @titleLength=split(//,$CacheData{$currentSequence.
972: ':title'});
973: # $extra is 3 for problems correct and 3 for space
974: # between problems correct and problem output
975: my $extra = 6;
976: if(($totalProblems + $extra) > (scalar @titleLength)) {
977: $CacheData{$currentSequence.':columnWidth'}=
978: $totalProblems + $extra;
979: } else {
980: $CacheData{$currentSequence.':columnWidth'}=
981: (scalar @titleLength);
982: }
1.51 stredwic 983: } else {
1.58 ! stredwic 984: # Remove sequence from list, if it contains no problems to
! 985: # display.
1.51 stredwic 986: $CacheData{'orderedSequences'}=~s/$currentSequence//;
987: $CacheData{'orderedSequences'}=~s/::/:/g;
988: $CacheData{'orderedSequences'}=~s/^:|:$//g;
989: }
1.44 stredwic 990:
991: $currentSequence=pop(@sequences);
992: if($currentSequence eq $topLevelSequenceNumber) {
993: last;
994: }
995: }
1.43 stredwic 996:
1.44 stredwic 997: # MOVE!!!
1.58 ! stredwic 998: # move to next resource
1.44 stredwic 999: unless(defined($hash{'to_'.$currentResourceID})) {
1000: # big problem, need to handle. Next is probably wrong
1001: last;
1002: }
1003: my @nextResources=();
1004: foreach (split(/\,/,$hash{'to_'.$currentResourceID})) {
1005: push(@nextResources, $hash{'goesto_'.$_});
1006: }
1007: push(@currentResource, @nextResources);
1.46 stredwic 1008: # Set the next resource to be processed
1009: $currentResourceID=pop(@currentResource);
1.44 stredwic 1010: }
1.5 minaeibi 1011:
1.44 stredwic 1012: unless (untie(%hash)) {
1013: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
1014: "Could not untie coursemap $fn (browse)".
1015: ".</font>");
1016: }
1.1 www 1017:
1.44 stredwic 1018: unless (untie(%CacheData)) {
1019: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
1020: "Could not untie Cache Hash (browse)".
1021: ".</font>");
1.1 www 1022: }
1.44 stredwic 1023:
1024: return 'OK';
1.1 www 1025: }
1.33 minaeibi 1026:
1.56 stredwic 1027: =pod
1028:
1029: =item &ProcessSection()
1030:
1031: Determine the section number for a student for the class. A student can have
1032: multiple sections for the same class. The correct one is chosen.
1033:
1034: =over 4
1035:
1036: Input: $sectionData, $courseid, $ActiveFlag
1037:
1038: $sectionData: A pointer to a hash containing all section data for this
1039: student for the class
1040:
1041: $courseid: The course ID.
1042:
1043: $ActiveFlag: The student's active status (Active/Expired)
1044:
1045: Output: $oldsection, $cursection, or -1
1046:
1047: $oldsection and $cursection and sections number that will be displayed in the
1048: chart.
1049:
1050: -1 is returned if an error occurs.
1051:
1052: =back
1053:
1054: =cut
1055:
1.44 stredwic 1056: sub ProcessSection {
1057: my ($sectionData, $courseid,$ActiveFlag)=@_;
1.33 minaeibi 1058: $courseid=~s/\_/\//g;
1059: $courseid=~s/^(\w)/\/$1/;
1.39 stredwic 1060:
1.41 albertel 1061: my $cursection='-1';
1062: my $oldsection='-1';
1063: my $status='Expired';
1.44 stredwic 1064: my $section='';
1065: foreach my $key (keys (%$sectionData)) {
1066: my $value = $sectionData->{$key};
1.33 minaeibi 1067: if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
1.44 stredwic 1068: $section=$1;
1069: if($key eq $courseid.'_st') {
1070: $section='';
1071: }
1.39 stredwic 1072: my ($dummy,$end,$start)=split(/\_/,$value);
1.41 albertel 1073: my $now=time;
1074: my $notactive=0;
1.43 stredwic 1075: if ($start) {
1076: if($now<$start) {
1077: $notactive=1;
1078: }
1079: }
1080: if($end) {
1081: if ($now>$end) {
1082: $notactive=1;
1083: }
1084: }
1085: if($notactive == 0) {
1086: $status='Active';
1087: $cursection=$section;
1.44 stredwic 1088: last;
1.43 stredwic 1089: }
1090: if($notactive == 1) {
1091: $oldsection=$section;
1092: }
1093: }
1094: }
1095: if($status eq $ActiveFlag) {
1096: if($cursection eq '-1') {
1097: return $oldsection;
1098: }
1099: return $cursection;
1100: }
1101: if($ActiveFlag eq 'Any') {
1102: if($cursection eq '-1') {
1103: return $oldsection;
1104: }
1105: return $cursection;
1.41 albertel 1106: }
1.36 minaeibi 1107: return '-1';
1.33 minaeibi 1108: }
1109:
1.56 stredwic 1110: =pod
1111:
1112: =item &ProcessStudentInformation()
1113:
1114: Takes data downloaded for a student and breaks it up into managable pieces and
1115: stored in cache data. The username, domain, class related date, PID,
1116: full name, and section are all processed here.
1117:
1118: =over 4
1119:
1120: Input: $CacheData, $studentInformation, $section, $date, $name, $courseID
1121:
1122: $CacheData: A hash pointer to the cached data
1123:
1124: $studentInformation: Student information is what was requested in
1125: &DownloadPrerequistedData(). See that function for what data is requested.
1126:
1127: $section: A hash pointer to class section related information.
1128:
1129: $date: A composite of the start and end date for this class for this
1130: student. Format: end:start
1131:
1132: $name: the username:domain information
1133:
1134: $courseID: The course ID
1135:
1136: Output: None
1137:
1138: *NOTE: There is no return value, but if an error occurs a key is added to
1139: the cache data with the value being the error message. The key is
1140: username:domain:error. It will only exist if an error occurs.
1141:
1142: =back
1143:
1144: =cut
1145:
1.44 stredwic 1146: sub ProcessStudentInformation {
1.56 stredwic 1147: my ($CacheData,$studentInformation,$section,$date,$name,$courseID)=@_;
1.44 stredwic 1148: my ($studentName,$studentDomain) = split(/\:/,$name);
1149:
1150: $CacheData->{$name.':username'}=$studentName;
1151: $CacheData->{$name.':domain'}=$studentDomain;
1152: $CacheData->{$name.':date'}=$date;
1153:
1154: my ($checkForError)=keys(%$studentInformation);
1155: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
1156: $CacheData->{$name.':error'}=
1157: 'Could not download student environment data.';
1158: $CacheData->{$name.':fullname'}='';
1159: $CacheData->{$name.':id'}='';
1160: } else {
1161: $CacheData->{$name.':fullname'}=&ProcessFullName(
1162: $studentInformation->{'lastname'},
1163: $studentInformation->{'generation'},
1164: $studentInformation->{'firstname'},
1165: $studentInformation->{'middlename'});
1166: $CacheData->{$name.':id'}=$studentInformation->{'id'};
1167: }
1168:
1169: # Get student's section number
1.51 stredwic 1170: my $sec=&ProcessSection($section, $courseID, $CacheData->{'form.status'});
1.44 stredwic 1171: if($sec != -1) {
1172: $CacheData->{$name.':section'}=$sec;
1173: } else {
1174: $CacheData->{$name.':section'}='';
1175: }
1176:
1.56 stredwic 1177: return;
1.44 stredwic 1178: }
1179:
1.56 stredwic 1180: =pod
1181:
1182: =item &ProcessClassList()
1183:
1184: Taking the class list dumped from &DownloadPrerequisiteData(), all the
1185: students and their non-class information is processed using the
1186: &ProcessStudentInformation() function. A date stamp is also recorded for
1187: when the data was processed.
1188:
1189: =over 4
1190:
1191: Input: $classlist, $courseID, $ChartDB, $c
1192:
1193: $classlist: The hash of data collected about a student from
1194: &DownloadPrerequisteData(). The hash contains a list of students, a pointer
1195: to a hash of student information for each student, and each student's section
1196: number.
1197:
1198: $courseID: The course ID
1199:
1200: $ChartDB: The name of the cache database file.
1201:
1202: $c: The connection class used to determine if an abort has been sent to the
1203: browser
1204:
1205: Output: @names
1206:
1207: @names: An array of students whose information has been processed, and are to
1208: be considered in an arbitrary order.
1209:
1210: =back
1211:
1212: =cut
1213:
1.44 stredwic 1214: sub ProcessClassList {
1215: my ($classlist,$courseID,$ChartDB,$c)=@_;
1216: my @names=();
1217:
1218: my %CacheData;
1219: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
1220: foreach my $name (keys(%$classlist)) {
1.48 stredwic 1221: if($name =~ /\:section/ || $name =~ /\:studentInformation/ ||
1222: $name eq '') {
1.44 stredwic 1223: next;
1224: }
1225: if($c->aborted()) {
1226: last;
1227: }
1228: push(@names,$name);
1229: &ProcessStudentInformation(
1230: \%CacheData,
1231: $classlist->{$name.':studentInformation'},
1232: $classlist->{$name.':section'},
1233: $classlist->{$name},
1.56 stredwic 1234: $name,$courseID);
1.44 stredwic 1235: }
1236:
1.54 stredwic 1237: # Time of download
1238: $CacheData{'time'}=localtime();
1.44 stredwic 1239: untie(%CacheData);
1240: }
1241:
1242: return @names;
1243: }
1.56 stredwic 1244:
1245: =pod
1246:
1247: =item &ProcessStudentData()
1248:
1249: Takes the course data downloaded for a student in
1250: &DownloadStudentCourseInformation() and breaks it up into key value pairs
1251: to be stored in the cached data. The keys are comprised of the
1252: $username:$domain:$keyFromCourseDatabase. The student username:domain is
1253: stored away signifying that the student's information has been downloaded and
1254: can be reused from cached data.
1255:
1256: =over 4
1257:
1258: Input: $courseData, $name, $ChartDB
1259:
1260: $courseData: A hash pointer that points to the course data downloaded for a
1261: student.
1262:
1263: $name: username:domain
1264:
1265: $ChartDB: The name of the cache database file which will allow the data to
1266: be written to the cache.
1267:
1268: Output: None
1269:
1270: *NOTE: There is no output, but an error message is stored away in the cache
1271: data. This is checked in &FormatStudentData(). The key username:domain:error
1272: will only exist if an error occured. The error is an error from
1273: &DownloadStudentCourseInformation().
1274:
1275: =back
1276:
1277: =cut
1.44 stredwic 1278:
1.55 stredwic 1279: sub ProcessStudentData {
1280: my ($courseData, $name, $ChartDB)=@_;
1281:
1282: my %CacheData;
1283: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
1284: my ($checkForError) = keys(%$courseData);
1285: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
1286: $CacheData{$name.':error'}='Could not download course data.';
1287: } else {
1288: foreach my $key (keys (%$courseData)) {
1289: $CacheData{$name.':'.$key}=$courseData->{$key};
1290: }
1291: if(defined($CacheData{'NamesOfStudents'})) {
1292: $CacheData{'NamesOfStudents'}.=':::'.$name;
1293: } else {
1294: $CacheData{'NamesOfStudents'}=$name;
1295: }
1296: }
1297: untie(%CacheData);
1298: }
1299:
1300: return;
1301: }
1302:
1303: =pod
1304:
1305: =item &ProcessFormData()
1306:
1307: Cache form data and set default form data (sort, status, heading.$number,
1308: sequence.$number, reselect, reset, recalculate, and refresh)
1309:
1310: =over 4
1311:
1312: Input: $ChartDB, $isCached
1313:
1314: $ChartDB: The name of the database for cached data
1315:
1316: $isCached: Is there already data for this course cached. This is used in
1317: conjunction with the absence of all form data to know to display all selection
1318: types.
1319:
1320: Output: None
1321:
1322: =back
1323:
1324: =cut
1325:
1.58 ! stredwic 1326: # For all data, if ENV data doesn't exist for it, default values is used.
1.55 stredwic 1327: sub ProcessFormData {
1328: my ($ChartDB, $isCached)=@_;
1329: my %CacheData;
1330:
1331: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
1.58 ! stredwic 1332: # Ignore $ENV{'form.refresh'}
! 1333: # Ignore $ENV{'form.recalculate'}
! 1334:
1.55 stredwic 1335: if(defined($ENV{'form.sort'})) {
1336: $CacheData{'form.sort'}=$ENV{'form.sort'};
1337: } elsif(!defined($CacheData{'form.sort'})) {
1338: $CacheData{'form.sort'}='username';
1339: }
1340:
1341: if(defined($ENV{'form.status'})) {
1342: $CacheData{'form.status'}=$ENV{'form.status'};
1343: } elsif(!defined($CacheData{'form.status'})) {
1344: $CacheData{'form.status'}='Active';
1345: }
1346:
1.58 ! stredwic 1347: # $found checks for any instances of form data in the ENV. If it is
! 1348: # missing I assume the chrt button on the remote has been pressed.
1.55 stredwic 1349: my @headings=();
1350: my @sequences=();
1351: my $found=0;
1352: foreach (keys(%ENV)) {
1353: if(/form\.heading/) {
1354: $found++;
1355: push(@headings, $_);
1356: } elsif(/form\.sequence/) {
1357: $found++;
1358: push(@sequences, $_);
1359: } elsif(/form\./) {
1360: $found++;
1361: }
1362: }
1363:
1364: if($found) {
1365: $CacheData{'form.headings'}=join(":::",@headings);
1366: $CacheData{'form.sequences'}=join(":::",@sequences);
1367: }
1368:
1369: if(defined($ENV{'form.reselect'})) {
1370: my @reselected = (ref($ENV{'form.reselect'}) ?
1371: @{$ENV{'form.reselect'}}
1372: : ($ENV{'form.reselect'}));
1373: foreach (@reselected) {
1374: if(/heading/) {
1375: $CacheData{'form.headings'}.=":::".$_;
1376: } elsif(/sequence/) {
1377: $CacheData{'form.sequences'}.=":::".$_;
1378: }
1379: }
1380: }
1381:
1.58 ! stredwic 1382: # !$found and !$isCached are how I determine if the chrt button
! 1383: # on the remote was pressed and needs to reset all the selections
1.55 stredwic 1384: if(defined($ENV{'form.reset'}) || (!$found && !$isCached)) {
1385: $CacheData{'form.reset'}='true';
1386: $CacheData{'form.status'}='Active';
1387: $CacheData{'form.sort'}='username';
1388: $CacheData{'form.headings'}='ALLHEADINGS';
1389: $CacheData{'form.sequences'}='ALLSEQUENCES';
1390: } else {
1391: $CacheData{'form.reset'}='false';
1392: }
1393:
1394: untie(%CacheData);
1395: }
1396:
1397: return;
1398: }
1399:
1400: =pod
1401:
1402: =item &SpaceColumns()
1403:
1404: Determines the width of all the columns in the chart. It is based on
1405: the max of the data for that column and its header.
1406:
1407: =over 4
1408:
1409: Input: $students, $studentInformation, $headings, $ChartDB
1410:
1411: $students: An array pointer to a list of students (username:domain)
1412:
1413: $studentInformatin: The type of data for the student information. It is
1414: used as part of the key in $CacheData.
1415:
1416: $headings: The name of the student information columns.
1417:
1418: $ChartDB: The name of the cache database which is opened for read/write.
1419:
1420: Output: None - All data stored in cache.
1421:
1422: =back
1.44 stredwic 1423:
1.55 stredwic 1424: =cut
1.44 stredwic 1425:
1426: sub SpaceColumns {
1427: my ($students,$studentInformation,$headings,$ChartDB)=@_;
1428:
1429: my %CacheData;
1430: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
1431: # Initialize Lengths
1432: for(my $index=0; $index<(scalar @$headings); $index++) {
1433: my @titleLength=split(//,$$headings[$index]);
1434: $CacheData{$$studentInformation[$index].'Length'}=
1435: scalar @titleLength;
1436: }
1437:
1438: foreach my $name (@$students) {
1439: foreach (@$studentInformation) {
1440: my @dataLength=split(//,$CacheData{$name.':'.$_});
1441: my $length=scalar @dataLength;
1442: if($length > $CacheData{$_.'Length'}) {
1443: $CacheData{$_.'Length'}=$length;
1444: }
1445: }
1446: }
1447: untie(%CacheData);
1448: }
1449:
1450: return;
1451: }
1452:
1.55 stredwic 1453: # ----- END PROCESSING FUNCTIONS ---------------------------------------
1454:
1455: =pod
1456:
1457: =head1 HELPER FUNCTIONS
1458:
1459: These are just a couple of functions do various odd and end
1460: jobs.
1461:
1462: =cut
1463:
1464: # ----- HELPER FUNCTIONS -----------------------------------------------
1465:
1466: =pod
1467:
1468: =item &ProcessFullName()
1469:
1470: Takes lastname, generation, firstname, and middlename (or some partial
1.58 ! stredwic 1471: set of this data) and returns the full name version as a string. Format
! 1472: is Lastname generation, firstname middlename or a subset of this.
1.55 stredwic 1473:
1474: =cut
1475:
1.43 stredwic 1476: sub ProcessFullName {
1.44 stredwic 1477: my ($lastname, $generation, $firstname, $middlename)=@_;
1.43 stredwic 1478: my $Str = '';
1479:
1.44 stredwic 1480: if($lastname ne '') {
1481: $Str .= $lastname.' ';
1482: if($generation ne '') {
1483: $Str .= $generation;
1.43 stredwic 1484: } else {
1485: chop($Str);
1486: }
1487: $Str .= ', ';
1.44 stredwic 1488: if($firstname ne '') {
1489: $Str .= $firstname.' ';
1.43 stredwic 1490: }
1.44 stredwic 1491: if($middlename ne '') {
1492: $Str .= $middlename;
1.40 stredwic 1493: } else {
1.43 stredwic 1494: chop($Str);
1.44 stredwic 1495: if($firstname eq '') {
1.43 stredwic 1496: chop($Str);
1.31 minaeibi 1497: }
1.30 minaeibi 1498: }
1.43 stredwic 1499: } else {
1.44 stredwic 1500: if($firstname ne '') {
1501: $Str .= $firstname.' ';
1.43 stredwic 1502: }
1.44 stredwic 1503: if($middlename ne '') {
1504: $Str .= $middlename.' ';
1.43 stredwic 1505: }
1.44 stredwic 1506: if($generation ne '') {
1507: $Str .= $generation;
1.43 stredwic 1508: } else {
1509: chop($Str);
1510: }
1511: }
1512:
1513: return $Str;
1514: }
1.30 minaeibi 1515:
1.55 stredwic 1516: =pod
1517:
1518: =item &SortStudents()
1519:
1520: Determines which students to display and in which order. Which are
1521: displayed are determined by their status(active/expired). The order
1522: is determined by the sort button pressed (default to username). The
1523: type of sorting is username, lastname, or section.
1524:
1525: =over 4
1526:
1527: Input: $students, $CacheData
1528:
1529: $students: A array pointer to a list of students (username:domain)
1530:
1531: $CacheData: A pointer to the hash tied to the cached data
1532:
1533: Output: @order
1534:
1535: @order: An ordered list of students (username:domain)
1536:
1537: =back
1538:
1539: =cut
1540:
1.44 stredwic 1541: sub SortStudents {
1.48 stredwic 1542: my ($students,$CacheData)=@_;
1.44 stredwic 1543:
1544: my @sorted1Students=();
1.48 stredwic 1545: foreach (@$students) {
1.44 stredwic 1546: my ($end,$start)=split(/\:/,$CacheData->{$_.':date'});
1547: my $active=1;
1548: my $now=time;
1.51 stredwic 1549: my $Status=$CacheData->{'form.status'};
1.44 stredwic 1550: $Status = ($Status) ? $Status : 'Active';
1551: if((($end) && $now > $end) && (($Status eq 'Active'))) {
1552: $active=0;
1553: }
1554: if(($Status eq 'Expired') && ($end == 0 || $now < $end)) {
1555: $active=0;
1556: }
1557: if($active) {
1558: push(@sorted1Students, $_);
1559: }
1.43 stredwic 1560: }
1.1 www 1561:
1.51 stredwic 1562: my $Pos = $CacheData->{'form.sort'};
1.43 stredwic 1563: my %sortData;
1564: if($Pos eq 'Last Name') {
1.44 stredwic 1565: for(my $index=0; $index<scalar @sorted1Students; $index++) {
1566: $sortData{$CacheData->{$sorted1Students[$index].':fullname'}}=
1567: $sorted1Students[$index];
1.43 stredwic 1568: }
1569: } elsif($Pos eq 'Section') {
1.44 stredwic 1570: for(my $index=0; $index<scalar @sorted1Students; $index++) {
1571: $sortData{$CacheData->{$sorted1Students[$index].':section'}.
1572: $sorted1Students[$index]}=$sorted1Students[$index];
1.43 stredwic 1573: }
1574: } else {
1575: # Sort by user name
1.44 stredwic 1576: for(my $index=0; $index<scalar @sorted1Students; $index++) {
1577: $sortData{$sorted1Students[$index]}=$sorted1Students[$index];
1.43 stredwic 1578: }
1579: }
1580:
1581: my @order = ();
1.48 stredwic 1582: foreach my $key (sort(keys(%sortData))) {
1.43 stredwic 1583: push (@order,$sortData{$key});
1584: }
1.33 minaeibi 1585:
1.43 stredwic 1586: return @order;
1.30 minaeibi 1587: }
1.1 www 1588:
1.55 stredwic 1589: =pod
1590:
1591: =item &TestCacheData()
1592:
1593: Determine if the cache database can be accessed with a tie. It waits up to
1594: ten seconds before returning failure. This function exists to help with
1595: the problems with stopping the data download. When an abort occurs and the
1596: user quickly presses a form button and httpd child is created. This
1597: child needs to wait for the other to finish (hopefully within ten seconds).
1598:
1599: =over 4
1600:
1601: Input: $ChartDB
1602:
1603: $ChartDB: The name of the cache database to be opened
1604:
1605: Output: -1, 0, 1
1606:
1607: -1: Couldn't tie database
1608: 0: Use cached data
1609: 1: New cache database created, use that.
1610:
1611: =back
1612:
1613: =cut
1614:
1.44 stredwic 1615: sub TestCacheData {
1616: my ($ChartDB)=@_;
1617: my $isCached=-1;
1618: my %testData;
1619: my $tieTries=0;
1.43 stredwic 1620:
1.51 stredwic 1621: if ((-e "$ChartDB") && (!defined($ENV{'form.recalculate'}))) {
1.44 stredwic 1622: $isCached = 1;
1623: } else {
1624: $isCached = 0;
1.43 stredwic 1625: }
1626:
1.51 stredwic 1627: while($tieTries < 10) {
1.44 stredwic 1628: my $result=0;
1629: if($isCached) {
1630: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER,0640);
1631: } else {
1632: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB,0640);
1633: }
1634: if($result) {
1635: last;
1636: }
1637: $tieTries++;
1638: sleep 1;
1639: }
1.51 stredwic 1640: if($tieTries >= 10) {
1.44 stredwic 1641: return -1;
1.43 stredwic 1642: }
1643:
1.44 stredwic 1644: untie(%testData);
1.30 minaeibi 1645:
1.44 stredwic 1646: return $isCached;
1.43 stredwic 1647: }
1.30 minaeibi 1648:
1.55 stredwic 1649: =pod
1650:
1651: =item &ShouldShowColumn()
1652:
1653: Determine if a specified column should be shown on the chart.
1654:
1655: =over 4
1656:
1657: Input: $cache, $test
1658:
1659: $cache: A pointer to the hash tied to the cached data
1660:
1661: $test: The form name of the column (heading.$headingIndex) or
1662: (sequence.$sequenceIndex)
1663:
1664: Output: 0 (false), 1 (true)
1.44 stredwic 1665:
1.55 stredwic 1666: =back
1.1 www 1667:
1.55 stredwic 1668: =cut
1.44 stredwic 1669:
1.49 stredwic 1670: sub ShouldShowColumn {
1.51 stredwic 1671: my ($cache,$test)=@_;
1.49 stredwic 1672:
1.51 stredwic 1673: if($cache->{'form.reset'} eq 'true') {
1.49 stredwic 1674: return 1;
1675: }
1676:
1.51 stredwic 1677: my $headings=$cache->{'form.headings'};
1678: my $sequences=$cache->{'form.sequences'};
1679: if($headings eq 'ALLHEADINGS' || $sequences eq 'ALLSEQUENCES' ||
1680: $headings=~/$test/ || $sequences=~/$test/) {
1.49 stredwic 1681: return 1;
1682: }
1683:
1.51 stredwic 1684: return 0;
1.49 stredwic 1685: }
1686:
1.55 stredwic 1687: # ----- END HELPER FUNCTIONS --------------------------------------------
1688:
1689: =pod
1690:
1691: =head1 Handler and main function(BuildChart)
1692:
1693: The handler does some initial error checking and then passes the torch to
1694: BuildChart. BuildChart calls all the appropriate functions to get the
1695: job done. These are the only two functions that use print ($r). All other
1696: functions return strings to BuildChart to be printed.
1697:
1698: =cut
1.51 stredwic 1699:
1.55 stredwic 1700: =pod
1.51 stredwic 1701:
1.55 stredwic 1702: =item &BuildChart()
1.51 stredwic 1703:
1.57 stredwic 1704: The following is the process that BuildChart goes through to
1705: create the html document.
1.51 stredwic 1706:
1.55 stredwic 1707: -Start the lonchart document
1708: -Test for access to the CacheData
1709: -Download class list information if not using cached data
1710: -Sort students and print out table desciptive data
1711: -Output student data
1.57 stredwic 1712: -If recalculating, store a list of students, but only if all
1713: their data was downloaded. Leave off the others.
1.55 stredwic 1714: -End document
1.51 stredwic 1715:
1.55 stredwic 1716: =over 4
1.51 stredwic 1717:
1.55 stredwic 1718: Input: $r
1.51 stredwic 1719:
1.55 stredwic 1720: $r: Used to print html
1.51 stredwic 1721:
1.55 stredwic 1722: Output: None
1.51 stredwic 1723:
1.55 stredwic 1724: =back
1.49 stredwic 1725:
1.55 stredwic 1726: =cut
1.44 stredwic 1727:
1728: sub BuildChart {
1729: my ($r)=@_;
1730: my $c = $r->connection;
1.1 www 1731:
1.44 stredwic 1732: # Start the lonchart document
1733: $r->content_type('text/html');
1734: $r->send_http_header;
1735: $r->print(&StartDocument());
1736: $r->rflush();
1.43 stredwic 1737:
1.44 stredwic 1738: # Test for access to the CacheData
1739: my $isCached=0;
1.43 stredwic 1740: my $cid=$ENV{'request.course.id'};
1741: my $ChartDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
1742: "_$ENV{'user.domain'}_$cid\_chart.db";
1.44 stredwic 1743:
1744: $isCached=&TestCacheData($ChartDB);
1745: if($isCached < 0) {
1746: $r->print("Unable to tie hash to db file");
1747: $r->rflush();
1748: return;
1749: }
1.55 stredwic 1750: &ProcessFormData($ChartDB, $isCached);
1.44 stredwic 1751:
1752: # Download class list information if not using cached data
1.48 stredwic 1753: my %CacheData;
1.44 stredwic 1754: my @students=();
1755: my @studentInformation=('username','domain','section','id','fullname');
1756: my @headings=('User Name','Domain','Section','PID','Full Name');
1757: my $spacePadding=' ';
1758: if(!$isCached) {
1759: my $processTopResourceMapReturn=&ProcessTopResourceMap($ChartDB,$c);
1760: if($processTopResourceMapReturn ne 'OK') {
1761: $r->print($processTopResourceMapReturn);
1762: return;
1763: }
1764: if($c->aborted()) { return; }
1765: my $classlist=&DownloadPrerequisiteData($cid, $c);
1766: my ($checkForError)=keys(%$classlist);
1767: if($checkForError =~ /^(con_lost|error|no_such_host)/i ||
1768: defined($classlist->{'error'})) {
1769: return;
1770: }
1771: if($c->aborted()) { return; }
1772: @students=&ProcessClassList($classlist,$cid,$ChartDB,$c);
1773: if($c->aborted()) { return; }
1774: &SpaceColumns(\@students,\@studentInformation,\@headings,
1775: $ChartDB);
1776: if($c->aborted()) { return; }
1.48 stredwic 1777: } else {
1778: if(!$c->aborted() && tie(%CacheData,'GDBM_File',$ChartDB,
1779: &GDBM_READER,0640)) {
1780: @students=split(/:::/,$CacheData{'NamesOfStudents'});
1781: }
1.44 stredwic 1782: }
1783:
1784: # Sort students and print out table desciptive data
1.55 stredwic 1785: my $downloadTime=0;
1.44 stredwic 1786: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) {
1.48 stredwic 1787: if(!$c->aborted()) { @students=&SortStudents(\@students,\%CacheData); }
1.54 stredwic 1788: if(defined($CacheData{'time'})) { $downloadTime=$CacheData{'time'}; }
1789: else { $downloadTime=localtime(); }
1790: if(!$c->aborted()) { $r->print('<h3>'.$downloadTime.'</h3>'); }
1.50 stredwic 1791: if(!$c->aborted()) { $r->print('<h1>'.(scalar @students).
1792: ' students</h1>'); }
1793: if(!$c->aborted()) { $r->rflush(); }
1.44 stredwic 1794: if(!$c->aborted()) { $r->print(&CreateLegend()); }
1.55 stredwic 1795: if(!$c->aborted()) { $r->print('<table border="0"><tbody>'); }
1.51 stredwic 1796: if(!$c->aborted()) { $r->print(&CreateForm(\%CacheData)); }
1.49 stredwic 1797: if(!$c->aborted()) { $r->print(&CreateColumnSelectionBox(
1798: \%CacheData,
1.55 stredwic 1799: \@headings)); }
1800: if(!$c->aborted()) { $r->print('</tbody></table>'); }
1801: if(!$c->aborted()) { $r->print('<b>Note: Uncheck the boxes above a'); }
1802: if(!$c->aborted()) { $r->print(' column to remove that column from'); }
1803: if(!$c->aborted()) { $r->print(' the display.</b></pre>'); }
1804: if(!$c->aborted()) { $r->print('<table border="0" cellpadding="0" '); }
1805: if(!$c->aborted()) { $r->print('cellspacing="0"><tbody>'); }
1.49 stredwic 1806: if(!$c->aborted()) { $r->print(&CreateColumnSelectors(
1807: \%CacheData,
1.55 stredwic 1808: \@headings)); }
1.44 stredwic 1809: if(!$c->aborted()) { $r->print(&CreateTableHeadings(
1810: \%CacheData,
1811: \@studentInformation,
1812: \@headings,
1813: $spacePadding)); }
1.55 stredwic 1814: if(!$c->aborted()) { $r->print('</tbody></table>'); }
1.49 stredwic 1815: if(!$c->aborted()) { $r->rflush(); }
1.44 stredwic 1816: untie(%CacheData);
1.43 stredwic 1817: } else {
1.44 stredwic 1818: $r->print("Init2: Unable to tie hash to db file");
1819: return;
1.43 stredwic 1820: }
1821:
1.55 stredwic 1822: # Output student data
1.43 stredwic 1823: my @updateStudentList = ();
1.44 stredwic 1824: my $courseData;
1.50 stredwic 1825: $r->print('<pre>');
1.44 stredwic 1826: foreach (@students) {
1827: if($c->aborted()) {
1828: last;
1829: }
1830:
1831: if(!$isCached) {
1832: $courseData=&DownloadStudentCourseInformation($_, $cid);
1.50 stredwic 1833: if($c->aborted()) { last; }
1.44 stredwic 1834: push(@updateStudentList, $_);
1.55 stredwic 1835: &ProcessStudentData($courseData, $_, $ChartDB);
1.44 stredwic 1836: }
1.55 stredwic 1837: $r->print(&FormatStudentData($_, \@studentInformation,
1.44 stredwic 1838: $spacePadding, $ChartDB));
1839: $r->rflush();
1.43 stredwic 1840: }
1841:
1.55 stredwic 1842: # If recalculating, store a list of students, but only if all their
1843: # data was downloaded. Leave off the others.
1.50 stredwic 1844: if(!$isCached && tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
1845: $CacheData{'NamesOfStudents'}=join(":::", @updateStudentList);
1846: # $CacheData{'NamesOfStudents'}=
1847: # &Apache::lonnet::arrayref2str(\@updateStudentList);
1848: untie(%CacheData);
1849: }
1850:
1.55 stredwic 1851: # End document
1.50 stredwic 1852: $r->print('</pre></body></html>');
1.30 minaeibi 1853: $r->rflush();
1.1 www 1854:
1.43 stredwic 1855: return;
1.30 minaeibi 1856: }
1.1 www 1857:
1.30 minaeibi 1858: # ================================================================ Main Handler
1.55 stredwic 1859:
1860: =pod
1861:
1862: =item &handler()
1863:
1864: The handler checks for permission to access the course data and for
1865: initial header problem. Then it passes the torch to the work horse
1866: function BuildChart.
1867:
1868: =over 4
1869:
1870: Input: $r
1871:
1872: $r: This is the object that is used to print.
1873:
1874: Output: A Value (OK or HTTP_NOT_ACCEPTABLE)
1875:
1876: =back
1877:
1878: =cut
1.1 www 1879:
1.30 minaeibi 1880: sub handler {
1.44 stredwic 1881: my $r=shift;
1.51 stredwic 1882: # $jr=$r;
1.44 stredwic 1883: unless(&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
1.30 minaeibi 1884: $ENV{'user.error.msg'}=
1.1 www 1885: $r->uri.":vgr:0:0:Cannot view grades for complete course";
1.30 minaeibi 1886: return HTTP_NOT_ACCEPTABLE;
1887: }
1.44 stredwic 1888:
1889: # Set document type for header only
1890: if ($r->header_only) {
1891: if($ENV{'browser.mathml'}) {
1892: $r->content_type('text/xml');
1893: } else {
1894: $r->content_type('text/html');
1895: }
1896: &Apache::loncommon::no_cache($r);
1897: $r->send_http_header;
1898: return OK;
1899: }
1.58 ! stredwic 1900:
1.44 stredwic 1901: unless($ENV{'request.course.fn'}) {
1902: my $requrl=$r->uri;
1903: $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
1904: return HTTP_NOT_ACCEPTABLE;
1905: }
1906:
1907: &BuildChart($r);
1908:
1909: return OK;
1.1 www 1910: }
1911: 1;
1912: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonchart.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface