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