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