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