Annotation of loncom/interface/lonchart.pm, revision 1.55
1.1 www 1: # The LearningOnline Network with CAPA
1.25 minaeibi 2: # (Publication Handler
3: #
1.55 ! stredwic 4: # $Id: lonchart.pm,v 1.54 2002/07/03 14:11:14 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:
! 675: Collects lastname, generation, middlename, firstname PID, and section for each
! 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:
! 796: =cut
1.44 stredwic 797:
798: sub ProcessTopResourceMap {
799: my ($ChartDB,$c)=@_;
800: my %hash;
801: my $fn=$ENV{'request.course.fn'};
802: if(-e "$fn.db") {
803: my $tieTries=0;
804: while($tieTries < 3) {
805: if(tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
806: last;
807: }
808: $tieTries++;
809: sleep 1;
1.43 stredwic 810: }
1.44 stredwic 811: if($tieTries >= 3) {
812: return 'Coursemap undefined.';
813: }
814: } else {
815: return 'Can not open Coursemap.';
1.43 stredwic 816: }
817:
1.44 stredwic 818: my %CacheData;
819: unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
820: untie(%hash);
821: return 'Could not tie cache hash.';
822: }
823:
824: my (@sequences, @currentResource, @finishResource);
825: my ($currentSequence, $currentResourceID, $lastResourceID);
826:
827: $currentResourceID=$hash{'ids_/res/'.$ENV{'request.course.uri'}};
1.46 stredwic 828: push(@currentResource, $currentResourceID);
1.44 stredwic 829: $lastResourceID=-1;
830: $currentSequence=-1;
831: my $topLevelSequenceNumber = $currentSequence;
832:
833: while(1) {
834: if($c->aborted()) {
835: last;
836: }
837: # HANDLE NEW SEQUENCE!
838: #if page || sequence
839: if(defined($hash{'map_pc_'.$hash{'src_'.$currentResourceID}})) {
840: push(@sequences, $currentSequence);
841: push(@currentResource, $currentResourceID);
842: push(@finishResource, $lastResourceID);
843:
844: $currentSequence=$hash{'map_pc_'.$hash{'src_'.$currentResourceID}};
1.51 stredwic 845:
846: # Mark sequence as containing problems. If it doesn't, then
847: # it will be removed when processing for this sequence is
848: # complete. This allows the problems in a sequence
849: # to be outputed before problems in the subsequences
850: if(!defined($CacheData{'orderedSequences'})) {
851: $CacheData{'orderedSequences'}=$currentSequence;
852: } else {
853: $CacheData{'orderedSequences'}.=':'.$currentSequence;
854: }
855:
1.44 stredwic 856: $lastResourceID=$hash{'map_finish_'.
857: $hash{'src_'.$currentResourceID}};
858: $currentResourceID=$hash{'map_start_'.
859: $hash{'src_'.$currentResourceID}};
860:
861: if(!($currentResourceID) || !($lastResourceID)) {
862: $currentSequence=pop(@sequences);
863: $currentResourceID=pop(@currentResource);
864: $lastResourceID=pop(@finishResource);
865: if($currentSequence eq $topLevelSequenceNumber) {
866: last;
867: }
868: }
869: }
870:
871: # Handle gradable resources: exams, problems, etc
872: $currentResourceID=~/(\d+)\.(\d+)/;
873: my $partA=$1;
874: my $partB=$2;
875: if($hash{'src_'.$currentResourceID}=~
876: /\.(problem|exam|quiz|assess|survey|form)$/ &&
877: $partA eq $currentSequence) {
878: my $Problem = &Apache::lonnet::symbclean(
879: &Apache::lonnet::declutter($hash{'map_id_'.$partA}).
880: '___'.$partB.'___'.
881: &Apache::lonnet::declutter($hash{'src_'.
882: $currentResourceID}));
883:
884: $CacheData{$currentResourceID.':problem'}=$Problem;
885: if(!defined($CacheData{$currentSequence.':problems'})) {
886: $CacheData{$currentSequence.':problems'}=$currentResourceID;
887: } else {
888: $CacheData{$currentSequence.':problems'}.=
889: ':'.$currentResourceID;
890: }
891:
892: #Get Parts for problem
893: my $meta=$hash{'src_'.$currentResourceID};
894: foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {
895: if($_=~/^stores\_(\d+)\_tries$/) {
896: my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
897: if(!defined($CacheData{$currentSequence.':'.
898: $currentResourceID.':parts'})) {
899: $CacheData{$currentSequence.':'.$currentResourceID.
900: ':parts'}=$Part;
901: } else {
902: $CacheData{$currentSequence.':'.$currentResourceID.
903: ':parts'}.=':'.$Part;
904: }
905: }
906: }
907: }
908:
909: #if resource == finish resource
910: if($currentResourceID eq $lastResourceID) {
911: #pop off last resource of sequence
912: $currentResourceID=pop(@currentResource);
913: $lastResourceID=pop(@finishResource);
914:
915: if(defined($CacheData{$currentSequence.':problems'})) {
916: # Capture sequence information here
917: $CacheData{$currentSequence.':title'}=
918: $hash{'title_'.$currentResourceID};
919:
920: my $totalProblems=0;
1.47 stredwic 921: foreach my $currentProblem (split(/\:/,
922: $CacheData{$currentSequence.
1.44 stredwic 923: ':problems'})) {
1.47 stredwic 924: foreach (split(/\:/,$CacheData{$currentSequence.':'.
925: $currentProblem.
926: ':parts'})) {
1.44 stredwic 927: $totalProblems++;
928: }
929: }
930: my @titleLength=split(//,$CacheData{$currentSequence.
931: ':title'});
932: # $extra is 3 for problems correct and 3 for space
933: # between problems correct and problem output
934: my $extra = 6;
935: if(($totalProblems + $extra) > (scalar @titleLength)) {
936: $CacheData{$currentSequence.':columnWidth'}=
937: $totalProblems + $extra;
938: } else {
939: $CacheData{$currentSequence.':columnWidth'}=
940: (scalar @titleLength);
941: }
1.51 stredwic 942: } else {
943: $CacheData{'orderedSequences'}=~s/$currentSequence//;
944: $CacheData{'orderedSequences'}=~s/::/:/g;
945: $CacheData{'orderedSequences'}=~s/^:|:$//g;
946: }
1.44 stredwic 947:
948: $currentSequence=pop(@sequences);
949: if($currentSequence eq $topLevelSequenceNumber) {
950: last;
951: }
952: }
1.43 stredwic 953:
1.44 stredwic 954: # MOVE!!!
955: #move to next resource
956: unless(defined($hash{'to_'.$currentResourceID})) {
957: # big problem, need to handle. Next is probably wrong
958: last;
959: }
960: my @nextResources=();
961: foreach (split(/\,/,$hash{'to_'.$currentResourceID})) {
962: push(@nextResources, $hash{'goesto_'.$_});
963: }
964: push(@currentResource, @nextResources);
1.46 stredwic 965: # Set the next resource to be processed
966: $currentResourceID=pop(@currentResource);
1.44 stredwic 967: }
1.5 minaeibi 968:
1.44 stredwic 969: unless (untie(%hash)) {
970: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
971: "Could not untie coursemap $fn (browse)".
972: ".</font>");
973: }
1.1 www 974:
1.44 stredwic 975: unless (untie(%CacheData)) {
976: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
977: "Could not untie Cache Hash (browse)".
978: ".</font>");
1.1 www 979: }
1.44 stredwic 980:
981: return 'OK';
1.1 www 982: }
1.33 minaeibi 983:
1.44 stredwic 984: sub ProcessSection {
985: my ($sectionData, $courseid,$ActiveFlag)=@_;
1.33 minaeibi 986: $courseid=~s/\_/\//g;
987: $courseid=~s/^(\w)/\/$1/;
1.39 stredwic 988:
1.41 albertel 989: my $cursection='-1';
990: my $oldsection='-1';
991: my $status='Expired';
1.44 stredwic 992: my $section='';
993: foreach my $key (keys (%$sectionData)) {
994: my $value = $sectionData->{$key};
1.33 minaeibi 995: if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
1.44 stredwic 996: $section=$1;
997: if($key eq $courseid.'_st') {
998: $section='';
999: }
1.39 stredwic 1000: my ($dummy,$end,$start)=split(/\_/,$value);
1.41 albertel 1001: my $now=time;
1002: my $notactive=0;
1.43 stredwic 1003: if ($start) {
1004: if($now<$start) {
1005: $notactive=1;
1006: }
1007: }
1008: if($end) {
1009: if ($now>$end) {
1010: $notactive=1;
1011: }
1012: }
1013: if($notactive == 0) {
1014: $status='Active';
1015: $cursection=$section;
1.44 stredwic 1016: last;
1.43 stredwic 1017: }
1018: if($notactive == 1) {
1019: $oldsection=$section;
1020: }
1021: }
1022: }
1023: if($status eq $ActiveFlag) {
1024: if($cursection eq '-1') {
1025: return $oldsection;
1026: }
1027: return $cursection;
1028: }
1029: if($ActiveFlag eq 'Any') {
1030: if($cursection eq '-1') {
1031: return $oldsection;
1032: }
1033: return $cursection;
1.41 albertel 1034: }
1.36 minaeibi 1035: return '-1';
1.33 minaeibi 1036: }
1037:
1.44 stredwic 1038: sub ProcessStudentInformation {
1039: my ($CacheData,$studentInformation,$section,$date,$name,$courseID,$c)=@_;
1040: my ($studentName,$studentDomain) = split(/\:/,$name);
1041:
1042: $CacheData->{$name.':username'}=$studentName;
1043: $CacheData->{$name.':domain'}=$studentDomain;
1044: $CacheData->{$name.':date'}=$date;
1045:
1046: my ($checkForError)=keys(%$studentInformation);
1047: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
1048: $CacheData->{$name.':error'}=
1049: 'Could not download student environment data.';
1050: $CacheData->{$name.':fullname'}='';
1051: $CacheData->{$name.':id'}='';
1052: } else {
1053: $CacheData->{$name.':fullname'}=&ProcessFullName(
1054: $studentInformation->{'lastname'},
1055: $studentInformation->{'generation'},
1056: $studentInformation->{'firstname'},
1057: $studentInformation->{'middlename'});
1058: $CacheData->{$name.':id'}=$studentInformation->{'id'};
1059: }
1060:
1061: # Get student's section number
1.51 stredwic 1062: my $sec=&ProcessSection($section, $courseID, $CacheData->{'form.status'});
1.44 stredwic 1063: if($sec != -1) {
1064: $CacheData->{$name.':section'}=$sec;
1065: } else {
1066: $CacheData->{$name.':section'}='';
1067: }
1068:
1069: return 0;
1070: }
1071:
1072: sub ProcessClassList {
1073: my ($classlist,$courseID,$ChartDB,$c)=@_;
1074: my @names=();
1075:
1076: my %CacheData;
1077: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
1078: foreach my $name (keys(%$classlist)) {
1.48 stredwic 1079: if($name =~ /\:section/ || $name =~ /\:studentInformation/ ||
1080: $name eq '') {
1.44 stredwic 1081: next;
1082: }
1083: if($c->aborted()) {
1084: last;
1085: }
1086: push(@names,$name);
1087: &ProcessStudentInformation(
1088: \%CacheData,
1089: $classlist->{$name.':studentInformation'},
1090: $classlist->{$name.':section'},
1091: $classlist->{$name},
1092: $name,$courseID,$c);
1093: }
1094:
1.54 stredwic 1095: # Time of download
1096: $CacheData{'time'}=localtime();
1.44 stredwic 1097: untie(%CacheData);
1098: }
1099:
1100: return @names;
1101: }
1102:
1.55 ! stredwic 1103: sub ProcessStudentData {
! 1104: my ($courseData, $name, $ChartDB)=@_;
! 1105:
! 1106: my %CacheData;
! 1107: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
! 1108: my ($checkForError) = keys(%$courseData);
! 1109: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
! 1110: $CacheData{$name.':error'}='Could not download course data.';
! 1111: } else {
! 1112: foreach my $key (keys (%$courseData)) {
! 1113: $CacheData{$name.':'.$key}=$courseData->{$key};
! 1114: }
! 1115: if(defined($CacheData{'NamesOfStudents'})) {
! 1116: $CacheData{'NamesOfStudents'}.=':::'.$name;
! 1117: } else {
! 1118: $CacheData{'NamesOfStudents'}=$name;
! 1119: }
! 1120: }
! 1121: untie(%CacheData);
! 1122: }
! 1123:
! 1124: return;
! 1125: }
! 1126:
! 1127: =pod
! 1128:
! 1129: =item &ProcessFormData()
! 1130:
! 1131: Cache form data and set default form data (sort, status, heading.$number,
! 1132: sequence.$number, reselect, reset, recalculate, and refresh)
! 1133:
! 1134: =over 4
! 1135:
! 1136: Input: $ChartDB, $isCached
! 1137:
! 1138: $ChartDB: The name of the database for cached data
! 1139:
! 1140: $isCached: Is there already data for this course cached. This is used in
! 1141: conjunction with the absence of all form data to know to display all selection
! 1142: types.
! 1143:
! 1144: Output: None
! 1145:
! 1146: =back
! 1147:
! 1148: =cut
! 1149:
! 1150: sub ProcessFormData {
! 1151: my ($ChartDB, $isCached)=@_;
! 1152: my %CacheData;
! 1153:
! 1154: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
! 1155: if(defined($ENV{'form.sort'})) {
! 1156: $CacheData{'form.sort'}=$ENV{'form.sort'};
! 1157: } elsif(!defined($CacheData{'form.sort'})) {
! 1158: $CacheData{'form.sort'}='username';
! 1159: }
! 1160:
! 1161: # Ignore $ENV{'form.refresh'}
! 1162: # Ignore $ENV{'form.recalculate'}
! 1163:
! 1164: if(defined($ENV{'form.status'})) {
! 1165: $CacheData{'form.status'}=$ENV{'form.status'};
! 1166: } elsif(!defined($CacheData{'form.status'})) {
! 1167: $CacheData{'form.status'}='Active';
! 1168: }
! 1169:
! 1170: my @headings=();
! 1171: my @sequences=();
! 1172: my $found=0;
! 1173: foreach (keys(%ENV)) {
! 1174: if(/form\.heading/) {
! 1175: $found++;
! 1176: push(@headings, $_);
! 1177: } elsif(/form\.sequence/) {
! 1178: $found++;
! 1179: push(@sequences, $_);
! 1180: } elsif(/form\./) {
! 1181: $found++;
! 1182: }
! 1183: }
! 1184:
! 1185: if($found) {
! 1186: $CacheData{'form.headings'}=join(":::",@headings);
! 1187: $CacheData{'form.sequences'}=join(":::",@sequences);
! 1188: }
! 1189:
! 1190: if(defined($ENV{'form.reselect'})) {
! 1191: my @reselected = (ref($ENV{'form.reselect'}) ?
! 1192: @{$ENV{'form.reselect'}}
! 1193: : ($ENV{'form.reselect'}));
! 1194: foreach (@reselected) {
! 1195: if(/heading/) {
! 1196: $CacheData{'form.headings'}.=":::".$_;
! 1197: } elsif(/sequence/) {
! 1198: $CacheData{'form.sequences'}.=":::".$_;
! 1199: }
! 1200: }
! 1201: }
! 1202:
! 1203: if(defined($ENV{'form.reset'}) || (!$found && !$isCached)) {
! 1204: $CacheData{'form.reset'}='true';
! 1205: $CacheData{'form.status'}='Active';
! 1206: $CacheData{'form.sort'}='username';
! 1207: $CacheData{'form.headings'}='ALLHEADINGS';
! 1208: $CacheData{'form.sequences'}='ALLSEQUENCES';
! 1209: } else {
! 1210: $CacheData{'form.reset'}='false';
! 1211: }
! 1212:
! 1213: untie(%CacheData);
! 1214: }
! 1215:
! 1216: return;
! 1217: }
! 1218:
! 1219: =pod
! 1220:
! 1221: =item &SpaceColumns()
! 1222:
! 1223: Determines the width of all the columns in the chart. It is based on
! 1224: the max of the data for that column and its header.
! 1225:
! 1226: =over 4
! 1227:
! 1228: Input: $students, $studentInformation, $headings, $ChartDB
! 1229:
! 1230: $students: An array pointer to a list of students (username:domain)
! 1231:
! 1232: $studentInformatin: The type of data for the student information. It is
! 1233: used as part of the key in $CacheData.
! 1234:
! 1235: $headings: The name of the student information columns.
! 1236:
! 1237: $ChartDB: The name of the cache database which is opened for read/write.
! 1238:
! 1239: Output: None - All data stored in cache.
! 1240:
! 1241: =back
1.44 stredwic 1242:
1.55 ! stredwic 1243: =cut
1.44 stredwic 1244:
1245: sub SpaceColumns {
1246: my ($students,$studentInformation,$headings,$ChartDB)=@_;
1247:
1248: my %CacheData;
1249: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
1250: # Initialize Lengths
1251: for(my $index=0; $index<(scalar @$headings); $index++) {
1252: my @titleLength=split(//,$$headings[$index]);
1253: $CacheData{$$studentInformation[$index].'Length'}=
1254: scalar @titleLength;
1255: }
1256:
1257: foreach my $name (@$students) {
1258: foreach (@$studentInformation) {
1259: my @dataLength=split(//,$CacheData{$name.':'.$_});
1260: my $length=scalar @dataLength;
1261: if($length > $CacheData{$_.'Length'}) {
1262: $CacheData{$_.'Length'}=$length;
1263: }
1264: }
1265: }
1266: untie(%CacheData);
1267: }
1268:
1269: return;
1270: }
1271:
1.55 ! stredwic 1272: # ----- END PROCESSING FUNCTIONS ---------------------------------------
! 1273:
! 1274: =pod
! 1275:
! 1276: =head1 HELPER FUNCTIONS
! 1277:
! 1278: These are just a couple of functions do various odd and end
! 1279: jobs.
! 1280:
! 1281: =cut
! 1282:
! 1283: # ----- HELPER FUNCTIONS -----------------------------------------------
! 1284:
! 1285: =pod
! 1286:
! 1287: =item &ProcessFullName()
! 1288:
! 1289: Takes lastname, generation, firstname, and middlename (or some partial
! 1290: set of this data) and returns the full name version as a string.
! 1291:
! 1292: =cut
! 1293:
1.43 stredwic 1294: sub ProcessFullName {
1.44 stredwic 1295: my ($lastname, $generation, $firstname, $middlename)=@_;
1.43 stredwic 1296: my $Str = '';
1297:
1.44 stredwic 1298: if($lastname ne '') {
1299: $Str .= $lastname.' ';
1300: if($generation ne '') {
1301: $Str .= $generation;
1.43 stredwic 1302: } else {
1303: chop($Str);
1304: }
1305: $Str .= ', ';
1.44 stredwic 1306: if($firstname ne '') {
1307: $Str .= $firstname.' ';
1.43 stredwic 1308: }
1.44 stredwic 1309: if($middlename ne '') {
1310: $Str .= $middlename;
1.40 stredwic 1311: } else {
1.43 stredwic 1312: chop($Str);
1.44 stredwic 1313: if($firstname eq '') {
1.43 stredwic 1314: chop($Str);
1.31 minaeibi 1315: }
1.30 minaeibi 1316: }
1.43 stredwic 1317: } else {
1.44 stredwic 1318: if($firstname ne '') {
1319: $Str .= $firstname.' ';
1.43 stredwic 1320: }
1.44 stredwic 1321: if($middlename ne '') {
1322: $Str .= $middlename.' ';
1.43 stredwic 1323: }
1.44 stredwic 1324: if($generation ne '') {
1325: $Str .= $generation;
1.43 stredwic 1326: } else {
1327: chop($Str);
1328: }
1329: }
1330:
1331: return $Str;
1332: }
1.30 minaeibi 1333:
1.55 ! stredwic 1334: =pod
! 1335:
! 1336: =item &SortStudents()
! 1337:
! 1338: Determines which students to display and in which order. Which are
! 1339: displayed are determined by their status(active/expired). The order
! 1340: is determined by the sort button pressed (default to username). The
! 1341: type of sorting is username, lastname, or section.
! 1342:
! 1343: =over 4
! 1344:
! 1345: Input: $students, $CacheData
! 1346:
! 1347: $students: A array pointer to a list of students (username:domain)
! 1348:
! 1349: $CacheData: A pointer to the hash tied to the cached data
! 1350:
! 1351: Output: @order
! 1352:
! 1353: @order: An ordered list of students (username:domain)
! 1354:
! 1355: =back
! 1356:
! 1357: =cut
! 1358:
1.44 stredwic 1359: sub SortStudents {
1.48 stredwic 1360: my ($students,$CacheData)=@_;
1.44 stredwic 1361:
1362: my @sorted1Students=();
1.48 stredwic 1363: foreach (@$students) {
1.44 stredwic 1364: my ($end,$start)=split(/\:/,$CacheData->{$_.':date'});
1365: my $active=1;
1366: my $now=time;
1.51 stredwic 1367: my $Status=$CacheData->{'form.status'};
1.44 stredwic 1368: $Status = ($Status) ? $Status : 'Active';
1369: if((($end) && $now > $end) && (($Status eq 'Active'))) {
1370: $active=0;
1371: }
1372: if(($Status eq 'Expired') && ($end == 0 || $now < $end)) {
1373: $active=0;
1374: }
1375: if($active) {
1376: push(@sorted1Students, $_);
1377: }
1.43 stredwic 1378: }
1.1 www 1379:
1.51 stredwic 1380: my $Pos = $CacheData->{'form.sort'};
1.43 stredwic 1381: my %sortData;
1382: if($Pos eq 'Last Name') {
1.44 stredwic 1383: for(my $index=0; $index<scalar @sorted1Students; $index++) {
1384: $sortData{$CacheData->{$sorted1Students[$index].':fullname'}}=
1385: $sorted1Students[$index];
1.43 stredwic 1386: }
1387: } elsif($Pos eq 'Section') {
1.44 stredwic 1388: for(my $index=0; $index<scalar @sorted1Students; $index++) {
1389: $sortData{$CacheData->{$sorted1Students[$index].':section'}.
1390: $sorted1Students[$index]}=$sorted1Students[$index];
1.43 stredwic 1391: }
1392: } else {
1393: # Sort by user name
1.44 stredwic 1394: for(my $index=0; $index<scalar @sorted1Students; $index++) {
1395: $sortData{$sorted1Students[$index]}=$sorted1Students[$index];
1.43 stredwic 1396: }
1397: }
1398:
1399: my @order = ();
1.48 stredwic 1400: foreach my $key (sort(keys(%sortData))) {
1.43 stredwic 1401: push (@order,$sortData{$key});
1402: }
1.33 minaeibi 1403:
1.43 stredwic 1404: return @order;
1.30 minaeibi 1405: }
1.1 www 1406:
1.55 ! stredwic 1407: =pod
! 1408:
! 1409: =item &TestCacheData()
! 1410:
! 1411: Determine if the cache database can be accessed with a tie. It waits up to
! 1412: ten seconds before returning failure. This function exists to help with
! 1413: the problems with stopping the data download. When an abort occurs and the
! 1414: user quickly presses a form button and httpd child is created. This
! 1415: child needs to wait for the other to finish (hopefully within ten seconds).
! 1416:
! 1417: =over 4
! 1418:
! 1419: Input: $ChartDB
! 1420:
! 1421: $ChartDB: The name of the cache database to be opened
! 1422:
! 1423: Output: -1, 0, 1
! 1424:
! 1425: -1: Couldn't tie database
! 1426: 0: Use cached data
! 1427: 1: New cache database created, use that.
! 1428:
! 1429: =back
! 1430:
! 1431: =cut
! 1432:
1.44 stredwic 1433: sub TestCacheData {
1434: my ($ChartDB)=@_;
1435: my $isCached=-1;
1436: my %testData;
1437: my $tieTries=0;
1.43 stredwic 1438:
1.51 stredwic 1439: if ((-e "$ChartDB") && (!defined($ENV{'form.recalculate'}))) {
1.44 stredwic 1440: $isCached = 1;
1441: } else {
1442: $isCached = 0;
1.43 stredwic 1443: }
1444:
1.51 stredwic 1445: while($tieTries < 10) {
1.44 stredwic 1446: my $result=0;
1447: if($isCached) {
1448: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER,0640);
1449: } else {
1450: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB,0640);
1451: }
1452: if($result) {
1453: last;
1454: }
1455: $tieTries++;
1456: sleep 1;
1457: }
1.51 stredwic 1458: if($tieTries >= 10) {
1.44 stredwic 1459: return -1;
1.43 stredwic 1460: }
1461:
1.44 stredwic 1462: untie(%testData);
1.30 minaeibi 1463:
1.44 stredwic 1464: return $isCached;
1.43 stredwic 1465: }
1.30 minaeibi 1466:
1.55 ! stredwic 1467: =pod
! 1468:
! 1469: =item &ShouldShowColumn()
! 1470:
! 1471: Determine if a specified column should be shown on the chart.
! 1472:
! 1473: =over 4
! 1474:
! 1475: Input: $cache, $test
! 1476:
! 1477: $cache: A pointer to the hash tied to the cached data
! 1478:
! 1479: $test: The form name of the column (heading.$headingIndex) or
! 1480: (sequence.$sequenceIndex)
! 1481:
! 1482: Output: 0 (false), 1 (true)
1.44 stredwic 1483:
1.55 ! stredwic 1484: =back
1.1 www 1485:
1.55 ! stredwic 1486: =cut
1.44 stredwic 1487:
1.49 stredwic 1488: sub ShouldShowColumn {
1.51 stredwic 1489: my ($cache,$test)=@_;
1.49 stredwic 1490:
1.51 stredwic 1491: if($cache->{'form.reset'} eq 'true') {
1.49 stredwic 1492: return 1;
1493: }
1494:
1.51 stredwic 1495: my $headings=$cache->{'form.headings'};
1496: my $sequences=$cache->{'form.sequences'};
1497: if($headings eq 'ALLHEADINGS' || $sequences eq 'ALLSEQUENCES' ||
1498: $headings=~/$test/ || $sequences=~/$test/) {
1.49 stredwic 1499: return 1;
1500: }
1501:
1.51 stredwic 1502: return 0;
1.49 stredwic 1503: }
1504:
1.55 ! stredwic 1505: # ----- END HELPER FUNCTIONS --------------------------------------------
! 1506:
! 1507: =pod
! 1508:
! 1509: =head1 Handler and main function(BuildChart)
! 1510:
! 1511: The handler does some initial error checking and then passes the torch to
! 1512: BuildChart. BuildChart calls all the appropriate functions to get the
! 1513: job done. These are the only two functions that use print ($r). All other
! 1514: functions return strings to BuildChart to be printed.
! 1515:
! 1516: =cut
1.51 stredwic 1517:
1.55 ! stredwic 1518: =pod
1.51 stredwic 1519:
1.55 ! stredwic 1520: =item &BuildChart()
1.51 stredwic 1521:
1.55 ! stredwic 1522: The following is the process that BuildChart goes through to create the
! 1523: html document.
1.51 stredwic 1524:
1.55 ! stredwic 1525: -Start the lonchart document
! 1526: -Test for access to the CacheData
! 1527: -Download class list information if not using cached data
! 1528: -Sort students and print out table desciptive data
! 1529: -Output student data
! 1530: -If recalculating, store a list of students, but only if all their data was
! 1531: downloaded. Leave off the others.
! 1532: -End document
1.51 stredwic 1533:
1.55 ! stredwic 1534: =over 4
1.51 stredwic 1535:
1.55 ! stredwic 1536: Input: $r
1.51 stredwic 1537:
1.55 ! stredwic 1538: $r: Used to print html
1.51 stredwic 1539:
1.55 ! stredwic 1540: Output: None
1.51 stredwic 1541:
1.55 ! stredwic 1542: =back
1.49 stredwic 1543:
1.55 ! stredwic 1544: =cut
1.44 stredwic 1545:
1546: sub BuildChart {
1547: my ($r)=@_;
1548: my $c = $r->connection;
1.1 www 1549:
1.44 stredwic 1550: # Start the lonchart document
1551: $r->content_type('text/html');
1552: $r->send_http_header;
1553: $r->print(&StartDocument());
1554: $r->rflush();
1.43 stredwic 1555:
1.44 stredwic 1556: # Test for access to the CacheData
1557: my $isCached=0;
1.43 stredwic 1558: my $cid=$ENV{'request.course.id'};
1559: my $ChartDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
1560: "_$ENV{'user.domain'}_$cid\_chart.db";
1.44 stredwic 1561:
1562: $isCached=&TestCacheData($ChartDB);
1563: if($isCached < 0) {
1564: $r->print("Unable to tie hash to db file");
1565: $r->rflush();
1566: return;
1567: }
1.55 ! stredwic 1568: &ProcessFormData($ChartDB, $isCached);
1.44 stredwic 1569:
1570: # Download class list information if not using cached data
1.48 stredwic 1571: my %CacheData;
1.44 stredwic 1572: my @students=();
1573: my @studentInformation=('username','domain','section','id','fullname');
1574: my @headings=('User Name','Domain','Section','PID','Full Name');
1575: my $spacePadding=' ';
1576: if(!$isCached) {
1577: my $processTopResourceMapReturn=&ProcessTopResourceMap($ChartDB,$c);
1578: if($processTopResourceMapReturn ne 'OK') {
1579: $r->print($processTopResourceMapReturn);
1580: return;
1581: }
1582: if($c->aborted()) { return; }
1583: my $classlist=&DownloadPrerequisiteData($cid, $c);
1584: my ($checkForError)=keys(%$classlist);
1585: if($checkForError =~ /^(con_lost|error|no_such_host)/i ||
1586: defined($classlist->{'error'})) {
1587: return;
1588: }
1589: if($c->aborted()) { return; }
1590: @students=&ProcessClassList($classlist,$cid,$ChartDB,$c);
1591: if($c->aborted()) { return; }
1592: &SpaceColumns(\@students,\@studentInformation,\@headings,
1593: $ChartDB);
1594: if($c->aborted()) { return; }
1.48 stredwic 1595: } else {
1596: if(!$c->aborted() && tie(%CacheData,'GDBM_File',$ChartDB,
1597: &GDBM_READER,0640)) {
1598: @students=split(/:::/,$CacheData{'NamesOfStudents'});
1599: }
1.44 stredwic 1600: }
1601:
1602: # Sort students and print out table desciptive data
1.55 ! stredwic 1603: my $downloadTime=0;
1.44 stredwic 1604: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) {
1.48 stredwic 1605: if(!$c->aborted()) { @students=&SortStudents(\@students,\%CacheData); }
1.54 stredwic 1606: if(defined($CacheData{'time'})) { $downloadTime=$CacheData{'time'}; }
1607: else { $downloadTime=localtime(); }
1608: if(!$c->aborted()) { $r->print('<h3>'.$downloadTime.'</h3>'); }
1.50 stredwic 1609: if(!$c->aborted()) { $r->print('<h1>'.(scalar @students).
1610: ' students</h1>'); }
1611: if(!$c->aborted()) { $r->rflush(); }
1.44 stredwic 1612: if(!$c->aborted()) { $r->print(&CreateLegend()); }
1.55 ! stredwic 1613: if(!$c->aborted()) { $r->print('<table border="0"><tbody>'); }
1.51 stredwic 1614: if(!$c->aborted()) { $r->print(&CreateForm(\%CacheData)); }
1.49 stredwic 1615: if(!$c->aborted()) { $r->print(&CreateColumnSelectionBox(
1616: \%CacheData,
1.55 ! stredwic 1617: \@headings)); }
! 1618: if(!$c->aborted()) { $r->print('</tbody></table>'); }
! 1619: if(!$c->aborted()) { $r->print('<b>Note: Uncheck the boxes above a'); }
! 1620: if(!$c->aborted()) { $r->print(' column to remove that column from'); }
! 1621: if(!$c->aborted()) { $r->print(' the display.</b></pre>'); }
! 1622: if(!$c->aborted()) { $r->print('<table border="0" cellpadding="0" '); }
! 1623: if(!$c->aborted()) { $r->print('cellspacing="0"><tbody>'); }
1.49 stredwic 1624: if(!$c->aborted()) { $r->print(&CreateColumnSelectors(
1625: \%CacheData,
1.55 ! stredwic 1626: \@headings)); }
1.44 stredwic 1627: if(!$c->aborted()) { $r->print(&CreateTableHeadings(
1628: \%CacheData,
1629: \@studentInformation,
1630: \@headings,
1631: $spacePadding)); }
1.55 ! stredwic 1632: if(!$c->aborted()) { $r->print('</tbody></table>'); }
1.49 stredwic 1633: if(!$c->aborted()) { $r->rflush(); }
1.44 stredwic 1634: untie(%CacheData);
1.43 stredwic 1635: } else {
1.44 stredwic 1636: $r->print("Init2: Unable to tie hash to db file");
1637: return;
1.43 stredwic 1638: }
1639:
1.55 ! stredwic 1640: # Output student data
1.43 stredwic 1641: my @updateStudentList = ();
1.44 stredwic 1642: my $courseData;
1.50 stredwic 1643: $r->print('<pre>');
1.44 stredwic 1644: foreach (@students) {
1645: if($c->aborted()) {
1646: last;
1647: }
1648:
1649: if(!$isCached) {
1650: $courseData=&DownloadStudentCourseInformation($_, $cid);
1.50 stredwic 1651: if($c->aborted()) { last; }
1.44 stredwic 1652: push(@updateStudentList, $_);
1.55 ! stredwic 1653: &ProcessStudentData($courseData, $_, $ChartDB);
1.44 stredwic 1654: }
1.55 ! stredwic 1655: $r->print(&FormatStudentData($_, \@studentInformation,
1.44 stredwic 1656: $spacePadding, $ChartDB));
1657: $r->rflush();
1.43 stredwic 1658: }
1659:
1.55 ! stredwic 1660: # If recalculating, store a list of students, but only if all their
! 1661: # data was downloaded. Leave off the others.
1.50 stredwic 1662: if(!$isCached && tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
1663: $CacheData{'NamesOfStudents'}=join(":::", @updateStudentList);
1664: # $CacheData{'NamesOfStudents'}=
1665: # &Apache::lonnet::arrayref2str(\@updateStudentList);
1666: untie(%CacheData);
1667: }
1668:
1.55 ! stredwic 1669: # End document
1.50 stredwic 1670: $r->print('</pre></body></html>');
1.30 minaeibi 1671: $r->rflush();
1.1 www 1672:
1.43 stredwic 1673: return;
1.30 minaeibi 1674: }
1.1 www 1675:
1.30 minaeibi 1676: # ================================================================ Main Handler
1.55 ! stredwic 1677:
! 1678: =pod
! 1679:
! 1680: =item &handler()
! 1681:
! 1682: The handler checks for permission to access the course data and for
! 1683: initial header problem. Then it passes the torch to the work horse
! 1684: function BuildChart.
! 1685:
! 1686: =over 4
! 1687:
! 1688: Input: $r
! 1689:
! 1690: $r: This is the object that is used to print.
! 1691:
! 1692: Output: A Value (OK or HTTP_NOT_ACCEPTABLE)
! 1693:
! 1694: =back
! 1695:
! 1696: =cut
1.1 www 1697:
1.30 minaeibi 1698: sub handler {
1.44 stredwic 1699: my $r=shift;
1.51 stredwic 1700: # $jr=$r;
1.44 stredwic 1701: unless(&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
1.30 minaeibi 1702: $ENV{'user.error.msg'}=
1.1 www 1703: $r->uri.":vgr:0:0:Cannot view grades for complete course";
1.30 minaeibi 1704: return HTTP_NOT_ACCEPTABLE;
1705: }
1.44 stredwic 1706:
1707: # Set document type for header only
1708: if ($r->header_only) {
1709: if($ENV{'browser.mathml'}) {
1710: $r->content_type('text/xml');
1711: } else {
1712: $r->content_type('text/html');
1713: }
1714: &Apache::loncommon::no_cache($r);
1715: $r->send_http_header;
1716: return OK;
1717: }
1718:
1719: unless($ENV{'request.course.fn'}) {
1720: my $requrl=$r->uri;
1721: $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
1722: return HTTP_NOT_ACCEPTABLE;
1723: }
1724:
1725: &BuildChart($r);
1726:
1727: return OK;
1.1 www 1728: }
1729: 1;
1730: __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