Annotation of loncom/interface/lonstatistics.pm, revision 1.4

1.1       albertel    1: # The LearningOnline Network with CAPA
                      2: # (Publication Handler
                      3: #
1.4     ! minaeibi    4: # $Id: lonstatistics.pm,v 1.3 2002/02/06 16:38:04 minaeibi Exp $
1.1       albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
                     28: # (Navigate problems for statistical reports
                     29: # YEAR=2001
                     30: # 5/05/01, 7/09/01, 7/25/01, 8/11/01,9/13/01, 9/26/01 Behrouz Minaei
                     31: # 10/5/01, 10/9/01, 10/22/01, 10/26/01 Behrouz Minaei
                     32: # 11/1/01, 11/4/01, 11/16/01 Behrouz Minaei
                     33: # 12/14/01, 12/16/01, 12/18/01,12/20/01,12/31/01 Behrouz Minaei
                     34: # YEAR=2002
1.3       minaeibi   35: # 1/22/02,2/1/02 Behrouz Minaei
1.1       albertel   36: ###
                     37: 
1.3       minaeibi   38: package Apache::lonstatistics; 
1.1       albertel   39: 
                     40: use strict;
                     41: use Apache::Constants qw(:common :http);
                     42: use Apache::lonnet();
                     43: use Apache::lonhomework;
                     44: use HTML::TokeParser;
                     45: use GDBM_File;
1.3       minaeibi   46: #use Benchmark;
1.1       albertel   47: 
                     48: # -------------------------------------------------------------- Module Globals
                     49: my %hash;
                     50: my %CachData;
                     51: my %GraphDat;
                     52: my %maps;
1.2       minaeibi   53: my @mapsort;
1.1       albertel   54: my %section;
                     55: my %StuBox;
                     56: my %DiscFac;
                     57: my $CurMap;
                     58: my $CurSec;
                     59: my $CurStu;
                     60: my @cols;
                     61: my @list;
                     62: my @students;
                     63: my $p_count;
                     64: my $Pos;
                     65: my $r;
                     66: my $OpSel1;
                     67: my $OpSel2;
                     68: my $OpSelDis1;
                     69: my $OpSelDis2;
                     70: my $CurDis=0;
                     71: my $OpSel3;
                     72: my $OpSel4;
                     73: my $GData;
                     74: my $cid;
                     75: my $firstres;
                     76: my $lastres;
                     77: my $DiscFlag=0;
1.2       minaeibi   78: my $HWN=0;
1.1       albertel   79: 
                     80: my %Header = (0,"Problem Title",1,"#Stdnts",2,"Tries",3,"Mod",
                     81:               4,"Mean",5,"#YES",6,"#yes",7,"%Wrng",8,"S.D.",
                     82:               9,"Skew.",10,"DoDiff",11,"Map");
                     83: #             9,"Skew.",10,"DoDiff",11,"Dis.F.",12,"Resourse URL");
                     84: 
                     85: sub NumericSort {          
                     86:     $a <=> $b;
                     87: }
                     88: 
                     89: # ------ Create different Student Report 
                     90: sub StudentReport {
                     91:     my ($sname,$sdom)=@_;
                     92:     if ( $sname eq 'All Students' ) {
                     93: 	$r->print( '<h3><font color=blue>WARNING: 
                     94:                     Please select a student</font></h3>' );
                     95: 	return;
                     96:     }
                     97:     my $shome=&Apache::lonnet::homeserver( $sname,$sdom );          
                     98:     my $reply=&Apache::lonnet::reply('dump:'.$sdom.':'.$sname.':'.$cid,$shome );
                     99:     my %result = ();
                    100:     my $ResId;
                    101:     my $Code;
                    102:     my $Tries;
                    103:     my $TotalTries = 0;
                    104:     my $ParCr = 0;
                    105:     my $Wrongs;
                    106:     my %TempHash;
                    107:     my $Version;
                    108:     my $LatestVersion;
                    109:     my $PtrTry='';
                    110:     my $PtrCod='';
                    111:     my $SetNo=0;
                    112:     my $Str = "\n".'<table border=2>'.
                    113:               "\n".'<tr>'.
                    114:               "\n".'<th> # </th>'.
                    115: 	      "\n".'<th> Set Title </th>'.
                    116: 	      "\n".'<th> Results </th>'.
                    117: 	      "\n".'<th> Tries </th>'.
                    118: 	      "\n".'</tr>';
                    119:     unless ($reply=~/^error\:/) {
                    120:         map {
                    121:             my ($name,$value)=split(/\=/,&Apache::lonnet::unescape($_));
                    122:             $result{$name}=$value;
                    123:         } split(/\&/,$reply);;
                    124:         foreach $ResId (@cols) {
                    125: 	    if ( !$ResId ) {
                    126: 		my $Set=&Apache::lonnet::declutter($hash{'map_id_'.$1});
                    127: 		if ( $Set ) {
                    128: 		    $SetNo++;
                    129: 		    $Str .= "\n"."<tr>".
                    130: 			    "\n"."<td> $SetNo </td>".
                    131:                             "\n"."<td> $Set </td>".
                    132:                             "\n"."<td> $PtrCod </td>".
                    133:                             "\n"."<td> $PtrTry</td>".
                    134:                             "\n"."</tr>";
                    135: 		}
                    136: 		$PtrTry='';
                    137: 		$PtrCod='';
                    138: 		next; 
                    139: 	    }
                    140:             $ResId=~/(\d+)\.(\d+)/;
                    141:             my $Map = &Apache::lonnet::declutter( $hash{'map_id_'.$1} );
                    142:             if ( $CurMap ne 'All Maps' ) {
                    143: 		my ( $ResMap, $NameMap ) = split(/\=/,$CurMap);
                    144: 		if ( $Map ne $ResMap ) { next; }
                    145: 	    }
                    146: 	    my $meta=$hash{'src_'.$ResId};
                    147: 	    my $PartNo = 0;
                    148: 	    undef %TempHash;
                    149: 	    map {
                    150: 		if ($_=~/^stores\_(\d+)\_tries$/) {
                    151:                     my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
                    152: 		    if ( $TempHash{"$Part"} eq '' ) { 
                    153: 			$TempHash{"$Part"} = $Part;
                    154: 			$TempHash{$PartNo}=$Part;
                    155: 			$TempHash{"$Part.Code"} = '-';  
                    156: 			$PartNo++;
                    157: 		    }
                    158: 		}
                    159:             } split(/\,/,&Apache::lonnet::metadata($meta,'keys'));
                    160: 
                    161:             my $Prob = $Map.'___'.$2.'___'.
                    162:                        &Apache::lonnet::declutter( $hash{'src_'.$ResId} );
                    163:             $Code='U';
                    164:             $Tries = 0;
                    165:             $Wrongs = 0;
                    166:   	    $LatestVersion = $result{"version:$Prob"};       
                    167: 
                    168: 	    if ( $LatestVersion ) {
                    169: 		for ( my $Version=1; $Version<=$LatestVersion; $Version++ ) {
                    170: 		    my $vkeys = $result{"$Version:keys:$Prob"};
                    171: 		    my @keys = split(/\:/,$vkeys);		
                    172:   
                    173: 		    foreach my $Key (@keys) {		  
                    174: 			if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) {
                    175: 			    my $Part = $1;
                    176: 			    $Tries = $result{"$Version:$Prob:resource.$Part.tries"};
                    177: 			    $TempHash{"$Part.Tries"} = ($Tries) ? $Tries : 0; 
                    178: 			    $TotalTries += $Tries;
                    179: 			    my $Val = $result{"$Version:$Prob:resource.$Part.solved"};
                    180: 			    if ( $Val eq 'correct_by_student' )
                    181:                                 { $Wrongs = $Tries - 1; $Code = 'Y'; } 
                    182: 			    elsif ( $Val eq 'correct_by_override' )
                    183:                                 { $Wrongs = $Tries - 1; $Code = 'y'; }                        
                    184: 			    elsif ( $Val eq 'incorrect_attempted' || 
                    185:                                 $Val eq 'incorrect_by_override' )
                    186: 		                { $Wrongs = $Tries; $Code = 'N'; }
                    187: 			    $TempHash{"$Part.Code"} = $Code;
                    188: 			    $TempHash{"$Part.Wrongs"} = $Wrongs;
                    189: 			}
                    190:      		    }
                    191:                 } 
                    192: 		for ( my $n = 0; $n < $PartNo; $n++ ) {		  
                    193: 		    my $part = $TempHash{$n};
                    194: 		    if ($PtrTry ne '') {$PtrTry .= ',';}
                    195: 		    $PtrTry .= "$TempHash{$part.'.Tries'}";
                    196:                     $PtrCod .= "$TempHash{$part.'.Code'}";    
                    197: 		}
                    198:             }
                    199: 	    else { 
                    200: 		for(my $n=0; $n<$PartNo; $n++) { 
                    201: 		    if ($PtrTry ne '') {$PtrTry .= ',';}
                    202: 		    $PtrTry .= "0";
                    203:                     $PtrCod .= "-"; 
                    204: 		}
                    205: 	    }
                    206:         }
                    207:     }
                    208:     $Str .= "\n".'</table>';
                    209:     $r->print($Str);
                    210:     $r->rflush();
                    211: }
                    212: 
                    213: 
                    214: # ------------------------------------------- Prepare Statistics Table
                    215: sub PreStatTable {
                    216:     my $CacheDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
                    217:                   "_$ENV{'user.domain'}_$cid\_statistics.db";
                    218:     my $GraphDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
                    219:                   "_$ENV{'user.domain'}_$cid\_graph.db";
                    220:     my $CachDisFac = "/home/httpd/perl/tmp/$ENV{'user.name'}".
                    221: 		     "_$ENV{'user.domain'}_$cid\_DiscFactor.db";
                    222:     $r->print('<br><input type="submit" name="sort" value="Recalculate Statistics" />');
                    223: 
                    224:     my $Ptr = '';
                    225: 
                    226:     $Ptr .= '<br><b> Sorting Type: &nbsp; </b>'."\n".
                    227:             '<select name="order"> <option '.$OpSel1.' >Ascending</option>'."\n".
                    228: 	    '<option '.$OpSel2.'>Descending</option> </select> '."\n";
                    229:     $Ptr .= '&nbsp;&nbsp;&nbsp;';
                    230:     $Ptr .= '<input type="submit" name="sort" value="DoDiff Graph" />'."\n";
                    231:     $Ptr .= '&nbsp;&nbsp;&nbsp;';
                    232:     $Ptr .= '<input type="submit" name="sort" value="%Wrong Graph" />'."\n";
                    233: 
                    234:     $Ptr .= '<pre>'.
                    235:     '  #Stdnts: Total Number of Students opened the problem.<br>'. 
                    236:     '  Tries  : Total Number of Tries for solving the problem.<br>'. 
                    237:     '  Mod    : Maximunm Number of Tries for solving the problem.<br>'. 
                    238:     '  Mean   : Average Number of the tries. [ Tries / #Stdns ]<br>'.
                    239:     '  #YES   : Number of students solved the problem correctly.<br>'. 
                    240:     '  #yes   : Number of students solved the problem by override.<br>'.
1.2       minaeibi  241:     '  %Wrng  : Percentage of students tried to solve the problem but'.
                    242:     ' still incorrect. [ 100*((#Stdnts-(#YES+#yes))/#Stdnts) ]<br>'.
                    243:     '  S.D.   : Standard Deviation of the tries.'.
                    244:     '[ sqrt(sum((Xi - Mean)^2)) / (#Stdnts-1)'.
                    245:     ' where Xi is every student\'s tries ]<br>'.
                    246:     '  Skew.  : Skewness of the students tries.'.
                    247:     ' [ (sqrt( sum((Xi - Mean)^3) / #Stdnts)) / (S.D.^3) ]<br>'.
1.1       albertel  248: #    '  DoDiff : Degree of Difficulty of the problem. [ Tries/(#YES+#yes+0.1) ]<br>'.
                    249:     '  DoDiff : Degree of Difficulty of the problem. [ 1 - ((#YES+#yes) / Tries) ]<br>'.
                    250: #    '  Dis.F. : Discrimination Factor. [ Sum of Partial Credits Awarded / Total Number of Tries in %27 upper and lower students]</b>'.	
                    251:             '</pre>';
                    252: 
                    253:     $r->print($Ptr);
                    254:     $r->rflush();	
                    255: 		      
                    256:     my $Result = "\n".'<table border=2>';
                    257:     $Result .= '<tr><th>P#</th>'."\n";
                    258:     for ( my $nIdx=0; $nIdx < 12; $nIdx++ ) { 
                    259: 	$Result .= '<th>'.'<input type="submit" name="sort" value="'.
                    260:                    $Header{$nIdx}.'" />'.'</th>'."\n";
                    261:     }
                    262:     $Result .= "\n".'</tr>'."\n";    
                    263:     $r->print( $Result );
                    264:     $r->rflush();
                    265: 
                    266:     if ((-e "$CacheDB")&&($ENV{'form.sort'} ne 'Recalculate Statistics')) {
                    267: 	if (tie(%CachData,'GDBM_File',"$CacheDB",&GDBM_READER,0640)) {
                    268: 	    tie(%GraphDat,'GDBM_File',$GraphDB,&GDBM_WRCREAT,0640);
                    269: 	    &Cache_Statistics();
                    270:         }
                    271:         else {
                    272: 	    $r->print("Unable to tie hash to db file");
                    273:         }
                    274:     }
                    275:     else {
                    276: 	if (tie(%CachData,'GDBM_File',$CacheDB,&GDBM_WRCREAT,0640)) {
                    277: 	    tie(%DiscFac,'GDBM_File',$CachDisFac,&GDBM_WRCREAT,0640);
                    278: 	    tie(%GraphDat,'GDBM_File',$GraphDB,&GDBM_WRCREAT,0640);
                    279: 	    foreach (keys %DiscFac) {delete $CachData{$_};}
                    280: 	    foreach (keys %CachData) {delete $CachData{$_};}
                    281: 	    $DiscFlag=0;
                    282: 	    &Build_Statistics();
                    283: 	}
                    284:         else {
                    285: 	    $r->print("Unable to tie hash to db file");
                    286:         }
                    287:     }
                    288:     #$r->print('Total instances of the problems : '.($p_count*($#students+1)));
                    289: 
                    290:     untie(%CachData);
                    291:     untie(%GraphDat);
                    292:     untie(%DiscFac);
                    293: 
                    294:     $r->print("\n".'</table>'."\n");
                    295:     $r->rflush();        
                    296: }
                    297: 
                    298: 
                    299: # ------------------------------------- Find the section of student in a course
                    300: 
                    301: sub usection {
                    302:     my ($udom,$unam,$courseid)=@_;
                    303:     $courseid=~s/\_/\//g;
                    304:     $courseid=~s/^(\w)/\/$1/;
                    305:     map {
                    306:         my ($key,$value)=split(/\=/,$_);
                    307:         $key=&Apache::lonnet::unescape($key);
                    308:         if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
                    309:             my $section=$1;
                    310:             if ($key eq $courseid.'_st') { $section=''; }
                    311: 	    my ($dummy,$end,$start)=split(/\_/,&Apache::lonnet::unescape($value));
                    312:             $section=($section) ? $section : '(none)';
1.4     ! minaeibi  313: #            $section=(int($section)) ? int($section) : $section;
1.1       albertel  314: #            $r->print($unam.'...'.$section.'<br>');
                    315: 	    return $section;
                    316:         }
                    317:     } split(/\&/,&Apache::lonnet::reply('dump:'.$udom.':'.$unam.':roles',
                    318:                         &Apache::lonnet::homeserver($unam,$udom)));
                    319:     return '';
                    320: }
                    321: 
                    322: 
                    323: # ------ Dump the Student's DB file and handling the data for statistics table 
                    324: 
                    325: sub ExtractStudentData {
                    326:     my ($student,$coid)=@_;
                    327:     my ($sname,$sdom) = split( /\:/, $student );
                    328:     my $shome=&Apache::lonnet::homeserver( $sname,$sdom );          
                    329:     my $reply=&Apache::lonnet::reply('dump:'.$sdom.':'.$sname.':'.$coid,$shome );
                    330:     my %result = ();
                    331:     my $ResId;
                    332:     my $Dis = '';
                    333:     my $Code;
                    334:     my $Tries;
                    335:     my $ParCr;
                    336:     my $TotalTries = 0;
                    337:     my $TotalOpend = 0;
                    338:     my $ProbSolved = 0;
                    339:     my $ProbTot = 0;
                    340:     my $TimeTot = 0;
                    341:     my $TotParCr = 0;
                    342:     my $Wrongs;
                    343:     my %TempHash;
                    344:     my $Version;
                    345:     my $LatestVersion;
                    346:     my $SecLimit;
                    347:     my $MapLimit;
                    348:     unless ($reply=~/^error\:/) {
                    349:         map {
                    350:             my ($name,$value)=split(/\=/,&Apache::lonnet::unescape($_));
                    351:             $result{$name}=$value;
                    352: #$r->print($name.'='.$value.'<br>');
                    353:         } split(/\&/,$reply);
                    354:         foreach $ResId (@cols) {
                    355: 	    if ( !$ResId ) { next; }
                    356:             $ResId=~/(\d+)\.(\d+)/;
                    357:             my $Map = &Apache::lonnet::declutter( $hash{'map_id_'.$1} );
                    358:             if ( $CurMap ne 'All Maps' ) {
                    359: 		my ( $ResMap, $NameMap ) = split(/\=/,$CurMap);
                    360: 		if ( $Map ne $ResMap ) { next; }
                    361: 	    }
                    362: 	    my $meta=$hash{'src_'.$ResId};
                    363: 	    my $PartNo = 0;
                    364: 	    $Dis .= ':';
                    365: 	    undef %TempHash;
                    366: 	    map {
                    367: 		if ($_=~/^stores\_(\d+)\_tries$/) {
                    368:                     my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
                    369: 		    if ( $TempHash{"$Part"} eq '' ) { 
                    370: 			$TempHash{"$Part"} = $Part;
                    371: 			$TempHash{$PartNo}=$Part;
                    372: 			$TempHash{"$Part.Code"} = 'U';  
                    373: 			$PartNo++;
                    374: 		    }
                    375: 		}
                    376:             } split(/\,/,&Apache::lonnet::metadata($meta,'keys'));
                    377: 
                    378:             my $Prob = $Map.'___'.$2.'___'.
                    379:                        &Apache::lonnet::declutter( $hash{'src_'.$ResId} );
                    380:             $Code='U';
                    381:             $Tries = 0;
                    382: 	    $ParCr = 0;
                    383:             $Wrongs = 0;
                    384:   	    $LatestVersion = $result{"version:$Prob"};       
                    385: 
                    386: 	    if ( $LatestVersion ) {
                    387: 		for ( my $Version=1; $Version<=$LatestVersion; $Version++ ) {
                    388: 		    my $vkeys = $result{"$Version:keys:$Prob"};
                    389: 		    my @keys = split(/\:/,$vkeys);		
                    390:   
                    391: 		    foreach my $Key (@keys) {		  
                    392: 			if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) {
                    393: 			    my $Part = $1;
                    394: 			    $Tries = $result{"$Version:$Prob:resource.$Part.tries"};
                    395: 			    $ParCr = $result{"$Version:$Prob:resource.$Part.awarded"};
                    396: 			    my $Time = $result{"$Version:$Prob:timestamp"};
                    397: 			    $TempHash{"$Part.Time"} = ($Time) ? $Time : 0;
                    398: 			    $TempHash{"$Part.Tries"} = ($Tries) ? $Tries : 0;
                    399: 			    $TempHash{"$Part.ParCr"} = ($ParCr) ? $ParCr : 0;        
                    400: 			    $TotalTries += $TempHash{"$Part.Tries"};
                    401: 			    $TotParCr += $TempHash{"$Part.ParCr"};
                    402: #$r->print($Version.'---'.$Prob.'==='.$Time.'<br>');
                    403: 			    my $Val = $result{"$Version:$Prob:resource.$Part.solved"};
                    404: 			    if ( $Val eq 'correct_by_student' )
                    405:                                { $Wrongs = $Tries - 1; $Code = 'C'; } 
                    406: 			    elsif ( $Val eq 'correct_by_override' )
                    407:                                { $Wrongs = $Tries - 1; $Code = 'O'; }                        
                    408: 			    elsif ( $Val eq 'incorrect_attempted' || 
                    409:                                 $Val eq 'incorrect_by_override' )
                    410: 		               { $Wrongs = $Tries; $Code = 'I'; }
                    411: 			    $TempHash{"$Part.Code"} = $Code;
                    412: 			    $TempHash{"$Part.Wrongs"} = $Wrongs;
                    413: 			}
                    414:      		    }
                    415:                 } 
                    416: 		for ( my $n = 0; $n < $PartNo; $n++ ) {		  
                    417: 		    my $part = $TempHash{$n};
                    418: 		    my $Yes = 0;
                    419:                     if ( $TempHash{$part.'.Code'} eq 'C' ||
                    420:                          $TempHash{$part.'.Code'} eq 'O'  ) 
                    421: 		       {$ProbSolved++;$Yes=1;}		    
                    422: 		    my $ptr = "$hash{'title_'.$ResId}";
                    423: 		    if ( $PartNo > 1 ) {                
                    424: 			$ptr .= " (part $part)";
                    425: 			$Dis .= ':';
                    426: 		    }
                    427: 		    my $Fac = ($TempHash{"$part.Tries"}) ? 
                    428:                               ($TempHash{"$part.ParCr"}/$TempHash{"$part.Tries"}) : 0;
                    429: 		    my $DisF;
                    430: 		    if ( $Fac > 0 &&  $Fac < 1 ) { 
                    431: 			$DisF = sprintf( "%.4f", $Fac );
                    432: 		    }
                    433: 		    else {$DisF = $Fac;}
                    434: #		    $DisF .= '+'.$TempHash{"$part.Time"};
                    435: 		    $TimeTot += $TempHash{"$part.Time"};
                    436: 		    $Dis .= $ptr.'*'.$ResId.'='.$DisF.'+'.$Yes;
                    437: 		    $ptr .= "*$ResId:$TempHash{$part.'.Tries'}".
                    438: 		            ":$TempHash{$part.'.Wrongs'}".
                    439:                             ":$TempHash{$part.'.Code'}";		    
                    440: #$r->print($sname.' -- '.$ptr.'--- timestamp='.$TempHash{"$part.Time"}.'<br>');
                    441: 		    push (@list, $ptr);
                    442: 		    $TotalOpend++;
                    443: 		    $ProbTot++;
                    444: 		}
                    445:             }
                    446: 	    else { 
                    447: 		for(my $n=0; $n<$PartNo; $n++) {
                    448: 		    push (@list, "$hash{'title_'.$ResId}*$ResId:0:0:U");
                    449: 		    $ProbTot++; 
                    450: 		}
                    451: 	    }
                    452:         }
                    453: 	if ( $TotalTries ) {
                    454: 	    my $DisFac = ( $TotalTries ) ? ($TotParCr/$TotalTries) : 0;
                    455: #	    my $DisFactor = int(sprintf( "%.4f", $DisFac ) * 100);
                    456: 	    my $DisFactor = sprintf( "%.4f", $DisFac );
                    457: 	    my $time;
                    458: 	    if ($ProbSolved){
                    459: 		$time = int(($TimeTot/$ProbSolved)/10000000);
                    460: 	    }
                    461: 	    $DiscFac{($DisFactor.':'.$sname.':'.$ProbTot.':'.$TotalOpend.':'.
                    462:                       $TotalTries.':'.$ProbSolved.':'.$time)}=$Dis;
                    463: #$r->print($DisFactor.$sname.'<br> --- Dis= '.$Dis.'<br>');
                    464: 	}
                    465:     }
                    466:     #$r->print($sname.' PrCr= '.$TotParCr.' Slvd= '.$ProbSolved.' Tries='.$TotalTries.'<br>');
                    467: }
                    468: 
                    469: 
                    470: # ------------------------------------------------------------ Build page table
                    471: sub tracetable {
                    472:     my ($rid,$beenhere)=@_;
                    473:     $rid=~/(\d+)\.(\d+)/;
                    474:     $maps{&Apache::lonnet::declutter($hash{'map_id_'.$1})}='';#$hash{'title_'.$rid}; 
                    475:     unless ($beenhere=~/\&$rid\&/) {
                    476:        $beenhere.=$rid.'&'; 
                    477:        if (defined($hash{'is_map_'.$rid})) {
                    478: 	   my $cmap=$hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}};
                    479:            if ( $cmap eq 'sequence' || $cmap eq 'page' ) { 
                    480:                $cols[$#cols+1]=0;
1.2       minaeibi  481: 	       $HWN++;
                    482:                $mapsort[$HWN]=$rid.$hash{'title_'.$rid}; 
1.1       albertel  483:                #$maps{&Apache::lonnet::declutter($hash{'src_'.$rid})}= 
                    484:                #      $hash{'title_'.$rid}; 
                    485:            }
                    486:            if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) &&
                    487:                (defined($hash{'map_finish_'.$hash{'src_'.$rid}}))) {
                    488:               my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}};
                    489: 
                    490:                 &tracetable($hash{'map_start_'.$hash{'src_'.$rid}},
                    491:                 '&'.$frid.'&');
                    492: 
                    493:               if ($hash{'src_'.$frid}) {
                    494:                  if ($hash{'src_'.$frid}=~
                    495:                                  /\.(problem|exam|quiz|assess|survey|form)$/) {
                    496: 		     $cols[$#cols+1]=$frid;
1.2       minaeibi  497: 		     $mapsort[$HWN] .= '&'.$frid;
1.1       albertel  498:                  }
                    499: 	      }
                    500: 	   }
                    501:        } else {
                    502:           if ($hash{'src_'.$rid}) {
                    503:              if ($hash{'src_'.$rid}=~
                    504:                                  /\.(problem|exam|quiz|assess|survey|form)$/) {
                    505: 	         $cols[$#cols+1]=$rid;
1.2       minaeibi  506: 		 $mapsort[$HWN] .= '&'.$rid;
1.1       albertel  507:              }
                    508:           }
                    509:        }
                    510:        if (defined($hash{'to_'.$rid})) {
                    511:           map {
                    512:               &tracetable($hash{'goesto_'.$_},$beenhere);
                    513:           } split(/\,/,$hash{'to_'.$rid});
                    514:        }
                    515:     }
                    516: }
                    517: 
                    518: sub MySort {          
                    519:     if ( $Pos > 0 && $Pos < 11 ) {
                    520: 	if ($ENV{'form.order'} eq 'Descending') {$b <=> $a;}
                    521: 	else { $a <=> $b; }
                    522:     }
                    523:     else {
                    524: 	if ($ENV{'form.order'} eq 'Descending') {$b cmp $a;}
                    525: 	else { $a cmp $b; }
                    526:     }
                    527: }
                    528: 
                    529: sub Build_Statistics {
                    530:     $r->print(<<ENDPOP);
                    531: <script>
                    532:     popwin=open('','popwin','width=400,height=100');
                    533:     popwin.document.writeln('<html><body bgcolor="#8cee8c">'+
                    534:       '<title>LON-CAPA Statistics</title>'+
                    535:       '<h4>Computation Progress</h4>'+
                    536:       '<form name=popremain>'+
                    537:       '<input type=text size=35 name=remaining value=Starting></form>'+
                    538:       '</body></html>');
                    539:     popwin.document.close();
                    540: </script>
                    541: ENDPOP
                    542: 
                    543:     $r->rflush();
                    544: # ---------------------------- Gathering the Data of students' tries
                    545:     my $index;
                    546:     for ($index=0;$index<=$#students;$index++) {
                    547: #----------- update progress
                    548:         $r->print('<script>popwin.document.popremain.remaining.value="'.
                    549:                   'Computing '.($index+1).'/'.($#students+1).': '.
                    550:                   $students[$index].'";</script>');
                    551:         $r->rflush();
                    552: 
                    553:         &ExtractStudentData($students[$index],$cid);
                    554:     }
                    555: #--------------------- close Progress Line
                    556:     $r->print('<script>popwin.close()</script>');
                    557:     $r->rflush(); 
                    558: # -------------------- sorting the Data
                    559:     @list = sort(@list);
                    560:     $OpSel2='';
                    561:     $OpSel1='selected';
                    562:  		   
                    563:     $p_count = 0; 
                    564:     my $nIdx = 0;
                    565:     my $dummy; 
                    566:     my $p_val;
                    567:     my $ResId;
                    568:     my $NoElements = $#list + 1;
                    569: #-------------------------------- loop for data representation
                    570:     while ( $nIdx < $NoElements ) {
                    571:         my %storestats=();
                    572: 	my ($Prob,$Tries,$Wrongs,$Code)=split(/\:/,$list[$nIdx]);
                    573: 	my $Temp = $Prob;
                    574: 	my $MxTries = 0;
                    575: 	my $TotalTries = 0;
                    576: 	my $YES = 0;
                    577: 	my $Incorrect = 0;
                    578: 	my $Override = 0;
                    579: 	my $StdNo = 0;
                    580: 	my @StdLst; 
                    581: 	do {
                    582: 	    $nIdx++;
                    583: 	    $StdNo++;
                    584: 	    $StdLst[ $StdNo ] = $Tries;
                    585: 	    $TotalTries += $Tries;
                    586: 	    if ( $MxTries < $Tries ) { $MxTries = $Tries; } 
                    587: 	    if ( $Code eq 'C' ){ $YES++; }
                    588: 	    elsif( $Code eq 'I' ) { $Incorrect++; }
                    589: 	    elsif( $Code eq 'O' ) { $Override++; }
                    590: 	    elsif( $Code eq 'U' ) { $StdNo--; }
                    591: 	    ($Prob,$Tries,$Wrongs,$Code)=split(/\:/,$list[$nIdx]);
                    592: 	} while ( $Prob eq $Temp && $nIdx < $NoElements );	
                    593: 
                    594: 	$p_count++;
                    595: 
                    596: 	($Temp,$ResId)=split(/\*/,$Temp);
                    597: 
                    598:         $Temp = '<a href="'.$hash{'src_'.$ResId}.'" target="_blank">'.$Temp.'</a>';
                    599:     
                    600: 	my $res = &Apache::lonnet::declutter($hash{'src_'.$ResId});
                    601:         my $urlres=$res;
                    602: 
                    603:         $ResId=~/(\d+)\.(\d+)/;
                    604:         my $Map = &Apache::lonnet::declutter( $hash{'map_id_'.$1} );
                    605:         $urlres=$Map;
                    606:  
                    607: 
                    608:         $res = '<a href="'.$hash{'src_'.$ResId}.'">'.$res.'</a>';
                    609: 
                    610:         #$Map = '<a href="'.$Map.'">'.$res.'</a>';
                    611: 
                    612: #------------------------ Compute the Average of Tries about one problem
                    613: 	my $Average = ($StdNo) ? $TotalTries/$StdNo : 0;
                    614: 
                    615:         $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___timestamp'}=time;       
                    616:         $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___stdno'}=$StdNo;
                    617:         $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___avetries'}=$Average;
                    618:    
                    619: #-------------------------------- Compute percentage of Wrong tries
                    620: 	my $Wrong = ( $StdNo ) ? 100 * ( $Incorrect / $StdNo ) : 0;
                    621: 
                    622: #-------------------------------- Compute Standard Deviation
                    623: 	my $StdDev = 0; 
                    624: 	if ( $StdNo > 1 ) {
                    625: 	    for ( my $n = 0; $n < $StdNo; $n++ ) {
                    626:                 my $Dif = $StdLst[ $n ]-$Average;
                    627: 		$StdDev += $Dif*$Dif;
                    628: 	    } 
                    629: 	    $StdDev /= ( $StdNo - 1 );
                    630: 	    $StdDev = sqrt( $StdDev );
                    631: 	}
                    632: 
                    633: #-------------------------------- Compute Degree of Difficulty
                    634: 	my $DoDiff = 0;
                    635: 	if( $TotalTries > 0 ) {
                    636: 	    $DoDiff = 1 - ( ( $YES + $Override ) / $TotalTries );
                    637: #	    $DoDiff =  ($TotalTries)/($YES + $Override+ 0.1);	    
                    638: 	}
                    639:        
                    640:         $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___difficulty'}=$DoDiff;
                    641: 
                    642: #-------------------------------- Compute the Skewness
                    643: 	my $Skewness = 0;
                    644:         my $Sum = 0; 
                    645: 	if ( $StdNo > 0 && $StdDev > 0 ) {
                    646: 	    for ( my $n = 0; $n < $StdNo; $n++ ) {
                    647:                 my $Dif = $StdLst[ $n ]-$Average;
                    648: 		$Skewness += $Dif*$Dif*$Dif;
                    649: 	    } 
                    650: 	    $Skewness /= $StdNo;
                    651: 	    $Skewness /= $StdDev*$StdDev*$StdDev;
                    652: 	}
                    653: #-----------------  Some restition in presenting the float numbers
                    654: 	my $Avg = sprintf( "%.2f", $Average );
                    655: 	my $Wrng = sprintf( "%.1f", $Wrong );
                    656: 	my $SD = sprintf( "%.1f", $StdDev );
                    657: 	my $DoD = sprintf( "%.2f", $DoDiff );
                    658: 	my $Sk = sprintf( "%.1f", $Skewness );
                    659:     
                    660: 	$CachData{($p_count-1)}=$Temp.':'.$StdNo.':'.$TotalTries.':'.
                    661:                                 $MxTries.':'.$Avg.':'.$YES.':'.
                    662:                                 $Override.':'.$Wrng.':'.$SD.':'.
                    663:                                 $Sk.':'.$DoD.':'.$Map.':'.$Prob;
                    664: 
                    665:         $urlres=~/^(\w+)\/(\w+)/;
                    666:         if ($StdNo) { 
                    667:            &Apache::lonnet::put('resevaldata',\%storestats,$1,$2); 
                    668:         }
                    669: 
                    670: #-------------------------------- Row of statistical table
                    671:         if ( $DiscFlag == 0 ) {
                    672: 	    $r->print( "\n".'<tr>'.
                    673:                "\n".'<td>'.$p_count.'</td>'.
                    674:                "\n".'<td>'.$Temp.'</td>'.
                    675:                "\n".'<td>'.$StdNo.'</td>'.
                    676:                "\n".'<td>'.$TotalTries.'</td>'.
                    677:                "\n".'<td>'.$MxTries.'</td>'.
                    678:                "\n".'<td>'.$Avg.'</td>'.
                    679:                "\n".'<td>'.$YES.'</td>'.
                    680:                "\n".'<td>'.$Override.'</td>'.
                    681:                "\n".'<td>'.$Wrng.'</td>'.
                    682:                "\n".'<td>'.$SD.'</td>'.
                    683:                "\n".'<td>'.$Sk.'</td>'.
                    684:                "\n".'<td>'.$DoD.'</td>'.
                    685:                "\n".'<td>'.$Map.'</td>'.
                    686:                        "\n".'</tr>' );
                    687: 	    $GraphDat{$nIdx}=$DoD.':'.$Wrng;
                    688: 	} 
                    689:     }
                    690: }
                    691: 
                    692: 
                    693: sub Cache_Statistics {
                    694:     my @list = ();
                    695:     my $Useful;
                    696:     my $UnUseful;
                    697:     my %myHeader = reverse( %Header );
                    698:     $Pos = $myHeader{$ENV{'form.sort'}};
                    699:     $p_count = 0;
                    700: 
                    701:     foreach my $key( keys %CachData) { 
                    702: 	my @Temp=split(/\:/,$CachData{$key});
                    703: 	if ( $Pos == 0 || $Pos == 11 ) {
                    704: 	    ($UnUseful,$Useful)=split(/\>/,$Temp[$Pos]);
                    705: 	}
                    706: 	else {
                    707: 	    $Useful = $Temp[$Pos];
                    708: 	}   
                    709: 	$list[$p_count]=$Useful.'&'.$CachData{$key};
                    710:         $p_count++;
                    711:     }
                    712: 
                    713:     @list = sort MySort (@list);
                    714: 
                    715:     for ( my $nIdx = 0; $nIdx < $p_count; $nIdx++ ) {
                    716: 	my( $Pre, $Post ) = split(/\&/,$list[$nIdx]); 
                    717: 	my ($Temp,$StdNo,$TotalTries,$MxTries,$Avg,$YES,
                    718:             $Override,$Wrng,$SD,$Sk,$DoD,$res,$Prob)=split(/\:/,$Post);	
                    719: 	$r->print( "\n".'<tr>'.
                    720:                "\n".'<td>'.($nIdx+1).'</td>'.
1.2       minaeibi  721:                "\n".'<td  bgcolor="#FFFFFF">'.$Temp.'</td>'.
1.1       albertel  722:                "\n".'<td>'.$StdNo.'</td>'.
                    723:                "\n".'<td>'.$TotalTries.'</td>'.
                    724:                "\n".'<td>'.$MxTries.'</td>'.
                    725:                "\n".'<td>'.$Avg.'</td>'.
                    726:                "\n".'<td>'.$YES.'</td>'.
                    727:                "\n".'<td>'.$Override.'</td>'.
                    728:                "\n".'<td>'.$Wrng.'</td>'.
                    729:                "\n".'<td>'.$SD.'</td>'.
                    730:                "\n".'<td>'.$Sk.'</td>'.
                    731:                "\n".'<td>'.$DoD.'</td>'.
                    732:                "\n".'<td>'.$res.'</td>'.
                    733:                "\n".'</tr>' );
                    734: 	$GraphDat{$nIdx}=$DoD.':'.$Wrng;
                    735:     } 
                    736: }
                    737: 
                    738: # ------------------------------------------- Prepare data for Graphical chart
                    739: 
                    740: sub GetGraphData {
                    741:     my $Tag = shift;
                    742:     my $Col;
                    743:     my $data='';
                    744:     my $count = 0;
                    745:     my $Max = 0;
                    746:     my $cid=$ENV{'request.course.id'};
                    747:     my $GraphDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
                    748:                   "_$ENV{'user.domain'}_$cid\_graph.db";
                    749:     foreach (keys %GraphDat) {delete $GraphDat{$_};}
                    750:     if (-e "$GraphDB") {
                    751: 	if (tie(%GraphDat,'GDBM_File',"$GraphDB",&GDBM_READER,0640)) {
                    752: 	    if ( $Tag eq 'DoDiff Graph' ) {
                    753: 		$Tag = 'Degree-of-Difficulty';
                    754: 		$Col = 0;
                    755: 	    }
                    756: 	    else {
                    757: 		$Tag = 'Wrong-Percentage';
                    758: 		$Col = 1;
                    759: 	    }
                    760: 	    foreach (sort NumericSort keys %GraphDat) { 
                    761: 		my @Temp=split(/\:/,$GraphDat{$_});
                    762:                 my $inf = $Temp[$Col]; 
                    763: 		if ( $Max < $inf ) {$Max = $inf;}
                    764: 		$data .= $inf.',';
                    765: 		$count++;
                    766: 	    }
                    767:             untie(%GraphDat);
                    768: 	    my $Course = $ENV{'course.'.$cid.'.description'};
                    769: 	    $Course =~ s/\ /"_"/eg;
                    770: 	    $GData=$Course.'&'.$Tag.'&'.$Max.'&'.$count.'&'.$data;
                    771: 
                    772: 	}
                    773: 	else {
                    774: 	    $r->print("Unable to tie hash to db file");
                    775: 	}
                    776:     }
                    777: }
                    778: 
                    779: 
                    780: sub initial {
                    781: # --------------------------------- Initialize the global varaibles
                    782:   undef @students;
                    783:   undef @cols;
                    784:   undef %maps;
                    785:   undef %section;
                    786:   undef %StuBox;
                    787:   undef @list;
                    788:   undef %CachData;
                    789:   undef %GraphDat;
                    790:   undef %DiscFac;
                    791:   undef $CurMap;
                    792:   undef $CurSec;
                    793:   undef $CurStu;
                    794:   undef $p_count;
                    795:   undef $Pos;
                    796:   undef $GData;
                    797: }
                    798: 
                    799: 
                    800: sub ClassList {
                    801: 
                    802:     &GetStatus();
                    803: 
                    804:     $cid=$ENV{'request.course.id'};
                    805:     my $chome=$ENV{'course.'.$cid.'.home'};
                    806:     my ($cdom,$cnum)=split(/\_/,$cid);
                    807: # ----------------------- Get first and last resource, see if there is anything
                    808:     $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}};
                    809:     $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}};
                    810:     if (($firstres) && ($lastres)) {
                    811: # ----------------------------------------------------------------- Render page
                    812: 	my $classlst=&Apache::lonnet::reply
                    813:                  ('dump:'.$cdom.':'.$cnum.':classlist',$chome);
                    814: 	my $StudNo = 0;
                    815: 	unless ($classlst=~/^error\:/) {
                    816: 	    foreach (sort split(/\&/,$classlst)) {
                    817: 		my ($name,$value)=split(/\=/,$_);
                    818: 		my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value));
                    819: 		$name=&Apache::lonnet::unescape($name);
                    820: 		my ($sname,$sdom)=split(/\:/,$name);
                    821: 		my $ssec=&Apache::lonnet::usection($sdom,$sname,$cid);
                    822:                 if ($ssec==-1) {next;}
                    823: 		$ssec=($ssec) ? $ssec : '(none)';
1.4     ! minaeibi  824: 		#$ssec=(int($ssec)) ? int($ssec) : $ssec;
1.1       albertel  825: 		#$r->print($sname.'...'.$ssec.'<br>');
                    826: 		$section{$ssec}=$ssec;
                    827: 		if ($CurSec eq 'All Sections' || $ssec eq $CurSec) {
                    828: 		    $students[$StudNo]=$name;
                    829: 		    $StuBox{$sname}=$ssec;
                    830: 		}
                    831: 		$StudNo++;
                    832: 	    }
                    833: 	}
                    834: 	else {
                    835: 	    $r->print('<h1>Could not access course data</h1>');
1.2       minaeibi  836: 	} 
1.1       albertel  837:         $r->print("Total number of students : ".($#students+1));
                    838:         $r->rflush();
                    839: # --------------- Find all assessments and put them into some linear-like order
                    840: 	&tracetable($firstres,'&'.$lastres.'&');
1.2       minaeibi  841: 
                    842: #my $c=0;
                    843: #foreach(@mapsort) {
                    844: #    $c++;
                    845: #    $r->print('<br>'.$mapsort[$c]);
                    846: #}
                    847: #$r->print('<br> Count = '.$c);
                    848: 
1.1       albertel  849:     }
                    850: 
                    851: # ------------------------------------------------------------- End render page 
                    852:     else {
                    853: 	$r->print('<h3>Undefined course sequence</h3>');
                    854:     }
                    855:     &MapSecOptions();
                    856: }
                    857: 
                    858: 
                    859: sub Menu {
                    860:     my $InpStr = $ENV{'form.sort'};
                    861:     if ( $InpStr eq 'DoDiff Graph' || $InpStr eq '%Wrong Graph' ) {      
                    862: 	&GetGraphData($InpStr);
                    863:     	$r->print('<IMG src="/cgi-bin/graph.gif?'.$GData.'" />');
                    864:     }
                    865:     else {
                    866: 	$r->print('<html><head><title>LON-CAPA Statistics</title></head>');
                    867: 
                    868: 
                    869:         $r->print('<body bgcolor="#FFFFFF">'.
                    870:                   '<script>window.focus(); window.width=500;window.height=500; </script>'.
                    871:                   '<img align=right src=/adm/lonIcons/lonlogos.gif>');
                    872: # ---------------------------------------------------------------- Course title
                    873:         $r->print('<h1> Course : "'.
                    874:                   $ENV{'course.'.$ENV{'request.course.id'}.
                    875:                   '.description'}.'"</h1><h2>'.localtime().'</h2>');
                    876: # ------------------------------- This is going to take a while, produce output
                    877:         $r->rflush();	
                    878: 
                    879: 	$r->print("\n".'<form name=stat method=post action="/adm/statistics" >');
                    880: 
                    881: 	my $content = $ENV{'form.sort'};
                    882: 	if ($content eq '' || $content eq 'Return to Menu') {
                    883: 	    my $Ptr = '<h3>';
                    884: 	    $Ptr .= '<input type=submit name=sort value="Problem Evaluation"/>';#General Statistics"/>';
                    885: 	    $Ptr .= '<br><br>';
                    886: 	    $Ptr .= '<input type=submit name=sort value="Student Assessment"/>';
                    887: 	    $Ptr .= '<br><br>';
                    888: #	    $Ptr .= '<input type=submit name=sort value=Discrimination>';#"Problem Evaluation"/>';
                    889: 	    $Ptr .= '</h3>';
                    890: 	    $r->print( $Ptr );
                    891:       	}
                    892: 	else {
                    893: 	    &initial();
                    894: 	    &ClassList();
                    895: 	    if ( $content eq 'Discrimination' || #'Problem Evaluation' ||
                    896:                  $content eq 'Recalculate Discrimintion Factor' ) {
                    897: 		&CreateDiscFac();
                    898: 	    }
                    899: 	    elsif ( $content eq 'Student Assessment' || 
                    900:                     $content eq 'Create Student Report' ) {
                    901: 		&StudentOptions();
                    902: 		&StudentReport($CurStu,$StuBox{"$CurStu"});
                    903: 	    }
                    904: 	    else {
                    905: 		&PreStatTable();
                    906: 	    }
                    907: 	}
                    908: 	$r->print("\n".'</form>'.
                    909:                   "\n".'</body>'.
                    910:                   "\n".'</html>');
                    911: 	$r->rflush();
                    912:     }
                    913: }
                    914: 
                    915: sub StudentOptions {
                    916:     my $OpSel5='';
                    917:     $CurStu = $ENV{'form.student'};
                    918:     if ( $CurStu eq '' ) { 
                    919:         $CurStu = 'All Students';
                    920:         $OpSel5 = 'selected';
                    921:     }
                    922:     my $Ptr ='';
                    923: # ----------------------------------- Loading the Students Combobox
                    924:     $Ptr .= '<br><b>Select Student</b>'."\n".
                    925:        	    '<select name="student">'."\n". 
                    926: 	    '<option '.$OpSel5.'>All Students</option>';                     	     	     
                    927:     foreach my $key ( sort keys %StuBox ) {	          
                    928: 	$Ptr .= '<option';
                    929: 	if ($CurStu eq $key) {$Ptr .= ' selected';}     
                    930:         $Ptr .= '>'.$key."</option>\n";	     
                    931:     }
                    932:     $Ptr .= '</select>';
                    933:     $Ptr .= '<br><input type="submit" name="sort" value="Create Student Report" />';
                    934:     $r->print( $Ptr );
                    935:     $r->rflush();	
                    936: }
                    937: 
                    938: sub GetStatus {
                    939: 
                    940:     $OpSelDis1='';
                    941:     $OpSelDis2='';
                    942:     $OpSel1='';
                    943:     $OpSel2='';
                    944:     $OpSel3='';
                    945:     $OpSel4='';
                    946: 
                    947: #    if ( $ENV{'form.DisType'} eq 'Total Number of Correct Answers' ) { 
                    948: #	$OpSelDis1='selected'; 
                    949: #	$CurDis=0;
                    950: #    }
                    951: #    else { $OpSel2 = 'selected'; $CurDis = 1;}
                    952: 
                    953:     if ( $ENV{'form.order'} eq 'Descending' ) { $OpSel2='selected'; }
                    954:     else { $OpSel1 = 'selected'; }
                    955:     $CurMap = $ENV{'form.maps'};
                    956:     if ( $CurMap eq '' ) { 
                    957: 	$CurMap = 'All Maps';
                    958: 	$OpSel3 = 'selected';
                    959:     }
                    960:     $CurSec = $ENV{'form.section'};
                    961:     if ( $CurSec eq '' ) { 
                    962: 	$CurSec = 'All Sections';
                    963:         $OpSel4 = 'selected';
                    964:     }
                    965: }
                    966: 
                    967: 
                    968: sub MapSecOptions {
                    969: # ----------------------------------- Loading the Maps Combobox
                    970:     my $Ptr = '<br>';
                    971:     $Ptr .= '<br><input type="submit" name="sort" value="Return to Menu" />';
                    972:     $Ptr .= '<br><b> Select &nbsp; Map &nbsp; &nbsp; </b>'."\n".
                    973:        	    '<select name="maps">'."\n". 
                    974: 	    '<option '.$OpSel3.'>All Maps</option>';                     	     	     
                    975:     foreach my $key ( sort keys %maps ) {	          
                    976: 	$Ptr .= '<option';
                    977:         if ($CurMap eq $key) {$Ptr .= ' selected';}	     
                    978: 	$Ptr .= '>'.$key."</option>\n";	     
                    979:     }
                    980:     $Ptr .= '</select>';
                    981:     $Ptr .= '&nbsp;&nbsp;&nbsp;';
                    982: 
                    983: # ----------------------------------- Loading the Sections Combobox
                    984:     $Ptr .= '<br><b>Select Section</b>'."\n".
                    985:        	    '<select name="section">'."\n". 
                    986: 	    '<option '.$OpSel4.'>All Sections</option>';                     	     	     
                    987:     foreach my $key ( sort keys %section ) {	          
                    988: 	$Ptr .= '<option';
                    989:         if ($CurSec eq $key) {$Ptr .= ' selected';}     
                    990: 	$Ptr .= '>'.$key."</option>"."\n";	     
                    991:     }
                    992:     $Ptr .= '</select>'."\n";
                    993: 
                    994:     $r->print( $Ptr );
                    995:     $r->rflush();
                    996: }
                    997: 
                    998: 
                    999: # ================================================================ Main Handler
                   1000: 
                   1001: sub handler {
                   1002:     $r=shift;
                   1003: 
                   1004:     if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
                   1005: # ------------------------------------------- Set document type for header only
                   1006: 	if ($r->header_only) {
                   1007: 	    if ($ENV{'browser.mathml'}) {
                   1008: 		$r->content_type('text/xml');
                   1009: 	    } 
                   1010: 	    else {
                   1011: 		$r->content_type('text/html');
                   1012: 	    }
                   1013: 	    $r->send_http_header;
                   1014: 	    return OK;
                   1015: 	}    
                   1016: 	my $requrl=$r->uri;
                   1017: # ----------------------------------------------------------------- Tie db file
                   1018: 
                   1019: 	undef %hash;
                   1020: 
                   1021: 	if ($ENV{'request.course.fn'}) {
                   1022: 	    my $fn=$ENV{'request.course.fn'};
                   1023: 	    if (-e "$fn.db") {
                   1024: 		if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
                   1025: # ------------------------------------------------------------------- Hash tied
                   1026: 		    $r->content_type('text/html');
                   1027: 		    $r->send_http_header;
                   1028: 		    &Menu();
                   1029: 		}
                   1030: 		else {
                   1031: 		    $r->content_type('text/html');
                   1032: 		    $r->send_http_header;
                   1033: 		    $r->print('<html><body>Coursemap undefined.</body></html>');
                   1034: 		}
                   1035: # ------------------------------------------------------------------ Untie hash
                   1036: 		unless (untie(%hash)) {
                   1037: 		    &Apache::lonnet::logthis("<font color=blue>WARNING: ".
                   1038:                             "Could not untie coursemap $fn (browse).</font>"); 
                   1039: 		}
                   1040: 
                   1041: # -------------------------------------------------------------------- All done
                   1042: 		return OK;
                   1043: # ----------------------------------------------- Errors, hash could no be tied
                   1044: 	    }
                   1045: 	} 
                   1046: 	else {
                   1047: 	    $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
                   1048: 	    return HTTP_NOT_ACCEPTABLE; 
                   1049: 	}
                   1050:     }
                   1051:     else {
                   1052:         $ENV{'user.error.msg'}=
                   1053:         $r->uri.":vgr:0:0:Cannot view grades for complete course";
                   1054: 
                   1055:         return HTTP_NOT_ACCEPTABLE; 
                   1056:     }
                   1057: }
                   1058: 1;
                   1059: __END__
                   1060: 
                   1061: 
                   1062: 

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