File:  [LON-CAPA] / loncom / interface / lonstatistics.pm
Revision 1.4: download - view: text, annotated - select for diffs
Wed Feb 6 16:59:01 2002 UTC (22 years, 4 months ago) by minaeibi
Branches: MAIN
CVS tags: HEAD
Leading Zero's went back to the sections

    1: # The LearningOnline Network with CAPA
    2: # (Publication Handler
    3: #
    4: # $Id: lonstatistics.pm,v 1.4 2002/02/06 16:59:01 minaeibi Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: # (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
   35: # 1/22/02,2/1/02 Behrouz Minaei
   36: ###
   37: 
   38: package Apache::lonstatistics; 
   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;
   46: #use Benchmark;
   47: 
   48: # -------------------------------------------------------------- Module Globals
   49: my %hash;
   50: my %CachData;
   51: my %GraphDat;
   52: my %maps;
   53: my @mapsort;
   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;
   78: my $HWN=0;
   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>'.
  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>'.
  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)';
  313: #            $section=(int($section)) ? int($section) : $section;
  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;
  481: 	       $HWN++;
  482:                $mapsort[$HWN]=$rid.$hash{'title_'.$rid}; 
  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;
  497: 		     $mapsort[$HWN] .= '&'.$frid;
  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;
  506: 		 $mapsort[$HWN] .= '&'.$rid;
  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>'.
  721:                "\n".'<td  bgcolor="#FFFFFF">'.$Temp.'</td>'.
  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)';
  824: 		#$ssec=(int($ssec)) ? int($ssec) : $ssec;
  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>');
  836: 	} 
  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.'&');
  841: 
  842: #my $c=0;
  843: #foreach(@mapsort) {
  844: #    $c++;
  845: #    $r->print('<br>'.$mapsort[$c]);
  846: #}
  847: #$r->print('<br> Count = '.$c);
  848: 
  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>