loncom/interface/lonchart.pm - view

File: [LON-CAPA] / loncom / interface / Attic / lonchart.pm
Revision 1.38: download - view: text, annotated - select for diffs
Thu May 9 17:06:09 2002 UTC (22 years, 4 months ago) by www
Branches: MAIN
CVS tags: HEAD

Implemented links according to bug 421.
Also, inserted &symbclean on artificially created symb to "de-version"

1: # The LearningOnline Network with CAPA 2: # (Publication Handler 3: # 4: # $Id: lonchart.pm,v 1.38 2002/05/09 17:06:09 www Exp $ 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: # 28: # Homework Performance Chart 29: # 30: # (Navigate Maps Handler 31: # 32: # (Page Handler 33: # 34: # (TeX Content Handler 35: # YEAR=2000 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) 39: # YEAR=2001 40: # 3/1/1,6/1,17/1,29/1,30/1,31/1 Gerd Kortemeyer) 41: # 7/10/01 Behrouz Minaei 42: # 9/8 Gerd Kortemeyer 43: # 10/1, 10/19, 11/17, 11/22, 11/24, 11/28 12/18 Behrouz Minaei 44: # YEAR=2002 45: # 2/1, 2/6, 2/19, 2/28 Behrouz Minaei 46: # 47: ### 48: 49: package Apache::lonchart; 50: 51: use strict; 52: use Apache::Constants qw(:common :http); 53: use Apache::lonnet(); 54: use Apache::loncommon(); 55: use HTML::TokeParser; 56: use GDBM_File; 57: 58: # -------------------------------------------------------------- Module Globals 59: my %hash; 60: my %CachData; 61: my @cols; 62: my @rowlabels; 63: my @students; 64: my @PreCol; 65: my $r; 66: 67: # ------------------------------------------------------------- Find out status 68: 69: sub ExtractStudentData { 70: my ($index,$coid)=@_; 71: my ($sname,$sdom) = split( /\:/, $students[$index] ); 72: my $shome=&Apache::lonnet::homeserver( $sname,$sdom ); 73: my $reply=&Apache::lonnet::reply('dump:'.$sdom.':'.$sname.':'.$coid,$shome ); 74: my %result=(); 75: my $ResId; 76: my $Code; 77: my $Tries; 78: my $Wrongs; 79: my %TempHash; 80: my $Version; 81: my $ProbNo; 82: my $ProbSolved; 83: my $ProbTotal; 84: my $LatestVersion; 85: my $Str=substr($students[$index]. 86: ' ',0,14).' ! '. 87: substr($rowlabels[$index]. 88: ' ',0,45).' ! '; 89: unless ($reply=~/^error\:/) { 90: foreach (split(/\&/,$reply)) { 91: my ($name,$value)=split(/\=/,&Apache::lonnet::unescape($_)); 92: $result{$name}=$value; 93: } 94: $ProbNo = 0; 95: $ProbTotal = 0; 96: $ProbSolved = 0; 97: my $IterationNo = 0; 98: foreach $ResId (@cols) { 99: if ($IterationNo == 0) {$IterationNo++; next;} 100: if (!$ResId) { 101: my $PrNo = sprintf( "%3d", $ProbNo ); 102: $Str .= ' '.'<font color="#007700">'.$PrNo.'</font> '; 103: $ProbSolved += $ProbNo; 104: $ProbNo=0; 105: next; 106: } 107: $ResId=~/(\d+)\.(\d+)/; 108: my $meta=$hash{'src_'.$ResId}; 109: my $PartNo = 0; 110: undef %TempHash; 111: foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) { 112: if ($_=~/^stores\_(\d+)\_tries$/) { 113: my $Part=&Apache::lonnet::metadata($meta,$_.'.part'); 114: if ( $TempHash{"$Part"} eq '' ) { 115: $TempHash{"$Part"} = $Part; 116: $TempHash{$PartNo}=$Part; 117: $TempHash{"$Part.Code"} = ' '; 118: $PartNo++; 119: } 120: } 121: } 122: 123: my $Prob = &Apache::lonnet::symbclean( 124: &Apache::lonnet::declutter( $hash{'map_id_'.$1} ). 125: '___'.$2.'___'. 126: &Apache::lonnet::declutter( $hash{'src_'.$ResId} )); 127: $Code=' '; 128: $Tries = 0; 129: $LatestVersion = $result{"version:$Prob"}; 130: 131: if ( $LatestVersion ) { 132: for ( my $Version=1; $Version<=$LatestVersion; $Version++ ) { 133: my $vkeys = $result{"$Version:keys:$Prob"}; 134: my @keys = split(/\:/,$vkeys); 135: 136: foreach my $Key (@keys) { 137: if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) { 138: my $Part = $1; 139: $Tries = $result{"$Version:$Prob:resource.$Part.tries"}; 140: $TempHash{"$Part.Tries"}=($Tries) ? $Tries : 0; 141: my $Val = $result{"$Version:$Prob:resource.$Part.solved"}; 142: if ($Val eq 'correct_by_student'){$Code='*';} 143: elsif ($Val eq 'correct_by_override'){$Code = '+';} 144: elsif ($Val eq 'incorrect_attempted'){$Code = '.';} 145: elsif ($Val eq 'incorrect_by_override'){$Code = '-';} 146: elsif ($Val eq 'excused'){$Code = 'x';} 147: elsif ($Val eq 'ungraded_attempted'){$Code = '#';} 148: else {$Code = ' ';} 149: $TempHash{"$Part.Code"} = $Code; 150: } 151: } 152: } 153: # Actually append problem to output (all parts) 154: $Str.='<a href="/adm/grades?symb='. 155: &Apache::lonnet::escape($Prob). 156: '&student='.$sname.'&domain='.$sdom.'&command=submission">'; 157: for ( my $n = 0; $n < $PartNo; $n++ ) { 158: my $part = $TempHash{$n}; 159: my $Code = $TempHash{"$part.Code"}; 160: if ( $Code eq '*') { 161: $ProbNo++; 162: if (($TempHash{"$part.Tries"}<10) || 163: ($TempHash{"$part.Tries"} eq '')) { 164: $TempHash{"$part.Code"}=$TempHash{"$part.Tries"}; 165: } 166: } 167: elsif ( $Code eq '+' ) {$ProbNo++;} 168: $Str .= $TempHash{"$part.Code"}; 169: if ( $Code ne 'x' ) {$ProbTotal++;} 170: } 171: $Str.='</a>'; 172: } 173: else { 174: for(my $n=0; $n<$PartNo; $n++) { 175: $Str.=' '; 176: $ProbTotal++; 177: } 178: } 179: } 180: } 181: my $PrTot = sprintf( "%5d", $ProbTotal ); 182: my $PrSvd = sprintf( "%5d", $ProbSolved ); 183: $Str .= ' '.'<font color="#000088">'.$PrSvd.' /'.$PrTot.'</font> '; 184: 185: return $Str ; 186: } 187: 188: 189: # ------------------------------------------------------------ Build page table 190: 191: sub tracetable { 192: my ($rid,$beenhere)=@_; 193: unless ($beenhere=~/\&$rid\&/) { 194: $beenhere.=$rid.'&'; 195: # new ... updating the map according to sequence and page 196: if (defined($hash{'is_map_'.$rid})) { 197: my $cmap=$hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}}; 198: if ( $cmap eq 'sequence' || $cmap eq 'page' ) { 199: $cols[$#cols+1]=0; 200: } 201: if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) && 202: (defined($hash{'map_finish_'.$hash{'src_'.$rid}}))) { 203: my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}}; 204: 205: &tracetable($hash{'map_start_'.$hash{'src_'.$rid}}, 206: '&'.$frid.'&'); 207: 208: if ($hash{'src_'.$frid}) { 209: if ($hash{'src_'.$frid}=~ 210: /\.(problem|exam|quiz|assess|survey|form)$/) { 211: $cols[$#cols+1]=$frid; 212: } 213: } 214: 215: } 216: } else { 217: if ($hash{'src_'.$rid}) { 218: if ($hash{'src_'.$rid}=~ 219: /\.(problem|exam|quiz|assess|survey|form)$/) { 220: $cols[$#cols+1]=$rid; 221: } 222: } 223: } 224: if (defined($hash{'to_'.$rid})) { 225: foreach (split(/\,/,$hash{'to_'.$rid})){ 226: &tracetable($hash{'goesto_'.$_},$beenhere); 227: } 228: } 229: } 230: } 231: 232: sub usection { 233: my ($udom,$unam,$courseid,$ActiveFlag)=@_; 234: $courseid=~s/\_/\//g; 235: $courseid=~s/^(\w)/\/$1/; 236: foreach (split(/\&/,&Apache::lonnet::reply('dump:'. 237: $udom.':'.$unam.':roles', 238: &Apache::lonnet::homeserver($unam,$udom)))){ 239: my ($key,$value)=split(/\=/,$_); 240: $key=&Apache::lonnet::unescape($key); 241: if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) { 242: my $section=$1; 243: if ($key eq $courseid.'_st') { $section=''; } 244: my ($dummy,$end,$start)=split(/\_/,&Apache::lonnet::unescape($value)); 245: if ( $ActiveFlag ne 'Any' ) { 246: my $now=time; 247: my $notactive=0; 248: if ($start) { 249: if ($now<$start) { $notactive=1; } 250: } 251: if ($end) { 252: if ($now>$end) { $notactive=1; } 253: } 254: if ((($ActiveFlag eq 'Expired') && $notactive == 1) || 255: (($ActiveFlag eq 'Active') && $notactive == 0 ) ) { 256: return $section; 257: } 258: else { return '-1'; } 259: } 260: return $section; 261: } 262: } 263: return '-1'; 264: } 265: 266: sub BuildChart { 267: # ----------------------- Get first and last resource, see if there is anything 268: my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}}; 269: my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}}; 270: if (($firstres) && ($lastres)) { 271: # ----------------------------------------------------------------- Render page 272: my $cid=$ENV{'request.course.id'}; 273: my $chome=$ENV{'course.'.$cid.'.home'}; 274: my ($cdom,$cnum)=split(/\_/,$cid); 275: # ---------------------------------------------- Read class list and row labels 276: my $classlst=&Apache::lonnet::reply 277: ('dump:'.$cdom.':'.$cnum.':classlist',$chome); 278: my $now=time; 279: unless ($classlst=~/^error\:/) { 280: foreach my $KeyPoint(sort split(/\&/,$classlst)) { 281: my ($name,$value)=split(/\=/,$KeyPoint); 282: my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value)); 283: my $active=1; 284: my $Status=$ENV{'form.status'}; 285: $Status = ($Status) ? $Status : 'Active'; 286: if ( ( ($end) && $now > $end ) && 287: ( ($Status eq 'Active') ) ) { $active=0; } 288: 289: if ( ($Status eq 'Expired') && 290: ($end == 0 || $now < $end) ) { $active=0; } 291: 292: if ($active) { 293: my $thisindex=$#students+1; 294: $name=&Apache::lonnet::unescape($name); 295: $students[$thisindex]=$name; 296: my ($sname,$sdom)=split(/\:/,$name); 297: $PreCol[$thisindex]=$sname.':'; 298: my $ssec=&usection($sdom,$sname,$cid,$Status); 299: if ($ssec==-1) { 300: $rowlabels[$thisindex]= 301: 'Data not available: '.$name; 302: } 303: else { 304: my %reply=&Apache::lonnet::idrget($sdom,$sname); 305: my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname. 306: ':environment:lastname&generation&firstname&middlename', 307: &Apache::lonnet::homeserver($sname,$sdom)); 308: #$ssec=(int($ssec)) ? int($ssec) : $ssec; 309: my $sec=sprintf('%3s',$ssec); 310: $rowlabels[$thisindex]=$sec.' '.$reply{$sname}.' '; 311: $PreCol[$thisindex] .= $reply.':'.$sec; 312: my $i=0; 313: foreach (split(/\&/,$reply)) { 314: $i++; 315: if ( $_ ne '') { 316: $rowlabels[$thisindex].=&Apache::lonnet::unescape($_).' '; 317: } 318: if ($i == 2) { 319: chop($rowlabels[$thisindex]); 320: $rowlabels[$thisindex].=', '; 321: } 322: } 323: } 324: } 325: } 326: 327: } else { 328: $r->print('<h1>Could not access course data</h1>'); 329: } 330: 331: my $allstudents=$#students+1; 332: $r->print('<h3>'.$allstudents.' students</h3>'); 333: &CreateForm(); 334: $r->rflush(); 335: 336: # --------------- Find all assessments and put them into some linear-like order 337: &tracetable($firstres,'&'.$lastres.'&'); 338: # ----------------------------------------------------------------- Start table 339: 340: $r->print('<p><pre>'); 341: my $index; 342: for ($index=0;$index<=$#students;$index++) { 343: my $Str=&ExtractStudentData($index,$cid); 344: $r->print($Str.'<br>'); 345: $r->rflush(); 346: $CachData{$PreCol[$index]}=$Str; 347: } 348: $r->print('</pre>'); 349: } else { 350: $r->print('<h3>Undefined course sequence</h3>'); 351: } 352: } 353: 354: sub CreateForm { 355: my $OpSel1=''; 356: my $OpSel2=''; 357: my $OpSel3=''; 358: my $Status = $ENV{'form.status'}; 359: if ( $Status eq 'Any' ) { $OpSel3='selected'; } 360: elsif ($Status eq 'Expired' ) { $OpSel2 = 'selected'; } 361: else { $OpSel1 = 'selected'; } 362: 363: my $Ptr = '<form name=stat method=post action="/adm/chart" >'."\n"; 364: $Ptr .= '<b> Sort by:   </b>'."\n"; 365: $Ptr .= '   '; 366: $Ptr .= '<input type=submit name=sort value="User Name" />'."\n"; 367: $Ptr .= '   '; 368: $Ptr .= '<input type=submit name=sort value="Last Name" />'."\n"; 369: $Ptr .= '   '; 370: $Ptr .= '<input type=submit name=sort value="Section"/>'."\n"; 371: $Ptr .= '<br><br>'; 372: $Ptr .= '<b> Student Status:   </b>'."\n". 373: '<select name="status">'. 374: '<option '.$OpSel1.' >Active</option>'."\n". 375: '<option '.$OpSel2.' >Expired</option>'."\n". 376: '<option '.$OpSel3.' >Any</option> </select> '."\n"; 377: $Ptr .= '   '; 378: $Ptr .= '<input type=submit name=sort value="Recalculate Chart"/>'."\n"; 379: $Ptr .= '</form>'."\n"; 380: $r->print( $Ptr ); 381: } 382: 383: sub CacheChart { 384: my %list = (); 385: my $count=0; 386: 387: my $Pos = $ENV{'form.sort'}; 388: if ( $Pos eq 'Last Name' ) {$Pos=1;} 389: elsif ( $Pos eq 'Section' ) {$Pos=2;} 390: else {$Pos=0;} 391: 392: foreach my $key( keys %CachData) { 393: my @Temp=split(/\:/,$key); 394: my $Use = $Temp[$Pos]; 395: $list{$Use.$key}=$key; 396: $count++; 397: } 398: 399: my @order = sort(keys(%list)); 400: 401: $r->print('<h3>'.$count.' students</h3>'); 402: &CreateForm(); 403: $r->rflush(); 404: 405: $r->print('<p><pre>'); 406: for ( my $n; $n < $count; $n++) { 407: $r->print($CachData{$list{$order[$n]}}.'<br>'); 408: } 409: $r->print('</pre>'); 410: } 411: 412: sub Start { 413: undef %hash; 414: undef %CachData; 415: undef @students; 416: undef @cols; 417: undef @rowlabels; 418: undef @PreCol; 419: 420: $r->print('<html><head><title>'. 421: 'LON-CAPA Assessment Chart</title></head>'); 422: $r->print('<body bgcolor="#FFFFFF">'. 423: '<script>window.focus();</script>'. 424: '<img align=right src=/adm/lonIcons/lonlogos.gif>'. 425: '<h1>Assessment Chart</h1>'); 426: # ---------------------------------------------------------------- Course title 427: $r->print('<h1>'.$ENV{'course.'.$ENV{'request.course.id'}. 428: '.description'}.'</h1><h3>'.localtime(). 429: "</h3><p><pre>1..9: correct by student in 1..9 tries\n". 430: " *: correct by student in more than 9 tries\n". 431: " +: correct by override\n". 432: " -: incorrect by override\n". 433: " .: incorrect attempted\n". 434: " #: ungraded attempted\n". 435: " : not attempted\n". 436: " x: excused</pre><p>"); 437: # ------------------------------- This is going to take a while, produce output 438: $r->rflush(); 439: 440: my $cid=$ENV{'request.course.id'}; 441: my $ChartDB = "/home/httpd/perl/tmp/$ENV{'user.name'}". 442: "_$ENV{'user.domain'}_$cid\_chart.db"; 443: 444: if ((-e "$ChartDB") && ($ENV{'form.sort'} ne 'Recalculate Chart')) { 445: if (tie(%CachData,'GDBM_File',"$ChartDB",&GDBM_READER,0640)) { 446: &CacheChart(); 447: } 448: else { 449: $r->print("Unable to tie hash to db file"); 450: } 451: } 452: else { 453: if (tie(%CachData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) { 454: foreach (keys %CachData) {delete $CachData{$_};} 455: &BuildChart(); 456: } 457: else { 458: $r->print("Unable to tie hash to db file"); 459: } 460: } 461: untie(%CachData); 462: } 463: 464: # ================================================================ Main Handler 465: 466: sub handler { 467: $r=shift; 468: if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) { 469: # ------------------------------------------- Set document type for header only 470: if ($r->header_only) { 471: if ($ENV{'browser.mathml'}) { 472: $r->content_type('text/xml'); 473: } else { 474: $r->content_type('text/html'); 475: } 476: &Apache::loncommon::no_cache($r); 477: $r->send_http_header; 478: return OK; 479: } 480: 481: my $requrl=$r->uri; 482: # ----------------------------------------------------------------- Tie db file 483: if ($ENV{'request.course.fn'}) { 484: my $fn=$ENV{'request.course.fn'}; 485: if (-e "$fn.db") { 486: if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) { 487: # ------------------------------------------------------------------- Hash tied 488: # ---------------------------------------------------------------- Send headers 489: $r->content_type('text/html'); 490: $r->send_http_header; 491: &Start(); 492: $r->print('</body></html>'); 493: # ------------------------------------------------------------- End render page 494: } else { 495: $r->content_type('text/html'); 496: $r->send_http_header; 497: $r->print('<html><body>Coursemap undefined.</body></html>'); 498: } 499: # ------------------------------------------------------------------ Untie hash 500: unless (untie(%hash)) { 501: &Apache::lonnet::logthis("<font color=blue>WARNING: ". 502: "Could not untie coursemap $fn (browse).</font>"); 503: } 504: 505: # -------------------------------------------------------------------- All done 506: return OK; 507: # ----------------------------------------------- Errors, hash could no be tied 508: } 509: } else { 510: $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized"; 511: return HTTP_NOT_ACCEPTABLE; 512: } 513: } else { 514: $ENV{'user.error.msg'}= 515: $r->uri.":vgr:0:0:Cannot view grades for complete course"; 516: return HTTP_NOT_ACCEPTABLE; 517: } 518: } 519: 1; 520: __END__