[BACK]Return to lonchart.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface
File:  [LON-CAPA] / loncom / interface / Attic / lonchart.pm
Revision 1.49: download - view: text, annotated - select for diffs
Mon Jul 1 21:12:06 2002 UTC (22 years, 9 months ago) by stredwic
Branches: MAIN
CVS tags: HEAD
See bug 218.
Lonchart now has the ability to remove columns from the chart.  When the check
box is unchecked and any of the refreshing buttons (not recalculate) are hit,
the column will be gone when the new page appears.  Selecting the column from
the selection box and hitting a refreshing button, the column will reappear
when the new page is displayed.  The recalculate button sets all columns to
appear.  The column selection box is only available when there are columns missing
and only contain the names of missing columns.

# The LearningOnline Network with CAPA
# (Publication Handler
#
# $Id: lonchart.pm,v 1.49 2002/07/01 21:12:06 stredwic Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
# Homework Performance Chart
#
# (Navigate Maps Handler
#
# (Page Handler
#
# (TeX Content Handler
# YEAR=2000
# 05/29/00,05/30 Gerd Kortemeyer)
# 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23,
# 10/02,10/10,10/14,10/16,10/18,10/19,10/31,11/6,11/14,11/16 Gerd Kortemeyer)
# YEAR=2001
# 3/1/1,6/1,17/1,29/1,30/1,31/1 Gerd Kortemeyer)
# 7/10/01 Behrouz Minaei
# 9/8 Gerd Kortemeyer
# 10/1, 10/19, 11/17, 11/22, 11/24, 11/28 12/18 Behrouz Minaei
# YEAR=2002
# 2/1, 2/6, 2/19, 2/28 Behrouz Minaei
#
###

package Apache::lonchart;

use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet();
use Apache::loncommon();
use HTML::TokeParser;
use GDBM_File;

my $jr; 
# ----- FORMAT PRINT DATA ----------------------------------------------

sub FormatStudentInformation {
    my ($cache,$name,$studentInformation,$reselected,$spacePadding)=@_;
    my $Str='<pre>';

    for(my $index=0; $index<(scalar @$studentInformation); $index++) {
        if(!&ShouldShowColumn($reselected, 'heading', $index)) {
            next;
        }
	my $data=$cache->{$name.':'.$studentInformation->[$index]};
	$Str .= $data;

	my @dataLength=split(//,$data);
	my $length=scalar @dataLength;
	$Str .= (' 'x($cache->{$studentInformation->[$index].'Length'}-
                      $length));
	$Str .= $spacePadding;
    }

    return $Str;
}

sub FormatStudentData {
    my ($reselected,$name,$coid,$studentInformation,$spacePadding,$ChartDB)=@_;
    my ($sname,$sdom) = split(/\:/,$name);
    my $Str;
    my %CacheData;

    unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) {
        return '';
    }
    # Handle Student information ------------------------------------------
    # Handle user data
    $Str=&FormatStudentInformation(\%CacheData, $name, $studentInformation, 
                                   $reselected, $spacePadding);

    # Handle errors
    if($CacheData{$name.':error'} =~ /environment/) {
        untie(%CacheData);
        $Str .= '</pre>';
        return $Str;
#	my $errorMessage = $CacheData{$name.':error'};
#	return '<td>'.$sname.'</td><td>'.$sdom.
#	    '</td><td><font color="#000088">'.$errorMessage.'</font></td>';
    }

    if($CacheData{$name.':error'} =~ /course/) {
        untie(%CacheData);
        $Str .= '</pre>';
	return $Str;
#	my $errorMessage = 'May have no course data or '.
#	                   $CacheData{$name.':error'};
#	return '<td>'.$sname.'</td><td>'.$sdom.
#	    '</td><td><font color="#000088">'.$errorMessage.'</font></td>';
    }

    # Handle problem data ------------------------------------------------
    my $Version;
    my $problemsCorrect = 0;
    my $totalProblems   = 0;
    my $problemsSolved  = 0;
    my $numberOfParts   = 0;
    foreach my $sequence (split(/\:/,$CacheData{'orderedSequences'})) {
        if(!&ShouldShowColumn($reselected, 'sequence', $sequence)) {
            next;
        }

	my $characterCount=0;
	foreach my $problemID (split(/\:/,$CacheData{$sequence.':problems'})) {
	    my $problem = $CacheData{$problemID.':problem'};
	    my $LatestVersion = $CacheData{$name.":version:$problem"};

            if(!$LatestVersion) {
                foreach my $part (split(/\:/,$CacheData{$sequence.':'.
                                                        $problemID.
                                                        ':parts'})) {
                    $Str .= ' ';
                    $totalProblems++;
                    $characterCount++;
                }
                next;
            }

            my %partData=undef;
            #initialize data, displays skips correctly
            foreach my $part (split(/\:/,$CacheData{$sequence.':'.
                                                    $problemID.
                                                    ':parts'})) {
                $partData{$part.':tries'}=0;
                $partData{$part.':code'}=' ';
            }
	    for(my $Version=1; $Version<=$LatestVersion; $Version++) {
                foreach my $part (split(/\:/,$CacheData{$sequence.':'.
                                                        $problemID.
                                                        ':parts'})) {

                    if(!defined($CacheData{$name.":$Version:$problem".
                                               ":resource.$part.solved"})) {
                        next;
                    }

                    my $tries=0;
                    my $code=' ';

                    $tries = $CacheData{$name.":$Version:$problem".
                                        ":resource.$part.tries"};
                    $partData{$part.':tries'}=($tries) ? $tries : 0;

                    my $val = $CacheData{$name.":$Version:$problem".
                                         ":resource.$part.solved"};
                    if    ($val eq 'correct_by_student')   {$code = '*';} 
                    elsif ($val eq 'correct_by_override')  {$code = '+';}
                    elsif ($val eq 'incorrect_attempted')  {$code = '.';} 
                    elsif ($val eq 'incorrect_by_override'){$code = '-';}
                    elsif ($val eq 'excused')              {$code = 'x';}
                    elsif ($val eq 'ungraded_attempted')   {$code = '#';}
                    else                                   {$code = ' ';}
                    $partData{$part.':code'}=$code;
                }
            }

            $Str.='<a href="/adm/grades?symb='.
                &Apache::lonnet::escape($problem).
                '&student='.$sname.'&domain='.$sdom.'&command=submission">'; 
            foreach(split(/\:/,$CacheData{$sequence.':'.$problemID.
                                          ':parts'})) {
                if($partData{$_.':code'} eq '*') {
                    $problemsCorrect++;
                    if (($partData{$_.':tries'}<10) &&
                        ($partData{$_.':tries'} ne '')) {
                        $partData{$_.':code'}=$partData{$_.':tries'};
                    }
                } elsif($partData{$_.':code'} eq '+') {
                    $problemsCorrect++;
                }

                $Str .= $partData{$_.':code'};
                $characterCount++;

                if($partData{$_.':code'} ne 'x') {
                    $totalProblems++;
                }
            }
            $Str.='</a>';
        }

        my $spacesNeeded=$CacheData{$sequence.':columnWidth'}-$characterCount;
        $spacesNeeded -= 3;
        $Str .= (' 'x$spacesNeeded);

	my $outputProblemsCorrect = sprintf( "%3d", $problemsCorrect );
	$Str .= '<font color="#007700">'.$outputProblemsCorrect.'</font>';
	$problemsSolved += $problemsCorrect;
	$problemsCorrect=0;

        $Str .= $spacePadding;
    }

    $Str .= '<font color="#000088">'.$problemsSolved.
	    ' / '.$totalProblems.'</font></pre>';

    untie(%CacheData);
    return $Str;
}

sub CreateTableHeadings {
    my ($CacheData,$studentInformation,$headings,$reselected,$spacePadding)=@_;
    my $Str='<pre>';

    for(my $index=0; $index<(scalar @$headings); $index++) {
        if(!&ShouldShowColumn($reselected, 'heading', $index)) {
            next;
        }

	my $data=$$headings[$index];
	$Str .= $data;

	my @dataLength=split(//,$data);
	my $length=scalar @dataLength;
	$Str .= (' 'x($CacheData->{$$studentInformation[$index].'Length'}-
                      $length));
	$Str .= $spacePadding;
    }

    foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
        if(!&ShouldShowColumn($reselected, 'sequence', $sequence)) {
            next;
        }

        my $name = $CacheData->{$sequence.':title'};
	$Str .= $name;
	my @titleLength=split(//,$CacheData->{$sequence.':title'});
	my $leftover=$CacheData->{$sequence.':columnWidth'}-
                     (scalar @titleLength);
	$Str .= (' 'x$leftover);
	$Str .= $spacePadding;
    }

    $Str .= 'Total Solved/Total Problems';
    $Str .= '</pre>';

    return $Str;
}

sub CreateColumnSelectionBox {
    my ($CacheData,$studentInformation,$headings,$reselected,$spacePadding)=@_;

    my $missing=0;
    my $notThere='<br><br><b>Select column to view:</b><br><br>';
    my $name;
    $notThere .= '&nbsp;&nbsp;&nbsp';
    $notThere .= '<select name="reselect" size="4" multiple="true">'."\n";

    for(my $index=0; $index<(scalar @$headings); $index++) {
        if(&ShouldShowColumn($reselected, 'heading', $index)) {
            next;
        }
        $name = $headings->[$index];
        $notThere .= '<option value="heading'.$index.'">';
        $notThere .= $name.'</option>'."\n";
        $missing++;
    }

    foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
        if(&ShouldShowColumn($reselected, 'sequence', $sequence)) {
            next;
        }
        $name = $CacheData->{$sequence.':title'};
        $notThere .= '<option value="sequence'.$sequence.'">';
        $notThere .= $name.'</option>'."\n";
        $missing++;
    }

    if($missing) {
        $notThere .= '</select><br><br>';
    } else {
        $notThere='';
    }

    return $notThere;
}

sub CreateColumnSelectors {
    my ($CacheData,$studentInformation,$headings,$reselected,$spacePadding)=@_;

    my $found=0;
    my ($name, $length, $position);
    my $present='<pre>';
    for(my $index=0; $index<(scalar @$headings); $index++) {
        if(!&ShouldShowColumn($reselected, 'heading', $index)) {
            next;
        }
        $name = $headings->[$index];
        $length=$CacheData->{$$studentInformation[$index].'Length'};
        $position=int($length/2);
	$present .= (' 'x($position));
        $present .= '<input type="checkbox" checked="on" ';
        $present .= 'name="heading'.$index.'">';
        $position+=2;
	$present .= (' 'x($length-$position));
	$present .= $spacePadding;
        $found++;
    }

    foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
        if(!&ShouldShowColumn($reselected, 'sequence', $sequence)) {
            next;
        }
        $name = $CacheData->{$sequence.':title'};
        $length=$CacheData->{$sequence.':columnWidth'};
        $position=int($length/2);
	$present .= (' 'x($position));
        $present .= '<input type="checkbox" checked="on" ';
        $present .= 'name="sequence'.$sequence.'">';
        $position+=2;
	$present .= (' 'x($length-$position));
	$present .= $spacePadding;
        $found++;
    }

    if($found) {
        $present .= '</pre>';
        $present  = $present;
    } else {
        $present = '';
    }

    return $present.'</form>'."\n";;
}

sub CreateForm {
    my $OpSel1='';
    my $OpSel2='';
    my $OpSel3='';
    my $Status = $ENV{'form.status'};
    if ( $Status eq 'Any' ) { $OpSel3='selected'; }
    elsif ($Status eq 'Expired' ) { $OpSel2 = 'selected'; }
    else { $OpSel1 = 'selected'; }

    my $Ptr = '<form name="stat" method="post" action="/adm/chart" >'."\n";
    $Ptr .= '<input type="submit" name="sort" value="Recalculate Chart"/>';
    $Ptr .= "\n";
    $Ptr .= '&nbsp;&nbsp;&nbsp;';
    $Ptr .= '<input type="submit" name="refresh" value="Refresh Chart"/>';
    $Ptr .= "\n";
    $Ptr .= '<br><br>';
    $Ptr .= '<b> Sort by: &nbsp; </b>'."\n";
    $Ptr .= '&nbsp;&nbsp;&nbsp;';
    $Ptr .= '<input type="submit" name="sort" value="User Name" />'."\n";
    $Ptr .= '&nbsp;&nbsp;&nbsp;';
    $Ptr .= '<input type="submit" name="sort" value="Last Name" />'."\n";
    $Ptr .= '&nbsp;&nbsp;&nbsp;';
    $Ptr .= '<input type="submit" name="sort" value="Section"/>'."\n";
    $Ptr .= '<br><br>';
    $Ptr .= '<b> Student Status: &nbsp; </b>'."\n".
            '&nbsp;&nbsp;&nbsp;'.
            '<select name="status">'. 
            '<option '.$OpSel1.' >Active</option>'."\n".
            '<option '.$OpSel2.' >Expired</option>'."\n".
	    '<option '.$OpSel3.' >Any</option> </select> '."\n";

    return $Ptr;
}

sub CreateLegend {
    my $Str = '<h1>'.$ENV{'course.'.$ENV{'request.course.id'}.'.description'}.
              '</h1><h3>'.localtime().
              "</h3><p><pre>1..9: correct by student in 1..9 tries\n".
              "   *: correct by student in more than 9 tries\n".
	      "   +: correct by override\n".
              "   -: incorrect by override\n".
	      "   .: incorrect attempted\n".
	      "   #: ungraded attempted\n".
              "    : not attempted\n".
	      "   x: excused</pre><p>"; 
    return $Str;
}

sub StartDocument {
    my $Str = '';
    $Str .= '<html>';
    $Str .= '<head><title>';
    $Str .= 'LON-CAPA Assessment Chart</title></head>';
    $Str .= '<body bgcolor="#FFFFFF">';
    $Str .= '<script>window.focus();</script>';
    $Str .= '<img align=right src=/adm/lonIcons/lonlogos.gif>';
    $Str .= '<h1>Assessment Chart</h1>';

    return $Str;
}

# ----- END FORMAT PRINT DATA ------------------------------------------

# ----- DOWNLOAD INFORMATION -------------------------------------------

sub DownloadPrerequisiteData {
    my ($courseID, $c)=@_;
    my ($courseDomain,$courseNumber)=split(/\_/,$courseID);

    my %classlist=&Apache::lonnet::dump('classlist',$courseDomain,
                                        $courseNumber);
    my ($checkForError)=keys (%classlist);
    if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
        return \%classlist;
    }

    foreach my $name (keys(%classlist)) {
        if($c->aborted()) {
            $classlist{'error'}='aborted';
            return \%classlist;
        }

        my ($studentName,$studentDomain) = split(/\:/,$name);
        # Download student environment data, specifically the full name and id.
        my %studentInformation=&Apache::lonnet::get('environment',
                                                    ['lastname','generation',
                                                     'firstname','middlename',
                                                     'id'],
                                                    $studentDomain,
                                                    $studentName);
        $classlist{$name.':studentInformation'}=\%studentInformation;

        if($c->aborted()) {
            $classlist{'error'}='aborted';
            return \%classlist;
        }

        #Section
        my %section=&Apache::lonnet::dump('roles',$studentDomain,$studentName);
        $classlist{$name.':section'}=\%section;
    }

    return \%classlist;
}

sub DownloadStudentCourseInformation {
    my ($name,$courseID)=@_;
    my ($studentName,$studentDomain) = split(/\:/,$name);

    # Download student course data
    my %courseData=&Apache::lonnet::dump($courseID,$studentDomain,
					 $studentName);
    return \%courseData;
}

# ----- END DOWNLOAD INFORMATION ---------------------------------------

# ----- END PROCESSING FUNCTIONS ---------------------------------------

sub ProcessTopResourceMap {
    my ($ChartDB,$c)=@_;
    my %hash;
    my $fn=$ENV{'request.course.fn'};
    if(-e "$fn.db") {
	my $tieTries=0;
	while($tieTries < 3) {
	    if(tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
		last;
	    }
	    $tieTries++;
	    sleep 1;
	}
	if($tieTries >= 3) {
            return 'Coursemap undefined.';
        }
    } else {
        return 'Can not open Coursemap.';
    }

    my %CacheData;
    unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
        untie(%hash);
	return 'Could not tie cache hash.';
    }

    my (@sequences, @currentResource, @finishResource);
    my ($currentSequence, $currentResourceID, $lastResourceID);

    $currentResourceID=$hash{'ids_/res/'.$ENV{'request.course.uri'}};
    push(@currentResource, $currentResourceID);
    $lastResourceID=-1;
    $currentSequence=-1;
    my $topLevelSequenceNumber = $currentSequence;

    while(1) {
        if($c->aborted()) {
            last;
        }
	# HANDLE NEW SEQUENCE!
	#if page || sequence
	if(defined($hash{'map_pc_'.$hash{'src_'.$currentResourceID}})) {
	    push(@sequences, $currentSequence);
	    push(@currentResource, $currentResourceID);
	    push(@finishResource, $lastResourceID);

	    $currentSequence=$hash{'map_pc_'.$hash{'src_'.$currentResourceID}};
	    $lastResourceID=$hash{'map_finish_'.
				  $hash{'src_'.$currentResourceID}};
	    $currentResourceID=$hash{'map_start_'.
				     $hash{'src_'.$currentResourceID}};

	    if(!($currentResourceID) || !($lastResourceID)) {
		$currentSequence=pop(@sequences);
		$currentResourceID=pop(@currentResource);
		$lastResourceID=pop(@finishResource);
		if($currentSequence eq $topLevelSequenceNumber) {
		    last;
		}
	    }
	}

	# Handle gradable resources: exams, problems, etc
	$currentResourceID=~/(\d+)\.(\d+)/;
        my $partA=$1;
        my $partB=$2;
	if($hash{'src_'.$currentResourceID}=~
	   /\.(problem|exam|quiz|assess|survey|form)$/ &&
	   $partA eq $currentSequence) {
	    my $Problem = &Apache::lonnet::symbclean(
			  &Apache::lonnet::declutter($hash{'map_id_'.$partA}).
			  '___'.$partB.'___'.
			  &Apache::lonnet::declutter($hash{'src_'.
							 $currentResourceID}));

	    $CacheData{$currentResourceID.':problem'}=$Problem;
	    if(!defined($CacheData{$currentSequence.':problems'})) {
		$CacheData{$currentSequence.':problems'}=$currentResourceID;
	    } else {
		$CacheData{$currentSequence.':problems'}.=
		    ':'.$currentResourceID;
	    }

            #Get Parts for problem
	    my $meta=$hash{'src_'.$currentResourceID};
	    foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {
		if($_=~/^stores\_(\d+)\_tries$/) {
		    my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
                    if(!defined($CacheData{$currentSequence.':'.
                                          $currentResourceID.':parts'})) {
                        $CacheData{$currentSequence.':'.$currentResourceID.
                                   ':parts'}=$Part;
                    } else {
                        $CacheData{$currentSequence.':'.$currentResourceID.
                                   ':parts'}.=':'.$Part;
                    }
		}
	    }
	}

	#if resource == finish resource
	if($currentResourceID eq $lastResourceID) {
	    #pop off last resource of sequence
	    $currentResourceID=pop(@currentResource);
	    $lastResourceID=pop(@finishResource);

	    if(defined($CacheData{$currentSequence.':problems'})) {
		# Capture sequence information here
		if(!defined($CacheData{'orderedSequences'})) {
		    $CacheData{'orderedSequences'}=$currentSequence;
		} else {
		    $CacheData{'orderedSequences'}.=':'.$currentSequence;
		}

		$CacheData{$currentSequence.':title'}=
		    $hash{'title_'.$currentResourceID};

                my $totalProblems=0;
                foreach my $currentProblem (split(/\:/,
                                               $CacheData{$currentSequence.
                                               ':problems'})) {
                    foreach (split(/\:/,$CacheData{$currentSequence.':'.
                                                   $currentProblem.
                                                   ':parts'})) {
                        $totalProblems++;
                    }
                }
		my @titleLength=split(//,$CacheData{$currentSequence.
                                                    ':title'});
                # $extra is 3 for problems correct and 3 for space
                # between problems correct and problem output
                my $extra = 6;
		if(($totalProblems + $extra) > (scalar @titleLength)) {
		    $CacheData{$currentSequence.':columnWidth'}=
                        $totalProblems + $extra;
		} else {
		    $CacheData{$currentSequence.':columnWidth'}=
                        (scalar @titleLength);
		}
	    }

	    $currentSequence=pop(@sequences);
	    if($currentSequence eq $topLevelSequenceNumber) {
		last;
	    }
	#else
	}

	# MOVE!!!
	#move to next resource
	unless(defined($hash{'to_'.$currentResourceID})) {
	    # big problem, need to handle.  Next is probably wrong
	    last;
	}
	my @nextResources=();
	foreach (split(/\,/,$hash{'to_'.$currentResourceID})) {
	    push(@nextResources, $hash{'goesto_'.$_});
	}
	push(@currentResource, @nextResources);
	# Set the next resource to be processed
	$currentResourceID=pop(@currentResource);
    }

    unless (untie(%hash)) {
        &Apache::lonnet::logthis("<font color=blue>WARNING: ".
                                 "Could not untie coursemap $fn (browse)".
                                 ".</font>"); 
    }

    unless (untie(%CacheData)) {
        &Apache::lonnet::logthis("<font color=blue>WARNING: ".
                                 "Could not untie Cache Hash (browse)".
                                 ".</font>"); 
    }

    return 'OK';
}

sub ProcessSection {
    my ($sectionData, $courseid,$ActiveFlag)=@_;
    $courseid=~s/\_/\//g;
    $courseid=~s/^(\w)/\/$1/;

    my $cursection='-1';
    my $oldsection='-1';
    my $status='Expired';
    my $section='';
    foreach my $key (keys (%$sectionData)) {
	my $value = $sectionData->{$key};
        if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
	    $section=$1;
	    if($key eq $courseid.'_st') {
		$section='';
	    }
	    my ($dummy,$end,$start)=split(/\_/,$value);
	    my $now=time;
	    my $notactive=0;
	    if ($start) {
		if($now<$start) {
		    $notactive=1;
		}
	    }
	    if($end) {
		if ($now>$end) {
		    $notactive=1;
		}
	    }
	    if($notactive == 0) {
		$status='Active';
		$cursection=$section;
		last;
	    }
	    if($notactive == 1) {
		$oldsection=$section;
	    }
	}
    }
    if($status eq $ActiveFlag) {
	if($cursection eq '-1') {
	    return $oldsection;
	}
	return $cursection;
    }
    if($ActiveFlag eq 'Any') {
	if($cursection eq '-1') {
	    return $oldsection;
	}
	return $cursection;
    }
    return '-1';
}

sub ProcessStudentInformation {
    my ($CacheData,$studentInformation,$section,$date,$name,$courseID,$c)=@_;
    my ($studentName,$studentDomain) = split(/\:/,$name);

    $CacheData->{$name.':username'}=$studentName;
    $CacheData->{$name.':domain'}=$studentDomain;
    $CacheData->{$name.':date'}=$date;

    my ($checkForError)=keys(%$studentInformation);
    if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
	$CacheData->{$name.':error'}=
	    'Could not download student environment data.';
	$CacheData->{$name.':fullname'}='';
	$CacheData->{$name.':id'}='';
    } else {
	$CacheData->{$name.':fullname'}=&ProcessFullName(
                                          $studentInformation->{'lastname'},
				          $studentInformation->{'generation'},
				          $studentInformation->{'firstname'},
                                          $studentInformation->{'middlename'});
	$CacheData->{$name.':id'}=$studentInformation->{'id'};
    }

    # Get student's section number
    my $sec=&ProcessSection($section, $courseID, $ENV{'form.status'});
    if($sec != -1) {
	$CacheData->{$name.':section'}=$sec;
    } else {
	$CacheData->{$name.':section'}='';
    }

    return 0;
}

sub ProcessClassList {
    my ($classlist,$courseID,$ChartDB,$c)=@_;
    my @names=();

    my %CacheData;
    if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
        foreach my $name (keys(%$classlist)) {
            if($name =~ /\:section/ || $name =~ /\:studentInformation/ ||
               $name eq '') {
                next;
            }
            if($c->aborted()) {
                last;
            }
            push(@names,$name);
            &ProcessStudentInformation(
                                    \%CacheData,
                                    $classlist->{$name.':studentInformation'},
                                    $classlist->{$name.':section'},
                                    $classlist->{$name},
                                    $name,$courseID,$c);
        }

	untie(%CacheData);
    }

    return @names;
}

# ----- END PROCESSING FUNCTIONS ---------------------------------------

# ----- HELPER FUNCTIONS -----------------------------------------------

sub SpaceColumns {
    my ($students,$studentInformation,$headings,$ChartDB)=@_;

    my %CacheData;
    if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
        # Initialize Lengths
        for(my $index=0; $index<(scalar @$headings); $index++) {
	    my @titleLength=split(//,$$headings[$index]);
	    $CacheData{$$studentInformation[$index].'Length'}=
                scalar @titleLength;
	}

        foreach my $name (@$students) {
            foreach (@$studentInformation) {
		my @dataLength=split(//,$CacheData{$name.':'.$_});
		my $length=scalar @dataLength;
		if($length > $CacheData{$_.'Length'}) {
		    $CacheData{$_.'Length'}=$length;
		}
            }
        }
        untie(%CacheData);
    }

    return;
}

sub ProcessFullName {
    my ($lastname, $generation, $firstname, $middlename)=@_;
    my $Str = '';

    if($lastname ne '') {
	$Str .= $lastname.' ';
	if($generation ne '') {
	    $Str .= $generation;
	} else {
	    chop($Str);
	}
	$Str .= ', ';
	if($firstname ne '') {
	    $Str .= $firstname.' ';
	}
	if($middlename ne '') {
	    $Str .= $middlename;
	} else {
	    chop($Str);
	    if($firstname eq '') {
		chop($Str);
	    }
	}
    } else {
	if($firstname ne '') {
	    $Str .= $firstname.' ';
	}
	if($middlename ne '') {
	    $Str .= $middlename.' ';
	}
	if($generation ne '') {
	    $Str .= $generation;
	} else {
	    chop($Str);
	}
    }

    return $Str;
}

sub SortStudents {
    my ($students,$CacheData)=@_;

    my @sorted1Students=();
    foreach (@$students) {
        my ($end,$start)=split(/\:/,$CacheData->{$_.':date'});
        my $active=1;
        my $now=time;
        my $Status=$ENV{'form.status'};
        $Status = ($Status) ? $Status : 'Active';
        if((($end) && $now > $end) && (($Status eq 'Active'))) { 
            $active=0; 
        }
        if(($Status eq 'Expired') && ($end == 0 || $now < $end)) {
            $active=0;
        }
        if($active) {
            push(@sorted1Students, $_);
        }
    }

    my $Pos = $ENV{'form.sort'};
    my %sortData;
    if($Pos eq 'Last Name') {
	for(my $index=0; $index<scalar @sorted1Students; $index++) {
	    $sortData{$CacheData->{$sorted1Students[$index].':fullname'}}=
		$sorted1Students[$index];
	}
    } elsif($Pos eq 'Section') {
	for(my $index=0; $index<scalar @sorted1Students; $index++) {
	    $sortData{$CacheData->{$sorted1Students[$index].':section'}.
		      $sorted1Students[$index]}=$sorted1Students[$index];
	}
    } else {
	# Sort by user name
	for(my $index=0; $index<scalar @sorted1Students; $index++) {
	    $sortData{$sorted1Students[$index]}=$sorted1Students[$index];
	}
    }

    my @order = ();
    foreach my $key (sort(keys(%sortData))) {
	push (@order,$sortData{$key});
    }

    return @order;
}

sub TestCacheData {
    my ($ChartDB)=@_;
    my $isCached=-1;
    my %testData;
    my $tieTries=0;

    if ((-e "$ChartDB") && ($ENV{'form.sort'} ne 'Recalculate Chart')) {
	$isCached = 1;
    } else {
	$isCached = 0;
    }

    while($tieTries < 3) {
        my $result=0;
        if($isCached) {
            $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER,0640);
        } else {
            $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB,0640);
        }
        if($result) {
            last;
        }
        $tieTries++;
        sleep 1;
    }
    if($tieTries >= 3) {
        return -1;
    }

    untie(%testData);

    return $isCached;
}

sub ExtractStudentData {
    my ($courseData, $name, $ChartDB)=@_;

    my %CacheData;
    if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
        my ($checkForError) = keys(%$courseData);
        if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
            $CacheData{$name.':error'}='Could not download course data.';
        } else {
            foreach my $key (keys (%$courseData)) {
                $CacheData{$name.':'.$key}=$courseData->{$key};
            }
            if(defined($CacheData{'NamesOfStudents'})) {
                $CacheData{'NamesOfStudents'}.=':::'.$name;
            } else {
                $CacheData{'NamesOfStudents'}=$name;
            }
        }
        untie(%CacheData);
    }

    return;
}

sub ShouldShowColumn {
    my ($reselected,$type,$value)=@_;

    if($ENV{'form.sort'} eq 'Recalculate Chart') {
        return 1;
    }

    if(defined($ENV{'form.'.$type.$value})) {
        return 1;
    }

    return &CheckForStringInArray($reselected, $type.$value);
}

sub CheckForStringInArray {
    my ($inputArray,$checkString)=@_;
    foreach (@$inputArray) {
#        $jr->print('a:'.$_.' b:'.$checkString.'<br>');
        if($_ eq $checkString) {
            return 1;
        }
    }
    return 0;
}

# ----- END HELPER FUNCTIONS --------------------------------------------

sub BuildChart {
    my ($r)=@_;
    my $c = $r->connection;

    # Start the lonchart document
    $r->content_type('text/html');
    $r->send_http_header;
    $r->print(&StartDocument());
    $r->rflush();

    # Test for access to the CacheData
    my $isCached=0;
    my $cid=$ENV{'request.course.id'};
    my $ChartDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
                  "_$ENV{'user.domain'}_$cid\_chart.db";
    # $ENV{'form.domains'} can be either a scalar or an array reference.
    # We need an array.
    my @reselected = (ref($ENV{'form.reselect'}) ? @{$ENV{'form.reselect'}}
                      : ($ENV{'form.reselect'}));

    $isCached=&TestCacheData($ChartDB);
    if($isCached < 0) {
        $r->print("Unable to tie hash to db file");
        $r->rflush();
        return;
    }

    # Download class list information if not using cached data
    my %CacheData;
    my @students=();
    my @studentInformation=('username','domain','section','id','fullname');
    my @headings=('User Name','Domain','Section','PID','Full Name');
    my $spacePadding='   ';
    if(!$isCached) {
        my $processTopResourceMapReturn=&ProcessTopResourceMap($ChartDB,$c);
        if($processTopResourceMapReturn ne 'OK') {
            $r->print($processTopResourceMapReturn);
            return;
        }
        if($c->aborted()) { return; }
        my $classlist=&DownloadPrerequisiteData($cid, $c);
        my ($checkForError)=keys(%$classlist);
        if($checkForError =~ /^(con_lost|error|no_such_host)/i ||
           defined($classlist->{'error'})) {
            return;
        }
        if($c->aborted()) { return; }
        @students=&ProcessClassList($classlist,$cid,$ChartDB,$c);
        if($c->aborted()) { return; }
        &SpaceColumns(\@students,\@studentInformation,\@headings,
                      $ChartDB);
        if($c->aborted()) { return; }
    } else {
        if(!$c->aborted() && tie(%CacheData,'GDBM_File',$ChartDB,
                                 &GDBM_READER,0640)) {
            @students=split(/:::/,$CacheData{'NamesOfStudents'});
        }
    }

    # Sort students and print out table desciptive data
    if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) {
        if(!$c->aborted()) { @students=&SortStudents(\@students,\%CacheData); }
	if(!$c->aborted()) { $r->print(&CreateLegend()); }
	if(!$c->aborted()) { $r->rflush(); }
	if(!$c->aborted()) { $r->print(&CreateForm()); }
	if(!$c->aborted()) { $r->print(&CreateColumnSelectionBox(
                                                       \%CacheData,
                                                       \@studentInformation, 
						       \@headings, 
                                                       \@reselected,
                                                       $spacePadding)); }
        if(!$c->aborted()) { $r->print('<h3>'.(scalar @students).
                                       ' students</h3>'); }
	if(!$c->aborted()) { $r->print(&CreateColumnSelectors(
                                                       \%CacheData,
                                                       \@studentInformation, 
						       \@headings, 
                                                       \@reselected,
                                                       $spacePadding)); }
	if(!$c->aborted()) { $r->print(&CreateTableHeadings(
                                                         \%CacheData,
                                                         \@studentInformation, 
							 \@headings, 
                                                         \@reselected,
							 $spacePadding)); }
	if(!$c->aborted()) { $r->rflush(); }
	untie(%CacheData);
    } else {
	$r->print("Init2: Unable to tie hash to db file");
	return;
    }

    my @updateStudentList = ();
    my $courseData;
    foreach (@students) {
        if($c->aborted()) {
            if(!$isCached && 
               tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
                $CacheData{'NamesOfStudents'}=join(":::", @updateStudentList);
#		    $CacheData{'NamesOfStudents'}=
#		            &Apache::lonnet::arrayref2str(\@updateStudentList);
                untie(%CacheData);
            }
            last;
        }

        if(!$isCached) {
            $courseData=&DownloadStudentCourseInformation($_, $cid);
            if($c->aborted()) { next; }
            push(@updateStudentList, $_);
            &ExtractStudentData($courseData, $_, $ChartDB);
        }
        $r->print(&FormatStudentData(\@reselected, $_, $cid, 
                                     \@studentInformation,
                                     $spacePadding, $ChartDB));
        $r->rflush();
    }

    $r->print('</body></html>');
    $r->rflush();

    return;
}

# ================================================================ Main Handler

sub handler {
    my $r=shift;
    $jr=$r;
    unless(&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
	$ENV{'user.error.msg'}=
        $r->uri.":vgr:0:0:Cannot view grades for complete course";
	return HTTP_NOT_ACCEPTABLE; 
    }

    # Set document type for header only
    if ($r->header_only) {
        if($ENV{'browser.mathml'}) {
            $r->content_type('text/xml');
        } else {
            $r->content_type('text/html');
        }
        &Apache::loncommon::no_cache($r);
        $r->send_http_header;
        return OK;
    }
    
    unless($ENV{'request.course.fn'}) {
        my $requrl=$r->uri;
        $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
        return HTTP_NOT_ACCEPTABLE; 
    }

    &BuildChart($r);

    return OK;
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>