Annotation of loncom/interface/lonchart.pm, revision 1.52
1.1 www 1: # The LearningOnline Network with CAPA
1.25 minaeibi 2: # (Publication Handler
3: #
1.52 ! stredwic 4: # $Id: lonchart.pm,v 1.51 2002/07/02 21:34:40 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:
51: =cut
52:
1.1 www 53: package Apache::lonchart;
54:
55: use strict;
56: use Apache::Constants qw(:common :http);
57: use Apache::lonnet();
1.28 albertel 58: use Apache::loncommon();
1.1 www 59: use HTML::TokeParser;
60: use GDBM_File;
61:
1.51 stredwic 62: #my $jr;
1.44 stredwic 63: # ----- FORMAT PRINT DATA ----------------------------------------------
1.1 www 64:
1.44 stredwic 65: sub FormatStudentInformation {
1.51 stredwic 66: my ($cache,$name,$studentInformation,$spacePadding)=@_;
1.50 stredwic 67: my $Str='';
1.44 stredwic 68:
1.49 stredwic 69: for(my $index=0; $index<(scalar @$studentInformation); $index++) {
1.51 stredwic 70: if(!&ShouldShowColumn($cache, 'heading'.$index)) {
1.49 stredwic 71: next;
72: }
73: my $data=$cache->{$name.':'.$studentInformation->[$index]};
1.44 stredwic 74: $Str .= $data;
75:
76: my @dataLength=split(//,$data);
77: my $length=scalar @dataLength;
1.49 stredwic 78: $Str .= (' 'x($cache->{$studentInformation->[$index].'Length'}-
79: $length));
1.44 stredwic 80: $Str .= $spacePadding;
81: }
82:
83: return $Str;
84: }
85:
86: sub FormatStudentData {
1.51 stredwic 87: my ($name,$coid,$studentInformation,$spacePadding,$ChartDB)=@_;
1.43 stredwic 88: my ($sname,$sdom) = split(/\:/,$name);
89: my $Str;
1.44 stredwic 90: my %CacheData;
1.43 stredwic 91:
1.44 stredwic 92: unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) {
93: return '';
94: }
1.43 stredwic 95: # Handle Student information ------------------------------------------
1.44 stredwic 96: # Handle user data
97: $Str=&FormatStudentInformation(\%CacheData, $name, $studentInformation,
1.51 stredwic 98: $spacePadding);
1.44 stredwic 99:
1.43 stredwic 100: # Handle errors
1.44 stredwic 101: if($CacheData{$name.':error'} =~ /environment/) {
1.50 stredwic 102: $Str .= '<br>';
1.44 stredwic 103: untie(%CacheData);
104: return $Str;
105: }
1.43 stredwic 106:
1.44 stredwic 107: if($CacheData{$name.':error'} =~ /course/) {
1.50 stredwic 108: $Str .= '<br>';
1.44 stredwic 109: untie(%CacheData);
1.50 stredwic 110: return $Str;
1.40 stredwic 111: }
112:
1.43 stredwic 113: # Handle problem data ------------------------------------------------
1.44 stredwic 114: my $Version;
115: my $problemsCorrect = 0;
116: my $totalProblems = 0;
117: my $problemsSolved = 0;
118: my $numberOfParts = 0;
119: foreach my $sequence (split(/\:/,$CacheData{'orderedSequences'})) {
1.51 stredwic 120: if(!&ShouldShowColumn(\%CacheData, 'sequence'.$sequence)) {
1.49 stredwic 121: next;
122: }
123:
1.44 stredwic 124: my $characterCount=0;
125: foreach my $problemID (split(/\:/,$CacheData{$sequence.':problems'})) {
126: my $problem = $CacheData{$problemID.':problem'};
127: my $LatestVersion = $CacheData{$name.":version:$problem"};
128:
129: if(!$LatestVersion) {
130: foreach my $part (split(/\:/,$CacheData{$sequence.':'.
131: $problemID.
132: ':parts'})) {
133: $Str .= ' ';
134: $totalProblems++;
135: $characterCount++;
136: }
137: next;
138: }
139:
140: my %partData=undef;
141: #initialize data, displays skips correctly
142: foreach my $part (split(/\:/,$CacheData{$sequence.':'.
143: $problemID.
144: ':parts'})) {
145: $partData{$part.':tries'}=0;
146: $partData{$part.':code'}=' ';
147: }
148: for(my $Version=1; $Version<=$LatestVersion; $Version++) {
149: foreach my $part (split(/\:/,$CacheData{$sequence.':'.
150: $problemID.
151: ':parts'})) {
152:
153: if(!defined($CacheData{$name.":$Version:$problem".
154: ":resource.$part.solved"})) {
155: next;
156: }
157:
158: my $tries=0;
159: my $code=' ';
160:
161: $tries = $CacheData{$name.":$Version:$problem".
162: ":resource.$part.tries"};
163: $partData{$part.':tries'}=($tries) ? $tries : 0;
164:
165: my $val = $CacheData{$name.":$Version:$problem".
166: ":resource.$part.solved"};
167: if ($val eq 'correct_by_student') {$code = '*';}
168: elsif ($val eq 'correct_by_override') {$code = '+';}
169: elsif ($val eq 'incorrect_attempted') {$code = '.';}
170: elsif ($val eq 'incorrect_by_override'){$code = '-';}
171: elsif ($val eq 'excused') {$code = 'x';}
172: elsif ($val eq 'ungraded_attempted') {$code = '#';}
173: else {$code = ' ';}
174: $partData{$part.':code'}=$code;
175: }
176: }
177:
178: $Str.='<a href="/adm/grades?symb='.
179: &Apache::lonnet::escape($problem).
180: '&student='.$sname.'&domain='.$sdom.'&command=submission">';
181: foreach(split(/\:/,$CacheData{$sequence.':'.$problemID.
182: ':parts'})) {
183: if($partData{$_.':code'} eq '*') {
184: $problemsCorrect++;
185: if (($partData{$_.':tries'}<10) &&
186: ($partData{$_.':tries'} ne '')) {
187: $partData{$_.':code'}=$partData{$_.':tries'};
188: }
189: } elsif($partData{$_.':code'} eq '+') {
190: $problemsCorrect++;
191: }
192:
193: $Str .= $partData{$_.':code'};
194: $characterCount++;
195:
196: if($partData{$_.':code'} ne 'x') {
197: $totalProblems++;
198: }
199: }
200: $Str.='</a>';
201: }
202:
203: my $spacesNeeded=$CacheData{$sequence.':columnWidth'}-$characterCount;
204: $spacesNeeded -= 3;
205: $Str .= (' 'x$spacesNeeded);
206:
207: my $outputProblemsCorrect = sprintf( "%3d", $problemsCorrect );
208: $Str .= '<font color="#007700">'.$outputProblemsCorrect.'</font>';
209: $problemsSolved += $problemsCorrect;
210: $problemsCorrect=0;
211:
212: $Str .= $spacePadding;
213: }
1.11 minaeibi 214:
1.51 stredwic 215: my $outputProblemsSolved = sprintf( "%4d", $problemsSolved );
216: my $outputTotalProblems = sprintf( "%4d", $totalProblems );
217: $Str .= '<font color="#000088">'.$outputProblemsSolved.
218: ' / '.$outputTotalProblems.'</font><br>';
1.39 stredwic 219:
1.44 stredwic 220: untie(%CacheData);
221: return $Str;
222: }
1.43 stredwic 223:
1.44 stredwic 224: sub CreateTableHeadings {
1.51 stredwic 225: my ($CacheData,$studentInformation,$headings,$spacePadding)=@_;
1.44 stredwic 226: my $Str='<pre>';
1.43 stredwic 227:
1.44 stredwic 228: for(my $index=0; $index<(scalar @$headings); $index++) {
1.51 stredwic 229: if(!&ShouldShowColumn($CacheData, 'heading'.$index)) {
1.49 stredwic 230: next;
231: }
232:
1.44 stredwic 233: my $data=$$headings[$index];
234: $Str .= $data;
235:
236: my @dataLength=split(//,$data);
237: my $length=scalar @dataLength;
238: $Str .= (' 'x($CacheData->{$$studentInformation[$index].'Length'}-
239: $length));
240: $Str .= $spacePadding;
241: }
242:
243: foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
1.51 stredwic 244: if(!&ShouldShowColumn($CacheData, 'sequence'.$sequence)) {
1.49 stredwic 245: next;
246: }
247:
248: my $name = $CacheData->{$sequence.':title'};
249: $Str .= $name;
1.44 stredwic 250: my @titleLength=split(//,$CacheData->{$sequence.':title'});
251: my $leftover=$CacheData->{$sequence.':columnWidth'}-
252: (scalar @titleLength);
253: $Str .= (' 'x$leftover);
254: $Str .= $spacePadding;
1.1 www 255: }
1.39 stredwic 256:
1.44 stredwic 257: $Str .= 'Total Solved/Total Problems';
258: $Str .= '</pre>';
1.11 minaeibi 259:
1.43 stredwic 260: return $Str;
261: }
262:
1.49 stredwic 263: sub CreateColumnSelectionBox {
1.51 stredwic 264: my ($CacheData,$studentInformation,$headings,$spacePadding)=@_;
1.46 stredwic 265:
1.49 stredwic 266: my $missing=0;
1.50 stredwic 267: my $notThere='<tr><td align="right"><b>Select column to view:</b>';
1.49 stredwic 268: my $name;
1.50 stredwic 269: $notThere .= '<td align="left">';
1.49 stredwic 270: $notThere .= '<select name="reselect" size="4" multiple="true">'."\n";
1.46 stredwic 271:
272: for(my $index=0; $index<(scalar @$headings); $index++) {
1.51 stredwic 273: if(&ShouldShowColumn($CacheData, 'heading'.$index)) {
1.49 stredwic 274: next;
275: }
276: $name = $headings->[$index];
277: $notThere .= '<option value="heading'.$index.'">';
278: $notThere .= $name.'</option>'."\n";
279: $missing++;
280: }
281:
282: foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
1.51 stredwic 283: if(&ShouldShowColumn($CacheData, 'sequence'.$sequence)) {
1.49 stredwic 284: next;
285: }
286: $name = $CacheData->{$sequence.':title'};
287: $notThere .= '<option value="sequence'.$sequence.'">';
288: $notThere .= $name.'</option>'."\n";
289: $missing++;
290: }
291:
292: if($missing) {
1.50 stredwic 293: $notThere .= '</select>';
1.49 stredwic 294: } else {
1.50 stredwic 295: $notThere='<tr><td>';
1.49 stredwic 296: }
297:
1.50 stredwic 298: return $notThere.'</td></tr></tbody></table>';
1.49 stredwic 299: }
300:
301: sub CreateColumnSelectors {
1.51 stredwic 302: my ($CacheData,$studentInformation,$headings,$spacePadding)=@_;
1.46 stredwic 303:
1.49 stredwic 304: my $found=0;
305: my ($name, $length, $position);
306: my $present='<pre>';
307: for(my $index=0; $index<(scalar @$headings); $index++) {
1.51 stredwic 308: if(!&ShouldShowColumn($CacheData, 'heading'.$index)) {
1.49 stredwic 309: next;
310: }
311: $name = $headings->[$index];
312: $length=$CacheData->{$$studentInformation[$index].'Length'};
313: $position=int($length/2);
314: $present .= (' 'x($position));
315: $present .= '<input type="checkbox" checked="on" ';
316: $present .= 'name="heading'.$index.'">';
317: $position+=2;
318: $present .= (' 'x($length-$position));
319: $present .= $spacePadding;
320: $found++;
1.46 stredwic 321: }
322:
323: foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
1.51 stredwic 324: if(!&ShouldShowColumn($CacheData, 'sequence'.$sequence)) {
1.49 stredwic 325: next;
326: }
327: $name = $CacheData->{$sequence.':title'};
328: $length=$CacheData->{$sequence.':columnWidth'};
329: $position=int($length/2);
330: $present .= (' 'x($position));
331: $present .= '<input type="checkbox" checked="on" ';
332: $present .= 'name="sequence'.$sequence.'">';
333: $position+=2;
334: $present .= (' 'x($length-$position));
335: $present .= $spacePadding;
336: $found++;
337: }
338:
339: if($found) {
340: $present .= '</pre>';
341: $present = $present;
342: } else {
343: $present = '';
1.46 stredwic 344: }
345:
1.49 stredwic 346: return $present.'</form>'."\n";;
1.46 stredwic 347: }
348:
1.43 stredwic 349: sub CreateForm {
1.51 stredwic 350: my ($CacheData)=@_;
1.43 stredwic 351: my $OpSel1='';
352: my $OpSel2='';
353: my $OpSel3='';
1.51 stredwic 354: my $Status = $CacheData->{'form.status'};
1.43 stredwic 355: if ( $Status eq 'Any' ) { $OpSel3='selected'; }
356: elsif ($Status eq 'Expired' ) { $OpSel2 = 'selected'; }
357: else { $OpSel1 = 'selected'; }
358:
1.50 stredwic 359: my $Ptr .= '<form name="stat" method="post" action="/adm/chart" >'."\n";
360: $Ptr .= '<table border="0"><tbody>';
361: $Ptr .= '<tr><td align="right">';
362: $Ptr .= '</td><td align="left">';
1.51 stredwic 363: $Ptr .= '<input type="submit" name="recalculate" ';
1.50 stredwic 364: $Ptr .= 'value="Recalculate Chart"/>'."\n";
1.43 stredwic 365: $Ptr .= ' ';
1.50 stredwic 366: $Ptr .= '<input type="submit" name="refresh" ';
1.51 stredwic 367: $Ptr .= 'value="Refresh Chart"/>'."\n";
368: $Ptr .= ' ';
369: $Ptr .= '<input type="submit" name="reset" ';
370: $Ptr .= 'value="Reset Selections"/></td>'."\n";
1.50 stredwic 371: $Ptr .= '</tr><tr><td align="right">';
372: $Ptr .= '<b> Sort by: </b>'."\n";
373: $Ptr .= '</td><td align="left">';
1.44 stredwic 374: $Ptr .= '<input type="submit" name="sort" value="User Name" />'."\n";
1.43 stredwic 375: $Ptr .= ' ';
1.44 stredwic 376: $Ptr .= '<input type="submit" name="sort" value="Last Name" />'."\n";
1.43 stredwic 377: $Ptr .= ' ';
1.44 stredwic 378: $Ptr .= '<input type="submit" name="sort" value="Section"/>'."\n";
1.50 stredwic 379: $Ptr .= '</td></tr><tr><td align="right">';
1.43 stredwic 380: $Ptr .= '<b> Student Status: </b>'."\n".
1.50 stredwic 381: '</td><td align="left">'.
1.43 stredwic 382: '<select name="status">'.
383: '<option '.$OpSel1.' >Active</option>'."\n".
384: '<option '.$OpSel2.' >Expired</option>'."\n".
385: '<option '.$OpSel3.' >Any</option> </select> '."\n";
1.50 stredwic 386: $Ptr .= '</td></tr>';
1.44 stredwic 387:
388: return $Ptr;
389: }
390:
391: sub CreateLegend {
1.50 stredwic 392: my $Str = "<p><pre>".
393: "1..9: correct by student in 1..9 tries\n".
1.44 stredwic 394: " *: correct by student in more than 9 tries\n".
395: " +: correct by override\n".
396: " -: incorrect by override\n".
397: " .: incorrect attempted\n".
398: " #: ungraded attempted\n".
399: " : not attempted\n".
1.50 stredwic 400: " x: excused".
401: "</pre><p>";
1.44 stredwic 402: return $Str;
403: }
404:
405: sub StartDocument {
406: my $Str = '';
407: $Str .= '<html>';
408: $Str .= '<head><title>';
409: $Str .= 'LON-CAPA Assessment Chart</title></head>';
410: $Str .= '<body bgcolor="#FFFFFF">';
411: $Str .= '<script>window.focus();</script>';
412: $Str .= '<img align=right src=/adm/lonIcons/lonlogos.gif>';
1.52 ! stredwic 413: $Str .= '<h1>Assessment Chart</h1>';
! 414: $Str .= '<h3>'.localtime().'</h3>';
1.50 stredwic 415: $Str .= '<h1>'.$ENV{'course.'.$ENV{'request.course.id'}.'.description'};
416: $Str .= '</h1>';
1.44 stredwic 417:
418: return $Str;
419: }
420:
421: # ----- END FORMAT PRINT DATA ------------------------------------------
422:
423: # ----- DOWNLOAD INFORMATION -------------------------------------------
424:
425: sub DownloadPrerequisiteData {
426: my ($courseID, $c)=@_;
427: my ($courseDomain,$courseNumber)=split(/\_/,$courseID);
428:
429: my %classlist=&Apache::lonnet::dump('classlist',$courseDomain,
430: $courseNumber);
431: my ($checkForError)=keys (%classlist);
432: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
433: return \%classlist;
434: }
435:
436: foreach my $name (keys(%classlist)) {
437: if($c->aborted()) {
438: $classlist{'error'}='aborted';
439: return \%classlist;
440: }
441:
442: my ($studentName,$studentDomain) = split(/\:/,$name);
443: # Download student environment data, specifically the full name and id.
444: my %studentInformation=&Apache::lonnet::get('environment',
445: ['lastname','generation',
446: 'firstname','middlename',
447: 'id'],
448: $studentDomain,
449: $studentName);
450: $classlist{$name.':studentInformation'}=\%studentInformation;
451:
452: if($c->aborted()) {
453: $classlist{'error'}='aborted';
454: return \%classlist;
455: }
456:
457: #Section
458: my %section=&Apache::lonnet::dump('roles',$studentDomain,$studentName);
459: $classlist{$name.':section'}=\%section;
460: }
461:
462: return \%classlist;
1.1 www 463: }
464:
1.44 stredwic 465: sub DownloadStudentCourseInformation {
466: my ($name,$courseID)=@_;
467: my ($studentName,$studentDomain) = split(/\:/,$name);
468:
469: # Download student course data
470: my %courseData=&Apache::lonnet::dump($courseID,$studentDomain,
471: $studentName);
472: return \%courseData;
473: }
474:
475: # ----- END DOWNLOAD INFORMATION ---------------------------------------
476:
477: # ----- END PROCESSING FUNCTIONS ---------------------------------------
478:
479: sub ProcessTopResourceMap {
480: my ($ChartDB,$c)=@_;
481: my %hash;
482: my $fn=$ENV{'request.course.fn'};
483: if(-e "$fn.db") {
484: my $tieTries=0;
485: while($tieTries < 3) {
486: if(tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
487: last;
488: }
489: $tieTries++;
490: sleep 1;
1.43 stredwic 491: }
1.44 stredwic 492: if($tieTries >= 3) {
493: return 'Coursemap undefined.';
494: }
495: } else {
496: return 'Can not open Coursemap.';
1.43 stredwic 497: }
498:
1.44 stredwic 499: my %CacheData;
500: unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
501: untie(%hash);
502: return 'Could not tie cache hash.';
503: }
504:
505: my (@sequences, @currentResource, @finishResource);
506: my ($currentSequence, $currentResourceID, $lastResourceID);
507:
508: $currentResourceID=$hash{'ids_/res/'.$ENV{'request.course.uri'}};
1.46 stredwic 509: push(@currentResource, $currentResourceID);
1.44 stredwic 510: $lastResourceID=-1;
511: $currentSequence=-1;
512: my $topLevelSequenceNumber = $currentSequence;
513:
514: while(1) {
515: if($c->aborted()) {
516: last;
517: }
518: # HANDLE NEW SEQUENCE!
519: #if page || sequence
520: if(defined($hash{'map_pc_'.$hash{'src_'.$currentResourceID}})) {
521: push(@sequences, $currentSequence);
522: push(@currentResource, $currentResourceID);
523: push(@finishResource, $lastResourceID);
524:
525: $currentSequence=$hash{'map_pc_'.$hash{'src_'.$currentResourceID}};
1.51 stredwic 526:
527: # Mark sequence as containing problems. If it doesn't, then
528: # it will be removed when processing for this sequence is
529: # complete. This allows the problems in a sequence
530: # to be outputed before problems in the subsequences
531: if(!defined($CacheData{'orderedSequences'})) {
532: $CacheData{'orderedSequences'}=$currentSequence;
533: } else {
534: $CacheData{'orderedSequences'}.=':'.$currentSequence;
535: }
536:
1.44 stredwic 537: $lastResourceID=$hash{'map_finish_'.
538: $hash{'src_'.$currentResourceID}};
539: $currentResourceID=$hash{'map_start_'.
540: $hash{'src_'.$currentResourceID}};
541:
542: if(!($currentResourceID) || !($lastResourceID)) {
543: $currentSequence=pop(@sequences);
544: $currentResourceID=pop(@currentResource);
545: $lastResourceID=pop(@finishResource);
546: if($currentSequence eq $topLevelSequenceNumber) {
547: last;
548: }
549: }
550: }
551:
552: # Handle gradable resources: exams, problems, etc
553: $currentResourceID=~/(\d+)\.(\d+)/;
554: my $partA=$1;
555: my $partB=$2;
556: if($hash{'src_'.$currentResourceID}=~
557: /\.(problem|exam|quiz|assess|survey|form)$/ &&
558: $partA eq $currentSequence) {
559: my $Problem = &Apache::lonnet::symbclean(
560: &Apache::lonnet::declutter($hash{'map_id_'.$partA}).
561: '___'.$partB.'___'.
562: &Apache::lonnet::declutter($hash{'src_'.
563: $currentResourceID}));
564:
565: $CacheData{$currentResourceID.':problem'}=$Problem;
566: if(!defined($CacheData{$currentSequence.':problems'})) {
567: $CacheData{$currentSequence.':problems'}=$currentResourceID;
568: } else {
569: $CacheData{$currentSequence.':problems'}.=
570: ':'.$currentResourceID;
571: }
572:
573: #Get Parts for problem
574: my $meta=$hash{'src_'.$currentResourceID};
575: foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {
576: if($_=~/^stores\_(\d+)\_tries$/) {
577: my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
578: if(!defined($CacheData{$currentSequence.':'.
579: $currentResourceID.':parts'})) {
580: $CacheData{$currentSequence.':'.$currentResourceID.
581: ':parts'}=$Part;
582: } else {
583: $CacheData{$currentSequence.':'.$currentResourceID.
584: ':parts'}.=':'.$Part;
585: }
586: }
587: }
588: }
589:
590: #if resource == finish resource
591: if($currentResourceID eq $lastResourceID) {
592: #pop off last resource of sequence
593: $currentResourceID=pop(@currentResource);
594: $lastResourceID=pop(@finishResource);
595:
596: if(defined($CacheData{$currentSequence.':problems'})) {
597: # Capture sequence information here
598: $CacheData{$currentSequence.':title'}=
599: $hash{'title_'.$currentResourceID};
600:
601: my $totalProblems=0;
1.47 stredwic 602: foreach my $currentProblem (split(/\:/,
603: $CacheData{$currentSequence.
1.44 stredwic 604: ':problems'})) {
1.47 stredwic 605: foreach (split(/\:/,$CacheData{$currentSequence.':'.
606: $currentProblem.
607: ':parts'})) {
1.44 stredwic 608: $totalProblems++;
609: }
610: }
611: my @titleLength=split(//,$CacheData{$currentSequence.
612: ':title'});
613: # $extra is 3 for problems correct and 3 for space
614: # between problems correct and problem output
615: my $extra = 6;
616: if(($totalProblems + $extra) > (scalar @titleLength)) {
617: $CacheData{$currentSequence.':columnWidth'}=
618: $totalProblems + $extra;
619: } else {
620: $CacheData{$currentSequence.':columnWidth'}=
621: (scalar @titleLength);
622: }
1.51 stredwic 623: } else {
624: $CacheData{'orderedSequences'}=~s/$currentSequence//;
625: $CacheData{'orderedSequences'}=~s/::/:/g;
626: $CacheData{'orderedSequences'}=~s/^:|:$//g;
627: }
1.44 stredwic 628:
629: $currentSequence=pop(@sequences);
630: if($currentSequence eq $topLevelSequenceNumber) {
631: last;
632: }
633: }
1.43 stredwic 634:
1.44 stredwic 635: # MOVE!!!
636: #move to next resource
637: unless(defined($hash{'to_'.$currentResourceID})) {
638: # big problem, need to handle. Next is probably wrong
639: last;
640: }
641: my @nextResources=();
642: foreach (split(/\,/,$hash{'to_'.$currentResourceID})) {
643: push(@nextResources, $hash{'goesto_'.$_});
644: }
645: push(@currentResource, @nextResources);
1.46 stredwic 646: # Set the next resource to be processed
647: $currentResourceID=pop(@currentResource);
1.44 stredwic 648: }
1.5 minaeibi 649:
1.44 stredwic 650: unless (untie(%hash)) {
651: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
652: "Could not untie coursemap $fn (browse)".
653: ".</font>");
654: }
1.1 www 655:
1.44 stredwic 656: unless (untie(%CacheData)) {
657: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
658: "Could not untie Cache Hash (browse)".
659: ".</font>");
1.1 www 660: }
1.44 stredwic 661:
662: return 'OK';
1.1 www 663: }
1.33 minaeibi 664:
1.44 stredwic 665: sub ProcessSection {
666: my ($sectionData, $courseid,$ActiveFlag)=@_;
1.33 minaeibi 667: $courseid=~s/\_/\//g;
668: $courseid=~s/^(\w)/\/$1/;
1.39 stredwic 669:
1.41 albertel 670: my $cursection='-1';
671: my $oldsection='-1';
672: my $status='Expired';
1.44 stredwic 673: my $section='';
674: foreach my $key (keys (%$sectionData)) {
675: my $value = $sectionData->{$key};
1.33 minaeibi 676: if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
1.44 stredwic 677: $section=$1;
678: if($key eq $courseid.'_st') {
679: $section='';
680: }
1.39 stredwic 681: my ($dummy,$end,$start)=split(/\_/,$value);
1.41 albertel 682: my $now=time;
683: my $notactive=0;
1.43 stredwic 684: if ($start) {
685: if($now<$start) {
686: $notactive=1;
687: }
688: }
689: if($end) {
690: if ($now>$end) {
691: $notactive=1;
692: }
693: }
694: if($notactive == 0) {
695: $status='Active';
696: $cursection=$section;
1.44 stredwic 697: last;
1.43 stredwic 698: }
699: if($notactive == 1) {
700: $oldsection=$section;
701: }
702: }
703: }
704: if($status eq $ActiveFlag) {
705: if($cursection eq '-1') {
706: return $oldsection;
707: }
708: return $cursection;
709: }
710: if($ActiveFlag eq 'Any') {
711: if($cursection eq '-1') {
712: return $oldsection;
713: }
714: return $cursection;
1.41 albertel 715: }
1.36 minaeibi 716: return '-1';
1.33 minaeibi 717: }
718:
1.44 stredwic 719: sub ProcessStudentInformation {
720: my ($CacheData,$studentInformation,$section,$date,$name,$courseID,$c)=@_;
721: my ($studentName,$studentDomain) = split(/\:/,$name);
722:
723: $CacheData->{$name.':username'}=$studentName;
724: $CacheData->{$name.':domain'}=$studentDomain;
725: $CacheData->{$name.':date'}=$date;
726:
727: my ($checkForError)=keys(%$studentInformation);
728: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
729: $CacheData->{$name.':error'}=
730: 'Could not download student environment data.';
731: $CacheData->{$name.':fullname'}='';
732: $CacheData->{$name.':id'}='';
733: } else {
734: $CacheData->{$name.':fullname'}=&ProcessFullName(
735: $studentInformation->{'lastname'},
736: $studentInformation->{'generation'},
737: $studentInformation->{'firstname'},
738: $studentInformation->{'middlename'});
739: $CacheData->{$name.':id'}=$studentInformation->{'id'};
740: }
741:
742: # Get student's section number
1.51 stredwic 743: my $sec=&ProcessSection($section, $courseID, $CacheData->{'form.status'});
1.44 stredwic 744: if($sec != -1) {
745: $CacheData->{$name.':section'}=$sec;
746: } else {
747: $CacheData->{$name.':section'}='';
748: }
749:
750: return 0;
751: }
752:
753: sub ProcessClassList {
754: my ($classlist,$courseID,$ChartDB,$c)=@_;
755: my @names=();
756:
757: my %CacheData;
758: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
759: foreach my $name (keys(%$classlist)) {
1.48 stredwic 760: if($name =~ /\:section/ || $name =~ /\:studentInformation/ ||
761: $name eq '') {
1.44 stredwic 762: next;
763: }
764: if($c->aborted()) {
765: last;
766: }
767: push(@names,$name);
768: &ProcessStudentInformation(
769: \%CacheData,
770: $classlist->{$name.':studentInformation'},
771: $classlist->{$name.':section'},
772: $classlist->{$name},
773: $name,$courseID,$c);
774: }
775:
776: untie(%CacheData);
777: }
778:
779: return @names;
780: }
781:
782: # ----- END PROCESSING FUNCTIONS ---------------------------------------
783:
784: # ----- HELPER FUNCTIONS -----------------------------------------------
785:
786: sub SpaceColumns {
787: my ($students,$studentInformation,$headings,$ChartDB)=@_;
788:
789: my %CacheData;
790: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
791: # Initialize Lengths
792: for(my $index=0; $index<(scalar @$headings); $index++) {
793: my @titleLength=split(//,$$headings[$index]);
794: $CacheData{$$studentInformation[$index].'Length'}=
795: scalar @titleLength;
796: }
797:
798: foreach my $name (@$students) {
799: foreach (@$studentInformation) {
800: my @dataLength=split(//,$CacheData{$name.':'.$_});
801: my $length=scalar @dataLength;
802: if($length > $CacheData{$_.'Length'}) {
803: $CacheData{$_.'Length'}=$length;
804: }
805: }
806: }
807: untie(%CacheData);
808: }
809:
810: return;
811: }
812:
1.43 stredwic 813: sub ProcessFullName {
1.44 stredwic 814: my ($lastname, $generation, $firstname, $middlename)=@_;
1.43 stredwic 815: my $Str = '';
816:
1.44 stredwic 817: if($lastname ne '') {
818: $Str .= $lastname.' ';
819: if($generation ne '') {
820: $Str .= $generation;
1.43 stredwic 821: } else {
822: chop($Str);
823: }
824: $Str .= ', ';
1.44 stredwic 825: if($firstname ne '') {
826: $Str .= $firstname.' ';
1.43 stredwic 827: }
1.44 stredwic 828: if($middlename ne '') {
829: $Str .= $middlename;
1.40 stredwic 830: } else {
1.43 stredwic 831: chop($Str);
1.44 stredwic 832: if($firstname eq '') {
1.43 stredwic 833: chop($Str);
1.31 minaeibi 834: }
1.30 minaeibi 835: }
1.43 stredwic 836: } else {
1.44 stredwic 837: if($firstname ne '') {
838: $Str .= $firstname.' ';
1.43 stredwic 839: }
1.44 stredwic 840: if($middlename ne '') {
841: $Str .= $middlename.' ';
1.43 stredwic 842: }
1.44 stredwic 843: if($generation ne '') {
844: $Str .= $generation;
1.43 stredwic 845: } else {
846: chop($Str);
847: }
848: }
849:
850: return $Str;
851: }
1.30 minaeibi 852:
1.44 stredwic 853: sub SortStudents {
1.48 stredwic 854: my ($students,$CacheData)=@_;
1.44 stredwic 855:
856: my @sorted1Students=();
1.48 stredwic 857: foreach (@$students) {
1.44 stredwic 858: my ($end,$start)=split(/\:/,$CacheData->{$_.':date'});
859: my $active=1;
860: my $now=time;
1.51 stredwic 861: my $Status=$CacheData->{'form.status'};
1.44 stredwic 862: $Status = ($Status) ? $Status : 'Active';
863: if((($end) && $now > $end) && (($Status eq 'Active'))) {
864: $active=0;
865: }
866: if(($Status eq 'Expired') && ($end == 0 || $now < $end)) {
867: $active=0;
868: }
869: if($active) {
870: push(@sorted1Students, $_);
871: }
1.43 stredwic 872: }
1.1 www 873:
1.51 stredwic 874: my $Pos = $CacheData->{'form.sort'};
1.43 stredwic 875: my %sortData;
876: if($Pos eq 'Last Name') {
1.44 stredwic 877: for(my $index=0; $index<scalar @sorted1Students; $index++) {
878: $sortData{$CacheData->{$sorted1Students[$index].':fullname'}}=
879: $sorted1Students[$index];
1.43 stredwic 880: }
881: } elsif($Pos eq 'Section') {
1.44 stredwic 882: for(my $index=0; $index<scalar @sorted1Students; $index++) {
883: $sortData{$CacheData->{$sorted1Students[$index].':section'}.
884: $sorted1Students[$index]}=$sorted1Students[$index];
1.43 stredwic 885: }
886: } else {
887: # Sort by user name
1.44 stredwic 888: for(my $index=0; $index<scalar @sorted1Students; $index++) {
889: $sortData{$sorted1Students[$index]}=$sorted1Students[$index];
1.43 stredwic 890: }
891: }
892:
893: my @order = ();
1.48 stredwic 894: foreach my $key (sort(keys(%sortData))) {
1.43 stredwic 895: push (@order,$sortData{$key});
896: }
1.33 minaeibi 897:
1.43 stredwic 898: return @order;
1.30 minaeibi 899: }
1.1 www 900:
1.44 stredwic 901: sub TestCacheData {
902: my ($ChartDB)=@_;
903: my $isCached=-1;
904: my %testData;
905: my $tieTries=0;
1.43 stredwic 906:
1.51 stredwic 907: if ((-e "$ChartDB") && (!defined($ENV{'form.recalculate'}))) {
1.44 stredwic 908: $isCached = 1;
909: } else {
910: $isCached = 0;
1.43 stredwic 911: }
912:
1.51 stredwic 913: while($tieTries < 10) {
1.44 stredwic 914: my $result=0;
915: if($isCached) {
916: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER,0640);
917: } else {
918: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB,0640);
919: }
920: if($result) {
921: last;
922: }
923: $tieTries++;
924: sleep 1;
925: }
1.51 stredwic 926: if($tieTries >= 10) {
1.44 stredwic 927: return -1;
1.43 stredwic 928: }
929:
1.44 stredwic 930: untie(%testData);
1.30 minaeibi 931:
1.44 stredwic 932: return $isCached;
1.43 stredwic 933: }
1.30 minaeibi 934:
1.44 stredwic 935: sub ExtractStudentData {
936: my ($courseData, $name, $ChartDB)=@_;
937:
938: my %CacheData;
939: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
940: my ($checkForError) = keys(%$courseData);
941: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
942: $CacheData{$name.':error'}='Could not download course data.';
943: } else {
944: foreach my $key (keys (%$courseData)) {
945: $CacheData{$name.':'.$key}=$courseData->{$key};
946: }
1.48 stredwic 947: if(defined($CacheData{'NamesOfStudents'})) {
948: $CacheData{'NamesOfStudents'}.=':::'.$name;
949: } else {
950: $CacheData{'NamesOfStudents'}=$name;
951: }
1.44 stredwic 952: }
953: untie(%CacheData);
1.30 minaeibi 954: }
1.1 www 955:
1.44 stredwic 956: return;
957: }
958:
1.49 stredwic 959: sub ShouldShowColumn {
1.51 stredwic 960: my ($cache,$test)=@_;
1.49 stredwic 961:
1.51 stredwic 962: if($cache->{'form.reset'} eq 'true') {
1.49 stredwic 963: return 1;
964: }
965:
1.51 stredwic 966: my $headings=$cache->{'form.headings'};
967: my $sequences=$cache->{'form.sequences'};
968: if($headings eq 'ALLHEADINGS' || $sequences eq 'ALLSEQUENCES' ||
969: $headings=~/$test/ || $sequences=~/$test/) {
1.49 stredwic 970: return 1;
971: }
972:
1.51 stredwic 973: # my $reselected=$cache->{'form.reselect'};
974: # if($reselected=~/$test/) {
975: # return 1;
976: # }
977:
978: return 0;
1.49 stredwic 979: }
980:
1.51 stredwic 981: sub ProcessFormData {
982: my ($ChartDB)=@_;
983: my %CacheData;
984:
985: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
986: if(defined($ENV{'form.sort'})) {
987: $CacheData{'form.sort'}=$ENV{'form.sort'};
988: } elsif(!defined($CacheData{'form.sort'})) {
989: $CacheData{'form.sort'}='username';
990: }
991:
992: # Ignore $ENV{'form.refresh'}
993: # Ignore $ENV{'form.recalculate'}
994:
995: if(defined($ENV{'form.status'})) {
996: $CacheData{'form.status'}=$ENV{'form.status'};
997: } elsif(!defined($CacheData{'form.status'})) {
998: $CacheData{'form.status'}='Active';
999: }
1000:
1001: my @headings=();
1002: my @sequences=();
1003: my $found=0;
1004: foreach (keys(%ENV)) {
1005: if(/form\.heading/) {
1006: $found++;
1007: push(@headings, $_);
1008: } elsif(/form\.sequence/) {
1009: $found++;
1010: push(@sequences, $_);
1011: } elsif(/form\./) {
1012: $found++;
1013: }
1014: }
1015:
1016: if($found) {
1017: $CacheData{'form.headings'}=join(":::",@headings);
1018: $CacheData{'form.sequences'}=join(":::",@sequences);
1019: }
1020:
1021: if(defined($ENV{'form.reselect'})) {
1022: my @reselected = (ref($ENV{'form.reselect'}) ?
1023: @{$ENV{'form.reselect'}}
1024: : ($ENV{'form.reselect'}));
1025: foreach (@reselected) {
1026: if(/heading/) {
1027: $CacheData{'form.headings'}.=":::".$_;
1028: } elsif(/sequence/) {
1029: $CacheData{'form.sequences'}.=":::".$_;
1030: }
1031: }
1.49 stredwic 1032: }
1.51 stredwic 1033:
1034: if(defined($ENV{'form.reset'})) {
1035: $CacheData{'form.reset'}='true';
1036: $CacheData{'form.status'}='Active';
1037: $CacheData{'form.sort'}='username';
1038: $CacheData{'form.headings'}='ALLHEADINGS';
1039: $CacheData{'form.sequences'}='ALLSEQUENCES';
1040: } else {
1041: $CacheData{'form.reset'}='false';
1042: }
1043:
1044: untie(%CacheData);
1.49 stredwic 1045: }
1.51 stredwic 1046:
1047: return;
1.49 stredwic 1048: }
1049:
1.44 stredwic 1050: # ----- END HELPER FUNCTIONS --------------------------------------------
1051:
1052: sub BuildChart {
1053: my ($r)=@_;
1054: my $c = $r->connection;
1.1 www 1055:
1.44 stredwic 1056: # Start the lonchart document
1057: $r->content_type('text/html');
1058: $r->send_http_header;
1059: $r->print(&StartDocument());
1060: $r->rflush();
1.43 stredwic 1061:
1.44 stredwic 1062: # Test for access to the CacheData
1063: my $isCached=0;
1.43 stredwic 1064: my $cid=$ENV{'request.course.id'};
1065: my $ChartDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
1066: "_$ENV{'user.domain'}_$cid\_chart.db";
1.44 stredwic 1067:
1068: $isCached=&TestCacheData($ChartDB);
1069: if($isCached < 0) {
1070: $r->print("Unable to tie hash to db file");
1071: $r->rflush();
1072: return;
1073: }
1.51 stredwic 1074: &ProcessFormData($ChartDB);
1.44 stredwic 1075:
1076: # Download class list information if not using cached data
1.48 stredwic 1077: my %CacheData;
1.44 stredwic 1078: my @students=();
1079: my @studentInformation=('username','domain','section','id','fullname');
1080: my @headings=('User Name','Domain','Section','PID','Full Name');
1081: my $spacePadding=' ';
1082: if(!$isCached) {
1083: my $processTopResourceMapReturn=&ProcessTopResourceMap($ChartDB,$c);
1084: if($processTopResourceMapReturn ne 'OK') {
1085: $r->print($processTopResourceMapReturn);
1086: return;
1087: }
1088: if($c->aborted()) { return; }
1089: my $classlist=&DownloadPrerequisiteData($cid, $c);
1090: my ($checkForError)=keys(%$classlist);
1091: if($checkForError =~ /^(con_lost|error|no_such_host)/i ||
1092: defined($classlist->{'error'})) {
1093: return;
1094: }
1095: if($c->aborted()) { return; }
1096: @students=&ProcessClassList($classlist,$cid,$ChartDB,$c);
1097: if($c->aborted()) { return; }
1098: &SpaceColumns(\@students,\@studentInformation,\@headings,
1099: $ChartDB);
1100: if($c->aborted()) { return; }
1.48 stredwic 1101: } else {
1102: if(!$c->aborted() && tie(%CacheData,'GDBM_File',$ChartDB,
1103: &GDBM_READER,0640)) {
1104: @students=split(/:::/,$CacheData{'NamesOfStudents'});
1105: }
1.44 stredwic 1106: }
1107:
1108: # Sort students and print out table desciptive data
1109: if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) {
1.48 stredwic 1110: if(!$c->aborted()) { @students=&SortStudents(\@students,\%CacheData); }
1.50 stredwic 1111: if(!$c->aborted()) { $r->print('<h1>'.(scalar @students).
1112: ' students</h1>'); }
1113: if(!$c->aborted()) { $r->rflush(); }
1.44 stredwic 1114: if(!$c->aborted()) { $r->print(&CreateLegend()); }
1.51 stredwic 1115: if(!$c->aborted()) { $r->print(&CreateForm(\%CacheData)); }
1.49 stredwic 1116: if(!$c->aborted()) { $r->print(&CreateColumnSelectionBox(
1117: \%CacheData,
1118: \@studentInformation,
1119: \@headings,
1120: $spacePadding)); }
1121: if(!$c->aborted()) { $r->print(&CreateColumnSelectors(
1122: \%CacheData,
1123: \@studentInformation,
1124: \@headings,
1125: $spacePadding)); }
1.44 stredwic 1126: if(!$c->aborted()) { $r->print(&CreateTableHeadings(
1127: \%CacheData,
1128: \@studentInformation,
1129: \@headings,
1130: $spacePadding)); }
1.49 stredwic 1131: if(!$c->aborted()) { $r->rflush(); }
1.44 stredwic 1132: untie(%CacheData);
1.43 stredwic 1133: } else {
1.44 stredwic 1134: $r->print("Init2: Unable to tie hash to db file");
1135: return;
1.43 stredwic 1136: }
1137:
1138: my @updateStudentList = ();
1.44 stredwic 1139: my $courseData;
1.50 stredwic 1140: $r->print('<pre>');
1.44 stredwic 1141: foreach (@students) {
1142: if($c->aborted()) {
1143: last;
1144: }
1145:
1146: if(!$isCached) {
1147: $courseData=&DownloadStudentCourseInformation($_, $cid);
1.50 stredwic 1148: if($c->aborted()) { last; }
1.44 stredwic 1149: push(@updateStudentList, $_);
1150: &ExtractStudentData($courseData, $_, $ChartDB);
1151: }
1.51 stredwic 1152: $r->print(&FormatStudentData($_, $cid, \@studentInformation,
1.44 stredwic 1153: $spacePadding, $ChartDB));
1154: $r->rflush();
1.43 stredwic 1155: }
1156:
1.50 stredwic 1157: if(!$isCached && tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
1158: $CacheData{'NamesOfStudents'}=join(":::", @updateStudentList);
1159: # $CacheData{'NamesOfStudents'}=
1160: # &Apache::lonnet::arrayref2str(\@updateStudentList);
1161: untie(%CacheData);
1162: }
1163:
1164: $r->print('</pre></body></html>');
1.30 minaeibi 1165: $r->rflush();
1.1 www 1166:
1.43 stredwic 1167: return;
1.30 minaeibi 1168: }
1.1 www 1169:
1.30 minaeibi 1170: # ================================================================ Main Handler
1.1 www 1171:
1.30 minaeibi 1172: sub handler {
1.44 stredwic 1173: my $r=shift;
1.51 stredwic 1174: # $jr=$r;
1.44 stredwic 1175: unless(&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
1.30 minaeibi 1176: $ENV{'user.error.msg'}=
1.1 www 1177: $r->uri.":vgr:0:0:Cannot view grades for complete course";
1.30 minaeibi 1178: return HTTP_NOT_ACCEPTABLE;
1179: }
1.44 stredwic 1180:
1181: # Set document type for header only
1182: if ($r->header_only) {
1183: if($ENV{'browser.mathml'}) {
1184: $r->content_type('text/xml');
1185: } else {
1186: $r->content_type('text/html');
1187: }
1188: &Apache::loncommon::no_cache($r);
1189: $r->send_http_header;
1190: return OK;
1191: }
1192:
1193: unless($ENV{'request.course.fn'}) {
1194: my $requrl=$r->uri;
1195: $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
1196: return HTTP_NOT_ACCEPTABLE;
1197: }
1198:
1199: &BuildChart($r);
1200:
1201: return OK;
1.1 www 1202: }
1203: 1;
1204: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>