Annotation of loncom/interface/lonchart.pm, revision 1.52

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>