#
# $Id: lonspreadsheet.pm,v 1.83 2002/04/10 15:30:13 matthew 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/
#
# The LearningOnline Network with CAPA
# Spreadsheet/Grades Display Handler
#
# 11/11,11/15,11/27,12/04,12/05,12/06,12/07,
# 12/08,12/09,12/11,12/12,12/15,12/16,12/18,12/19,12/30,
# 01/01/01,02/01,03/01,19/01,20/01,22/01,
# 03/05,03/08,03/10,03/12,03/13,03/15,03/17,
# 03/19,03/20,03/21,03/27,04/05,04/09,
# 07/09,07/14,07/21,09/01,09/10,9/11,9/12,9/13,9/14,9/17,
# 10/16,10/17,10/20,11/05,11/28,12/27 Gerd Kortemeyer
# 01/14/02 Matthew
# 02/04/02 Matthew

# POD required stuff:

=head1 NAME

lonspreadsheet

=head1 SYNOPSIS

Spreadsheet interface to internal LON-CAPA data

=head1 DESCRIPTION

Lonspreadsheet provides course coordinators the ability to manage their
students grades online.  The students are able to view their own grades, but
not the grades of their peers.  The spreadsheet is highly customizable,
offering the ability to use Perl code to manipulate data, as well as many
built-in functions.


=head2 Functions available to user of lonspreadsheet

=over 4

=cut

package Apache::lonspreadsheet;
            
use strict;
use Safe;
use Safe::Hole;
use Opcode;
use Apache::lonnet;
use Apache::Constants qw(:common :http);
use GDBM_File;
use HTML::TokeParser;

#
# Caches for previously calculated spreadsheets
#

my %oldsheets;
my %loadedcaches;
my %expiredates;

#
# Cache for stores of an individual user
#

my $cachedassess;
my %cachedstores;

#
# These cache hashes need to be independent of user, resource and course
# (user and course can/should be in the keys)
#

my %spreadsheets;
my %courserdatas;
my %userrdatas;
my %defaultsheets;
my %updatedata;

#
# These global hashes are dependent on user, course and resource, 
# and need to be initialized every time when a sheet is calculated
#
my %courseopt;
my %useropt;
my %parmhash;

# Stuff that only the screen handler can know

my $includedir;
my $tmpdir;

# =============================================================================
# ===================================== Implements an instance of a spreadsheet

sub initsheet {
    my $safeeval = new Safe(shift);
    my $safehole = new Safe::Hole;
    $safeeval->permit("entereval");
    $safeeval->permit(":base_math");
    $safeeval->permit("sort");
    $safeeval->deny(":base_io");
    $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
    my $code=<<'ENDDEFS';
# ---------------------------------------------------- Inside of the safe space

#
# f: formulas
# t: intermediate format (variable references expanded)
# v: output values
# c: preloaded constants (A-column)
# rl: row label
# os: other spreadsheets (for student spreadsheet only)

undef %v; 
undef %t;
undef %f;
undef %c;
undef %rl;
undef @os;

$maxrow=0;
$sheettype='';

# filename/reference of the sheet

$filename='';

# user data
$uname='';
$uhome='';
$udom='';

# course data

$csec='';
$chome='';
$cnum='';
$cdom='';
$cid='';
$cfn='';

# symb

$usymb='';

sub mask {
    my ($lower,$upper)=@_;

    $lower=~/([A-Za-z]|\*)(\d+|\*)/;
    my $la=$1;
    my $ld=$2;

    $upper=~/([A-Za-z]|\*)(\d+|\*)/;
    my $ua=$1;
    my $ud=$2;
    my $alpha='';
    my $num='';

    if (($la eq '*') || ($ua eq '*')) {
       $alpha='[A-Za-z]';
    } else {
       if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) ||
           ($la=~/[a-z]/) && ($ua=~/[a-z]/)) {
          $alpha='['.$la.'-'.$ua.']';
       } else {
          $alpha='['.$la.'-Za-'.$ua.']';
       }
    }   

    if (($ld eq '*') || ($ud eq '*')) {
	$num='\d+';
    } else {
        if (length($ld)!=length($ud)) {
           $num.='(';
	   foreach ($ld=~m/\d/g) {
              $num.='['.$_.'-9]';
	   }
           if (length($ud)-length($ld)>1) {
              $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
	   }
           $num.='|';
           foreach ($ud=~m/\d/g) {
               $num.='[0-'.$_.']';
           }
           $num.=')';
       } else {
           my @lda=($ld=~m/\d/g);
           my @uda=($ud=~m/\d/g);
           my $i; $j=0; $notdone=1;
           for ($i=0;($i<=$#lda)&&($notdone);$i++) {
               if ($lda[$i]==$uda[$i]) {
		   $num.=$lda[$i];
                   $j=$i;
               } else {
                   $notdone=0;
               }
           }
           if ($j<$#lda-1) {
	       $num.='('.$lda[$j+1];
               for ($i=$j+2;$i<=$#lda;$i++) {
                   $num.='['.$lda[$i].'-9]';
               }
               if ($uda[$j+1]-$lda[$j+1]>1) {
		   $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'.
                   ($#lda-$j-1).'}';
               }
	       $num.='|'.$uda[$j+1];
               for ($i=$j+2;$i<=$#uda;$i++) {
                   $num.='[0-'.$uda[$i].']';
               }
               $num.=')';
           } else {
               if ($lda[$#lda]!=$uda[$#uda]) {
                  $num.='['.$lda[$#lda].'-'.$uda[$#uda].']';
	       }
           }
       }
    }
    return '^'.$alpha.$num."\$";
}

#-------------------------------------------------------

=item UWCALC(hashname,modules,units,date) 

returns the proportion of the module 
weights not previously completed by the student.

=over 4

=item hashname 

name of the hash the module dates have been inserted into

=item modules 

reference to a cell which contains a comma deliminated list of modules 
covered by the assignment.

=item units 

reference to a cell which contains a comma deliminated list of module 
weights with respect to the assignment

=item date 

reference to a cell which contains the date the assignment was completed.

=back 

=cut

#-------------------------------------------------------
sub UWCALC {
    my ($hashname,$modules,$units,$date) = @_;
    my @Modules = split(/,/,$modules);
    my @Units   = split(/,/,$units);
    my $total_weight;
    foreach (@Units) {
	$total_weight += $_;
    }
    my $usum=0;
    for (my $i=0; $i<=$#Modules; $i++) {
	if (&HASH($hashname,$Modules[$i]) eq $date) {
	    $usum += $Units[$i];
	}
    }
    return $usum/$total_weight;
}

#-------------------------------------------------------

=item CDLSUM(list) 

returns the sum of the elements in a cell which contains
a Comma Deliminate List of numerical values.
'list' is a reference to a cell which contains a comma deliminated list.

=cut

#-------------------------------------------------------
sub CDLSUM {
    my ($list)=@_;
    my $sum;
    foreach (split/,/,$list) {
	$sum += $_;
    }
    return $sum;
}

#-------------------------------------------------------

=item CDLITEM(list,index) 

returns the item at 'index' in a Comma Deliminated List.

=over 4

=item list

reference to a cell which contains a comma deliminated list.

=item index 

the Perl index of the item requested (first element in list has
an index of 0) 

=back

=cut

#-------------------------------------------------------
sub CDLITEM {
    my ($list,$index)=@_;
    my @Temp = split/,/,$list;
    return $Temp[$index];
}

#-------------------------------------------------------

=item CDLHASH(name,key,value) 

loads a comma deliminated list of keys into
the hash 'name', all with a value of 'value'.

=over 4

=item name  

name of the hash.

=item key

(a pointer to) a comma deliminated list of keys.

=item value

a single value to be entered for each key.

=back

=cut

#-------------------------------------------------------
sub CDLHASH {
    my ($name,$key,$value)=@_;
    my @Keys;
    my @Values;
    # Check to see if we have multiple $key values
    if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
	my $keymask = &mask($key);
	# Assume the keys are addresses
	my @Temp = grep /$keymask/,keys(%v);
	@Keys = $v{@Temp};
    } else {
	$Keys[0]= $key;
    }
    my @Temp;
    foreach $key (@Keys) {
	@Temp = (@Temp, split/,/,$key);
    }
    @Keys = @Temp;
    if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
	my $valmask = &mask($value);
	my @Temp = grep /$valmask/,keys(%v);
	@Values =$v{@Temp};
    } else {
	$Values[0]= $value;
    }
    $value = $Values[0];
    # Add values to hash
    for (my $i = 0; $i<=$#Keys; $i++) {
	my $key   = $Keys[$i];
	if (! exists ($hashes{$name}->{$key})) {
	    $hashes{$name}->{$key}->[0]=$value;
	} else {
	    my @Temp = sort(@{$hashes{$name}->{$key}},$value);
	    $hashes{$name}->{$key} = \@Temp;
	}
    }
    return "hash '$name' updated";
}

#-------------------------------------------------------

=item GETHASH(name,key,index) 

returns the element in hash 'name' 
reference by the key 'key', at index 'index' in the values list.

=cut

#-------------------------------------------------------
sub GETHASH {
    my ($name,$key,$index)=@_;
    if (! defined($index)) {
	$index = 0;
    }
    if ($key =~ /^[A-z]\d+$/) {
	$key = $v{$key};
    }
    return $hashes{$name}->{$key}->[$index];
}

#-------------------------------------------------------

=item CLEARHASH(name) 

clears all the values from the hash 'name'

=item CLEARHASH(name,key) 

clears all the values from the hash 'name' associated with the given key.

=cut

#-------------------------------------------------------
sub CLEARHASH {
    my ($name,$key)=@_;
    if (defined($key)) {
	if (exists($hashes{$name}->{$key})) {
	    $hashes{$name}->{$key}=undef;
	    return "hash '$name' key '$key' cleared";
	}
    } else {
	if (exists($hashes{$name})) {
	    $hashes{$name}=undef;
	    return "hash '$name' cleared";
	}
    }
    return "Error in clearing hash";
}

#-------------------------------------------------------

=item HASH(name,key,value) 

loads values into an internal hash.  If a key 
already has a value associated with it, the values are sorted numerically.  

=item HASH(name,key) 

returns the 0th value in the hash 'name' associated with 'key'.

=cut

#-------------------------------------------------------
sub HASH {
    my ($name,$key,$value)=@_;
    my @Keys;
    undef @Keys;
    my @Values;
    # Check to see if we have multiple $key values
    if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
	my $keymask = &mask($key);
	# Assume the keys are addresses
	my @Temp = grep /$keymask/,keys(%v);
	@Keys = $v{@Temp};
    } else {
	$Keys[0]= $key;
    }
    # If $value is empty, return the first value associated 
    # with the first key.
    if (! $value) {
	return $hashes{$name}->{$Keys[0]}->[0];
    }
    # Check to see if we have multiple $value(s) 
    if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
	my $valmask = &mask($value);
	my @Temp = grep /$valmask/,keys(%v);
	@Values =$v{@Temp};
    } else {
	$Values[0]= $value;
    }
    # Add values to hash
    for (my $i = 0; $i<=$#Keys; $i++) {
	my $key   = $Keys[$i];
	my $value = ($i<=$#Values ? $Values[$i] : $Values[0]);
	if (! exists ($hashes{$name}->{$key})) {
	    $hashes{$name}->{$key}->[0]=$value;
	} else {
	    my @Temp = sort(@{$hashes{$name}->{$key}},$value);
	    $hashes{$name}->{$key} = \@Temp;
	}
    }
    return $Values[-1];
}

sub NUM {
    my $mask=mask(@_);
    my $num= $#{@{grep(/$mask/,keys(%v))}}+1;
    return $num;   
}

sub BIN {
    my ($low,$high,$lower,$upper)=@_;
    my $mask=mask($lower,$upper);
    my $num=0;
    foreach (grep /$mask/,keys(%v)) {
        if (($v{$_}>=$low) && ($v{$_}<=$high)) {
            $num++;
        }
    }
    return $num;   
}


sub SUM {
    my $mask=mask(@_);
    my $sum=0;
    foreach (grep /$mask/,keys(%v)) {
        $sum+=$v{$_};
    }
    return $sum;   
}

sub MEAN {
    my $mask=mask(@_);
    my $sum=0; my $num=0;
    foreach (grep /$mask/,keys(%v)) {
        $sum+=$v{$_};
        $num++;
    }
    if ($num) {
       return $sum/$num;
    } else {
       return undef;
    }   
}

sub STDDEV {
    my $mask=mask(@_);
    my $sum=0; my $num=0;
    foreach (grep /$mask/,keys(%v)) {
        $sum+=$v{$_};
        $num++;
    }
    unless ($num>1) { return undef; }
    my $mean=$sum/$num;
    $sum=0;
    foreach (grep /$mask/,keys(%v)) {
        $sum+=($v{$_}-$mean)**2;
    }
    return sqrt($sum/($num-1));    
}

sub PROD {
    my $mask=mask(@_);
    my $prod=1;
    foreach (grep /$mask/,keys(%v)) {
        $prod*=$v{$_};
    }
    return $prod;   
}

sub MAX {
    my $mask=mask(@_);
    my $max='-';
    foreach (grep /$mask/,keys(%v)) {
        unless ($max) { $max=$v{$_}; }
        if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; }
    } 
    return $max;   
}

sub MIN {
    my $mask=mask(@_);
    my $min='-';
    foreach (grep /$mask/,keys(%v)) {
        unless ($max) { $max=$v{$_}; }
        if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; }
    }
    return $min;   
}

sub SUMMAX {
    my ($num,$lower,$upper)=@_;
    my $mask=mask($lower,$upper);
    my @inside=();
    foreach (grep /$mask/,keys(%v)) {
	$inside[$#inside+1]=$v{$_};
    }
    @inside=sort(@inside);
    my $sum=0; my $i;
    for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) { 
        $sum+=$inside[$i];
    }
    return $sum;   
}

sub SUMMIN {
    my ($num,$lower,$upper)=@_;
    my $mask=mask($lower,$upper);
    my @inside=();
    foreach (grep /$mask/,keys(%v)) {
	$inside[$#inside+1]=$v{$_};
    }
    @inside=sort(@inside);
    my $sum=0; my $i;
    for ($i=0;(($i<$num) && ($i<=$#inside));$i++) { 
        $sum+=$inside[$i];
    }
    return $sum;   
}

sub expandnamed {
    my $expression=shift;
    if ($expression=~/^\&/) {
	my ($func,$var,$formula)=($expression=~/^\&(\w+)\(([^\;]+)\;(.*)\)/);
	my @vars=split(/\W+/,$formula);
        my %values=();
        undef %values;
	foreach ( @vars ) {
            my $varname=$_;
            if ($varname=~/\D/) {
               $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge;
               $varname=~s/$var/\(\\w\+\)/g;
	       foreach (keys(%c)) {
		  if ($_=~/$varname/) {
		      $values{$1}=1;
                  }
               }
	    }
        }
        if ($func eq 'EXPANDSUM') {
            my $result='';
	    foreach (keys(%values)) {
                my $thissum=$formula;
                $thissum=~s/$var/$_/g;
                $result.=$thissum.'+';
            } 
            $result=~s/\+$//;
            return $result;
        } else {
	    return 0;
        }
    } else {
        return '$c{\''.$expression.'\'}';
    }
}

sub sett {
    %t=();
    my $pattern='';
    if ($sheettype eq 'assesscalc') {
	$pattern='A';
    } else {
        $pattern='[A-Z]';
    }
    foreach (keys(%f)) {
	if ($_=~/template\_(\w)/) {
	  my $col=$1;
          unless ($col=~/^$pattern/) {
	    foreach (keys(%f)) {
	      if ($_=~/A(\d+)/) {
		my $trow=$1;
                if ($trow) {
		    my $lb=$col.$trow;
                    $t{$lb}=$f{'template_'.$col};
                    $t{$lb}=~s/\#/$trow/g;
                    $t{$lb}=~s/\.\.+/\,/g;
                    $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
                    $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
                }
	      }
	    }
	  }
      }
    }
    foreach (keys(%f)) {
	if (($f{$_}) && ($_!~/template\_/)) {
            my $matches=($_=~/^$pattern(\d+)/);
            if  (($matches) && ($1)) {
	        unless ($f{$_}=~/^\!/) {
		    $t{$_}=$c{$_};
                }
            } else {
	       $t{$_}=$f{$_};
               $t{$_}=~s/\.\.+/\,/g;
               $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
               $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
            }
        }
    }
    $t{'A0'}=$f{'A0'};
    $t{'A0'}=~s/\.\.+/\,/g;
    $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
    $t{'A0'}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
}

sub calc {
    %v=();
    &sett();
    my $notfinished=1;
    my $depth=0;
    while ($notfinished) {
	$notfinished=0;
        foreach (keys(%t)) {
            my $old=$v{$_};
            $v{$_}=eval($t{$_});
	    if ($@) {
		%v=();
                return $@;
            }
	    if ($v{$_} ne $old) { $notfinished=1; }
        }
        $depth++;
        if ($depth>100) {
	    %v=();
            return 'Maximum calculation depth exceeded';
        }
    }
    return '';
}

sub templaterow {
    my @cols=();
    $cols[0]='<b><font size=+1>Template</font></b>';
    foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
	     'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
	     'a','b','c','d','e','f','g','h','i','j','k','l','m',
	     'n','o','p','q','r','s','t','u','v','w','x','y','z') {
        my $fm=$f{'template_'.$_};
        $fm=~s/[\'\"]/\&\#34;/g;
        $cols[$#cols+1]="'template_$_','$fm'".'___eq___'.$fm;
    }
    return @cols;
}

sub outrowassess {
    my $n=shift;
    my @cols=();
    if ($n) {
       my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n});
       $cols[0]=$rl{$usy}.'<br>'.
                '<select name="sel_'.$n.'" onChange="changesheet('.$n.
                ')"><option name="default">Default</option>';
       foreach (@os) {
           $cols[0].='<option name="'.$_.'"';
            if ($ufn eq $_) {
               $cols[0].=' selected';
            }
            $cols[0].='>'.$_.'</option>';
       }
       $cols[0].='</select>';
    } else {
       $cols[0]='<b><font size=+1>Export</font></b>';
    }
    foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
	     'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
	     'a','b','c','d','e','f','g','h','i','j','k','l','m',
	     'n','o','p','q','r','s','t','u','v','w','x','y','z') {
        my $fm=$f{$_.$n};
        $fm=~s/[\'\"]/\&\#34;/g;
        push(@cols,"'$_$n','$fm'".'___eq___'.$v{$_.$n});
    }
    return @cols;
}

sub outrow {
    my $n=shift;
    my @cols=();
    if ($n) {
       $cols[0]=$rl{$f{'A'.$n}};
    } else {
       $cols[0]='<b><font size=+1>Export</font></b>';
    }
    foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
	     'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
	     'a','b','c','d','e','f','g','h','i','j','k','l','m',
	     'n','o','p','q','r','s','t','u','v','w','x','y','z') {
        my $fm=$f{$_.$n};
        $fm=~s/[\'\"]/\&\#34;/g;
        $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};
    }
    return @cols;
}

sub exportrowa {
    my @exportarray=();
    foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
	     'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
	$exportarray[$#exportarray+1]=$v{$_.'0'};
    } 
    return @exportarray;
}

# ------------------------------------------- End of "Inside of the safe space"
ENDDEFS
    $safeeval->reval($code);
    return $safeeval;
}

# ------------------------------------------------ Add or change formula values

sub setformulas {
    my ($safeeval,%f)=@_;
    %{$safeeval->varglob('f')}=%f;
}

# ------------------------------------------------ Add or change formula values

sub setconstants {
    my ($safeeval,%c)=@_;
    %{$safeeval->varglob('c')}=%c;
}

# --------------------------------------------- Set names of other spreadsheets

sub setothersheets {
    my ($safeeval,@os)=@_;
    @{$safeeval->varglob('os')}=@os;
}

# ------------------------------------------------ Add or change formula values

sub setrowlabels {
    my ($safeeval,%rl)=@_;
    %{$safeeval->varglob('rl')}=%rl;
}

# ------------------------------------------------------- Calculate spreadsheet

sub calcsheet {
    my $safeeval=shift;
    $safeeval->reval('&calc();');
}

# ------------------------------------------------------------------ Get values

sub getvalues {
    my $safeeval=shift;
    return $safeeval->reval('%v');
}

# ---------------------------------------------------------------- Get formulas

sub getformulas {
    my $safeeval=shift;
    return %{$safeeval->varglob('f')};
}

# -------------------------------------------------------------------- Get type

sub gettype {
    my $safeeval=shift;
    return $safeeval->reval('$sheettype');
}

# ------------------------------------------------------------------ Set maxrow

sub setmaxrow {
    my ($safeeval,$row)=@_;
    $safeeval->reval('$maxrow='.$row.';');
}

# ------------------------------------------------------------------ Get maxrow

sub getmaxrow {
    my $safeeval=shift;
    return $safeeval->reval('$maxrow');
}

# ---------------------------------------------------------------- Set filename

sub setfilename {
    my ($safeeval,$fn)=@_;
    $safeeval->reval('$filename="'.$fn.'";');
}

# ---------------------------------------------------------------- Get filename

sub getfilename {
    my $safeeval=shift;
    return $safeeval->reval('$filename');
}

# --------------------------------------------------------------- Get course ID

sub getcid {
    my $safeeval=shift;
    return $safeeval->reval('$cid');
}

# --------------------------------------------------------- Get course filename

sub getcfn {
    my $safeeval=shift;
    return $safeeval->reval('$cfn');
}

# ----------------------------------------------------------- Get course number

sub getcnum {
    my $safeeval=shift;
    return $safeeval->reval('$cnum');
}

# ------------------------------------------------------------- Get course home

sub getchome {
    my $safeeval=shift;
    return $safeeval->reval('$chome');
}

# ----------------------------------------------------------- Get course domain

sub getcdom {
    my $safeeval=shift;
    return $safeeval->reval('$cdom');
}

# ---------------------------------------------------------- Get course section

sub getcsec {
    my $safeeval=shift;
    return $safeeval->reval('$csec');
}

# --------------------------------------------------------------- Get user name

sub getuname {
    my $safeeval=shift;
    return $safeeval->reval('$uname');
}

# ------------------------------------------------------------- Get user domain

sub getudom {
    my $safeeval=shift;
    return $safeeval->reval('$udom');
}

# --------------------------------------------------------------- Get user home

sub getuhome {
    my $safeeval=shift;
    return $safeeval->reval('$uhome');
}

# -------------------------------------------------------------------- Get symb

sub getusymb {
    my $safeeval=shift;
    return $safeeval->reval('$usymb');
}

# ------------------------------------------------------------- Export of A-row

sub exportdata {
    my $safeeval=shift;
    return $safeeval->reval('&exportrowa()');
}


# ========================================================== End of Spreadsheet
# =============================================================================

#
# Procedures for screen output
#
# --------------------------------------------- Produce output row n from sheet

sub rown {
    my ($safeeval,$n)=@_;
    my $defaultbg;
    my $rowdata='';
    my $dataflag=0;
    unless ($n eq '-') {
       $defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF';
    } else {
       $defaultbg='#E0FF';
    }
    unless ($ENV{'form.showcsv'}) {
       $rowdata.="\n<tr><td><b><font size=+1>$n</font></b></td>";
    } else {
       $rowdata.="\n".'"'.$n.'"';
    }
    my $showf=0;
    my $proc;
    my $maxred;
    my $sheettype=&gettype($safeeval);
    if ($sheettype eq 'studentcalc') {
        $proc='&outrowassess';
        $maxred=26;
    } else {
        $proc='&outrow';
    }
    if ($sheettype eq 'assesscalc') {
        $maxred=1;
    } else {
        $maxred=26;
    }
    if ($n eq '-') { $proc='&templaterow'; $n=-1; $dataflag=1; }
    foreach ($safeeval->reval($proc.'('.$n.')')) {
       my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');
       my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
       if ((($vl ne '') || ($vl eq '0')) &&
           (($showf==1) || ($sheettype ne 'studentcalc'))) { $dataflag=1; }
       if ($showf==0) { $vl=$_; }
      unless ($ENV{'form.showcsv'}) {
       if ($showf<=$maxred) { $bgcolor='#FFDDDD'; }
       if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; } 
       if (($showf>$maxred) || ((!$n) && ($showf>0))) {
	   if ($vl eq '') {
	       $vl='<font size=+2 color='.$bgcolor.'>&#35;</font>';
           }
           $rowdata.=
       '<td bgcolor='.$bgcolor.'><a href="javascript:celledit('.$fm.');">'.$vl.
	       '</a></td>';
       } else {
           $rowdata.='<td bgcolor='.$bgcolor.'>&nbsp;'.$vl.'&nbsp;</td>';
       }
      } else {
	  $rowdata.=',"'.$vl.'"';
      }
       $showf++;
    }  # End of foreach($safeval...)
    if ($ENV{'form.showall'} || ($dataflag)) {
       return $rowdata.($ENV{'form.showcsv'}?'':'</tr>');
    } else {
       return '';
    }
}

# ------------------------------------------------------------- Print out sheet

sub outsheet {
    my ($r,$safeeval)=@_;
    my $maxred;
    my $realm;
    if (&gettype($safeeval) eq 'assesscalc') {
        $maxred=1;
        $realm='Assessment';
    } elsif (&gettype($safeeval) eq 'studentcalc') {
        $maxred=26;
        $realm='User';
    } else {
        $maxred=26;
        $realm='Course';
    }
    my $maxyellow=52-$maxred;
    my $tabledata;
    unless ($ENV{'form.showcsv'}) {
       $tabledata=
        '<table border=2><tr><th colspan=2 rowspan=2><font size=+2>'.
                  $realm.'</font></th>'.
                  '<td bgcolor=#FFDDDD colspan='.$maxred.
                  '><b><font size=+1>Import</font></b></td>'.
                  '<td colspan='.$maxyellow.
		  '><b><font size=+1>Calculations</font></b></td></tr><tr>';
    my $showf=0;
    foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
	     'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
	     'a','b','c','d','e','f','g','h','i','j','k','l','m',
	     'n','o','p','q','r','s','t','u','v','w','x','y','z') {
        $showf++;
        if ($showf<=$maxred) { 
           $tabledata.='<td bgcolor="#FFDDDD">'; 
        } else {
           $tabledata.='<td>';
        }
        $tabledata.="<b><font size=+1>$_</font></b></td>";
    }
    $tabledata.='</tr>'.&rown($safeeval,'-').&rown($safeeval,0);
   } else { $tabledata='<pre>'; }

    $r->print($tabledata);

    my $row;
    my $maxrow=&getmaxrow($safeeval);

    my @sortby=();
    my @sortidx=();
    for ($row=1;$row<=$maxrow;$row++) {
       $sortby[$row-1]=$safeeval->reval('$f{"A'.$row.'"}');
       $sortidx[$row-1]=$row-1;
    }
    @sortidx=sort { $sortby[$a] cmp $sortby[$b]; } @sortidx;

        my $what='Student';
        if (&gettype($safeeval) eq 'assesscalc') {
	    $what='Item';
	} elsif (&gettype($safeeval) eq 'studentcalc') {
            $what='Assessment';
        }

    my $n=0;
    for ($row=0;$row<$maxrow;$row++) {
     my $thisrow=&rown($safeeval,$sortidx[$row]+1);
     if ($thisrow) {
       if (($n/25==int($n/25)) && (!$ENV{'form.showcsv'})) {
	$r->print("</table>\n<br>\n");
        $r->rflush();
        $r->print('<table border=2><tr><td>&nbsp;<td>'.$what.'</td>');
        foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
		 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
		 'a','b','c','d','e','f','g','h','i','j','k','l','m',
		 'n','o','p','q','r','s','t','u','v','w','x','y','z') {
           $r->print('<td>'.$_.'</td>');
        }
        $r->print('</tr>');
       }
       $n++;
       $r->print($thisrow);
      }
    }
    $r->print($ENV{'form.showcsv'}?'</pre>':'</table>');
}

#
# ----------------------------------------------- Read list of available sheets
# 
sub othersheets {
    my ($safeeval,$stype)=@_;
    #
    my $cnum=&getcnum($safeeval);
    my $cdom=&getcdom($safeeval);
    my $chome=&getchome($safeeval);
    #
    my @alternatives=();
    my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum);
    my ($tmp) = keys(%results);
    unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
        @alternatives = sort (keys(%results));
    }
    return @alternatives; 
}


#
# -------------------------------------- Parse a spreadsheet
# 
sub parse_sheet {
    # $sheetxml is a scalar reference or a scalar
    my ($sheetxml) = @_;
    if (! ref($sheetxml)) {
        my $tmp = $sheetxml;
        $sheetxml = \$tmp;
    }
    my %f;
    my $parser=HTML::TokeParser->new($sheetxml);
    my $token;
    while ($token=$parser->get_token) {
        if ($token->[0] eq 'S') {
            if ($token->[1] eq 'field') {
                $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
                    $parser->get_text('/field');
            }
            if ($token->[1] eq 'template') {
                $f{'template_'.$token->[2]->{'col'}}=
                    $parser->get_text('/template');
            }
        }
    }
    return \%f;
}

#
# -------------------------------------- Read spreadsheet formulas for a course
#

sub readsheet {
  my ($safeeval,$fn)=@_;
  my $stype=&gettype($safeeval);
  my $cnum=&getcnum($safeeval);
  my $cdom=&getcdom($safeeval);
  my $chome=&getchome($safeeval);

  if (! defined($fn)) {
      # There is no filename. Look for defaults in course and global, cache
      unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) {
          my %tmphash = &Apache::lonnet::get('environment',
                                             ['spreadsheet_default_'.$stype],
                                             $cdom,$cnum);
          my ($tmp) = keys(%tmphash);
          if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
              $fn = 'default_'.$stype;
          } else {
              $fn = $tmphash{'spreadsheet_default_'.$stype};
          } 
          $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; 
      }
  }

# ---------------------------------------------------------- fn now has a value

  &setfilename($safeeval,$fn);

# ------------------------------------------------------ see if sheet is cached
  my $fstring='';
  if ($fstring=$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}) {
      &setformulas($safeeval,split(/\_\_\_\;\_\_\_/,$fstring));
  } else {

# ---------------------------------------------------- Not cached, need to read

     my %f=();

     if ($fn=~/^default\_/) {
         my $sheetxml='';
         my $fh;
         my $dfn=$fn;
         $dfn=~s/\_/\./g;
         if ($fh=Apache::File->new($includedir.'/'.$dfn)) {
             $sheetxml=join('',<$fh>);
         } else {
             $sheetxml='<field row="0" col="A">"Error"</field>';
         }
         %f=%{&parse_sheet(\$sheetxml)};
     } elsif($fn=~/\/*\.spreadsheet$/) {
         my $sheetxml=&Apache::lonnet::getfile
             (&Apache::lonnet::filelocation('',$fn));
         print "<pre>$sheetxml</pre>";
         if ($sheetxml == -1) {
             $sheetxml='<field row="0" col="A">"Error loading spreadsheet '
                 .$fn.'"</field>';
         }
         %f=%{&parse_sheet(\$sheetxml)};
         print "<pre>";
         foreach (sort( keys(%f))) {
             print "$_ = $f{$_}\n";
         }
         print "</pre>";
     } else {
         my $sheet='';
         my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum);
         my ($tmp) = keys(%tmphash);
         unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
             foreach (keys(%tmphash)) {
                 $f{$_}=$tmphash{$_};
             }
         }
     }
# --------------------------------------------------------------- Cache and set
       $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);  
       &setformulas($safeeval,%f);
    }
}

# -------------------------------------------------------- Make new spreadsheet

sub makenewsheet {
    my ($uname,$udom,$stype,$usymb)=@_;
    my $safeeval=initsheet($stype);
    $safeeval->reval(
       '$uname="'.$uname.
      '";$udom="'.$udom.
      '";$uhome="'.&Apache::lonnet::homeserver($uname,$udom).
      '";$sheettype="'.$stype.
      '";$usymb="'.$usymb.
      '";$csec="'.&Apache::lonnet::usection($udom,$uname,
                                            $ENV{'request.course.id'}).
      '";$cid="'.$ENV{'request.course.id'}.
      '";$cfn="'.$ENV{'request.course.fn'}.
      '";$cnum="'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
      '";$cdom="'.$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.
      '";$chome="'.$ENV{'course.'.$ENV{'request.course.id'}.'.home'}.'";');
    return $safeeval;
}

# ------------------------------------------------------------ Save spreadsheet

sub writesheet {
  my ($safeeval,$makedef)=@_;
  my $cid=&getcid($safeeval);
  if (&Apache::lonnet::allowed('opa',$cid)) {
    my %f=&getformulas($safeeval);
    my $stype=&gettype($safeeval);
    my $cnum=&getcnum($safeeval);
    my $cdom=&getcdom($safeeval);
    my $chome=&getchome($safeeval);
    my $fn=&getfilename($safeeval);

# ------------------------------------------------------------- Cache new sheet
    $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);    
# ----------------------------------------------------------------- Write sheet
    my $sheetdata='';
    foreach (keys(%f)) {
     unless ($f{$_} eq 'import') {
       $sheetdata.=&Apache::lonnet::escape($_).'='.
	   &Apache::lonnet::escape($f{$_}).'&';
     }
    }
    $sheetdata=~s/\&$//;
    my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'.
              $sheetdata,$chome);
    if ($reply eq 'ok') {
          $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.
              $stype.'_spreadsheets:'.
              &Apache::lonnet::escape($fn).'='.$ENV{'user.name'}.'@'.
                                               $ENV{'user.domain'},
              $chome);
          if ($reply eq 'ok') {
              if ($makedef) { 
                return &Apache::lonnet::reply('put:'.$cdom.':'.$cnum.
                                ':environment:spreadsheet_default_'.$stype.'='.
                                &Apache::lonnet::escape($fn),
                                $chome);
	      } else {
		  return $reply;
    	      }
	   } else {
	       return $reply;
           }
      } else {
	  return $reply;
      }
  }
  return 'unauthorized';
}

# ----------------------------------------------- Make a temp copy of the sheet
# "Modified workcopy" - interactive only
#

sub tmpwrite {
    my $safeeval=shift;
    my $fn=$ENV{'user.name'}.'_'.
           $ENV{'user.domain'}.'_spreadsheet_'.&getusymb($safeeval).'_'.
           &getfilename($safeeval);
    $fn=~s/\W/\_/g;
    $fn=$tmpdir.$fn.'.tmp';
    my $fh;
    if ($fh=Apache::File->new('>'.$fn)) {
	print $fh join("\n",&getformulas($safeeval));
    }
}

# ---------------------------------------------------------- Read the temp copy

sub tmpread {
    my ($safeeval,$nfield,$nform)=@_;
    my $fn=$ENV{'user.name'}.'_'.
           $ENV{'user.domain'}.'_spreadsheet_'.&getusymb($safeeval).'_'.
           &getfilename($safeeval);
    $fn=~s/\W/\_/g;
    $fn=$tmpdir.$fn.'.tmp';
    my $fh;
    my %fo=();
    if ($fh=Apache::File->new($fn)) {
        my $name;
        while ($name=<$fh>) {
	    chomp($name);
            my $value=<$fh>;
            chomp($value);
            $fo{$name}=$value;
        }
    }
    if ($nform eq 'changesheet') {
        $fo{'A'.$nfield}=(split(/\_\_\&\&\&\_\_/,$fo{'A'.$nfield}))[0];
        unless ($ENV{'form.sel_'.$nfield} eq 'Default') {
	    $fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield};
        }
    } else {
       if ($nfield) { $fo{$nfield}=$nform; }
    }
    &setformulas($safeeval,%fo);
}

# ================================================================== Parameters
# -------------------------------------------- Figure out a cascading parameter
#
# For this function to work
#
# * parmhash needs to be tied
# * courseopt and useropt need to be initialized for this user and course
#

sub parmval {
    my ($what,$safeeval)=@_;
    my $cid=&getcid($safeeval);
    my $csec=&getcsec($safeeval);
    my $uname=&getuname($safeeval);
    my $udom=&getudom($safeeval);
    my $symb=&getusymb($safeeval);

    unless ($symb) { return ''; }
    my $result='';

    my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
# ----------------------------------------------------- Cascading lookup scheme
       my $rwhat=$what;
       $what=~s/^parameter\_//;
       $what=~s/\_([^\_]+)$/\.$1/;

       my $symbparm=$symb.'.'.$what;
       my $mapparm=$mapname.'___(all).'.$what;
       my $usercourseprefix=$uname.'_'.$udom.'_'.$cid;

       my $seclevel=
            $usercourseprefix.'.['.
		$csec.'].'.$what;
       my $seclevelr=
            $usercourseprefix.'.['.
		$csec.'].'.$symbparm;
       my $seclevelm=
            $usercourseprefix.'.['.
		$csec.'].'.$mapparm;

       my $courselevel=
            $usercourseprefix.'.'.$what;
       my $courselevelr=
            $usercourseprefix.'.'.$symbparm;
       my $courselevelm=
            $usercourseprefix.'.'.$mapparm;

# ---------------------------------------------------------- fourth, check user
      
      if ($uname) { 

       if ($useropt{$courselevelr}) { return $useropt{$courselevelr}; }

       if ($useropt{$courselevelm}) { return $useropt{$courselevelm}; }

       if ($useropt{$courselevel}) { return $useropt{$courselevel}; }

      }

# --------------------------------------------------------- third, check course
     
       if ($csec) {
 
        if ($courseopt{$seclevelr}) { return $courseopt{$seclevelr}; }

        if ($courseopt{$seclevelm}) { return $courseopt{$seclevelm}; }  

        if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }
  
      }

       if ($courseopt{$courselevelr}) { return $courseopt{$courselevelr}; }

       if ($courseopt{$courselevelm}) { return $courseopt{$courselevelm}; }

       if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }

# ----------------------------------------------------- second, check map parms

       my $thisparm=$parmhash{$symbparm};
       if ($thisparm) { return $thisparm; }

# -------------------------------------------------------- first, check default

       return &Apache::lonnet::metadata($fn,$rwhat.'.default');
        
}

# ---------------------------------------------- Update rows for course listing

sub updateclasssheet {
    my $safeeval=shift;
    my $cnum=&getcnum($safeeval);
    my $cdom=&getcdom($safeeval);
    my $cid=&getcid($safeeval);
    my $chome=&getchome($safeeval);

# ---------------------------------------------- Read class list and row labels

    my $classlst=&Apache::lonnet::reply
                                 ('dump:'.$cdom.':'.$cnum.':classlist',$chome);
    my %currentlist=();
    my $now=time;
    unless ($classlst=~/^error\:/) {
        foreach (split(/\&/,$classlst)) {
            my ($name,$value)=split(/\=/,$_);
            my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value));
            my $active=1;
            if (($end) && ($now>$end)) { $active=0; }
            if ($active) {
                my $rowlabel='';
                $name=&Apache::lonnet::unescape($name);
                my ($sname,$sdom)=split(/\:/,$name);
                my $ssec=&Apache::lonnet::usection($sdom,$sname,$cid);
                if ($ssec==-1) {
		   unless ($ENV{'form.showcsv'}) {
                    $rowlabel='<font color=red>Data not available: '.$name.
			      '</font>';
		   } else {
		       $rowlabel='ERROR","'.$name.
                                 '","Data not available","","","';
                   }
                } else {
                    my %reply=&Apache::lonnet::idrget($sdom,$sname);
                    my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname.
		      ':environment:firstname&middlename&lastname&generation',
                      &Apache::lonnet::homeserver($sname,$sdom));
		   unless ($ENV{'form.showcsv'}) {
                    $rowlabel='<a href="/adm/studentcalc?uname='.$sname.
                              '&udom='.$sdom.'">'.
                              $ssec.'&nbsp;'.$reply{$sname}.'<br>';
                    foreach ( split(/\&/,$reply)) {
                        $rowlabel.=&Apache::lonnet::unescape($_).' ';
                    }
                    $rowlabel.='</a>';
		   } else {
		    $rowlabel=$ssec.'","'.$reply{$sname}.'"';
                    my $ncount=0;
                    foreach (split(/\&/,$reply)) {
                        $rowlabel.=',"'.&Apache::lonnet::unescape($_).'"';
                        $ncount++;
                    }
                    unless ($ncount==4) { $rowlabel.=',""'; }
                    $rowlabel=~s/\"$//;
		   }
                }
		$currentlist{&Apache::lonnet::unescape($name)}=$rowlabel;
            }
        } # end of foreach (split(/\&/,$classlst))
#
# -------------------- Find discrepancies between the course row table and this
#
        my %f=&getformulas($safeeval);
        my $changed=0;

        my $maxrow=0;
        my %existing=();

# ----------------------------------------------------------- Now obsolete rows
	foreach (keys(%f)) {
	    if ($_=~/^A(\d+)/) {
                $maxrow=($1>$maxrow)?$1:$maxrow;
                $existing{$f{$_}}=1;
		unless ((defined($currentlist{$f{$_}})) || (!$1)) {
		   $f{$_}='!!! Obsolete';
                   $changed=1;
                }
            }
        }

# -------------------------------------------------------- New and unknown keys
     
        foreach (sort keys(%currentlist)) {
            unless ($existing{$_}) {
		$changed=1;
                $maxrow++;
                $f{'A'.$maxrow}=$_;
            }
        }
     
        if ($changed) { &setformulas($safeeval,%f); }

        &setmaxrow($safeeval,$maxrow);
        &setrowlabels($safeeval,%currentlist);

    } else {
        return 'Could not access course data';
    }
}

# ----------------------------------- Update rows for student and assess sheets

sub updatestudentassesssheet {
    my $safeeval=shift;
    my %bighash;
    my $stype=&gettype($safeeval);
    my %current=();
    unless ($updatedata{$ENV{'request.course.fn'}.'_'.$stype}) {
# -------------------------------------------------------------------- Tie hash
      if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
                       &GDBM_READER,0640)) {
# --------------------------------------------------------- Get all assessments

	my %allkeys=('timestamp' => 
                     'Timestamp of Last Transaction<br>timestamp',
                     'subnumber' =>
                     'Number of Submissions<br>subnumber',
                     'tutornumber' =>
                     'Number of Tutor Responses<br>tutornumber',
                     'totalpoints' =>
                     'Total Points Granted<br>totalpoints');

        my $adduserstr='';
        if ((&getuname($safeeval) ne $ENV{'user.name'}) ||
            (&getudom($safeeval) ne $ENV{'user.domain'})) {
            $adduserstr='&uname='.&getuname($safeeval).
		'&udom='.&getudom($safeeval);
        }

        my %allassess=('_feedback' =>
	              '<a href="/adm/assesscalc?usymb=_feedback'.$adduserstr.
                       '">Feedback</a>',
                       '_evaluation' =>
	              '<a href="/adm/assesscalc?usymb=_evaluation'.$adduserstr.
                       '">Evaluation</a>',
                       '_tutoring' =>
	              '<a href="/adm/assesscalc?usymb=_tutoring'.$adduserstr.
                       '">Tutoring</a>',
                       '_discussion' =>
	              '<a href="/adm/assesscalc?usymb=_discussion'.$adduserstr.
                       '">Discussion</a>'
        );

        foreach (keys(%bighash)) {
	    if ($_=~/^src\_(\d+)\.(\d+)$/) {
	       my $mapid=$1;
               my $resid=$2;
               my $id=$mapid.'.'.$resid;
               my $srcf=$bighash{$_};
               if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
                 my $symb=
                     &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
			    '___'.$resid.'___'.
			    &Apache::lonnet::declutter($srcf);
		 $allassess{$symb}=
	            '<a href="/adm/assesscalc?usymb='.$symb.$adduserstr.'">'.
                     $bighash{'title_'.$id}.'</a>';
                 if ($stype eq 'assesscalc') {
		     foreach (split(/\,/,
				    &Apache::lonnet::metadata($srcf,'keys'))) {
                       if (($_=~/^stores\_(.*)/) || ($_=~/^parameter\_(.*)/)) {
			  my $key=$_;
                          my $display=
			      &Apache::lonnet::metadata($srcf,$key.'.display');
                          unless ($display) {
                              $display.=
			         &Apache::lonnet::metadata($srcf,$key.'.name');
                          }
                          $display.='<br>'.$key;
                          $allkeys{$key}=$display;
		       }
                   } # end of foreach
	         }
	      }
	   }
        } # end of foreach (keys(%bighash))
        untie(%bighash);
    
#
# %allkeys has a list of storage and parameter displays by unikey
# %allassess has a list of all resource displays by symb
#

        if ($stype eq 'assesscalc') {
	    %current=%allkeys;
        } elsif ($stype eq 'studentcalc') {
            %current=%allassess;
        }
        $updatedata{$ENV{'request.course.fn'}.'_'.$stype}=
	    join('___;___',%current);
    } else {
        return 'Could not access course data';
    }
# ------------------------------------------------------ Get current from cache
    } else {
        %current=split(/\_\_\_\;\_\_\_/,
		       $updatedata{$ENV{'request.course.fn'}.'_'.$stype});
    }
# -------------------- Find discrepancies between the course row table and this
#
        my %f=&getformulas($safeeval);
        my $changed=0;

        my $maxrow=0;
        my %existing=();

# ----------------------------------------------------------- Now obsolete rows
	foreach (keys(%f)) {
	    if ($_=~/^A(\d+)/) {
                $maxrow=($1>$maxrow)?$1:$maxrow;
                my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_});
                $existing{$usy}=1;
		unless ((defined($current{$usy})) || (!$1)) {
		   $f{$_}='!!! Obsolete';
                   $changed=1;
	        } elsif ($ufn) {
		    $current{$usy}
                       =~s/assesscalc\?usymb\=/assesscalc\?ufn\=$ufn\&usymb\=/;
                }
            }
        }

# -------------------------------------------------------- New and unknown keys
     
        foreach (keys(%current)) {
            unless ($existing{$_}) {
		$changed=1;
                $maxrow++;
                $f{'A'.$maxrow}=$_;
            }
        }
    
        if ($changed) { &setformulas($safeeval,%f); }

        &setmaxrow($safeeval,$maxrow);
        &setrowlabels($safeeval,%current);
 
        undef %current;
        undef %existing;
}

# ------------------------------------------------ Load data for one assessment

sub loadstudent {
    my $safeeval=shift;
    my %c=();
    my %f=&getformulas($safeeval);
    $cachedassess=&getuname($safeeval).':'.&getudom($safeeval);
    %cachedstores=();
    {
      my $reply=&Apache::lonnet::reply('dump:'.&getudom($safeeval).':'.
                                               &getuname($safeeval).':'.
                                               &getcid($safeeval),
                                               &getuhome($safeeval));
      unless ($reply=~/^error\:/) {
	 foreach ( split(/\&/,$reply)) {
            my ($name,$value)=split(/\=/,$_);
            $cachedstores{&Apache::lonnet::unescape($name)}=
	                  &Apache::lonnet::unescape($value);
	}
      }
    }
    my @assessdata=();
    foreach (keys(%f)) {
	if ($_=~/^A(\d+)/) {
	   my $row=$1;
           unless (($f{$_}=~/^\!/) || ($row==0)) {
	      my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_});
	      @assessdata=&exportsheet(&getuname($safeeval),
                                       &getudom($safeeval),
                                       'assesscalc',$usy,$ufn);
              my $index=0;
              foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
	               'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
                  if ($assessdata[$index]) {
		     my $col=$_;
		     if ($assessdata[$index]=~/\D/) {
                         $c{$col.$row}="'".$assessdata[$index]."'";
 		     } else {
		         $c{$col.$row}=$assessdata[$index];
		     }
                     unless ($col eq 'A') { 
			 $f{$col.$row}='import';
                     }
		  }
                  $index++;
              }
	   }
        }
    }
    $cachedassess='';
    undef %cachedstores;
    &setformulas($safeeval,%f);
    &setconstants($safeeval,%c);
}

# --------------------------------------------------- Load data for one student

sub loadcourse {
    my ($safeeval,$r)=@_;
    my %c=();
    my %f=&getformulas($safeeval);
    my $total=0;
    foreach (keys(%f)) {
	if ($_=~/^A(\d+)/) {
	    unless ($f{$_}=~/^\!/) { $total++; }
        }
    }
    my $now=0;
    my $since=time;
    $r->print(<<ENDPOP);
<script>
    popwin=open('','popwin','width=400,height=100');
    popwin.document.writeln('<html><body bgcolor="#FFFFFF">'+
      '<h3>Spreadsheet Calculation Progress</h3>'+
      '<form name=popremain>'+
      '<input type=text size=35 name=remaining value=Starting></form>'+
      '</body></html>');
    popwin.document.close();
</script>
ENDPOP
    $r->rflush();
    foreach (keys(%f)) {
	if ($_=~/^A(\d+)/) {
	   my $row=$1;
           unless (($f{$_}=~/^\!/)  || ($row==0)) {
	      my @studentdata=&exportsheet(split(/\:/,$f{$_}),
                                           'studentcalc');
              undef %userrdatas;
              $now++;
              $r->print('<script>popwin.document.popremain.remaining.value="'.
                  $now.'/'.$total.': '.int((time-$since)/$now*($total-$now)).
                        ' secs remaining";</script>');
              $r->rflush(); 

              my $index=0;
             foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
	              'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
                  if ($studentdata[$index]) {
		     my $col=$_;
		     if ($studentdata[$index]=~/\D/) {
                         $c{$col.$row}="'".$studentdata[$index]."'";
 		     } else {
		         $c{$col.$row}=$studentdata[$index];
		     }
                     unless ($col eq 'A') { 
			 $f{$col.$row}='import';
                     }
		  }
                  $index++;
              }
	   }
        }
    }
    &setformulas($safeeval,%f);
    &setconstants($safeeval,%c);
    $r->print('<script>popwin.close()</script>');
    $r->rflush(); 
}

# ------------------------------------------------ Load data for one assessment

sub loadassessment {
    my $safeeval=shift;

    my $uhome=&getuhome($safeeval);
    my $uname=&getuname($safeeval);
    my $udom=&getudom($safeeval);
    my $symb=&getusymb($safeeval);
    my $cid=&getcid($safeeval);
    my $cnum=&getcnum($safeeval);
    my $cdom=&getcdom($safeeval);
    my $chome=&getchome($safeeval);

    my $namespace;
    unless ($namespace=$cid) { return ''; }

# ----------------------------------------------------------- Get stored values

   my %returnhash=();

   if ($cachedassess eq $uname.':'.$udom) {
#
# get data out of the dumped stores
# 

       my $version=$cachedstores{'version:'.$symb};
       my $scope;
       for ($scope=1;$scope<=$version;$scope++) {
           foreach (split(/\:/,$cachedstores{$scope.':keys:'.$symb})) {
               $returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_};
           } 
       }

   } else {
#
# restore individual
#

    my $answer=&Apache::lonnet::reply(
       "restore:$udom:$uname:".
       &Apache::lonnet::escape($namespace).":".
       &Apache::lonnet::escape($symb),$uhome);
    foreach (split(/\&/,$answer)) {
	my ($name,$value)=split(/\=/,$_);
        $returnhash{&Apache::lonnet::unescape($name)}=
                    &Apache::lonnet::unescape($value);
    }
    my $version;
    for ($version=1;$version<=$returnhash{'version'};$version++) {
       foreach (split(/\:/,$returnhash{$version.':keys'})) {
          $returnhash{$_}=$returnhash{$version.':'.$_};
       } 
    }
   }
# ----------------------------- returnhash now has all stores for this resource

# --------- convert all "_" to "." to be able to use libraries, multiparts, etc

    my @oldkeys=keys %returnhash;

    foreach (@oldkeys) {
        my $name=$_;
        my $value=$returnhash{$_};
        delete $returnhash{$_};
        $name=~s/\_/\./g;
        $returnhash{$name}=$value;
    }

# ---------------------------- initialize coursedata and userdata for this user
    undef %courseopt;
    undef %useropt;

    my $userprefix=$uname.'_'.$udom.'_';

    unless ($uhome eq 'no_host') { 
# -------------------------------------------------------------- Get coursedata
      unless
        ((time-$courserdatas{$cid.'.last_cache'})<240) {
         my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.
              ':resourcedata',$chome);
         if ($reply!~/^error\:/) {
            $courserdatas{$cid}=$reply;
            $courserdatas{$cid.'.last_cache'}=time;
         }
      }
      foreach (split(/\&/,$courserdatas{$cid})) {
         my ($name,$value)=split(/\=/,$_);
         $courseopt{$userprefix.&Apache::lonnet::unescape($name)}=
                    &Apache::lonnet::unescape($value);  
      }
# --------------------------------------------------- Get userdata (if present)
      unless
        ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {
         my $reply=
       &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
         if ($reply!~/^error\:/) {
	     $userrdatas{$uname.'___'.$udom}=$reply;
	     $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
         }
      }
      foreach (split(/\&/,$userrdatas{$uname.'___'.$udom})) {
         my ($name,$value)=split(/\=/,$_);
         $useropt{$userprefix.&Apache::lonnet::unescape($name)}=
	          &Apache::lonnet::unescape($value);
      }
    }
# ----------------- now courseopt, useropt initialized for this user and course
# (used by parmval)

#
# Load keys for this assessment only
#
    my %thisassess=();
    my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb);
    
    foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) {
        $thisassess{$_}=1;
    } 
#
# Load parameters
#
   my %c=();

   if (tie(%parmhash,'GDBM_File',
           &getcfn($safeeval).'_parms.db',&GDBM_READER,0640)) {
    my %f=&getformulas($safeeval);
    foreach (keys(%f))  {
	if ($_=~/^A/) {
            unless ($f{$_}=~/^\!/) {
  	       if ($f{$_}=~/^parameter/) {
		if ($thisassess{$f{$_}}) {
                  my $val=&parmval($f{$_},$safeeval);
                  $c{$_}=$val;
                  $c{$f{$_}}=$val;
	        }
	       } else {
		  my $key=$f{$_};
                  my $ckey=$key;
                  $key=~s/^stores\_/resource\./;
                  $key=~s/\_/\./g;
 	          $c{$_}=$returnhash{$key};
                  $c{$ckey}=$returnhash{$key};
	       }
	   }
        }
    }
    untie(%parmhash);
   }
   &setconstants($safeeval,%c);
}

# --------------------------------------------------------- Various form fields

sub textfield {
    my ($title,$name,$value)=@_;
    return "\n<p><b>$title:</b><br>".
           '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
}

sub hiddenfield {
    my ($name,$value)=@_;
    return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
}

sub selectbox {
    my ($title,$name,$value,%options)=@_;
    my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
    foreach (sort keys(%options)) {
        $selout.='<option value="'.$_.'"';
        if ($_ eq $value) { $selout.=' selected'; }
        $selout.='>'.$options{$_}.'</option>';
    }
    return $selout.'</select>';
}

# =============================================== Update information in a sheet
#
# Add new users or assessments, etc.
#

sub updatesheet {
    my $safeeval=shift;
    my $stype=&gettype($safeeval);
    if ($stype eq 'classcalc') {
	return &updateclasssheet($safeeval);
    } else {
        return &updatestudentassesssheet($safeeval);
    }
}

# =================================================== Load the rows for a sheet
#
# Import the data for rows
#

sub loadrows {
    my ($safeeval,$r)=@_;
    my $stype=&gettype($safeeval);
    if ($stype eq 'classcalc') {
	&loadcourse($safeeval,$r);
    } elsif ($stype eq 'studentcalc') {
        &loadstudent($safeeval);
    } else {
        &loadassessment($safeeval);
    }
}

# ======================================================= Forced recalculation?

sub checkthis {
    my ($keyname,$time)=@_;
    return ($time<$expiredates{$keyname});
}
sub forcedrecalc {
    my ($uname,$udom,$stype,$usymb)=@_;
    my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
    my $time=$oldsheets{$key.'.time'};
    if ($ENV{'form.forcerecalc'}) { return 1; }
    unless ($time) { return 1; }
    if ($stype eq 'assesscalc') {
        my $map=(split(/\_\_\_/,$usymb))[0];
        if (&checkthis('::assesscalc:',$time) ||
            &checkthis('::assesscalc:'.$map,$time) ||
            &checkthis('::assesscalc:'.$usymb,$time) ||
            &checkthis($uname.':'.$udom.':assesscalc:',$time) ||
            &checkthis($uname.':'.$udom.':assesscalc:'.$map,$time) ||
            &checkthis($uname.':'.$udom.':assesscalc:'.$usymb,$time)) {
            return 1;
        } 
    } else {
        if (&checkthis('::studentcalc:',$time) || 
            &checkthis($uname.':'.$udom.':studentcalc:',$time)) {
	    return 1;
        }
    }
    return 0; 
}

# ============================================================== Export handler
#
# Non-interactive call from with program
#

sub exportsheet {
 my ($uname,$udom,$stype,$usymb,$fn)=@_;
 my @exportarr=();

 if (($usymb=~/^\_(\w+)/) && (!$fn)) {
    $fn='default_'.$1;
 }

#
# Check if cached
#

 my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
 my $found='';

 if ($oldsheets{$key}) {
     foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) {
         my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
         if ($name eq $fn) {
	     $found=$value;
         }
     }
 }

 unless ($found) {
     &cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom));
     if ($oldsheets{$key}) {
	foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) {
            my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
            if ($name eq $fn) {
	        $found=$value;
            }
        } 
     }
 }
#
# Check if still valid
#
 if ($found) {
     if (&forcedrecalc($uname,$udom,$stype,$usymb)) {
	 $found='';
     }
 }
 
 if ($found) {
#
# Return what was cached
#
     @exportarr=split(/\_\_\_\;\_\_\_/,$found);

 } else {
#
# Not cached
#        

    my $thissheet=&makenewsheet($uname,$udom,$stype,$usymb);
    &readsheet($thissheet,$fn);
    &updatesheet($thissheet);
    &loadrows($thissheet);
    &calcsheet($thissheet); 
    @exportarr=&exportdata($thissheet);
#
# Store now
#
    my $cid=$ENV{'request.course.id'}; 
    my $current='';
    if ($stype eq 'studentcalc') {
       $current=&Apache::lonnet::reply('get:'.
                                     $ENV{'course.'.$cid.'.domain'}.':'.
                                     $ENV{'course.'.$cid.'.num'}.
				     ':nohist_calculatedsheets:'.
                                     &Apache::lonnet::escape($key),
                                     $ENV{'course.'.$cid.'.home'});
    } else {
       $current=&Apache::lonnet::reply('get:'.
                                     &getudom($thissheet).':'.
                                     &getuname($thissheet).
				     ':nohist_calculatedsheets_'.
                                     $ENV{'request.course.id'}.':'.
                                     &Apache::lonnet::escape($key),
                                     &getuhome($thissheet));

    }
    my %currentlystored=();
    unless ($current=~/^error\:/) {
       foreach (split(/\_\_\_\&\_\_\_/,&Apache::lonnet::unescape($current))) {
           my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
           $currentlystored{$name}=$value;
       }
    }
    $currentlystored{$fn}=join('___;___',@exportarr);

    my $newstore='';
    foreach (keys(%currentlystored)) {
        if ($newstore) { $newstore.='___&___'; }
        $newstore.=$_.'___=___'.$currentlystored{$_};
    }
    my $now=time;
    if ($stype eq 'studentcalc') {
       &Apache::lonnet::reply('put:'.
                         $ENV{'course.'.$cid.'.domain'}.':'.
                         $ENV{'course.'.$cid.'.num'}.
			 ':nohist_calculatedsheets:'.
                         &Apache::lonnet::escape($key).'='.
			 &Apache::lonnet::escape($newstore).'&'.
                         &Apache::lonnet::escape($key).'.time='.$now,
                         $ENV{'course.'.$cid.'.home'});
   } else {
       &Apache::lonnet::reply('put:'.
                         &getudom($thissheet).':'.
                         &getuname($thissheet).
			 ':nohist_calculatedsheets_'.
                         $ENV{'request.course.id'}.':'.
                         &Apache::lonnet::escape($key).'='.
			 &Apache::lonnet::escape($newstore).'&'.
                         &Apache::lonnet::escape($key).'.time='.$now,
                         &getuhome($thissheet));
   }
 }
 return @exportarr;
}
# ============================================================ Expiration Dates
#
# Load previously cached student spreadsheets for this course
#

sub expirationdates {
    undef %expiredates;
    my $cid=$ENV{'request.course.id'};
    my $reply=&Apache::lonnet::reply('dump:'.
				     $ENV{'course.'.$cid.'.domain'}.':'.
                                     $ENV{'course.'.$cid.'.num'}.
				     ':nohist_expirationdates',
                                     $ENV{'course.'.$cid.'.home'});
    unless ($reply=~/^error\:/) {
	foreach (split(/\&/,$reply)) {
            my ($name,$value)=split(/\=/,$_);
            $expiredates{&Apache::lonnet::unescape($name)}
                        =&Apache::lonnet::unescape($value);
        }
    }
}

# ===================================================== Calculated sheets cache
#
# Load previously cached student spreadsheets for this course
#

sub cachedcsheets {
    my $cid=$ENV{'request.course.id'};
    my $reply=&Apache::lonnet::reply('dump:'.
				     $ENV{'course.'.$cid.'.domain'}.':'.
                                     $ENV{'course.'.$cid.'.num'}.
				     ':nohist_calculatedsheets',
                                     $ENV{'course.'.$cid.'.home'});
    unless ($reply=~/^error\:/) {
	foreach ( split(/\&/,$reply)) {
            my ($name,$value)=split(/\=/,$_);
            $oldsheets{&Apache::lonnet::unescape($name)}
                      =&Apache::lonnet::unescape($value);
        }
    }
}

# ===================================================== Calculated sheets cache
#
# Load previously cached assessment spreadsheets for this student
#

sub cachedssheets {
  my ($sname,$sdom,$shome)=@_;
  unless (($loadedcaches{$sname.'_'.$sdom}) || ($shome eq 'no_host')) {
    my $cid=$ENV{'request.course.id'};
    my $reply=&Apache::lonnet::reply('dump:'.$sdom.':'.$sname.
			             ':nohist_calculatedsheets_'.
                                      $ENV{'request.course.id'},
                                     $shome);
    unless ($reply=~/^error\:/) {
	foreach ( split(/\&/,$reply)) {
            my ($name,$value)=split(/\=/,$_);
            $oldsheets{&Apache::lonnet::unescape($name)}
                      =&Apache::lonnet::unescape($value);
        }
    }
    $loadedcaches{$sname.'_'.$sdom}=1;
  }
}

# ===================================================== Calculated sheets cache
#
# Load previously cached assessment spreadsheets for this student
#

# ================================================================ Main handler
#
# Interactive call to screen
#
#


sub handler {
    my $r=shift;

    if ($r->header_only) {
      $r->content_type('text/html');
      $r->send_http_header;
      return OK;
    }

# ---------------------------------------------------- Global directory configs

$includedir=$r->dir_config('lonIncludes');
$tmpdir=$r->dir_config('lonDaemons').'/tmp/';

# ----------------------------------------------------- Needs to be in a course

  if ($ENV{'request.course.fn'}) { 

# --------------------------- Get query string for limited number of parameters

    foreach (split(/&/,$ENV{'QUERY_STRING'})) {
       my ($name, $value) = split(/=/,$_);
       $value =~ tr/+/ /;
       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
       if (($name eq 'uname') || ($name eq 'udom') || 
           ($name eq 'usymb') || ($name eq 'ufn')) {
           unless ($ENV{'form.'.$name}) {
              $ENV{'form.'.$name}=$value;
	   }
       }
    }

    if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) {
	$ENV{'form.ufn'}='default_'.$1;
    }

# -------------------------------------- Interactive loading of specific sheet?
    if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) {
	$ENV{'form.ufn'}=$ENV{'form.loadthissheet'};
    }
# ------------------------------------------- Nothing there? Must be login user

    my $aname;
    my $adom;

    unless ($ENV{'form.uname'}) {
	$aname=$ENV{'user.name'};
        $adom=$ENV{'user.domain'};
    } else {
        $aname=$ENV{'form.uname'};
        $adom=$ENV{'form.udom'};
    }

# ------------------------------------------------------------------- Open page

    $r->content_type('text/html');
    $r->header_out('Cache-control','no-cache');
    $r->header_out('Pragma','no-cache');
    $r->send_http_header;

# --------------------------------------------------------------- Screen output

    $r->print('<html><head><title>LON-CAPA Spreadsheet</title>');
    $r->print(<<ENDSCRIPT);
<script language="JavaScript">

    function celledit(cn,cf) {
        var cnf=prompt(cn,cf);
	if (cnf!=null) {
	    document.sheet.unewfield.value=cn;
            document.sheet.unewformula.value=cnf;
            document.sheet.submit();
        }
    }

    function changesheet(cn) {
	document.sheet.unewfield.value=cn;
        document.sheet.unewformula.value='changesheet';
        document.sheet.submit();
    }

</script>
ENDSCRIPT
    $r->print('</head><body bgcolor="#FFFFFF">'.
       '<img align=right src=/adm/lonIcons/lonlogos.gif>'.
       '<h1>LON-CAPA Spreadsheet</h1>'.
       '<form action="'.$r->uri.'" name=sheet method=post>'.
       &hiddenfield('uname',$ENV{'form.uname'}).
       &hiddenfield('udom',$ENV{'form.udom'}).
       &hiddenfield('usymb',$ENV{'form.usymb'}).
       &hiddenfield('unewfield','').
       &hiddenfield('unewformula',''));

# ---------------------- Make sure that this gets out, even if user hits "stop"

    $r->rflush();

# ---------------------------------------------------------------- Full recalc?


    if ($ENV{'form.forcerecalc'}) {
	$r->print('<h4>Completely Recalculating Sheet ...</h4>');
        undef %spreadsheets;
        undef %courserdatas;
        undef %userrdatas;
        undef %defaultsheets;
        undef %updatedata;
   }
 
# ---------------------------------------- Read new sheet or modified worksheet

    $r->uri=~/\/(\w+)$/;

    my $asheet=&makenewsheet($aname,$adom,$1,$ENV{'form.usymb'});

# ------------------------ If a new formula had been entered, go from work copy

    if ($ENV{'form.unewfield'}) {
        $r->print('<h2>Modified Workcopy</h2>');
        $ENV{'form.unewformula'}=~s/\'/\"/g;
        $r->print('<p>New formula: '.$ENV{'form.unewfield'}.'='.
                  $ENV{'form.unewformula'}.'<p>');
        &setfilename($asheet,$ENV{'form.ufn'});
	&tmpread($asheet,
                 $ENV{'form.unewfield'},$ENV{'form.unewformula'});

     } elsif ($ENV{'form.saveas'}) {
        &setfilename($asheet,$ENV{'form.ufn'});
	&tmpread($asheet);
    } else {
        &readsheet($asheet,$ENV{'form.ufn'});
    }

# -------------------------------------------------- Print out user information

    unless (&gettype($asheet) eq 'classcalc') {
        $r->print('<p><b>User:</b> '.&getuname($asheet).
                  '<br><b>Domain:</b> '.&getudom($asheet));
        if (&getcsec($asheet) eq '-1') {
           $r->print('<h3><font color=red>'.
                     'Not a student in this course</font></h3>');
        } else {
           $r->print('<br><b>Section/Group:</b> '.&getcsec($asheet));
        }
        if ($ENV{'form.usymb'}) {
           $r->print('<br><b>Assessment:</b> <tt>'.$ENV{'form.usymb'}.'</tt>');
        }
    }

# ---------------------------------------------------------------- Course title

    $r->print('<h1>'.
            $ENV{'course.'.$ENV{'request.course.id'}.'.description'}.
             '</h1><h3>'.localtime().'</h3>');

# ---------------------------------------------------- See if user can see this

    if ((&gettype($asheet) eq 'classcalc') || 
        (&getuname($asheet) ne $ENV{'user.name'}) ||
        (&getudom($asheet) ne $ENV{'user.domain'})) {
        unless (&Apache::lonnet::allowed('vgr',&getcid($asheet))) {
	    $r->print(
           '<h1>Access Permission Denied</h1></form></body></html>');
            return OK;
        }
    }

# ---------------------------------------------------------- Additional options

    $r->print(
 '<input type=submit name=forcerecalc value="Completely Recalculate Sheet"><p>'
		 );
    if (&gettype($asheet) eq 'assesscalc') {
       $r->print ('<p><font size=+2><a href="/adm/studentcalc?uname='.
                                               &getuname($asheet).
                                               '&udom='.&getudom($asheet).
                  '">Level up: Student Sheet</a></font><p>');
    }
    
    if ((&gettype($asheet) eq 'studentcalc') && 
        (&Apache::lonnet::allowed('vgr',&getcid($asheet)))) {
       $r->print (
                   '<p><font size=+2><a href="/adm/classcalc">'.
                   'Level up: Course Sheet</a></font><p>');
    }
    

# ----------------------------------------------------------------- Save dialog


    if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
        my $fname=$ENV{'form.ufn'};
        $fname=~s/\_[^\_]+$//;
        if ($fname eq 'default') { $fname='course_default'; }
        $r->print('<input type=submit name=saveas value="Save as ...">'.
              '<input type=text size=20 name=newfn value="'.$fname.
              '"> (make default: <input type=checkbox name="makedefufn">)<p>');
    }

    $r->print(&hiddenfield('ufn',&getfilename($asheet)));

# ----------------------------------------------------------------- Load dialog
    if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
	$r->print('<p><input type=submit name=load value="Load ...">'.
                  '<select name="loadthissheet">'.
                  '<option name="default">Default</option>');
        foreach (&othersheets($asheet,&gettype($asheet))) {
	    $r->print('<option name="'.$_.'"');
            if ($ENV{'form.ufn'} eq $_) {
               $r->print(' selected');
            }
            $r->print('>'.$_.'</option>');
        } 
        $r->print('</select><p>');
        if (&gettype($asheet) eq 'studentcalc') {
	    &setothersheets($asheet,&othersheets($asheet,'assesscalc'));
        }
    }

# --------------------------------------------------------------- Cached sheets

    &expirationdates();

    undef %oldsheets;
    undef %loadedcaches;

    if (&gettype($asheet) eq 'classcalc') {
        $r->print("Loading previously calculated student sheets ...<br>\n");
        $r->rflush();
        &cachedcsheets();
    } elsif (&gettype($asheet) eq 'studentcalc') {
        $r->print("Loading previously calculated assessment sheets ...<br>\n");
        $r->rflush();
        &cachedssheets(&getuname($asheet),&getudom($asheet),
                       &getuhome($asheet));
    }

# ----------------------------------------------------- Update sheet, load rows

    $r->print("Loaded sheet(s), updating rows ...<br>\n");
    $r->rflush();

    &updatesheet($asheet);

    $r->print("Updated rows, loading row data ...<br>\n");
    $r->rflush();

    &loadrows($asheet,$r);

    $r->print("Loaded row data, calculating sheet ...<br>\n");
    $r->rflush();

    my $calcoutput=&calcsheet($asheet);
    $r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');

# ---------------------------------------------------- See if something to save

    if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
        my $fname='';
	if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) {
            $fname=~s/\W/\_/g;
            if ($fname eq 'default') { $fname='course_default'; }
            $fname.='_'.&gettype($asheet);
            &setfilename($asheet,$fname);
            $ENV{'form.ufn'}=$fname;
	    $r->print('<p>Saving spreadsheet: '.
                         &writesheet($asheet,$ENV{'form.makedefufn'}).'<p>');
	}
    }

# ------------------------------------------------ Write the modified worksheet

   $r->print('<b>Current sheet:</b> '.&getfilename($asheet).'<p>');

   &tmpwrite($asheet);

    if (&gettype($asheet) eq 'studentcalc') {
	$r->print('<br>Show rows with empty A column: ');
    } else {
        $r->print('<br>Show empty rows: ');
    } 

    $r->print(&hiddenfield('userselhidden','true').
             '<input type=checkbox name=showall onClick="submit()"');

    if ($ENV{'form.showall'}) { 
       $r->print(' checked'); 
    } else {
	unless ($ENV{'form.userselhidden'}) {
           unless 
	($ENV{'course.'.$ENV{'request.course.id'}.'.hideemptyrows'} eq 'yes') {
          $r->print(' checked');
          $ENV{'form.showall'}=1;
           }
       }
    }
    $r->print('>');
    if (&gettype($asheet) eq 'classcalc') {
       $r->print(
   ' Output CSV format: <input type=checkbox name=showcsv onClick="submit()"');
       if ($ENV{'form.showcsv'}) { $r->print(' checked'); }
       $r->print('>');
    }
# ------------------------------------------------------------- Print out sheet

    &outsheet($r,$asheet);
    $r->print('</form></body></html>');

# ------------------------------------------------------------------------ Done
  } else {
# ----------------------------- Not in a course, or not allowed to modify parms
      $ENV{'user.error.msg'}=
        $r->uri.":opa:0:0:Cannot modify spreadsheet";
      return HTTP_NOT_ACCEPTABLE; 
  }
    return OK;

}

1;
__END__