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