Annotation of loncom/interface/lonchart.pm, revision 1.43
1.1 www 1: # The LearningOnline Network with CAPA
1.25 minaeibi 2: # (Publication Handler
3: #
1.43 ! stredwic 4: # $Id: lonchart.pm,v 1.40 2002/05/30 13:08:34 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:
58: # -------------------------------------------------------------- Module Globals
59: my %hash;
1.30 minaeibi 60: my %CachData;
1.1 www 61: my @cols;
1.30 minaeibi 62: my $r;
1.43 ! stredwic 63: my $c;
1.33 minaeibi 64:
1.1 www 65: # ------------------------------------------------------------- Find out status
66:
1.5 minaeibi 67: sub ExtractStudentData {
1.43 ! stredwic 68: my ($name,$coid)=@_;
! 69: my ($sname,$sdom) = split(/\:/,$name);
1.5 minaeibi 70: my $ResId;
71: my $Code;
72: my $Tries;
73: my $Wrongs;
1.7 minaeibi 74: my %TempHash;
1.5 minaeibi 75: my $Version;
1.43 ! stredwic 76: my $problemsCorrect;
! 77: my $problemsSolved;
! 78: my $totalProblems;
! 79: my $LatestVersion;
! 80: my $Str;
! 81:
! 82: # Handle Student information ------------------------------------------
! 83: # Handle errors
! 84: # if($CachData{$name.':error'} =~ /environment/) {
! 85: # my $errorMessage = $CachData{$name.':error'};
! 86: # return '<td>'.$sname.'</td><td>'.$sdom.
! 87: # '</td><td><font color="#000088">'.$errorMessage.'</font></td>';
! 88: # }
! 89:
! 90: # Handle user data
! 91: $Str = '<td><pre>'.$sname.'</pre></td><td><pre>'.$sdom;
! 92: $Str .= '</pre></td><td><pre>'.$CachData{$name.':section'};
! 93: $Str .= '</pre></td><td><pre>'.$CachData{$name.':id'};
! 94: $Str .= '</pre></td><td><pre>'.$CachData{$name.':fullname'};
! 95: $Str .= '</pre></td>';
1.39 stredwic 96:
1.43 ! stredwic 97: if($CachData{$name.':error'} =~ /course/) {
1.40 stredwic 98: return $Str;
1.43 ! stredwic 99: # my $errorMessage = 'May have no course data or '.
! 100: # $CachData{$name.':error'};
! 101: # return '<td>'.$sname.'</td><td>'.$sdom.
! 102: # '</td><td><font color="#000088">'.$errorMessage.'</font></td>';
1.40 stredwic 103: }
104:
1.43 ! stredwic 105: # Handle problem data ------------------------------------------------
! 106: $Str .= '<td><pre>';
! 107: $problemsCorrect = 0;
! 108: $totalProblems = 0;
! 109: $problemsSolved = 0;
1.39 stredwic 110: my $IterationNo = 0;
111: foreach $ResId (@cols) {
1.43 ! stredwic 112: if ($IterationNo == 0) {
! 113: # Looks to be skipping start resource
! 114: $IterationNo++;
! 115: next;
! 116: }
! 117:
! 118: # ResId is 0 for sequences and pages,
! 119: # please check tracetable for changes
! 120: if (!$ResId) {
! 121: my $outputProblemsCorrect = sprintf( "%3d", $problemsCorrect );
! 122: $Str .= '<font color="#007700">'.$outputProblemsCorrect.
! 123: '</font></pre></td>';
! 124: $Str .= '<td><pre>';
! 125: $problemsSolved += $problemsCorrect;
! 126: $problemsCorrect=0;
1.39 stredwic 127: next;
128: }
1.43 ! stredwic 129:
! 130: # Set $1 and $2
1.39 stredwic 131: $ResId=~/(\d+)\.(\d+)/;
132: my $meta=$hash{'src_'.$ResId};
1.43 ! stredwic 133: my $numberOfParts = 0;
1.39 stredwic 134: undef %TempHash;
135: foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {
1.43 ! stredwic 136: #----------- Overwrite $1 in next statement ---------------------------------
1.39 stredwic 137: if ($_=~/^stores\_(\d+)\_tries$/) {
138: my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
139: if ( $TempHash{"$Part"} eq '' ) {
140: $TempHash{"$Part"} = $Part;
1.43 ! stredwic 141: $TempHash{$numberOfParts}=$Part;
1.39 stredwic 142: $TempHash{"$Part.Code"} = ' ';
1.43 ! stredwic 143: $numberOfParts++;
1.39 stredwic 144: }
1.10 minaeibi 145: }
1.39 stredwic 146: }
1.11 minaeibi 147:
1.43 ! stredwic 148: #----------- Using $1 and $2 -----------------------------------------------
1.39 stredwic 149: my $Prob = &Apache::lonnet::symbclean(
150: &Apache::lonnet::declutter($hash{'map_id_'.$1} ).
1.5 minaeibi 151: '___'.$2.'___'.
1.38 www 152: &Apache::lonnet::declutter( $hash{'src_'.$ResId} ));
1.39 stredwic 153: $Code=' ';
154: $Tries = 0;
1.43 ! stredwic 155: $LatestVersion = $CachData{$name.":version:$Prob"};
1.39 stredwic 156:
157: if ( $LatestVersion ) {
158: for ( my $Version=1; $Version<=$LatestVersion; $Version++ ) {
1.43 ! stredwic 159: my $vkeys = $CachData{$name.":$Version:keys:$Prob"};
1.39 stredwic 160: my @keys = split(/\:/,$vkeys);
161:
1.43 ! stredwic 162: foreach my $Key (@keys) {
! 163: #---------------------- Changing $1 -------------------------------------------
1.39 stredwic 164: if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) {
1.43 ! stredwic 165: #---------------------- Using $1 -----------------------------------------------
1.39 stredwic 166: my $Part = $1;
1.43 ! stredwic 167: $Tries = $CachData{$name.":$Version:$Prob".
! 168: ":resource.$Part.tries"};
1.39 stredwic 169: $TempHash{"$Part.Tries"}=($Tries) ? $Tries : 0;
1.43 ! stredwic 170: my $Val = $CachData{$name.":$Version:$Prob".
! 171: ":resource.$Part.solved"};
! 172: if ($Val eq 'correct_by_student') {$Code = '*';}
! 173: elsif ($Val eq 'correct_by_override') {$Code = '+';}
! 174: elsif ($Val eq 'incorrect_attempted') {$Code = '.';}
1.39 stredwic 175: elsif ($Val eq 'incorrect_by_override'){$Code = '-';}
1.43 ! stredwic 176: elsif ($Val eq 'excused') {$Code = 'x';}
! 177: elsif ($Val eq 'ungraded_attempted') {$Code = '#';}
! 178: else {$Code = ' ';}
1.39 stredwic 179:
180: $TempHash{"$Part.Code"} = $Code;
181: }
182: }
183: }
1.38 www 184: # Actually append problem to output (all parts)
1.39 stredwic 185: $Str.='<a href="/adm/grades?symb='.
1.38 www 186: &Apache::lonnet::escape($Prob).
187: '&student='.$sname.'&domain='.$sdom.'&command=submission">';
1.43 ! stredwic 188: for(my $n = 0; $n < $numberOfParts; $n++) {
1.39 stredwic 189: my $part = $TempHash{$n};
1.43 ! stredwic 190: my $code2 = $TempHash{"$part.Code"};
! 191: if($code2 eq '*') {
! 192: $problemsCorrect++;
! 193: # !!!!!!!!!!!------------------------- Should 10 not be maxtries? ------------
1.39 stredwic 194: if (($TempHash{"$part.Tries"}<10) ||
195: ($TempHash{"$part.Tries"} eq '')) {
196: $TempHash{"$part.Code"}=$TempHash{"$part.Tries"};
197: }
1.43 ! stredwic 198: } elsif($code2 eq '+') {
! 199: $problemsCorrect++;
1.26 minaeibi 200: }
1.43 ! stredwic 201:
1.39 stredwic 202: $Str .= $TempHash{"$part.Code"};
1.43 ! stredwic 203:
! 204: if($code2 ne 'x') {
! 205: $totalProblems++;
! 206: }
1.39 stredwic 207: }
208: $Str.='</a>';
209: } else {
1.43 ! stredwic 210: for(my $n=0; $n<$numberOfParts; $n++) {
1.39 stredwic 211: $Str.=' ';
1.43 ! stredwic 212: $totalProblems++;
1.26 minaeibi 213: }
1.39 stredwic 214: }
1.1 www 215: }
1.39 stredwic 216:
1.43 ! stredwic 217: $Str .= '<td><pre><font color="#000088">'.$problemsSolved.
! 218: ' / '.$totalProblems.'</font></pre></td>';
1.11 minaeibi 219:
1.43 ! stredwic 220: return $Str;
! 221: }
! 222:
! 223: sub CreateForm {
! 224: my $OpSel1='';
! 225: my $OpSel2='';
! 226: my $OpSel3='';
! 227: my $Status = $ENV{'form.status'};
! 228: if ( $Status eq 'Any' ) { $OpSel3='selected'; }
! 229: elsif ($Status eq 'Expired' ) { $OpSel2 = 'selected'; }
! 230: else { $OpSel1 = 'selected'; }
! 231:
! 232: my $Ptr = '<form name=stat method=post action="/adm/chart" >'."\n";
! 233: $Ptr .= '<b> Sort by: </b>'."\n";
! 234: $Ptr .= ' ';
! 235: $Ptr .= '<input type=submit name=sort value="User Name" />'."\n";
! 236: $Ptr .= ' ';
! 237: $Ptr .= '<input type=submit name=sort value="Last Name" />'."\n";
! 238: $Ptr .= ' ';
! 239: $Ptr .= '<input type=submit name=sort value="Section"/>'."\n";
! 240: $Ptr .= '<br><br>';
! 241: $Ptr .= '<b> Student Status: </b>'."\n".
! 242: '<select name="status">'.
! 243: '<option '.$OpSel1.' >Active</option>'."\n".
! 244: '<option '.$OpSel2.' >Expired</option>'."\n".
! 245: '<option '.$OpSel3.' >Any</option> </select> '."\n";
! 246: $Ptr .= ' ';
! 247: $Ptr .= '<input type=submit name=sort value="Recalculate Chart"/>'."\n";
! 248: $Ptr .= '</form>'."\n";
! 249: $r->print( $Ptr );
1.1 www 250: }
251:
1.43 ! stredwic 252: sub CreateTableHeadings {
! 253: $r->print('<tr>');
! 254: $r->print('<td>User Name</td>');
! 255: $r->print('<td>Domain</td>');
! 256: $r->print('<td>Section</td>');
! 257: $r->print('<td>PID</td>');
! 258: $r->print('<td>Full Name</td>');
! 259:
! 260: my $ResId;
! 261: my $IterationNo = 0;
! 262: foreach $ResId (@cols) {
! 263: if ($IterationNo == 0) {$IterationNo++; next;}
! 264: if (!$ResId) {
! 265: # my $PrNo = sprintf( "%3d", $ProbNo );
! 266: # $Str .= '<td><font color="#007700">Chapter '.$PrNo.'</font></td>';
! 267: $r->print('<td><font color="#007700">Chapter '.'0'.'</font></td>');
! 268: }
! 269: }
! 270:
! 271: $r->print('</tr>');
! 272: $r->rflush();
! 273:
! 274: return;
! 275: }
1.5 minaeibi 276:
1.1 www 277: # ------------------------------------------------------------ Build page table
278:
279: sub tracetable {
280: my ($rid,$beenhere)=@_;
281: unless ($beenhere=~/\&$rid\&/) {
282: $beenhere.=$rid.'&';
1.7 minaeibi 283: # new ... updating the map according to sequence and page
1.1 www 284: if (defined($hash{'is_map_'.$rid})) {
1.7 minaeibi 285: my $cmap=$hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}};
286: if ( $cmap eq 'sequence' || $cmap eq 'page' ) {
1.1 www 287: $cols[$#cols+1]=0;
288: }
289: if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) &&
290: (defined($hash{'map_finish_'.$hash{'src_'.$rid}}))) {
291: my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}};
292:
293: &tracetable($hash{'map_start_'.$hash{'src_'.$rid}},
294: '&'.$frid.'&');
295:
296: if ($hash{'src_'.$frid}) {
297: if ($hash{'src_'.$frid}=~
298: /\.(problem|exam|quiz|assess|survey|form)$/) {
299: $cols[$#cols+1]=$frid;
300: }
301: }
302:
303: }
304: } else {
305: if ($hash{'src_'.$rid}) {
306: if ($hash{'src_'.$rid}=~
307: /\.(problem|exam|quiz|assess|survey|form)$/) {
308: $cols[$#cols+1]=$rid;
309: }
310: }
311: }
312: if (defined($hash{'to_'.$rid})) {
1.31 minaeibi 313: foreach (split(/\,/,$hash{'to_'.$rid})){
1.1 www 314: &tracetable($hash{'goesto_'.$_},$beenhere);
1.31 minaeibi 315: }
1.1 www 316: }
317: }
318: }
1.33 minaeibi 319:
320: sub usection {
1.36 minaeibi 321: my ($udom,$unam,$courseid,$ActiveFlag)=@_;
1.33 minaeibi 322: $courseid=~s/\_/\//g;
323: $courseid=~s/^(\w)/\/$1/;
1.39 stredwic 324:
325: my %result=&Apache::lonnet::dump('roles',$udom,$unam);
1.40 stredwic 326:
327: my($checkForError)=keys (%result);
328: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
329: return -1;
330: }
1.43 ! stredwic 331:
1.41 albertel 332: my $cursection='-1';
333: my $oldsection='-1';
334: my $status='Expired';
1.39 stredwic 335: foreach my $key (keys (%result)) {
336: my $value = $result{$key};
1.33 minaeibi 337: if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
338: my $section=$1;
339: if ($key eq $courseid.'_st') { $section=''; }
1.39 stredwic 340: my ($dummy,$end,$start)=split(/\_/,$value);
1.41 albertel 341: my $now=time;
342: my $notactive=0;
1.43 ! stredwic 343: if ($start) {
! 344: if($now<$start) {
! 345: $notactive=1;
! 346: }
! 347: }
! 348: if($end) {
! 349: if ($now>$end) {
! 350: $notactive=1;
! 351: }
! 352: }
! 353: if($notactive == 0) {
! 354: $status='Active';
! 355: $cursection=$section;
! 356: }
! 357: if($notactive == 1) {
! 358: $oldsection=$section;
! 359: }
! 360: }
! 361: }
! 362: if($status eq $ActiveFlag) {
! 363: if($cursection eq '-1') {
! 364: return $oldsection;
! 365: }
! 366: return $cursection;
! 367: }
! 368: if($ActiveFlag eq 'Any') {
! 369: if($cursection eq '-1') {
! 370: return $oldsection;
! 371: }
! 372: return $cursection;
1.41 albertel 373: }
1.36 minaeibi 374: return '-1';
1.33 minaeibi 375: }
376:
1.43 ! stredwic 377: sub ProcessFullName {
! 378: my ($name)=@_;
! 379: my $Str = '';
! 380:
! 381: if($CachData{$name.':lastname'} ne '') {
! 382: $Str .= $CachData{$name.':lastname'}.' ';
! 383: if($CachData{$name.':generation'} ne '') {
! 384: $Str .= $CachData{$name.':generation'};
! 385: } else {
! 386: chop($Str);
! 387: }
! 388: $Str .= ', ';
! 389: if($CachData{$name.':firstname'} ne '') {
! 390: $Str .= $CachData{$name.':firstname'}.' ';
! 391: }
! 392: if($CachData{$name.':middlename'} ne '') {
! 393: $Str .= $CachData{$name.':middlename'};
1.40 stredwic 394: } else {
1.43 ! stredwic 395: chop($Str);
! 396: if($CachData{$name.'firstname'} eq '') {
! 397: chop($Str);
1.31 minaeibi 398: }
1.30 minaeibi 399: }
1.43 ! stredwic 400: } else {
! 401: if($CachData{$name.':firstname'} ne '') {
! 402: $Str .= $CachData{$name.':firstname'}.' ';
! 403: }
! 404: if($CachData{$name.':middlename'} ne '') {
! 405: $Str .= $CachData{$name.':middlename'}.' ';
! 406: }
! 407: if($CachData{$name.':generation'} ne '') {
! 408: $Str .= $CachData{$name.':generation'};
! 409: } else {
! 410: chop($Str);
! 411: }
! 412: }
! 413:
! 414: return $Str;
! 415: }
1.30 minaeibi 416:
1.43 ! stredwic 417: sub DownloadStudentInformation {
! 418: my ($name,$courseID)=@_;
! 419: my ($studentName,$studentDomain) = split(/\:/,$name);
! 420: my $checkForError;
! 421: my $key;
! 422: my $Status=$CachData{$name.':Status'};
! 423:
! 424: #-----------------------------------------------------------------
! 425: # Download student environment data, specifically the full name and id.
! 426: my %studentInformation=&Apache::lonnet::get('environment',
! 427: ['lastname','generation',
! 428: 'firstname','middlename',
! 429: 'id'],
! 430: $studentDomain,$studentName);
! 431: if($c->aborted()) {
! 432: return;
! 433: }
! 434: ($checkForError)=keys (%studentInformation);
! 435: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
! 436: $CachData{$name.':error'}=
! 437: 'Could not download student environment data.';
! 438: # return;
! 439: $CachData{$name.':lastname'}='';
! 440: $CachData{$name.':generation'}='';
! 441: $CachData{$name.':firstname'}='';
! 442: $CachData{$name.':middlename'}='';
! 443: $CachData{$name.':fullname'}='';
! 444: $CachData{$name.':id'}='';
! 445: } else {
! 446: $CachData{$name.':lastname'}=$studentInformation{'lastname'};
! 447: $CachData{$name.':generation'}=$studentInformation{'generation'};
! 448: $CachData{$name.':firstname'}=$studentInformation{'firstname'};
! 449: $CachData{$name.':middlename'}=$studentInformation{'middlename'};
! 450: $CachData{$name.':fullname'}=&ProcessFullName($name);
! 451: $CachData{$name.':id'}=$studentInformation{'id'};
! 452: }
1.24 minaeibi 453:
1.43 ! stredwic 454: # Download student course data
! 455: my %courseData=&Apache::lonnet::dump($courseID,$studentDomain,
! 456: $studentName);
! 457: if($c->aborted()) {
! 458: return;
! 459: }
! 460: ($checkForError)=keys (%courseData);
! 461: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
! 462: $CachData{$name.':error'}='Could not download course data.';
! 463: # return;
! 464: } else {
! 465: foreach $key (keys (%courseData)) {
! 466: $CachData{$name.':'.$key}=$courseData{$key};
! 467: }
! 468: }
1.1 www 469:
1.43 ! stredwic 470: # Get student's section number
! 471: my $sec=&usection($studentDomain, $studentName, $courseID, $Status);
! 472: if($sec != -1) {
! 473: $CachData{$name.':section'}=sprintf('%3s',$sec);
1.30 minaeibi 474: } else {
1.43 ! stredwic 475: $CachData{$name.':section'}='';
1.30 minaeibi 476: }
1.43 ! stredwic 477:
! 478: return;
1.30 minaeibi 479: }
1.1 www 480:
1.43 ! stredwic 481: sub SortStudents {
! 482: # --------------------------------------------------------------- Sort Students
! 483: my $Pos = $ENV{'form.sort'};
! 484: my @students = split(/:::/,$CachData{'NamesOfStudents'});
! 485: my %sortData;
! 486:
! 487: if($Pos eq 'Last Name') {
! 488: for(my $index=0; $index<$#students+1; $index++) {
! 489: $sortData{$CachData{$students[$index].':fullname'}}=
! 490: $students[$index];
! 491: }
! 492: } elsif($Pos eq 'Section') {
! 493: for(my $index=0; $index<$#students+1; $index++) {
! 494: $sortData{$CachData{$students[$index].':section'}.
! 495: $students[$index]}=$students[$index];
! 496: }
! 497: } else {
! 498: # Sort by user name
! 499: for(my $index=0; $index<$#students+1; $index++) {
! 500: $sortData{$students[$index]}=$students[$index];
! 501: }
! 502: }
! 503:
! 504: my @order = ();
! 505: foreach my $key (sort keys(%sortData)) {
! 506: push (@order,$sortData{$key});
! 507: }
1.33 minaeibi 508:
1.43 ! stredwic 509: return @order;
1.30 minaeibi 510: }
1.1 www 511:
1.43 ! stredwic 512: sub CollectClasslist {
! 513: # -------------------------------------------------------------- Get class list
! 514: my $cid=$ENV{'request.course.id'};
! 515: my $chome=$ENV{'course.'.$cid.'.home'};
! 516: my ($cdom,$cnum)=split(/\_/,$cid);
! 517: my %classlist=&Apache::lonnet::dump('classlist',$cdom,$cnum);
! 518: my @names = ();
! 519:
! 520: my($checkForError)=keys (%classlist);
! 521: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
! 522: $r->print('<h1>Could not access course data</h1>');
! 523: push (@names, 'error');
! 524: return @names;
! 525: }
! 526:
! 527: # ------------------------------------- Calculate Status and number of students
! 528: my $now=time;
! 529: foreach my $name (sort(keys(%classlist))) {
! 530: my $value=$classlist{$name};
! 531: my ($end,$start)=split(/\:/,$value);
! 532: my $active=1;
! 533: my $Status=$ENV{'form.status'};
! 534: $Status = ($Status) ? $Status : 'Active';
! 535: if((($end) && $now > $end) && (($Status eq 'Active'))) {
! 536: $active=0;
! 537: }
! 538: if(($Status eq 'Expired') && ($end == 0 || $now < $end)) {
! 539: $active=0;
! 540: }
! 541: if($active) {
! 542: push(@names,$name);
! 543: $CachData{$name.':Status'}=$Status;
! 544: }
! 545: }
! 546:
! 547: $CachData{'NamesOfStudents'}=join(":::",@names);
1.30 minaeibi 548:
1.43 ! stredwic 549: return @names;
! 550: }
1.30 minaeibi 551:
1.43 ! stredwic 552: sub BuildChart {
! 553: # ----------------------- Get first and last resource, see if there is anything
! 554: my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}};
! 555: my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}};
! 556: if (!($firstres) || !($lastres)) {
! 557: $r->print('<h3>Undefined course sequence</h3>');
! 558: return;
1.30 minaeibi 559: }
1.1 www 560:
1.43 ! stredwic 561: # --------------- Find all assessments and put them into some linear-like order
! 562: &tracetable($firstres,'&'.$lastres.'&');
1.1 www 563:
1.43 ! stredwic 564: # ----------------------------------------------------------------- Render page
1.30 minaeibi 565: &CreateForm();
1.43 ! stredwic 566:
! 567: my $cid=$ENV{'request.course.id'};
! 568: my $ChartDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
! 569: "_$ENV{'user.domain'}_$cid\_chart.db";
! 570: my $isCached = 0;
! 571: my @students;
! 572: if ((-e "$ChartDB") && ($ENV{'form.sort'} ne 'Recalculate Chart')) {
! 573: if (tie(%CachData,'GDBM_File',"$ChartDB",&GDBM_READER,0640)) {
! 574: $isCached = 1;
! 575: @students=&SortStudents();
! 576: } else {
! 577: $r->print("Unable to tie hash to db file");
! 578: $r->rflush();
! 579: return;
! 580: }
! 581: } else {
! 582: if (tie(%CachData,'GDBM_File',$ChartDB,&GDBM_NEWDB,0640)) {
! 583: $isCached = 0;
! 584: @students=&CollectClasslist();
! 585: if($students[0] eq 'error') {
! 586: return;
! 587: }
! 588: } else {
! 589: $r->print("Unable to tie hash to db file");
! 590: return;
! 591: }
! 592: }
! 593:
! 594: $r->print('<h3>'.($#students+1).' students</h3>');
1.30 minaeibi 595: $r->rflush();
1.43 ! stredwic 596:
! 597: # ----------------------------------------------------------------- Start table
! 598: $r->print('<table><tbody>');
! 599: # &CreateTableHeadings();
! 600: my @updateStudentList = ();
! 601: foreach my $student (@students) {
! 602: if($c->aborted()) {
! 603: if($isCached == 0) {
! 604: $CachData{'NamesOfStudents'}=join(":::",@updateStudentList);
! 605: }
! 606: last;
! 607: }
! 608: if($isCached == 0) {
! 609: &DownloadStudentInformation($student,$cid);
! 610: push (@updateStudentList, $student);
! 611: }
! 612: my $Str=&ExtractStudentData($student,$cid);
! 613: $r->print('<tr>'.$Str.'</tr>');
! 614: }
! 615: $r->print('</tbody></table>');
! 616:
! 617: untie(%CachData);
! 618:
! 619: return;
1.30 minaeibi 620: }
1.1 www 621:
1.30 minaeibi 622: sub Start {
1.43 ! stredwic 623: $r->print('<head><title>'.
1.30 minaeibi 624: 'LON-CAPA Assessment Chart</title></head>');
625: $r->print('<body bgcolor="#FFFFFF">'.
626: '<script>window.focus();</script>'.
627: '<img align=right src=/adm/lonIcons/lonlogos.gif>'.
628: '<h1>Assessment Chart</h1>');
1.1 www 629: # ---------------------------------------------------------------- Course title
1.30 minaeibi 630: $r->print('<h1>'.$ENV{'course.'.$ENV{'request.course.id'}.
631: '.description'}.'</h1><h3>'.localtime().
632: "</h3><p><pre>1..9: correct by student in 1..9 tries\n".
633: " *: correct by student in more than 9 tries\n".
634: " +: correct by override\n".
635: " -: incorrect by override\n".
636: " .: incorrect attempted\n".
637: " #: ungraded attempted\n".
638: " : not attempted\n".
639: " x: excused</pre><p>");
1.1 www 640: # ------------------------------- This is going to take a while, produce output
1.30 minaeibi 641: $r->rflush();
1.1 www 642:
1.43 ! stredwic 643: &BuildChart();
! 644:
! 645: $r->print('</body>');
1.30 minaeibi 646:
1.43 ! stredwic 647: return;
1.30 minaeibi 648: }
1.1 www 649:
1.30 minaeibi 650: # ================================================================ Main Handler
1.1 www 651:
1.30 minaeibi 652: sub handler {
1.43 ! stredwic 653: undef %hash;
! 654: undef %CachData;
! 655: undef @cols;
! 656:
1.30 minaeibi 657: $r=shift;
1.43 ! stredwic 658: $c = $r->connection;
1.30 minaeibi 659: if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
660: # ------------------------------------------- Set document type for header only
661: if ($r->header_only) {
662: if ($ENV{'browser.mathml'}) {
663: $r->content_type('text/xml');
664: } else {
665: $r->content_type('text/html');
666: }
667: &Apache::loncommon::no_cache($r);
668: $r->send_http_header;
669: return OK;
670: }
1.1 www 671:
1.30 minaeibi 672: my $requrl=$r->uri;
673: # ----------------------------------------------------------------- Tie db file
674: if ($ENV{'request.course.fn'}) {
675: my $fn=$ENV{'request.course.fn'};
676: if (-e "$fn.db") {
677: if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
678: # ------------------------------------------------------------------- Hash tied
679: # ---------------------------------------------------------------- Send headers
680: $r->content_type('text/html');
681: $r->send_http_header;
1.43 ! stredwic 682: $r->print('<html>');
1.30 minaeibi 683: &Start();
1.43 ! stredwic 684: $r->print('</html>');
! 685: $r->rflush();
1.1 www 686: # ------------------------------------------------------------- End render page
1.30 minaeibi 687: } else {
688: $r->content_type('text/html');
689: $r->send_http_header;
690: $r->print('<html><body>Coursemap undefined.</body></html>');
691: }
1.1 www 692: # ------------------------------------------------------------------ Untie hash
1.30 minaeibi 693: unless (untie(%hash)) {
694: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
695: "Could not untie coursemap $fn (browse).</font>");
696: }
1.1 www 697:
698: # -------------------------------------------------------------------- All done
1.30 minaeibi 699: return OK;
1.1 www 700: # ----------------------------------------------- Errors, hash could no be tied
1.30 minaeibi 701: }
702: } else {
703: $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
704: return HTTP_NOT_ACCEPTABLE;
705: }
706: } else {
707: $ENV{'user.error.msg'}=
1.1 www 708: $r->uri.":vgr:0:0:Cannot view grades for complete course";
1.30 minaeibi 709: return HTTP_NOT_ACCEPTABLE;
710: }
1.1 www 711: }
712: 1;
713: __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